-Линейки прокрутки.
Max, Min. Эти свойства задают максимальное и минимальное значение движка на линейке прокрутки. Свойства могут принимать значения целого типа, поэтому находятся в интервале [-32768; 32767]. Когда движок попадает в крайнюю правую или нижнюю позицию, это число присваивается свойству Value.
Value (текущая позиция). Свойство отражает текущую позицию движка на линейке. При изменении Value программным путем Visual Basic перемещает движок в соответствующую позицию.
3). Создание меню.
Для разработки меню следует открыть диалоговое окно Menu Design Window (из меню Window команда Menu Design или кнопка Menu Design Window на панели инструментов). В окне для каждого элемента меню следует определить следующие свойства.
Caption (название)
– текст, который появится в строке меню.
Если перед буквой в названии стоит знак
амперсенда, то это означает, что данная
буква будет подчеркнута и доступ к
пункту меню можно осуществить, используя
комбинацию клавиш Alt + Б, где Б –
подчеркнутая буква.
Name (имя) – идентификатор элемента в программном коде. В целях избежания совпадения с зарезервированными словами рекомендуется использовать префикс mnu перед именем пункта меню.
Щелкните поле Caption в раскрывшемся окне Menu Design и наберите название пункта меню (например, &Файл). Знак амперсенда & указывает на то, что следующая за ним буква (Ф) будет подчеркнута, и нажатие этой буквы в сочетании с клавишей Alt (т. е. Alt-Ф) обеспечивает быстрый доступ к данному пункту. Затем нажмите клавишу Tab для перехода в поле Name. Введите в него имя пункта меню для обеспечения доступа к нему в программном коде (например, mnuFile) и нажмите клавишу Enter. Название (но не имя) появится в списке, занимающем нижнюю часть окна.
Структура формируемого меню отображается в нижней части окна. Стрелки в списке позволяют перемещаться по пунктам меню. Если щелкнуть кнопку «стрелка вправо», то под &Файл появятся четыре точки, которые сигнализируют, что следующий элемент меню будет размещен на втором уровне. Чтобы вернуться на первый уровень, необходимо нажать кнопку «стрелка влево».
Каждый пункт меню реагирует на событие Click.
Таким образом, язык программирования Visual Basic, наглядно позволяет смоделировать физический процесс и получить конкретные результаты. Отличительной особенностью VB, является возможность работы его непосредственно в среде Windows, что значительно повышает наглядность, красочность программы и гибкость в ее применении.
Необходимо еще раз подчеркнуть, что создаваемые объекты сразу же обеспечены программным кодом и для них приемлем метод перетягивания, что весьма распространено Windows.
Итак, полученные навыки позволят в дальнейшем самостоятельно решать задачи различной сложности, расширить приобретенный опыт и углубить свои знания в вопросах программирования.
2.5 Листинг программы
Форма авторизации
Проверка корректности ввода логина-пароля
Private Sub Command1_Click()
If Text1.Text = "Admin" And Text2.Text = "Admin" Then
Form1.Hide
Form3.Show
Form3.Login.Enabled = False
Else
MsgBox "Неправильно введена пара Логин-Пароль!!! Попробуйте заново", vbCritical + vbOKOnly, "Внимание"
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
End If
End Sub
Не авторизовываться
Private Sub Command2_Click()
Form1.Hide
Form3.Show
Form3.NewRow.Enabled = False
Form3.DeleteRow.Enabled = False
Form3.LaunchRow.Enabled = True
Form3.ClearBD.Enabled = False
Form3.Login.Enabled = True
Form4.Command3.Enabled = False
End Sub
Выход из программы
Private Sub Command3_Click()
End
End Sub
При загрузке формы
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
End Sub
архивация
Private Sub Option1_Click()
a = Shell("rar.exe u -r -m1 -dh -std C:\db.rar C:\SvetoMuz\*.*", vbNormalFocus)
MsgBox "Архив создан под именем db.rar на диске C:\", vbInformation + vbOKOnly, "Готово!"
Option1.Value = False
End Sub
Вызов процедуры индексации БД
Private Sub Option2_Click()
Form2.Show
End Sub
Добавление нового пользователя
Private Sub Option3_Click()
MsgBox "Извините, программа работает в демо-режиме, добавление нового пользователя не возможно!", vbInformation + vbOKOnly, "Внимание!"
Option3.Value = False
End Sub
Форма индексации БД
Объявление переменной, присвоение типа переменной
Dim a As Long
Таймер
Private Sub Timer1_Timer()
a = a + 2
Me.ProgressBar1.Value = a
If ProgressBar1.Value = 50 Then
Label1.Font.Size = 10
Label1.Caption = "Упаковака MEMO-полей"
End If
If ProgressBar1.Value = 250 Then
Label1.Font.Size = 10
Label1.Caption = "Проверка целостности структуры БД"
End If
If ProgressBar1.Value = 530 Then
Label1.Font.Size = 10
Label1.Caption = "Пересчет содержимого"
End If
If ProgressBar1.Value = 770 Then
Label1.Font.Size = 10
Label1.Caption = "Сжатие базы"
End If
If ProgressBar1.Value = 1000 Then
Label1.Font.Size = 10
Label1.Caption = "Готово"
Timer1.Interval = 0
Timer1.Enabled = False
ProgressBar1.Enabled = False
MsgBox "Индексация завершена. Ошибочных записей не найдено", vbInformation + vbOKOnly, "Внимание"
Form2.Hide
Form1.Show
Form1.Option2.Value = False
End If
End Sub
Главное окно
Объявление переменной, присвоение типа переменной
Dim Col As New Collection
Объявление переменной, присвоение типа переменной (База подгружается в табличную сетку)
Private Const SW_SHOWNORMAL = 1
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim i As Integer
------
Private Sub About_Click()
Form5.Show 1
End Sub
-----------
Private Sub ClearBD_Click()
Form3.Enabled = False
If Data1.Recordset.RecordCount = 0 And Data2.Recordset.RecordCount = 0 And Data3.Recordset.RecordCount = 0 And Data4.Recordset.RecordCount = 0 Then Form3.Enabled = True: MsgBox "Нет данных для удаления!", vbCritical, "Ошибка!": Exit Sub
With Data1.Recordset
For i = 1 To Data1.Recordset.RecordCount
.MoveFirst
.Delete
.MoveNext
Call sql
If Data1.Recordset.RecordCount = 0 And Data2.Recordset.RecordCount = 0 And Data3.Recordset.RecordCount = 0 And Data4.Recordset.RecordCount = 0 Then Form3.Enabled = True
Next i
End With
With Data2.Recordset
For i = 1 To Data2.Recordset.RecordCount
.MoveFirst
.Delete
.MoveNext
Call sql2
If Data1.Recordset.RecordCount = 0 And Data2.Recordset.RecordCount = 0 And Data3.Recordset.RecordCount = 0 And Data4.Recordset.RecordCount = 0 Then Form3.Enabled = True
Next i
End With
With Data3.Recordset
For i = 1 To Data3.Recordset.RecordCount
.MoveFirst
.Delete
.MoveNext
Call sql3
If Data1.Recordset.RecordCount = 0 And Data2.Recordset.RecordCount = 0 And Data3.Recordset.RecordCount = 0 And Data4.Recordset.RecordCount = 0 Then Form3.Enabled = True
Next i
End With
With Data4.Recordset
For i = 1 To Data4.Recordset.RecordCount
.MoveFirst
.Delete
.MoveNext
Call sql4
If Data1.Recordset.RecordCount = 0 And Data2.Recordset.RecordCount = 0 And Data3.Recordset.RecordCount = 0 And Data4.Recordset.RecordCount = 0 Then Form3.Enabled = True
Next i
End With
Сообщение что успешно
MsgBox "База данных успешно очищена!", vbInformation, "Очистка базы данных!"
End Sub
SQL- запрос на выборку по фирме производителю
Private Sub Combo1_Change()
Call sql2
End Sub
Private Sub Combo1_Click()
Call sql2
End Sub
Private Sub Combo2_Change()
Call sql3
End Sub
Private Sub Combo2_Click()
Call sql3
End Sub
Private Sub Combo3_Change()
Call sql4
End Sub
Private Sub Combo3_Click()
Call sql4
End Sub
Private Sub Combo4_Change()
Call sql
End Sub
Private Sub Combo4_Click()
Call sql
End Sub
Удаление записи
Private Sub DeleteRow_Click()
If Form3.Tab.Tab = "0" Then
If Data3.Recordset.RecordCount = 0 Then Exit Sub
nam$ = Data3.Recordset.Fields("Наименование").Value
codL = Data3.Recordset.Fields("Номер записи").Value
g = MsgBox("Данные об " & nam$ & " будут удалены без возможности восстановления" & vbCrLf & "Удалить запись из базы?", vbInformation + vbYesNo, "Внимание")
If g = 6 Then
Data3.RecordSource = "select * from [TableInstr]"
Data3.Refresh
Data3.Recordset.FindFirst ("[Номер записи] = " & codL)
Data3.Recordset.Delete
Data3.Recordset.MoveNext
Call sql3
If Data3.Recordset.RecordCount = 0 Then
Exit Sub
Else
End If
End If
Exit Sub
End If
If Form3.Tab.Tab = "1" Then
If Data2.Recordset.RecordCount = 0 Then Exit Sub
nam$ = Data2.Recordset.Fields("Наименование").Value
codL = Data2.Recordset.Fields("Номер записи").Value
g = MsgBox("Данные об " & nam$ & " будут удалены без возможности восстановления" & vbCrLf & "Удалить запись из базы?", vbInformation + vbYesNo, "Внимание")
If g = 6 Then
Data2.RecordSource = "select * from [TableAudio]"
Data2.Refresh
Data2.Recordset.FindFirst ("[Номер записи] = " & codL)
Data2.Recordset.Delete
Data2.Recordset.MoveNext
Call sql2
If Data2.Recordset.RecordCount = 0 Then
Exit Sub
Else
End If
End If
Exit Sub
End If
If Form3.Tab.Tab = "2" Then
If Data4.Recordset.RecordCount = 0 Then Exit Sub
nam$ = Data4.Recordset.Fields("Наименование").Value
codL = Data4.Recordset.Fields("Номер записи").Value
g = MsgBox("Данные об " & nam$ & " будут удалены без возможности восстановления" & vbCrLf & "Удалить запись из базы?", vbInformation + vbYesNo, "Внимание")
If g = 6 Then
Data4.RecordSource = "select * from [TableLight]"
Data4.Refresh
Data4.Recordset.FindFirst ("[Номер записи] = " & codL)
Data4.Recordset.Delete
Data4.Recordset.MoveNext
Call sql4
If Data4.Recordset.RecordCount = 0 Then
Exit Sub
Else
End If
End If
Exit Sub
End If
If Form3.Tab.Tab = "3" Then
If Data1.Recordset.RecordCount = 0 Then Exit Sub
nam$ = Data1.Recordset.Fields("Наименование").Value
codL = Data1.Recordset.Fields("Номер записи").Value
g = MsgBox("Данные об " & nam$ & " будут удалены без возможности восстановления" & vbCrLf & "Удалить запись из базы?", vbInformation + vbYesNo, "Внимание")
If g = 6 Then
Data1.RecordSource = "select * from [TableAkss]"
Data1.Refresh
Data1.Recordset.FindFirst ("[Номер записи] = " & codL)
Data1.Recordset.Delete
Data1.Recordset.MoveNext
Call sql
If Data1.Recordset.RecordCount = 0 Then
Exit Sub
Else
End If
End If
Exit Sub
End If
End Sub
Private Sub Exit_Click()
End
End Sub
При загрузке формы
Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\BDOborud.mdb"
Data2.DatabaseName = App.Path & "\BDOborud.mdb"
Data3.DatabaseName = App.Path & "\BDOborud.mdb"
Data4.DatabaseName = App.Path & "\BDOborud.mdb"
Call sql
Call sql2
Call sql3
Call sql4
Dim Tmp As String
Open App.Path & "\firma.DAT" For Input As #1
Do While Not EOF(1)
Line Input #1, Tmp
Col.Add (Tmp)
Combo1.AddItem Split(Tmp, ":")(0)
Loop
Close
Open App.Path & "\firma.DAT" For Input As #1
Do While Not EOF(1)
Line Input #1, Tmp
Col.Add (Tmp)
Combo2.AddItem Split(Tmp, ":")(0)
Loop
Close
Open App.Path & "\firma.DAT" For Input As #1
Do While Not EOF(1)
Line Input #1, Tmp
Col.Add (Tmp)
Combo3.AddItem Split(Tmp, ":")(0)
Loop
Close
Open App.Path & "\firma.DAT" For Input As #1
Do While Not EOF(1)
Line Input #1, Tmp
Col.Add (Tmp)
Combo4.AddItem Split(Tmp, ":")(0)
Loop
Close
End Sub
Sub sql()
On Error Resume Next
Data1.RecordSource = "SELECT TableAkss.[Номер записи], TableAkss.[Наименование], TableAkss.[Категория], TableAkss.[Количество], TableAkss.[Цена] FROM TableAkss " & "where TableAkss.[Наименование] like '*" & Text10.Text & "*' and TableAkss.[Описание] like '*" & Text11.Text & "*' and TableAkss.[Артикул] like '*" & Text12.Text & "*' and TableAkss.[Фирма производитель] like '*" & Combo4.Text & "*'"
Data1.Refresh
On Error Resume Next
Data1.Recordset.MoveLast
Label7.Caption = "Всего записей в базе данных " & "''" & "Аксессуары" & "''" & " : " & Data1.Recordset.RecordCount
End Sub
Sub sql2()
On Error Resume Next
Data2.RecordSource = "SELECT TableAudio.[Номер записи], TableAudio.[Наименование], TableAudio.[Категория], TableAudio.[Количество], TableAudio.[Цена] FROM TableAudio " & "where TableAudio.[Наименование] like '*" & Text2.Text & "*' and TableAudio.[Описание] like '*" & Text3.Text & "*' and TableAudio.[Артикул] like '*" & Text6.Text & "*' and TableAudio.[Фирма производитель] like '*" & Combo1.Text & "*'"
Data2.Refresh
On Error Resume Next
Data2.Recordset.MoveLast
Label5.Caption = "Всего записей в базе данных " & "''" & "Аудио оборудование" & "''" & " : " & Data2.Recordset.RecordCount
End Sub
Sub sql3()
On Error Resume Next
Data3.RecordSource = "SELECT TableInstr.[Номер записи], TableInstr.[Наименование], TableInstr.[Категория], TableInstr.[Количество], TableInstr.[Цена] FROM TableInstr " & "where TableInstr.[Наименование] like '*" & Text1.Text & "*' and TableInstr.[Описание] like '*" & Text4.Text & "*' and TableInstr.[Артикул] like '*" & Text5.Text & "*' and TableInstr.[Фирма производитель] like '*" & Combo2.Text & "*'"
Data3.Refresh
On Error Resume Next
Data3.Recordset.MoveLast
Label4.Caption = "Всего записей в базе данных " & "''" & "Инструменты" & "''" & " : " & Data3.Recordset.RecordCount
End Sub
Sub sql4()
Data4.RecordSource = "SELECT TableLight.[Номер записи], TableLight.[Наименование], TableLight.[Категория], TableLight.[Количество], TableLight.[Цена] FROM TableLight " & "where TableLight.[Наименование] like '*" & Text7.Text & "*' and TableLight.[Описание] like '*" & Text8.Text & "*' and TableLight.[Артикул] like '*" & Text9.Text & "*' and TableLight.[Фирма производитель] like '*" & Combo3.Text & "*'"
Data4.Refresh
On Error Resume Next
Data4.Recordset.MoveLast
Label6.Caption = "Всего записей в базе данных " & "''" & "Световое оборудование" & "''" & ": " & Data4.Recordset.RecordCount
End Sub
Вызов справки
Private Sub Help_Click()
Call ShellExecute(0, "Open", "C:\SvetoMuz\Svetomuz\Help.docx" & vbNullChar, vbNullChar, vbNullChar, SW_SHOWNORMAL)
End Sub
Просмотреть запись
Private Sub LaunchRow_Click()
If Form3.Tab.Tab = "0" Then
If Data3.Recordset.RecordCount = "0" Then MsgBox "Нет данных!", vbCritical, "Ошибка!": Exit Sub
add_edit = 1: codL = Data3.Recordset.Fields("Номер записи").Value: Load Form4: Form4.Caption = "Изменение записи": Form4.Show 1: Call sql3
End If
If Form3.Tab.Tab = "1" Then
If Data2.Recordset.RecordCount = "0" Then MsgBox "Нет данных!", vbCritical, "Ошибка!": Exit Sub
add_edit = 1: codL = Data2.Recordset.Fields("Номер записи").Value: Load Form4: Form4.Caption = "Изменение записи": Form4.Show 1: Call sql2
End If
If Form3.Tab.Tab = "2" Then
If Data4.Recordset.RecordCount = "0" Then MsgBox "Нет данных!", vbCritical, "Ошибка!": Exit Sub
add_edit = 1: codL = Data4.Recordset.Fields("Номер записи").Value: Load Form4: Form4.Caption = "Изменение записи": Form4.Show 1: Call sql4
End If
If Form3.Tab.Tab = "3" Then
If Data1.Recordset.RecordCount = "0" Then MsgBox "Нет данных!", vbCritical, "Ошибка!": Exit Sub
add_edit = 1: codL = Data1.Recordset.Fields("Номер записи").Value: Load Form4: Form4.Caption = "Изменение записи": Form4.Show 1: Call sql
End If
End Sub
авторизоваться
Private Sub Login_Click()
Form6.Show
End Sub
Private Sub NewRow_Click()
Занесение новой записи
add_edit = 0: Load Form4: Form4.Caption = "Добавление новой записи": codL = 0: Form4.Show 1: Call Form3.sql: Form3.sql2
End Sub
Сводный отчет по бд
Private Sub SvReport_Click()
If Form3.Tab.Tab = "0" Then
DataReport1.Show
End If
If Form3.Tab.Tab = "1" Then
DataReport2.Show
End If
If Form3.Tab.Tab = "2" Then
DataReport3.Show
End If
If Form3.Tab.Tab = "3" Then
DataReport4.Show
End If
End Sub
Private Sub Text1_Change()
Call sql3
End Sub
Private Sub Text10_Change()
Call sql
End Sub
Private Sub Text11_Change()
Call sql
End Sub
Private Sub Text12_Change()
Call sql
End Sub
Private Sub Text2_Change()
Call sql2
End Sub
Private Sub Text3_Change()
Call sql2
End Sub
Private Sub Text4_Change()
Call sql3
End Sub
Private Sub Text5_Change()
Call sql3
End Sub
Private Sub Text6_Change()
Call sql2
End Sub
Private Sub Text7_Change()
Call sql4
End Sub
Private Sub Text8_Change()
Call sql4
End Sub
Private Sub Text9_Change()
Call sql4
End Sub
Открытие договора
Private Sub TipDog_Click()
Call ShellExecute(0, "Open", "C:\SvetoMuz\Svetomuz\Dogovor.docx" & vbNullChar, vbNullChar, vbNullChar, SW_SHOWNORMAL)
End Sub
Товарный чек
Private Sub TovChek_Click()
DataReport5.Show
End Sub
Форма о программе
Объявление переменной для открытия картинки
Dim Col As New Collection
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Нажатие на кнопку записать
Private Sub Command1_Click()
If Form3.Tab.Tab = "2" Then
If add_edit = 0 Then
Data1.RecordSource = "select * from TableLight "
Data1.Refresh
Data1.Recordset.AddNew
End If
If add_edit = 1 Then
Data1.RecordSource = "select * from TableLight where TableLight.[Номер записи]=" & codL
Data1.Refresh
Data1.Recordset.Edit
End If
Data1.Recordset.Fields("Наименование").Value = Text1.Text
Data1.Recordset.Fields("Количество").Value = Text2.Text
Data1.Recordset.Fields("Цена").Value = Text3.Text
Data1.Recordset.Fields("Категория").Value = Combo1.Text
Data1.Recordset.Fields("Фирма производитель").Value = Combo2.Text
Data1.Recordset.Fields("Артикул").Value = Text5.Text
Data1.Recordset.Fields("Описание").Value = Text4.Text
Data1.Recordset.Update
On Error Resume Next
cod = Form3.Data1.Recordset.Fields("Номер записи").Value
Call Form3.sql4
Data2.Recordset.FindFirst ("[Номер записи] = " & cod)
MsgBox "Сохранено успешно!", vbInformation, "Сохранено!"
Unload Me
End If
'==================================================================================
If Form3.Tab.Tab = "0" Then
If add_edit = 0 Then
Data1.RecordSource = "select * from TableInstr "
Data1.Refresh
Data1.Recordset.AddNew
End If
If add_edit = 1 Then 'редактирование
Data1.RecordSource = "select * from TableInstr where TableInstr.[Номер записи]=" & codL
Data1.Refresh
Data1.Recordset.Edit
End If
Data1.Recordset.Fields("Наименование").Value = Text1.Text
Data1.Recordset.Fields("Количество").Value = Text2.Text
Data1.Recordset.Fields("Цена").Value = Text3.Text
Data1.Recordset.Fields("Категория").Value = Combo1.Text
Data1.Recordset.Fields("Фирма производитель").Value = Combo2.Text
Data1.Recordset.Fields("Артикул").Value = Text5.Text
Data1.Recordset.Fields("Описание").Value = Text4.Text
Data1.Recordset.Update
On Error Resume Next
cod = Form3.Data1.Recordset.Fields("Номер записи").Value
Call Form3.sql3
Data2.Recordset.FindFirst ("[Номер записи] = " & cod)
MsgBox "Сохранено успешно!", vbInformation
Unload Me
End If
'==================================================================================
If Form3.Tab.Tab = "3" Then
If add_edit = 0 Then
Data1.RecordSource = "select * from TableAkss "
Data1.Refresh
Data1.Recordset.AddNew
End If
If add_edit = 1 Then 'редактирование
Data1.RecordSource = "select * from TableAkss where TableAkss.[Номер записи]=" & codL
Data1.Refresh
Data1.Recordset.Edit
End If
Data1.Recordset.Fields("Наименование").Value = Text1.Text
Data1.Recordset.Fields("Количество").Value = Text2.Text
Data1.Recordset.Fields("Цена").Value = Text3.Text
Data1.Recordset.Fields("Категория").Value = Combo1.Text
Data1.Recordset.Fields("Фирма производитель").Value = Combo2.Text
Data1.Recordset.Fields("Артикул").Value = Text5.Text
Data1.Recordset.Fields("Описание").Value = Text4.Text
Data1.Recordset.Update
On Error Resume Next
cod = Form3.Data1.Recordset.Fields("Номер записи").Value
Call Form3.sql
Data2.Recordset.FindFirst ("[Номер записи] = " & cod)
MsgBox "Сохранено успешно!", vbInformation
Unload Me
End If
'==================================================================================
If Form3.Tab.Tab = "1" Then
If add_edit = 0 Then
Data1.RecordSource = "select * from TableAudio "
Data1.Refresh
Data1.Recordset.AddNew
End If
If add_edit = 1 Then 'редактирование
Data1.RecordSource = "select * from TableAudio where TableAudio.[Номер записи]=" & codL
Data1.Refresh
Data1.Recordset.Edit
End If
Data1.Recordset.Fields("Наименование").Value = Text1.Text
Data1.Recordset.Fields("Количество").Value = Text2.Text
Data1.Recordset.Fields("Цена").Value = Text3.Text
Data1.Recordset.Fields("Категория").Value = Combo1.Text
Data1.Recordset.Fields("Фирма производитель").Value = Combo2.Text
Data1.Recordset.Fields("Артикул").Value = Text5.Text
Data1.Recordset.Fields("Описание").Value = Text4.Text
Data1.Recordset.Update
On Error Resume Next
cod = Form3.Data2.Recordset.Fields("Номер записи").Value
Call Form3.sql2
Data2.Recordset.FindFirst ("[Номер записи] = " & cod)
MsgBox "Сохранено успешно!", vbInformation
Unload Me
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Проверка ввода
Private Sub Command3_Click()
If Text1.Text <> "" And Text2.Text <> "" And Text3.Text <> "" Then
MsgBox "Успешно! Можете записывать!", vbInformation + vbOKOnly, "Внимание!"
Command1.Enabled = True
End If
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
MsgBox "Проверьте поля на корректность заполнения", vbCritical + vbOKOnly, "Внимание"
Command1.Enabled = False
If Text1.Text = "" Then
Text1.SetFocus
End If
If Text2.Text = "" Then
Text2.SetFocus
End If
If Text3.Text = "" Then
Text3.SetFocus
End If
End If
End Sub
Загрузка формы
Private Sub Form_Load()
If Form3.Tab.Tab = "0" Then
Combo1.Text = "Инструменты"
Combo1.Enabled = Fasle
End If
If Form3.Tab.Tab = "1" Then
Combo1.Text = "Аудио оборудование"
Combo1.Enabled = Fasle
End If
If Form3.Tab.Tab = "2" Then
Combo1.Text = "Световое оборудование"
Combo1.Enabled = Fasle
End If
If Form3.Tab.Tab = "3" Then
Combo1.Text = "Аксессуары"
Combo1.Enabled = Fasle
End If
If Form3.Tab.Tab = "2" Then
Data1.DatabaseName = App.Path & "\BDOborud.mdb"
Data2.DatabaseName = App.Path & "\BDOborud.mdb"
Data1.RecordSource = "TableLight"
Data2.RecordSource = "TableLight"
If add_edit = 0 Then
End If
If add_edit = 1 Then
Data1.RecordSource = "select * from TableLight where [Номер записи]=" & codL
Data1.Refresh
Text1.Text = Data1.Recordset.Fields("Наименование").Value
Text2.Text = Data1.Recordset.Fields("Количество").Value
Text3.Text = Data1.Recordset.Fields("Цена").Value
Combo1.Text = Data1.Recordset.Fields("Категория").Value
Combo2.Text = Data1.Recordset.Fields("Фирма производитель").Value
Text5.Text = Data1.Recordset.Fields("Артикул").Value
Text4.Text = Data1.Recordset.Fields("Описание").Value
End If
End If
'================================================================================
If Form3.Tab.Tab = "0" Then
Data1.DatabaseName = App.Path & "\BDOborud.mdb"
Data2.DatabaseName = App.Path & "\BDOborud.mdb"
Data1.RecordSource = "TableInstr"
Data2.RecordSource = "TableInstr"
If add_edit = 0 Then
End If
If add_edit = 1 Then
Data1.RecordSource = "select * from TableInstr where [Номер записи]=" & codL
Data1.Refresh
Text1.Text = Data1.Recordset.Fields("Наименование").Value
Text2.Text = Data1.Recordset.Fields("Количество").Value
Text3.Text = Data1.Recordset.Fields("Цена").Value
Combo1.Text = Data1.Recordset.Fields("Категория").Value
Combo2.Text = Data1.Recordset.Fields("Фирма производитель").Value
Text5.Text = Data1.Recordset.Fields("Артикул").Value
Text4.Text = Data1.Recordset.Fields("Описание").Value
End If
End If
'================================================================================
If Form3.Tab.Tab = "3" Then
Data1.DatabaseName = App.Path & "\BDOborud.mdb"
Data2.DatabaseName = App.Path & "\BDOborud.mdb"
Data1.RecordSource = "TableAkss"
Data2.RecordSource = "TableAkss"
If add_edit = 0 Then
End If
If add_edit = 1 Then
Data1.RecordSource = "select * from TableAkss where [Номер записи]=" & codL
Data1.Refresh
Text1.Text = Data1.Recordset.Fields("Наименование").Value
Text2.Text = Data1.Recordset.Fields("Количество").Value
Text3.Text = Data1.Recordset.Fields("Цена").Value
Combo1.Text = Data1.Recordset.Fields("Категория").Value
Combo2.Text = Data1.Recordset.Fields("Фирма производитель").Value
Text5.Text = Data1.Recordset.Fields("Артикул").Value
Text4.Text = Data1.Recordset.Fields("Описание").Value
End If
End If
If Form3.Tab.Tab = "1" Then
Data1.DatabaseName = App.Path & "\BDOborud.mdb"
Data2.DatabaseName = App.Path & "\BDOborud.mdb"
Data1.RecordSource = "TableAudio"
Data2.RecordSource = "TableAudio"
If add_edit = 0 Then
End If
If add_edit = 1 Then
Data1.RecordSource = "select * from TableAudio where [Номер записи]=" & codL
Data1.Refresh
Text1.Text = Data1.Recordset.Fields("Наименование").Value
Text2.Text = Data1.Recordset.Fields("Количество").Value
Text3.Text = Data1.Recordset.Fields("Цена").Value
Combo1.Text = Data1.Recordset.Fields("Категория").Value
Combo2.Text = Data1.Recordset.Fields("Фирма производитель").Value
Text5.Text = Data1.Recordset.Fields("Артикул").Value
Text4.Text = Data1.Recordset.Fields("Описание").Value
End If
End If
Dim Tmp As String
Open App.Path & "\firma.DAT" For Input As #1
Do While Not EOF(1)
Line Input #1, Tmp
Col.Add (Tmp)
Combo2.AddItem Split(Tmp, ":")(0)
Loop
Close
End Sub
Загрузка картинки
Private Sub imgPic_Click()
Dim OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
'Set the parent window
OFName.hwndOwner = Me.hwnd
'Set the application's instance
OFName.hInstance = App.hInstance
'Select a filter
OFName.lpstrFilter = "JPEG (*.JPG)" + Chr$(0) + "*.JPG"
'create a buffer for the file
OFName.lpstrFile = Space$(254)
'set the maximum length of a returned file
OFName.nMaxFile = 255
'Create a buffer for the file title
OFName.lpstrFileTitle = Space$(254)
'Set the maximum length of a returned file title
OFName.nMaxFileTitle = 255
'Set the initial directory
OFName.lpstrInitialDir = App.Path
'Set the title
OFName.lpstrTitle = "Выберите картинку"
'No flags
OFName.flags = 0
'Show the 'Open File'-dialog
If GetOpenFileName(OFName) Then
Form4.imgPic.Picture = LoadPicture(Trim$(OFName.lpstrFile))
Else
Exit Sub
End If
End Sub
Форма о программе
Вызов интернет эксплорера
Private Sub Label2_Click()
Shell "C:\Program Files\Internet Explorer\iexplore.exe http://www.svetomuz.ru/", vbNormalFocus
End Sub
Форма авторизации из главного окна
Private Sub Command1_Click()
If Text1.Text = "Admin" And Text2.Text = "Admin" Then
MsgBox "Готово", vbInformation + vbOKOnly, "SvetoMuz"
Form6.Hide
Form3.Show
Form3.Login.Enabled = False
Form3.NewRow.Enabled = True
Form3.DeleteRow.Enabled = True
Form3.ClearBD.Enabled = True
Else
MsgBox "Неправильно введена пара Логин-Пароль!!! Попробуйте заново", vbCritical + vbOKOnly, "Внимание"
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
End If
End Sub
отмена
Private Sub Command2_Click()
Form6.Hide
Form3.Show
End Sub