396 If (DBCurIndex <> TabStrip. SelectedItem. Index - 1) Then
397 DBCurIndex = TabStrip. SelectedItem. Index - 1
398 Call ShowTable(DBCurIndex)
399End If
400End Sub
401
402Private Sub TabStrip_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
403 If (Shift = vbCtrlMask) Then PopupMenu TSMenu
404End Sub
405
406Private Sub TSClose_Click()
407 If (MsgForm. QuestMsg("Закрытьзакладку? ") = resOk) Then
408 TabIndex% = TabStrip. SelectedItem. Index
409 TabStrip. Tabs. Remove (TabIndex)
410 Call DelTable(TabIndex - 1)
411
412 If (TabStrip. Tabs. Count = 0) Then
413 DBChanged = False
414 Call DisEnImage(2, 1)
415 Call DisEnImage(3, 1)
416 Call DisEnImage(4, 1)
417 Call ShowTable(-1)
418 Else
419 TabStrip. SelectedItem = TabStrip. Tabs. Item(1)
420 End If
421 End If
422End Sub
Форма: TableForm. frm
423Dim tmp As String
424
425Public Function AddColDlg(DBIndex%) As String
426 tmp = ""
427 With StCol
428. Clear
429 For i% = 1 To DB(DBIndex). Header. ColCount
430. AddItem DB(DBIndex). Cols(i - 1). title
431 Next
432. ListIndex =. ListCount - 1
433 End With
434 ColType. ListIndex = 0
435 Me. Show vbModal
436 AddColDlg = tmp
437 Unload Me
438End Function
439
440Private Sub ColType_Click()
441 ' изменение допустимых длин
442 If Visible Then
443 Select Case ColType. ListIndex
444 Case ccInteger: InitValue. MaxLength = 4
445 Case ccString: InitValue. MaxLength = 255
446 End Select
447 End If
448
449' контрольввода
450 If Visible And (ColType. ListIndex = ccInteger) Then
451 If (Not IsInteger(InitValue. Text)) Then InitValue. Text = "0"
452 End If
453End Sub
454
455Private Sub CreateBut_Click()
456 Call SoundClick
457 s1$ = Trim(ColTitle. Text)
458 Do While (s1 = "")
459 s1 = Trim(InputForm. InputVal("Вы не ввели заголовок столбца. Повторитеввод. "))
460 Loop
461 tmp$ = s1 + ", "
462 Dim ct
463 Dim s2
464 Select Case ColType. ListIndex
465 Case ccInteger
466 t$ = Trim(InitValue. Text)
467 If (Not IsInteger(t)) Then
468 CallMsgForm. InfoMsg("Введённое значение не является целым числом. Преобразованок '0'. ")
469 t = "0"
470 End If
471 tmp = tmp + " " + sI + ", " + t
472 Case ccString
473 t$ = Trim(InitValue. Text)
474 If (t = "") Then t = " "
475 tmp = tmp + " " + sS + ", " + t
476 End Select
477 Dim pos%
478 If (OnlyEndCheck. value = 1) Then
479 pos = - 1
480 Else
481 pos = StCol. ListIndex
482 If (Option2. value = True) Then pos = pos + 1
483 End If
484 tmp = tmp + ", " + CStr(pos)
485 Hide
486End Sub
487
488Private Sub CancelBut_Click()
489 Call SoundClick
490 Hide
491End Sub
492
493Private Sub Form_Load()
494 Call ButEnabled(CreateImg, CreateBut, True)
495 Call ButEnabled(CancelImg, CancelBut, True)
496End Sub
Форма: TextEditForm. frm
497Public res%
498Dim dW%, dH%
499
500Private Sub Form_Activate()
501 With TextEdit
502. SelStart = Len(. Text)
503 End With
504End Sub
505
506Private Sub Form_Load()
507 res = 0
508 dW = Width - TextEdit. Width
509 dH = Height - TextEdit. Height
510End Sub
511
512Private Sub Form_Resize()
513 Min% = Height - dH
514 If (Min <= 1000) Then: Min = 1000: Height = dH + Min
515 TextEdit. Height = Min
516
517 Min = Width - dW
518 If (Min <= 1000) Then: Min = 1000: Width = dW + Min
519 TextEdit. Width = Min
520End Sub
521
522Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib. Button)
523 On Error Resume Next
524 Select Case Button. Key
525 Case "ClearText"
526 TextEdit. TextRTF = ""
527 Case "SaveText"
528 res = 1
529 Hide
530 Case "CopyText"
531 Clipboard. SetText (TextEdit. SelText)
532 Case "PasteText"
533 TextEdit. SelText = VB. Clipboard. GetText
534 Case "CutText"
535 Clipboard. SetText (TextEdit. SelText)
536 TextEdit. SelText = ""
537 Case "DeleteText"
538 TextEdit. SelText = ""
539 Case "Properties"
540 On Error GoTo checkerror
541 FontDlg. ShowFont
542 TextEdit. Font. Name = FontDlg. FontName
543 TextEdit. Font. Bold = FontDlg. FontBold
544 TextEdit. Font. Italic = FontDlg. FontItalic
545 TextEdit. Font. Size = FontDlg. FontSize
546 TextEdit. Font. Strikethrough = FontDlg. FontStrikethru
547 TextEdit. Font. Underline = FontDlg. FontUnderline
548 Exit Sub
549checkerror:
550 MsgBox "error"
551 End Select
552End Sub
553
Форма: SelectForm. frm
554Dim tmp%, tmps$
555
556Public Function SelectDlg(DBIndex%, ByVal title$, ByVal what$) As Integer
557 Dim s$
558 List1. Visible = True
559 List2. Visible = False
560 List1. Clear
561 Select Case what
562 Case sRow ' *******************...::: Select Row:::... ********************
563 With MainForm. ListView. ListItems
564 For i% = 1 To. Count
565 s = CStr(i - 1) + ")" +. Item(i)
566 For j% = 1 To DB(DBIndex). Header. ColCount - 1
567 s = s + " - " +. Item(i). SubItems(j)
568 Next j
569 List1. AddItem s
570 Next i
571 End With
572
573 Case sCol ' *******************...::: Select Col:::... ********************
574 With MainForm. ListView. ColumnHeaders
575 For i% = 1 To. Count
576 List1. AddItem CStr(i - 1) + ")" +. Item(i)
577 Next i
578 End With
579
580 Case sTable ' *******************...::: Select Table:::... ********************
581 For i% = 0 To (MainForm. TabStrip. Tabs. Count - 1)
582 List1. AddItem CStr(i) + ")" + MainForm. TabStrip. Tabs. Item(i + 1)
583 Next i
584 End Select
585
586 If (List1. ListCount > 0) Then
587 List1. ListIndex = 0
588 Call ButEnabled(SelectImg, SelectBut, True)
589 Else
590 Call ButEnabled(SelectImg, SelectBut, False)
591 End If
592 Label1. Caption = title
593 tmp = - 1
594 Show vbModal
595 SelectDlg = CStr(tmp)
596End Function
597
598Public Function MultiSelectDlg(DBIndex%, ByVal title$, ByVal what$) As String
599 Dim s$
600 List2. Visible = True
601 List1. Visible = False
602 List2. Clear
603 CheckConfirm. Visible = False
604 If (what = sRow) Then
605 With MainForm. ListView. ListItems
606 For i% = 1 To. Count
607 s = CStr(i - 1) + ")" +. Item(i)
608 For j% = 1 To DB(DBIndex). Header. ColCount - 1
609 s = s + " - " +. Item(i). SubItems(j)
610 Next j
611 List2. AddItem s
612 Next i
613 End With
614 Else
615 With MainForm. ListView. ColumnHeaders
616 For i% = 1 To. Count
617 List2. AddItem CStr(i - 1) + ")" +. Item(i)
618 Next i
619 End With
620 End If
621 Call ButEnabled(SelectImg, SelectBut, False)
622 Label1. Caption = title
623 tmps = ""
624 Show vbModal
625 CheckConfirm. Visible = True
626 MultiSelectDlg = tmps
627End Function
628
629Private Sub Form_Activate()
630 Call ButEnabled(CancelImg, CancelBut, True)
631End Sub
632
633Private Sub SelectBut_Click()
634 If (SelectBut. Tag = 0) Then Exit Sub
635 If (List1. Visible) Then
636 tmp = List1. ListIndex
637 Else
638 For i = 0 To List2. ListCount - 1
639 If List2. Selected(i) Then tmps = tmps + CStr(i) + ","
640 Next i
641 tmps = Strings. Left$(tmps, Len(tmps) - 1)
642 End If
643 Hide
644End Sub
645
646Private Sub CancelBut_Click()
647 Hide
648End Sub
649
650Private Sub List1_Click()
651 Call ButEnabled(SelectImg, SelectBut, (List1. ListIndex <> - 1))
652End Sub
653
654Private Sub List2_Click()
655 Call ButEnabled(SelectImg, SelectBut, (List2. SelCount = 2))
656End Sub
Форма: QueryMasterForm. frm
657Public QMFDBIndex%
658
659Sub AddStr(str$)
660 If (str <> "") Then
661 QueryList. AddItem str
662 Else
663 Call MsgForm. ErrorMsg("Запросотменен! ")
664 End If
665End Sub
666
667Private Sub AddImage_Click()
668Call SoundClick
669With QueryList
670 Select Case QueryTypeCombo. ListIndex
671 '******************* Добавление ***********************
672 Case 0
673 Select Case QuerySubtypeCombo. ListIndex
674 Case 0 ' добавлениестолбца
675 Call AddStr(Generate_Add(sCol))
676 Case 1 ' добавлениезаписи
677 Call AddStr(Generate_Add(sRow))
678 End Select
679 '******************* Удаление***********************
680 Case 1
681 Select Case QuerySubtypeCombo. ListIndex
682 Case 0 ' удалениестолбца
683 Call AddStr(Generate_Del(sCol))
684 Case 1 ' удалениезаписи
685 Call AddStr(Generate_Del(sRow))
686 End Select
687
688 '******************* Сортировка ***********************
689 Case 2
690 Select Case QuerySubtypeCombo. ListIndex
691 Case 0 ' сортировкапоалфавиту
692 Call AddStr(Generate_Sort(sAZ))
693 Case 1 ' сортировкапротивалфавита
694 Call AddStr(Generate_Sort(sZA))
695 End Select
696
697 '******************* Вывод***********************
698 Case 3
699 Select Case QuerySubtypeCombo. ListIndex
700 Case 0 ' выводнаравенствозаписи
701 Call AddStr(Generate_Out(sEqual))
702 Case 1 ' выводбольшезаписи
703 Call AddStr(Generate_Out(sAbove))
704 Case 2 ' выводменьшезаписи
705 Call AddStr(Generate_Out(sBelow))
706 Case 3 ' вывод на равенство кол-ву
707 Call AddStr(Generate_Out(sCountEqual))
708 Case 4 ' вывод больше кол-ва
709 Call AddStr(Generate_Out(sCountAbove))
710 Case 5 ' вывод меньше кол-ва
711 Call AddStr(Generate_Out(sCountBelow))
712 End Select
713
714 '******************* Обмен***********************
715 Case 4
716 Select Case QuerySubtypeCombo. ListIndex
717 Case 0 ' обменстолбцов
718 Call AddStr(Generate_Swap(sCol))
719 Case 1 ' обменстрок
720 Call AddStr(Generate_Swap(sRow))
721 End Select
722
723 '******************* Смена***********************
724 Case 5
725 Select Case QuerySubtypeCombo. ListIndex
726 Case 0 ' сменатипаполя
727 Call AddStr(Generate_Change(sType))
728 Case 1 ' сменаназванияполя
729 Call AddStr(Generate_Change(sName))
730 End Select
731 End Select
732
733End With
734End Sub
735
736Private Sub CancelBut_Click()
737 Call SoundClick
738 If (QueryList. ListCount > 0) Then
739 If (MsgForm. QuestMsg("Список запросов не пуст. Выйти? ") = resOk) Then Unload Me
740 Else
741 Unload Me
742 End If
743End Sub
744
745' заменазапроса
746Private Sub ChangeImage_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
747 If (Trim(Text1) <> "") Then
748 Call SoundClick
749 With QueryList
750 If (. ListIndex = - 1) Or (Shift And vbShiftMask <> 0) Then
751. AddItem Text1
752 Else
753. List(. ListIndex) = Text1
754 End If
755 End With
756 End If
757 Text1 = ""
758 Text1. SetFocus
759End Sub
760
761' очистказапросов
762Private Sub ClearImage_Click()
763 If (QueryList. ListCount > 0) Then
764 Call SoundClick
765 If (MsgForm. QuestMsg("Очистить список запросов? ") = resOk) Then
766 QueryList. Clear
767 Text1 = ""
768 Text1. SetFocus
769 End If
770 End If
771End Sub
772
773' удалениезапроса
774Private Sub DelImage_Click()
775 If (QueryList. ListIndex >= 0) Then
776 Call SoundClick
777 If (MsgForm. QuestMsg("Удалить выбранный запрос из списка? ") = resOk) Then
778 QueryList. RemoveItem QueryList. ListIndex
779 Text1 = ""
780 Text1. SetFocus
781 End If
782 End If
783End Sub
784
785Private Sub Form_Load()
786 QueryTypeCombo. ListIndex = 0
787 Call ButEnabled(RunImg, RunBut, True)
788 Call ButEnabled(CancelImg, CancelBut, True)
789 TopImg. Picture = MainForm. TopImageList. ListImages(1). Picture
790End Sub
791
792Private Sub QueryList_DblClick()
793 With QueryList
794 If (. ListIndex <> - 1) Then
795 Text1 =. List(. ListIndex)
796 Text1. SetFocus
797 End If
798 End With
799End Sub
800
801Private Sub QueryTypeCombo_Click()
802 With QuerySubtypeCombo
803. Clear
804 Select Case QueryTypeCombo. ListIndex
805 Case 0
806. AddItem "Поля"
807. AddItem "Записи"
808 Case 1
809. AddItem "Поля"
810. AddItem "Записи"
811 Case 2
812. AddItem "Поалфавиту"
813. AddItem "Противалфавита"
814 Case 3
815. AddItem "Равно записи"
816. AddItem "Больше записи"
817. AddItem "Меньше записи"
818. AddItem "Равно кол-ву копий"
819. AddItem "Больше кол-ва копий"
820. AddItem "Меньше кол-ва копий"
821 Case 4
822. AddItem "Полей"
823. AddItem "Записей"
824 Case 5
825. AddItem "Типаполя"
826. AddItem "Названияполя"
827 End Select
828. ListIndex = 0
829 End With
830End Sub
831
832Private Sub RunBut_Click()
833 If (QueryList. ListCount > 0) Then
834 Call SoundClick
835 For i% = 0 To QueryList. ListCount - 1
836 Call RunQuery(QMFDBIndex, QueryList. List(i))
837 Next i
838 With MainForm
839. TabStrip. SelectedItem =. TabStrip. Tabs(QMFDBIndex + 1)
840 Call ShowTable(QMFDBIndex)
841 End With
842 QueryList. Clear
843 Call MsgForm. InfoMsg("Запросывыполнены. ")
844 End If
845End Sub
846
847Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
848 If (KeyCode = 13) Then Call ChangeImage_MouseDown(vbLeftButton, Shift, 1, 1)
849End Sub
Форма: EditRecordForm. frm
850Public ERFDBIndex%
851Dim RowIndexSave%
852Dim protect As Boolean
853Dim Arr()
854
855Public Sub LoadData(RowIndex%)
856 RowIndexSave = RowIndex
857 With DB(ERFDBIndex). Header
858 ReDim Arr(. ColCount, 1)
859 For i% = 0 To. ColCount - 1
860 Arr(i, 0) = DB(ERFDBIndex). Rows(RowIndex). Fields(i)
861 Arr(i, 1) = DB(ERFDBIndex). Cols(i). Class
862 Next i
863 End With
864End Sub
865
866Private Sub CellList_Click()
867 i% = CellList. ListIndex
868 Select Case Arr(i, 1)
869 Case ccInteger
870 Label6. Caption = "Полечисловоготипа"
871 Call ButEnabled(EditorImg, EditorBut, False)
872 Case ccString
873 Label6. Caption = "Полестроковоготипа"
874 Call ButEnabled(EditorImg, EditorBut, True)
875 End Select
876 With Text1
877. Text = CStr(Arr(i, 0))
878. SelStart = 0
879. SelLength = Len(. Text)