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 CallMsgForm. 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 (NotIsNull(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
1108 Call sndPlaySound("Data\Info. wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1109 Show vbModal
1110 InfoMsg = res
1111 Unload Me
1112End Function
1113
1114Public Function QuestMsg(str$, Optional showcancel As Boolean = False) As Integer
1115 Caption = "Вопрос"
1116 Text = str
1117
1118 If showcancel Then
1119 YesFrame. Visible = True
1120 NoFrame. Visible = True
1121 CancelFrame. Visible = True
1122
1123 YesFrame. Move 360
1124 NoFrame. Move 4380
1125 CancelFrame. Move 2400
1126
1127 Else
1128 YesFrame. Visible = True
1129 NoFrame. Visible = True
1130 CancelFrame. Visible = False
1131
1132 YesFrame. Move 900
1133 NoFrame. Move 3840
1134 End If
1135
1136 InfoImage. Visible = False
1137 ErrImage. Visible = False
1138 QuestImage. Visible = True
1139
1140 res = 0
1141 Call sndPlaySound("Data\Quest. wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)
1142 Show vbModal
1143 QuestMsg = res
1144 Unload Me
1145End Function
1146
1147Private Sub CancelBut_Click()
1148 res = resCancel
1149 Call SoundClick
1150 Hide
1151End Sub
1152
1153Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
1154 Select Case KeyCode
1155 Case 13
1156 Call YesBut_Click
1157 Case 27
1158 Call NoBut_Click
1159 Case 8
1160 If (CancelFrame. Visible = True) Then Call CancelBut_Click
1161 End Select
1162End Sub
1163
1164Private Sub Form_Load()
1165 Call ButEnabled(YesImg, YesBut, True)
1166 Call ButEnabled(CancelImg, CancelBut, True)
1167 Call ButEnabled(NoImg, NoBut, True)
1168End Sub
1169
1170Private Sub NoBut_Click()
1171 res = resNo
1172 Call SoundClick
1173 Hide
1174End Sub
1175
1176Private Sub YesBut_Click()
1177 res = resOk
1178 Call SoundClick
1179 Hide
1180End Sub
1181
Форма: DiagMasterForm. frm
1182Dim DiagData()
1183
1184Private Sub DiagTypeCombo_Click()
1185 DiagTypeImage. Picture = DiagTypeImgs. ListImages(DiagTypeCombo. ListIndex + 1). Picture
1186 Select Case DiagTypeCombo. ListIndex
1187 Case 0, 2: Frame2. Visible = False
1188 Case 1, 3: Frame2. Visible = True
1189 End Select
1190End Sub
1191
1192Private Sub Enabled3DCheck_Click()
1193 DimImg. Picture = DiagTypeImgs. ListImages(5 + Enabled3DCheck. value). Picture
1194End Sub
1195
1196Private Sub Form_Load()
1197 Call ButEnabled(OkImg, OkBut, False)
1198 Call ButEnabled(CancelImg, CancelBut, True)
1199 TopImg. Picture = MainForm. TopImageList. ListImages(1). Picture
1200 DiagTypeCombo. ListIndex = 0
1201 DimImg. Picture = DiagTypeImgs. ListImages(5). Picture
1202
1203 TableIndexCombo. Clear
1204 SelectColList. Clear
1205 For i% = 1 To MainForm. TabStrip. Tabs. Count
1206 TableIndexCombo. AddItem MainForm. TabStrip. Tabs(i). Caption
1207 Next i
1208 TableIndexCombo. ListIndex = 0
1209End Sub
1210
1211' построке "{x, YYY} ZZZ" возвращаетномертаблицы(x)
1212Sub GetTableIndex(ByVal str As String, TI As Integer)
1213 s$ = Trim$(Mid$(str, 2, InStr(1, str, ",") - 2))
1214 TI = CInt(s)
1215End Sub
1216
1217' по строке "{x, YYY} ZZZ" и номеру таблицы возвращает номер поля с заголовком ZZZ
1218Sub GetColIndex(ByVal str As String, ByVal TI As Integer, CI As Integer)
1219 s$ = Trim$(Mid$(str, InStr(1, str, "}") + 1))
1220 For i% = 0 To DB(TI). Header. ColCount - 1
1221 If (s = Trim(DB(TI). Cols(i). title)) Then
1222 CI = i
1223 Exit Sub
1224 End If
1225 Next i
1226 CI = - 1 ' событие невозможное но вероятное
1227End Sub
1228
1229Function GettingDiagData(OnlyOneCol As Boolean) As Boolean
1230 GettingDiagData = False
1231
1232 Dim TI As Integer, CI As Integer
1233
1234 Select Case OnlyOneCol
1235 Case True ' ************************************************************************
1236 Call GetTableIndex(SelectColList. List(0), TI)
1237 Call GetColIndex(SelectColList. List(0), TI, CI)
1238 ' зная номер таблицы и номер поля данных нужно проверить тип поля
1239 If (DB(TI). Cols(CI). Class <> ccInteger) Then
1240 Call MsgForm. ErrorMsg("Нельзя строить диаграмму по нечисленным данным! ")
1241 Exit Function
1242 End If
1243 ' заполнение массива данных
1244 ReDimDiagData(2 * DB(TI). Header. RowCount)
1245 For i% = 0 To DB(TI). Header. RowCount - 1
1246 DiagData(2 * i) = DB(TI). Rows(i). Fields(CI)
1247 DiagData(2 * i + 1) = DiagData(2 * i)
1248 Next i
1249 GettingDiagData = True
1250
1251 Case False ' ************************************************************************
1252 ReDim DiagData(2 * SelectColList. ListCount)
1253 For R% = 0 To SelectColList. ListCount - 1
1254 Call GetTableIndex(SelectColList. List(R), TI)
1255 Call GetColIndex(SelectColList. List(R), TI, CI)
1256 ' зная номер таблицы и номер поля данных нужно проверить тип поля
1257 If (DB(TI). Cols(CI). Class <> ccInteger) Then
1258 Call MsgForm. ErrorMsg("Нельзя строить диаграмму по нечисленным данным! ")
1259 Exit Function
1260 End If
1261 Dim Summary As Integer
1262 Summary = 0
1263 For i% = 0 To DB(TI). Header. RowCount - 1
1264 Summary = Summary + DB(TI). Rows(i). Fields(CI)
1265 Next i
1266 ' заполнение массива данных
1267 DiagData(2 * R) = Summary
1268 DiagData(2 * R + 1) = MainForm. TabStrip. Tabs(TI + 1). Caption + ". " + DB(TI). Cols(CI). title
1269 Next R
1270 GettingDiagData = True
1271 End Select
1272
1273End Function
1274
1275Private Sub OkBut_Click()
1276 If (OkBut. Tag = 0) Then Exit Sub
1277 Call SoundClick
1278
1279 If GettingDiagData(SelectColList. ListCount = 1) Then
1280 Load DiagResForm
1281 Call DiagResForm. InitDiagData(DiagData, DiagTypeCombo. ListIndex, (Enabled3DCheck. value = 1))
1282 DiagResForm. Show vbModal
1283 End If
1284End Sub
1285
1286Private Sub CancelBut_Click()
1287 Call SoundClick
1288 Unload Me
1289End Sub
1290
1291Private Sub TableColList_DblClick()
1292 i% = TableColList. ListIndex
1293 s$ = "{ " + CStr(TableIndexCombo. ListIndex) + ", " + TableIndexCombo. Text + " } " + TableColList. List(i)
1294 For j% = 0 To SelectColList. ListCount - 1
1295 If (SelectColList. List(j) = s) Then Exit Sub
1296 Next j
1297 Call ButEnabled(OkImg, OkBut, True)
1298 SelectColList. AddItem s
1299End Sub
1300
1301Private Sub SelectColList_DblClick()
1302 If (SelectColList. ListIndex > - 1) Then SelectColList. RemoveItem SelectColList. ListIndex
1303 Call ButEnabled(OkImg, OkBut, (SelectColList. ListCount > 0))
1304End Sub
1305
1306Private Sub TableIndexCombo_Click()
1307 DBI% = TableIndexCombo. ListIndex
1308 TableColList. Clear
1309 For i% = 0 To DB(DBI). Header. ColCount - 1
1310 TableColList. AddItem DB(DBI). Cols(i). title
1311 Next i
1312 If (TableColList. ListCount > 0) Then TableColList. ListIndex = 0
1313End Sub
Форма: PasswordForm. frm
1314Public res As Boolean
1315
1316Private Sub Form_Activate()
1317 res = False
1318 If Frame1. Visible Then
1319 PassText. SetFocus
1320 Else
1321 SetPassText. SetFocus
1322 End If
1323End Sub
1324
1325Private Sub Form_Load()
1326 Call ButEnabled(OkImg, OkBut, True)
1327 Call ButEnabled(CancelImg, CancelBut, True)
1328 TopImg. Picture = MainForm. TopImageList. ListImages(1). Picture
1329End Sub
1330
1331Private Sub OkBut_Click()
1332 res = True
1333 Call SoundClick
1334 Hide
1335End Sub
1336
1337Private Sub CancelBut_Click()
1338 Call SoundClick
1339 Hide
1340End Sub
1341
1342Private Sub PassText_KeyDown(KeyCode As Integer, Shift As Integer)
1343 If (KeyCode = 13) Then Call OkBut_Click
1344End Sub
1345
1346Private Sub SetPassText_KeyDown(KeyCode As Integer, Shift As Integer)
1347 If (KeyCode = 13) Then Call OkBut_Click
1348End Sub
Форма: AboutForm. frm
1349Private Sub Form_Load()
1350 Call MInit
1351 Call ButEnabled(OkImg, OkBut, True)
1352 Label6. Caption = "v. " + CStr(App. Major) + ". " + CStr(App. Minor) + ". " + CStr(App. Revision)
1353End Sub
1354