50133 (609948), страница 4
Текст из файла (страница 4)
Очистить список запросов?
Удалить выбранный запрос из списка?
Запросы выполнены.
Выводить в новую таблицу? Нет для вывода в уже существующую. (запрос может выводить результат либо в уже существующую таблицу, дописывая в конец, либо создать новую)
Не задано относительное значение! (для выполнения запроса недостаточно данных)
Ошибка в запросе! (произошла ошибка во время интерпретации или выполнения запроса)
Добавляемое поле уже существует!
Добавляемый столбец дублируется!
Нельзя добавлять записи в БД без полей! (запись добавляется, а полей в БД еще нет)
В БД нет полей!
В БД нет записей!
Нечего сортировать! (вызвана сортировка пустой БД)
Не с чем сравнивать! (сравнения по пустой БД)
Эквивалентом вывода целочисленного столбца не является целое число! Условие всегда истинно! (в запросе вывода указано строковое значение, а вывод идет по числовому полю)
Добавляемая запись уже существует!
Поле строкового типа преобразуется в числовой тип. Все нечисловые значения будут преобразованы в 0. Продолжить? (при изменении типа поля из строкового в числовое все строки, которые нельзя преобразовать в целые числа, будут заменены 0).
Поле с названием XXX уже существует!
Окно настроек создаваемого поля:
Введенное значение не является целым числом. Преобразовано к '0'.
Главное окно:
Недостаточно прав для выполнения действия! (открыта БД, защищенная паролем, в режиме чтения и производится попытка изменения данных)
Ошибка удаления столбца!
Удалить столбец?
Ошибка удаления записи!
Удалить запись?
БД сохранена!
БД повреждена! (при загрузке БД произошла ошибка)
Пароль принят! (БД, защищенная паролем, открыта с корректно введенным паролем)
Только чтение! (БД, защищенная паролем, открыта в режиме чтения)
Пароль не принят! Доступ запрещён!
БД загружена!
БД создана с настройками по-умолчанию!
литература
-
Microsoft Corporation Microsoft Visual Basic 6.0 Programmer’s Guide, Microsoft Press, 2003 г.
-
Microsoft® Win32® Programmer's Reference, 1996 г.
Приложение 1
Исходный код программы
Форма: MainForm. frm
0' разница ширины и высоты формы и TabStrip'а
1Dim dW1%, dH1%
2' разница ширины и высоты TabStrip'а и ListView'а
3Dim dW2%, dH2%
4' последний выбранный элемент
5Dim saveItemIndex%
6' текущая таблица
7Public DBCurIndex%
8' последний Image, над которым был курсор
9Dim OldImageIndex%
10
11Private Sub AboutProg_Click()
12 CoolTimer. Enabled = False
13 AboutForm. Show vbModal
14 CoolTimer. Enabled = True
15End Sub
16
17Private Sub CloseDB_Click()
18 CoolTimer. Enabled = False
19
20 If DBChanged Then
21 If (MsgForm. QuestMsg("В БД внесены не сохранённые изменения. Закрыть не сохраняя? ") <> resOk) Then GoTo exit_
22 End If
23
24 SB. Panels(3). Text = ""
25 Call ClearAll
26 Call ShowTable(-1)
27 Call DisEnImage(2, 1)
28 Call DisEnImage(3, 1)
29 Call DisEnImage(4, 1)
30
31exit_:
32
33 CoolTimer. Enabled = True
34End Sub
35
36' index,mode / сегмент, смещение
37Sub DisEnImage(Index%, Mode%)
38 CoolBut(Index). Picture = CoolImgs. ListImages(1 + (Index * 3 + Mode)). Picture
39 CoolBut(Index). Enabled = (Mode <> 1)
40End Sub
41
42Sub RetImage()
43 If (OldImageIndex > - 1) Then
44 If CoolBut(OldImageIndex). Enabled Then
45 Call DisEnImage(OldImageIndex, 0)
46 Else
47 Call DisEnImage(OldImageIndex, 1)
48 End If
49 End If
50 OldImageIndex = - 1
51End Sub
52
53Sub CoolMouseMove(Index%)
54 If (Index = OldImageIndex) Then Exit Sub
55 Call DisEnImage(Index, 2)
56 Call RetImage
57 OldImageIndex = Index
58End Sub
59
60Private Sub CoolBut_Click(Index As Integer)
61 Call DisEnImage(Index, 0)
62 Select Case Index
63 Case 0: Call CreateDB_Click
64 Case 1: Call OpenDB_Click
65 Case 2: Call SaveDB_Click
66 Case 3: Call CloseDB_Click
67 Case 4: Call ResCopyDB_Click
68 Case 5: Call ExitPr_Click
69 End Select
70End Sub
71
72Private Sub CoolTimer_Timer()
73 Dim Point As POINTAPI
74 Dim R As RECT, R2 As RECT
75 Call GetCursorPos(Point)
76 Call GetWindowRect(Frame1. hwnd, R)
77 For i% = 0 To 5
78 If (Not CoolBut(i). Enabled) Then GoTo loop_
79 x% = R. Left + CoolBut(i). Left / Screen. TwipsPerPixelX
80 y% = R. Top + CoolBut(i). Top / Screen. TwipsPerPixelY
81 X2% = x + CoolBut(i). Width / Screen. TwipsPerPixelX
82 Y2% = y + CoolBut(i). Height / Screen. TwipsPerPixelY
83 R2. Left = x
84 R2. Top = y
85 R2. Right = X2
86 R2. Bottom = Y2
87 If ((Point. x >= R2. Left) And (Point. x = R2. Top) And (Point. y <= R2. Bottom)) Then
88 Call CoolMouseMove(i)
89 Exit Sub
90 End If
91loop_:
92 Next i
93 Call RetImage
94End Sub
95
96Private Sub CreateDB_Click()
97 CoolTimer. Enabled = False
98 Dlgs. FileName = ""
99 Dlgs. ShowSave
100 If (Dlgs. FileName <> "") Then
101 ' создаю новую БД
102 Call NewDB(Dlgs. FileName)
103 ' вывожу путь к БД
104 SB. Panels(3). Text = DBPath
105 ' разрешения
106 Call DisEnImage(2, 0)
107 Call DisEnImage(3, 0)
108 Call DisEnImage(4, 0)
109 Call ShowTable(DBCurIndex)
110 End If
111 CoolTimer. Enabled = True
112End Sub
113
114Private Sub DiagDraw_Click()
115 CoolTimer. Enabled = False
116 DiagMasterForm. Show vbModal
117 CoolTimer. Enabled = True
118End Sub
119
120Private Sub ExitBut_Click()
121 Call ExitPr_Click
122End Sub
123
124Private Sub ExitPr_Click()
125 CoolTimer. Enabled = False
126 If Not DBChanged Then
127 End
128 Else
129 If (MsgForm. QuestMsg("В БД внесены не сохранённые изменения. Выйти не сохраняя? ") = resOk) Then End
130 End If
131 CoolTimer. Enabled = True
132End Sub
133
134Private Sub File_Click()
135 SaveDB. Enabled = DBPath <> ""
136 CloseDB. Enabled = SaveDB. Enabled
137 ResCopyDB. Enabled = SaveDB. Enabled
138End Sub
139
140Private Sub HelpProg_Click()
141 CoolTimer. Enabled = False
142 Call ShellExecute(hwnd, "open", "Help\index. html", "", "", 0)
143 CoolTimer. Enabled = True
144End Sub
145
146Sub CreateHTML(Path$)
147 Call DeleteFile(Path)
148 DBI% = FreeFile
149 Open Path For Binary As DBI
150
151 Capt$ = InputForm. InputVal("Введите заголовок для таблицы")
152
153 HTMLHeader$ = Replace("" + _
154 "", "~", Chr(34))
155
156 HTMLInfo$ = "" + Capt + ""
157
158 HTMLStart$ = Replace("
159
160 HTMLEnd$ = "
Файл сгенерирован программой DB Xtension по содержимому БД ' " + DBPath + "' "
161
162 HTMLCaption$ = Replace("
163
164 HTMLRowS$ = "
165 HTMLRowE$ = ""
166
167 If (DB(DBCurIndex). Header. ColCount > 0) Then ColWidth% = 100 \ DB(DBCurIndex). Header. ColCount
168
169 HTMLCols$ = Replace("
170
171 HTMLCells$ = Replace("
172
173 Put DBI,, HTMLHeader
174 Put DBI,, HTMLInfo
175
176 If (DB(DBCurIndex). Header. ColCount > 0) Then
177 Put DBI,, HTMLStart
178 Put DBI,, HTMLCaption
179
180 Put DBI,, HTMLRowS
181 For c% = 0 To DB(DBCurIndex). Header. ColCount - 1
182 Put DBI,, Replace(HTMLCols, "^", CStr(DB(DBCurIndex). Cols(c). title))
183 Next c
184 Put DBI,, HTMLRowE
185
186 For R% = 0 To DB(DBCurIndex). Header. RowCount - 1
187 Put DBI,, HTMLRowS
188 For c% = 0 To DB(DBCurIndex). Header. ColCount - 1
189 tmp$ = CStr(DB(DBCurIndex). Rows(R). Fields(c))
190 If (Trim(tmp) = "") Then tmp = " "
191 Put DBI,, Replace(HTMLCells, "^", tmp)
192 Next c
193 Put DBI,, HTMLRowE
194 Next R
195
196 Put DBI,, HTMLEnd
197 Else
198 Put DBI,, "База не содержит данных"
199 End If
200
201 Close DBI
202
203 If (MsgForm. QuestMsg("Файл '" + Path + "' создан. Открыть? ") = resOk) Then
204 Call ShellExecute(hwnd, "open", Path, "", "", 0)
205 End If
206End Sub
207
208Private Sub HTMLCreator_Click()
209 CoolTimer. Enabled = False
210 HTMLPath. FileName = ""
211 HTMLPath. ShowSave
212 If (HTMLPath. FileName <> "") Then
213 Call CreateHTML(HTMLPath. FileName)
214 Else
215 Call MsgForm. ErrorMsg("Формирование HTML-документа отменено! ")
216 End If
217 CoolTimer. Enabled = True
218End Sub
219
220Private Sub ListView_DblClick()
221 If (saveItemIndex > 0) Then
222 Load EditRecordForm
223 With EditRecordForm
224. CellList. Clear
225. ERFDBIndex = DBCurIndex
226 Call. LoadData(saveItemIndex - 1)
227 Call. OverloadList
228. Show vbModal
229 End With
230 End If
231End Sub
232
233Private Sub ListView_ItemClick(ByVal Item As MSComctlLib. ListItem)
234 saveItemIndex = Item. Index
235End Sub
236
237Private Sub ListView_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
238 saveItemIndex = 0
239End Sub
240
241Private Sub OptDB_Click()
242 Security. Enabled = DBPath <> ""
243End Sub
244
245Private Sub Form_Load()
246' регистрации расширения
247 Call ShellExecute(0, "", "assoc. exe", App. Path + "\" + App. EXEName + ". exe", "", 0)
248 DBCurIndex = 0
249 UserIsAdmin = True
250 saveItemIndex = 0
251 OldImageIndex = - 1
252 Call ClearAll
253 dW1 = Width - TabStrip. Width
254 dH1 = Height - TabStrip. Height
255 dW2 = Width - ListView. Width
256 dH2 = Height - ListView. Height
257 Call DisEnImage(0, 0)
258 Call DisEnImage(1, 0)
259 Call DisEnImage(2, 1)
260 Call DisEnImage(3, 1)
261 Call DisEnImage(4, 1)
262 Call DisEnImage(5, 0)
263End Sub
264
265Private Sub Form_Resize()
266 CoolBar1. Width = 2 * Width
267
268 Min% = MainForm. Width - dW2
269 If (Min < 0) Then: Min = 0
270 ListView. Width = Min
271
272 Min = MainForm. Height - dH2
273 If (Min < 0) Then: Min = 0
274 ListView. Height = Min
275
276 Min = MainForm. Width - dW1
277 If (Min < 0) Then: Min = 0
278 TabStrip. Width = Min
279
280 Min = MainForm. Height - dH1
281 If (Min < 0) Then: Min = 0
282 TabStrip. Height = Min
283End Sub
284
285Private Sub Form_Unload(Cancel%)
286 If DBChanged Then
287 If (MsgForm. QuestMsg("Выйти? ") = resNo) Then Cancel = 1
288 End If
289 Close ' пожалуй, это лишнее, но да мало ли:)
290End Sub
291
292Private Sub OpenDB_Click()
293 CoolTimer. Enabled = False
294 Dlgs. FileName = ""
295 Dlgs. ShowOpen
296 If (Dlgs. FileName <> "") Then
297 ' открываю БД
298 If LoadDB(DBCurIndex, Dlgs. FileName) Then
299 ' вывожу путь к БД
300 SB. Panels(3). Text = DBPath
301 Call DisEnImage(2, 0)
302 Call DisEnImage(3, 0)
303 Call DisEnImage(4, 0)
304 Call ShowTable(DBCurIndex)
305 End If
306 End If
307 CoolTimer. Enabled = True
308End Sub
309
310Private Sub QueryDB_Click()
311 QueryM. Enabled = DBPath <> ""
312End Sub
313
314Private Sub ResDB_Click()
315 DiagDraw. Enabled = DBPath <> ""
316 HTMLCreator. Enabled = DBPath <> ""
317End Sub
318
319Private Sub QueryM_Click()
320 CoolTimer. Enabled = False
321 With QueryMasterForm
322. QMFDBIndex = DBCurIndex
323. Show vbModal
324 End With
325 CoolTimer. Enabled = True
326End Sub
327
328Private Sub ResCopyDB_Click()
329 CoolTimer. Enabled = False
330 Dlgs. FileName = ""
331 Dlgs. ShowSave
332 If (Dlgs. FileName <> "") Then
333 If (Dlgs. FileName = DBPath) Then
334 Call MsgForm. ErrorMsg("Нельзя копировать файл сам в себя! ")
335 Else
336 Call CopyFile(DBPath, Dlgs. FileName, False)
337 Call MsgForm. InfoMsg("Архивная копия БД создана. ")
338 End If
339 Else
340 Call MsgForm. ErrorMsg("Резервное копирование БД отменено! ")
341 End If
342 CoolTimer. Enabled = True
343End Sub
344
345Private Sub SaveDB_Click()
346 CoolTimer. Enabled = False
347 Dlgs. FileName = ""
348 Dlgs. ShowSave
349 If (Dlgs. FileName <> "") Then
350 DBPath = Dlgs. FileName
351 Call FlushDB(DBCurIndex)
352 End If
353 CoolTimer. Enabled = True
354End Sub
355
356Private Sub Security_Click()
357 CoolTimer. Enabled = False
358 If UserIsAdmin Then
359 With PasswordForm
360. SetPassText = DB(DBCurIndex). Password
361
362 If (DB(DBCurIndex). Header. Flags And flCoded) Then
363. CheckCoded = 1
364 Else
365. CheckCoded = 0
366 End If
367 If (DB(DBCurIndex). Header. Flags And flReadOnlyEnable) Then
368. CheckNoRO = 1
369 Else
370. CheckNoRO = 0
371 End If
372. CaptionLabel = "Настройка защиты"
373. TextLabel = "Вы можете изменить пароль и права доступа к данной БД. Наличие пароля предполагает ограниченный доступ. "
374. Frame1. Visible = False
375. Frame2. Visible = True
376. Show vbModal
377 If (. res) Then
378 DB(DBCurIndex). Header. Flags = 0
379 If (Trim(. SetPassText) <> "") Then
380 DB(DBCurIndex). Password = Trim(. SetPassText)
381 DB(DBCurIndex). Header. Flags = flPasswordNeed
382 Call MsgForm. InfoMsg("Был задан пароль! ")
383 End If
384 DB(DBCurIndex). Header. Flags = DB(DBCurIndex). Header. Flags + (flCoded *. CheckCoded) + (flReadOnlyEnable *. CheckNoRO)
385 End If
386 Unload PasswordForm
387 End With
388 Else
389 Call ProtectedMsg
390 End If
391 CoolTimer. Enabled = True
392End Sub
393
394Private Sub TabStrip_Click()
395 If (TabStrip. Tabs. Count = 0) Then Exit Sub
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 Call MsgForm. 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))