Адресная книга на языка Visual Basic
Контрольная работа - Компьютеры, программирование
Другие контрольные работы по предмету Компьютеры, программирование
a
SetWindowText hWnd, App.ProductName
Dim lngTop As Long, lngLeft As Long, lngWidth As Long, lngHeight As Long
lngTop = Reg.RegRead("HKCU\Book\Top")
lngLeft = Reg.RegRead("HKCU\Book\Left")
lngHeight = Reg.RegRead("HKCU\Book\Height")
lngWidth = Reg.RegRead("HKCU\Book\Width")
If lngHeight < 3510 Then lngHeight = 3510
If lngWidth < 6630 Then lngWidth = 6630
Move lngLeft, lngTop, lngWidth, lngHeight
If Reg.RegRead("HKCU\Book\OnTop") = True Then SetTop hWnd, True
End Sub
Public Sub GetData()
On Error Resume Next
Dim Cnt As Long
lstMain.ItemClear
If bPoisk Then
If Not Exist(Path & "search.dat") Then Exit Sub
Open Path & "search.dat" For Input As #1
Else
If Not Exist(Path & "data.dat") Then Exit Sub
Open Path & "data.dat" For Input As #1
End If
Open Path & "data.dat" For Input As #1
While Not EOF(1)
ReDim Preserve User(Cnt)
Line Input #1, User(Cnt).strName
Line Input #1, User(Cnt).strOtchectvo
Line Input #1, User(Cnt).strFamilia
Line Input #1, User(Cnt).strAdress
Line Input #1, User(Cnt).strDoma
Line Input #1, User(Cnt).strKvartira
Line Input #1, User(Cnt).strPhone
Line Input #1, User(Cnt).strComment
lstMain.ItemAdd User(Cnt).strPhone & String(6, " ") & User(Cnt).strName
Cnt = Cnt + 1
Wend
Close
Slider.SetMax lstMain.GetMax
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not Button = vbLeftButton Then Exit Sub
Dim lngY As Long
Dim lngX As Long
Dim lngHeight As Long
Dim lngWidth As Long
lngY = (Y \ 13) + 1
lngX = (X \ 13) + 1
lngHeight = (lngY * 13) * Screen.TwipsPerPixelY
lngWidth = (lngX * 13) * Screen.TwipsPerPixelX
If lngHeight <= 3510 Then
lngHeight = 3510
End If
If lngWidth <= 6630 Then
lngWidth = 6630
End If
Height = lngHeight
Width = lngWidth
End Sub
Private Sub Form_Resize()
PosControls
lstMain.SetValue Slider.Value
Cls
Line (ScaleWidth - 14, ScaleHeight)-(ScaleWidth, ScaleHeight - 14), vbWhite
Line (ScaleWidth - 13, ScaleHeight)-(ScaleWidth, ScaleHeight - 13), vb3DShadow
Line (ScaleWidth - 12, ScaleHeight)-(ScaleWidth, ScaleHeight - 12), vb3DShadow
Line (ScaleWidth - 10, ScaleHeight)-(ScaleWidth, ScaleHeight - 10), vbWhite
Line (ScaleWidth - 9, ScaleHeight)-(ScaleWidth, ScaleHeight - 9), vb3DShadow
Line (ScaleWidth - 8, ScaleHeight)-(ScaleWidth, ScaleHeight - 8), vb3DShadow
Line (ScaleWidth - 6, ScaleHeight)-(ScaleWidth, ScaleHeight - 6), vbWhite
Line (ScaleWidth - 5, ScaleHeight)-(ScaleWidth, ScaleHeight - 5), vb3DShadow
Line (ScaleWidth - 4, ScaleHeight)-(ScaleWidth, ScaleHeight - 4), vb3DShadow
Line (lstMain.Left - 1, lstMain.Top - 1)-(lstMain.Left + lstMain.Width + 1, lstMain.Top - 1), vb3DShadow
Line -(lstMain.Left + lstMain.Width + 1, lstMain.Top + lstMain.Height + 1), vb3DLight
Line -(lstMain.Left - 1, lstMain.Top + lstMain.Height + 1), vb3DLight
Line -(lstMain.Left - 1, lstMain.Top - 1), vb3DShadow
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveData
If blnDial Then butDial_Click
On Error Resume Next
Reg.RegWrite "HKCU\Book\Top", Top
Reg.RegWrite "HKCU\Book\Left", Left
Reg.RegWrite "HKCU\Book\Height", Height
Reg.RegWrite "HKCU\Book\Width", Width
Set Reg = Nothing
End Sub
Private Sub lstMain_Click(Button As Integer)
If Not Button = vbRightButton Then Exit Sub
PopupMenu mnuMain
End Sub
Private Sub mnuAdd_Click()
butAdd_Click
End Sub
Private Sub mnuDelete_Click()
butDelete_Click
End Sub
Private Sub mnuDial_Click()
butDial_Click
End Sub
Private Sub mnuEdit_Click()
butEdit_Click
End Sub
Private Sub mnuMain_Click()
If bPoisk Then
mnuAdd.Enabled = False
mnuDelete.Enabled = False
mnuEdit.Enabled = False
Else
mnuAdd.Enabled = True
mnuDelete.Enabled = True
mnuEdit.Enabled = True
End If
End Sub
Private Sub Slider_Change()
lstMain.SetValue Slider.Value
End Sub
Private Sub PosControls()
lstMain.Height = ScaleHeight - lstMain.Top
Slider.Height = lstMain.Height
Slider.SetMax lstMain.GetMax
Panel.Left = ScaleWidth - Panel.Width - 11
butExit.Left = Panel.Left
Slider.Left = Panel.Left - Slider.Width - 8
lstMain.Width = Slider.Left - lstMain.Left - 8
butExit.Top = lstMain.Height
End Sub
FrmEdit
Option Explicit
Private Sub butCancel_Click()
Unload Me
End Sub
Private Sub butOk_Click()
Dim sLine As String, sInfo As String, bInform As Boolean, arrRecord(7) As String
Dim iCount As Integer, iCountLine As Integer, iFileNum As Integer
If bPoisk Then
""Then">If Dir(Path & "data.dat") <> "" Then
iCount = 1: iCountLine = 0: bInform = False
Open Path & "data.dat" For Input As #1
Считываем иформацию из файла и проверяем ее на совпадение
Do While Not EOF(1)
Line Input #1, sInfo
Select Case iCount
Имя
Case 1
0Then">If InStr(Trim(txtName.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
Очество
Case 2
0Then">If InStr(Trim(txtOtchectvo.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
Фамилия
Case 3
0Then">If InStr(Trim(txtFamilia.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
Адрес
Case 4
0Then">If InStr(Trim(txtAdress.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
Дом
Case 5
0Then">If InStr(Trim(txtdoma.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
Квартира
Case 6
0Then">If InStr(Trim(txtkvartira.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
Телефон
Case 7
0Then">If InStr(Trim(txtPhone.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
Комментарий
Case 8
0Then">If InStr(Trim(txtComment.Text), sInfo) <> 0 Then
bInform = True
iCount = 0
Else
iCount = iCount + 1
End If
End Select
Если есть хоть одно совпадение, то записываем всю инфу в файл "search.dat"
arrRecord(iCountLine) = sInfo
iCountLine = iCountLine + 1
If iCountLine = 8 Then
If bInform Then
iFileNum = FreeFile
Open Path & "search.dat" For Append As #iFileNum
For iCountLine = 0 To UBound(arrRecord)
Print #iFileNum, arrRecord(iCountLine)
Next
Close #iFileNum
End If
Erase arrRecord
bInform = False
iCountLine = 0
iCount = 1
End If
Loop
Close
Показываем результат поиска
frmMain.GetData
bPoisk = False
Else
MsgBox "Данные не найдены.", vbExclamation
Unload Me
Exit Sub
End If
Else
With User(lngIndex)
.strName = txtName
.strOtchectvo = txtOtchectvo
.strFamilia = txtFamilia
.strAdress = txtAdress
.strDoma = txtdoma
.strKvartira = txtkvartira
.strPhone = txtPhone
.strComment = txtComment
End With
frmMain.SaveData
frmMain.GetData
End If
Unload Me
End Sub
Private Sub txtPhone_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) And Not KeyAscii = 8 Then KeyAscii = 0
End Sub
Private Sub Form_Load()
If Reg.RegRead("HKCU\Book\OnTop") = True Then SetTop hWnd, True
End Sub
FrmOptions
Option Explicit
Private Sub butCancel_Click()
Unload Me
End Sub
Private Sub butOk_Click()
Reg.RegWrite "HKCU\Book\Port", txtPort
Reg.RegWrite "HKCU\Book\OnTop", chkOnTop.Value
If optDialMode(0).Value = True Then
Reg.RegWrite "HKCU\Book\DialMode", 0
Else
Reg.RegWrite "HKCU\Book\DialMode", 1