50133 (609948), страница 5
Текст из файла (страница 5)
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)
880 End With
881End Sub
882
883Public Sub OverloadList()
884 CellList. Clear
885 For i% = 0 To DB(ERFDBIndex). Header. ColCount - 1
886 CellList. AddItem CStr(Arr(i, 0))
887 Next i
888 CellList. ListIndex = 0
889End Sub
890
891Private Sub Form_Load()
892 protect = False
893 Call ButEnabled(ReturnImg, ReturnBut, True)
894 Call ButEnabled(EditorImg, EditorBut, False)
895 Call ButEnabled(FlipImg, FlipBut, True)
896 Call ButEnabled(SelectImg, SelectBut, True)
897 Call ButEnabled(CancelImg, CancelBut, True)
898 TopImg. Picture = MainForm. TopImageList. ListImages(1). Picture
899
900' If (Not protect) Then
901' Call OverloadList
902' Else
903' protect = False
904' End If
905
906End Sub
907
908Private Sub ReturnBut_Click()
909 Call SoundClick
910 If (MsgForm. QuestMsg("Восстановить поля из БД? ") = resOk) Then
911 Call LoadData(RowIndexSave)
912 Call OverloadList
913 Call MsgForm. InfoMsg("Поля были восстановлены! ")
914 End If
915End Sub
916
917Private Sub EditorBut_Click()
918 If (EditorBut. Tag = 0) Then Exit Sub
919 Call SoundClick
920 i% = CellList. ListIndex
921 If (Arr(i, 1) = ccInteger) Then
922 Call MsgForm. InfoMsg("Для редактирования чисел редактор не исспользуется. ")
923 Exit Sub
924 End If
925 If IsDate(Text1. Text) And (MonthForm. Check1. value = 0) Then
926 s$ = Text1. Text
927 p% = InStr(1, s, ". ")
928 MonthForm. MonthView1. Day = CInt(Left(s, p - 1))
929 s = Mid(s, p + 1)
930 p% = InStr(1, s, ". ")
931 MonthForm. MonthView1. Month = CInt(Left(s, p - 1))
932 s = Mid(s, p + 1)
933 MonthForm. MonthView1. Year = CInt(s)
934
935 MonthForm. Show vbModal
936 Select Case MonthForm. res
937 Case 1
938 Text1. Text = CStr(MonthForm. MonthView1. Day) + ". " + CStr(MonthForm. MonthView1. Month) + ". " + CStr(MonthForm. MonthView1. Year)
939 Case - 1
940 GoTo text_
941 End Select
942 Else
943text_:
944 With TextEditForm
945. TextEdit. Text = Text1. Text
946 protect = True
947. Show vbModal
948 If (. res = 1) Then Text1. Text =. TextEdit. Text
949 Unload TextEditForm
950 End With
951 End If
952End Sub
953
954Private Sub SelectBut_Click()
955Call SoundClick
956If UserIsAdmin Then
957 If (MsgForm. QuestMsg("Сохранить поля в БД? ") = resOk) Then
958 With DB(ERFDBIndex)
959 Dim tmparr()
960 ReDim tmparr(. Header. ColCount)
961 For i% = 0 To. Header. ColCount - 1
962 tmparr(i) = Arr(i, 0)
963 Next i
964 If (Not FindRow(ERFDBIndex, tmparr)) Then
965 For i% = 0 To. Header. ColCount - 1
966. Rows(RowIndexSave). Fields(i) = Arr(i, 0)
967 Next i
968 DBChanged = True
969 Call MsgForm. InfoMsg("Поля были сохранены в БД! ")
970 Call ShowTable(ERFDBIndex)
971 Unload Me
972 Else
973 Call MsgForm. ErrorMsg("Изменённое поле перекрывает уже существующее! Измените данные. ")
974 End If
975 End With
976 End If
977Else
978 Call ProtectedMsg
979End If
980End Sub
981
982Private Sub CancelBut_Click()
983 Call SoundClick
984 Unload Me
985End Sub
986
987' Посимвольное сравнение str с '2147483647' - максимальным значением Long
988Function isVeryLong(str$) As Boolean
989 If (Left(str, 1) = "-") Then str = Mid(str, 2)
990 For i% = 1 To (10 - Len(str))
991 str = "0" + str
992 Next i
993
994 maxval$ = "2147483647"
995 For i% = 1 To 10
996 ch1$ = Mid(maxval, i, 1)
997 ch2$ = Mid(str, i, 1)
998 If (Asc(ch2) > Asc(ch1)) Then
999 isVeryLong = True
1000 GoTo exit_
1001 ElseIf (ch2 <> ch1) Then
1002 isVeryLong = False
1003 GoTo exit_
1004 End If
1005 Next i
1006 isVeryLong = False
1007exit_:
1008End Function
1009
1010Private Sub FlipBut_Click()
1011Call SoundClick
1012If UserIsAdmin Then
1013 tmp = Null
1014 i% = CellList. ListIndex
1015 mln% = 10
1016 If (Left(Text1. Text, 1) = "-") Then mln = mln + 1
1017 If (Arr(i, 1) = ccInteger) Then
1018 If (Len(Trim(Text1. Text)) > mln) Or (isVeryLong(Trim(Text1. Text))) Then
1019 Call MsgForm. ErrorMsg("Числовое значение превышает разрядную сетку! ")
1020 With Text1
1021. SelStart = 0
1022. SelLength = Len(. Text)
1023 End With
1024 GoTo exit_
1025 End If
1026
1027 If IsInteger(Trim(Text1. Text)) Then
1028 tmp = CLng(Text1. Text)
1029 Else
1030 Call MsgForm. ErrorMsg("Значение не является целым числом! ")
1031 With Text1
1032. SelStart = 0
1033. SelLength = Len(. Text)
1034 End With
1035 End If
1036 Else
1037 If (Trim(Text1. Text) = "") Then
1038 If (MsgForm. QuestMsg("Строка пуста. Продолжить? ") = resOk) Then
1039 tmp = Text1. Text
1040 GoTo exit_
1041 Else
1042 With Text1
1043. SelStart = 0
1044. SelLength = Len(. Text)
1045 End With
1046 End If
1047 Else
1048 tmp = Text1. Text
1049 End If
1050 End If
1051
1052 ' Введёное значение прошло контроль
1053 If (Not IsNull(tmp)) Then
1054 Select Case Arr(i, 1)
1055 Case ccInteger: Arr(i, 0) = CLng(tmp)
1056 Case ccString: Arr(i, 0) = CStr(tmp)
1057 End Select
1058 curpos% = CellList. ListIndex
1059 Call OverloadList
1060 CellList. ListIndex = curpos
1061 End If
1062exit_:
1063Else
1064 Call ProtectedMsg
1065End If
1066End Sub
1067
1068Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
1069 If (KeyCode = 13) Then FlipBut_Click
1070End Sub
Форма: MsgForm. frm
1071Dim res As Byte
1072
1073Public Function ErrorMsg(str$) As Integer
1074 Caption = "Ошибка"
1075 Text = str
1076
1077 YesFrame. Visible = True
1078 NoFrame. Visible = False
1079 CancelFrame. Visible = False
1080
1081 InfoImage. Visible = False
1082 ErrImage. Visible = True
1083 QuestImage. Visible = False
1084
1085 YesFrame. Move 2400
1086 res = resBad
1087 Call sndPlaySound("Data\Error. wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1088 Show vbModal
1089 ErrorMsg = res
1090 Unload Me
1091End Function
1092
1093Public Function InfoMsg(str$) As Integer
1094 Caption = "Информация"
1095 Text = str
1096
1097 YesFrame. Visible = True
1098 NoFrame. Visible = False
1099 CancelFrame. Visible = False
1100
1101 InfoImage. Visible = True
1102 ErrImage. Visible = False
1103 QuestImage. Visible = False
1104
1105 YesFrame. Move 2400
1106
1107 res = 0