|
Создание базы данных |
29 CoolTimer. Enabled = False330 Dlgs. FileName = ""331 Dlgs. ShowSave332 If (Dlgs. FileName <> "") Then333 If (Dlgs. FileName = DBPath) Then334 Call MsgForm. ErrorMsg("Нельзя копировать файл сам в себя! ") 335 Else336 Call CopyFile(DBPath, Dlgs. FileName, False) 337 Call MsgForm. InfoMsg("Архивная копия БД создана. ") 338 End If339 Else340 Call MsgForm. ErrorMsg("Резервное копирование БД отменено! ") 341 End If342 CoolTimer. Enabled = True343End Sub344345Private Sub SaveDB_Click() 346 CoolTimer. Enabled = False347 Dlgs. FileName = ""348 Dlgs. ShowSave349 If (Dlgs. FileName <> "") Then350 DBPath = Dlgs. FileName351 Call FlushDB(DBCurIndex) 352 End If353 CoolTimer. Enabled = True354End Sub355356Private Sub Security_Click() 357 CoolTimer. Enabled = False358 If UserIsAdmin Then359 With PasswordForm360. SetPassText = DB(DBCurIndex). Password361 362 If (DB(DBCurIndex). Header. Flags And flCoded) Then363. CheckCoded = 1364 Else365. CheckCoded = 0366 End If367 If (DB(DBCurIndex). Header. Flags And flReadOnlyEnable) Then368. CheckNoRO = 1369 Else370. CheckNoRO = 0371 End If372. CaptionLabel = "Настройка защиты"373. TextLabel = "Вы можете изменить пароль и права доступа к данной БД. Наличие пароля предполагает ограниченный доступ. "374. Frame1. Visible = False375. Frame2. Visible = True376. Show vbModal377 If (. res) Then378 DB(DBCurIndex). Header. Flags = 0379 If (Trim(. SetPassText) <> "") Then380 DB(DBCurIndex). Password = Trim(. SetPassText) 381 DB(DBCurIndex). Header. Flags = flPasswordNeed382 Call MsgForm. InfoMsg("Был задан пароль! ") 383 End If384 DB(DBCurIndex). Header. Flags = DB(DBCurIndex). Header. Flags + (flCoded *. CheckCoded) + (flReadOnlyEnable *. CheckNoRO) 385 End If386 Unload PasswordForm387 End With388 Else389 Call ProtectedMsg390 End If391 CoolTimer. Enabled = True392End Sub393394Private Sub TabStrip_Click() 395 If (TabStrip. Tabs. Count = 0) Then Exit Sub396 If (DBCurIndex <> TabStrip. SelectedItem. Index - 1) Then397 DBCurIndex = TabStrip. SelectedItem. Index - 1398 Call ShowTable(DBCurIndex) 399End If400End Sub401402Private Sub TabStrip_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 403 If (Shift = vbCtrlMask) Then PopupMenu TSMenu404End Sub405406Private Sub TSClose_Click() 407 If (MsgForm. QuestMsg("Закрыть закладку? ") = resOk) Then408 TabIndex% = TabStrip. SelectedItem. Index409 TabStrip. Tabs. Remove (TabIndex) 410 Call DelTable(TabIndex - 1) 411 412 If (TabStrip. Tabs. Count = 0) Then413 DBChanged = False414 Call DisEnImage(2, 1) 415 Call DisEnImage(3, 1) 416 Call DisEnImage(4, 1) 417 Call ShowTable(-1) 418 Else419 TabStrip. SelectedItem = TabStrip. Tabs. Item(1) 420 End If421 End If422End SubФорма: TableForm. frm423Dim tmp As String424425Public Function AddColDlg(DBIndex%) As String426 tmp = ""427 With StCol428. Clear429 For i% = 1 To DB(DBIndex). Header. ColCount430. AddItem DB(DBIndex). Cols(i - 1). title431 Next432. ListIndex =. ListCount - 1433 End With434 ColType. ListIndex = 0435 Me. Show vbModal436 AddColDlg = tmp437 Unload Me438End Function439440Private Sub ColType_Click() 441 ' изменение допустимых длин442 If Visible Then443 Select Case ColType. ListIndex444 Case ccInteger: InitValue. MaxLength = 4445 Case ccString: InitValue. MaxLength = 255446 End Select447 End If448449' контроль ввода450 If Visible And (ColType. ListIndex = ccInteger) Then451 If (Not IsInteger(InitValue. Text)) Then InitValue. Text = "0"452 End If453End Sub454455Private Sub CreateBut_Click() 456 Call SoundClick457 s1$ = Trim(ColTitle. Text) 458 Do While (s1 = "") 459 s1 = Trim(InputForm. InputVal("Вы не ввели заголовок столбца. Повторите ввод. ")) 460 Loop461 tmp$ = s1 + ", "462 Dim ct463 Dim s2464 Select Case ColType. ListIndex465 Case ccInteger466 t$ = Trim(InitValue. Text) 467 If (Not IsInteger(t)) Then468 Call MsgForm. InfoMsg("Введённое значение не является целым числом. Преобразовано к '0'. ") 469 t = "0"470 End If471 tmp = tmp + " " + sI + ", " + t472 Case ccString473 t$ = Trim(InitValue. Text) 474 If (t = "") Then t = " "475 tmp = tmp + " " + sS + ", " + t476 End Select477 Dim pos%478 If (OnlyEndCheck. value = 1) Then479 pos = - 1480 Else481 pos = StCol. ListIndex482 If (Option2. value = True) Then pos = pos + 1483 End If484 tmp = tmp + ", " + CStr(pos) 485 Hide486End Sub487488Private Sub CancelBut_Click() 489 Call SoundClick490 Hide491End Sub492493Private Sub Form_Load() 494 Call ButEnabled(CreateImg, CreateBut, True) 495 Call ButEnabled(CancelImg, CancelBut, True) 496End SubФорма: TextEditForm. frm497Public res%498Dim dW%, dH%499500Private Sub Form_Activate() 501 With TextEdit502. SelStart = Len(. Text) 503 End With504End Sub505506Private Sub Form_Load() 507 res = 0508 dW = Width - TextEdit. Width509 dH = Height - TextEdit. Height510End Sub511512Private Sub Form_Resize() 513 Min% = Height - dH514 If (Min <= 1000) Then: Min = 1000: Height = dH + Min515 TextEdit. Height = Min516 517 Min = Width - dW518 If (Min <= 1000) Then: Min = 1000: Width = dW + Min519 TextEdit. Width = Min520End Sub521522Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib. Button) 523 On Error Resume Next524 Select Case Button. Key525 Case "ClearText"526 TextEdit. TextRTF = ""527 Case "SaveText"528 res = 1529 Hide530 Case "CopyText"531 Clipboard. SetText (TextEdit. SelText) 532 Case "PasteText"533 TextEdit. SelText = VB. Clipboard. GetText534 Case "CutText"535 Clipboard. SetText (TextEdit. SelText) 536 TextEdit. SelText = ""537 Case "DeleteText"538 TextEdit. SelText = ""539 Case "Properties"540 On Error GoTo checkerror541 FontDlg. ShowFont542 TextEdit. Font. Name = FontDlg. FontName543 TextEdit. Font. Bold = FontDlg. FontBold544 TextEdit. Font. Italic = FontDlg. FontItalic545 TextEdit. Font. Size = FontDlg. FontSize546 TextEdit. Font. Strikethrough = FontDlg. FontStrikethru547 TextEdit. Font. Underline = FontDlg. FontUnderline548 Exit Sub549checkerror: 550 MsgBox "error"551 End Select552End Sub553Форма: SelectForm. frm554Dim tmp%, tmps$555556Public Function SelectDlg(DBIndex%, ByVal title$, ByVal what$) As Integer557 Dim s$558 List1. Visible = True559 List2. Visible = False560 List1. Clear561 Select Case what562 Case sRow ' *******************...::: Select Row:::... ********************563 With MainForm. ListView. ListItems564 For i% = 1 To. Count565 s = CStr(i - 1) + ")" +. Item(i) 566 For j% = 1 To DB(DBIndex). Header. ColCount - 1567 s = s + " - " +. Item(i). SubItems(j) 568 Next j569 List1. AddItem s570 Next i571 End With572 573 Case sCol ' *******************...::: Select Col:::... ********************574 With MainForm. ListView. ColumnHeaders575 For i% = 1 To. Count576 List1. AddItem CStr(i - 1) + ")" +. Item(i) 577 Next i578 End With579 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 i584 End Select585586 If (List1. ListCount > 0) Then587 List1. ListIndex = 0588 Call ButEnabled(SelectImg, SelectBut, True) 589 Else590 Call ButEnabled(SelectImg, SelectBut, False) 591 End If592 Label1. Caption = title593 tmp = - 1594 Show vbModal595 SelectDlg = CStr(tmp) 596End Function597598Public Function MultiSelectDlg(DBIndex%, ByVal title$, ByVal what$) As String599 Dim s$600 List2. Visible = True601 List1. Visible = False602 List2. Clear603 CheckConfirm. Visible = False604 If (what = sRow) Then605 With MainForm. ListView. ListItems606 For i% = 1 To. Count607 s = CStr(i - 1) + ")" +. Item(i) 608 For j% = 1 To DB(DBIndex). Header. ColCount - 1609 s = s + " - " +. Item(i). SubItems(j) 610 Next j611 List2. AddItem s612 Next i613 End With614 Else615 With MainForm. ListView. ColumnHeaders616 For i% = 1 To. Count617 List2. AddItem CStr(i - 1) + ")" +. Item(i) 618 Next i619 End With620 End If621 Call ButEnabled(SelectImg, SelectBut, False) 622 Label1. Caption = title623 tmps = ""624 Show vbModal625 CheckConfirm. Visible = True626 MultiSelectDlg = tmps627End Function628629Private Sub Form_Activate() 630 Call ButEnabled(CancelImg, CancelBut, True) 631End Sub632633Private Sub SelectBut_Click() 634 If (SelectBut. Tag = 0) Then Exit Sub635 If (List1. Visible) Then636 tmp = List1. ListIndex637 Else638 For i = 0 To List2. ListCount - 1639 If List2. Selected(i) Then tmps = tmps + CStr(i) + ","640 Next i641 tmps = Strings. Left$(tmps, Len(tmps) - 1) 642 End If643 Hide644End Sub645646Private Sub CancelBut_Click() 647 Hide648End Sub649650Private Sub List1_Click() 651 Call ButEnabled(SelectImg, SelectBut, (List1. ListIndex <> - 1)) 652End Sub653654Private Sub List2_Click() 655 Call ButEnabled(SelectImg, SelectBut, (List2. SelCount = 2)) 656End SubФорма: QueryMasterForm. frm657Public QMFDBIndex%658659Sub AddStr(str$) 660 If (str <> "") Then661 QueryList. AddItem str662 Else663 Call MsgForm. ErrorMsg("Запрос отменен! ") 664 End If665End Sub666667Private Sub AddImage_Click() 668Call SoundClick669With QueryList670 Select Case QueryTypeCombo. ListIndex671 '******************* Добавление ***********************672 Case 0673 Select Case QuerySubtypeCombo. ListIndex674 Case 0 ' добавление столбца675 Call AddStr(Generate_Add(sCol)) 676 Case 1 ' добавление записи677 Call AddStr(Generate_Add(sRow)) 678 End Select679 '******************* Удаление ***********************680 Case 1681 Select Case QuerySubtypeCombo. ListIndex682 Case 0 ' удаление столбца683 Call AddStr(Generate_Del(sCol)) 684 Case 1 ' удаление записи685 Call AddStr(Generate_Del(sRow)) 686 End Select687 688 '******************* Сортировка ***********************689 Case 2690 Select Case QuerySubtypeCombo. ListIndex691 Case 0 ' сортировка по алфавиту692 Call AddStr(Generate_Sort(sAZ)) 693 Case 1 ' сортировка против алфавита694 Call AddStr(Generate_Sort(sZA)) 695 End Select696 697 '******************* Вывод ***********************698 Case 3699 Select Case QuerySubtypeCombo. ListIndex700 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 Select713 714 '******************* Обмен ***********************715 Case 4716 Select Case QuerySubtypeCombo. ListIndex717 Case 0 ' обмен столбцов718 Call AddStr(Generate_Swap(sCol)) 719 Case 1 ' обмен строк720 Call AddStr(Generate_Swap(sRow)) 721 End Select722 723 '******************* Смена ***********************724 Case 5725 Select Case QuerySubtypeCombo. ListIndex726 Case 0 ' смена типа поля727 Call AddStr(Generate_Change(sType)) 728 Case 1 ' смена названия поля729 Call AddStr(Generate_Change(sName)) 730 End Select731 End Select732 733End With734End Sub735736Private Sub CancelBut_Click() 737 Call SoundClick738 If (QueryList. ListCount > 0) Then739 If (MsgForm. QuestMsg("Список запросов не пуст. Выйти? ") = resOk) Then Unload Me740 Else741 Unload Me742 End If743End Sub744745' замена запроса746Private Sub ChangeImage_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 747 If (Trim(Text1) <> "") Then748 Call SoundClick749 With QueryList750 If (. ListIndex = - 1) Or (Shift And vbShiftMask <> 0) Then751. AddItem Text1752 Else753. List(. ListIndex) = Text1754 End If755 End With756 End If757 Text1 = ""758 Text1. SetFocus759End Sub760761' очистка запросов762Private Sub ClearImage_Click() 763 If (QueryList. ListCount > 0) Then764 Call SoundClick765 If (MsgForm. QuestMsg("Очистить список запросов? ") = resOk) Then766 QueryList. Clear767 Text1 = ""768 Text1. SetFocus769 End If770 End If771End Sub772773' удаление запроса774Private Sub DelImage_Click() 775 If (QueryList. ListIndex >= 0) Then776 Call SoundClick777 If (MsgForm. QuestMsg("Удалить выбранный запрос из списка? ") = resOk) Then778 QueryList. RemoveItem QueryList. ListIndex779 Text1 = ""780 Text1. SetFocus781 End If782 End If783End Sub784785Private Sub Form_Load()
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
|
|
|
© 2003-2013
Рефераты бесплатно, курсовые, рефераты биология, большая бибилиотека рефератов, дипломы, научные работы, рефераты право, рефераты, рефераты скачать, рефераты литература, курсовые работы, реферат, доклады, рефераты медицина, рефераты на тему, сочинения, реферат бесплатно, рефераты авиация, рефераты психология, рефераты математика, рефераты кулинария, рефераты логистика, рефераты анатомия, рефераты маркетинг, рефераты релиния, рефераты социология, рефераты менеджемент. |
|
|