Приложение
FrmMain
Rem Автор программы ZIGMyND <admin@zigmynd.tk>
Option Explicit
Public Sub SaveData()
Dim Index As Long
Dim strText As String
SetAttr Path & "data.dat", vbNormal
On Error Resume Next
Open Path & "data.dat" For Output As #1
For Index = 0 To UBound(User)
If Not (User(Index).strKvartira = vbNullString Or User(Index).strDoma = vbNullString Or User(Index).strFamilia = vbNullString Or User(Index).strOtchectvo = vbNullString Or User(Index).strAdress = vbNullString Or User(Index).strComment = vbNullString Or User(Index).strName = vbNullString Or User(Index).strPhone = vbNullString) Then
Print #1, User(Index).strName
Print #1, User(Index).strOtchectvo
Print #1, User(Index).strFamilia
Print #1, User(Index).strAdress
Print #1, User(Index).strDoma
Print #1, User(Index).strKvartira
Print #1, User(Index).strPhone
Print #1, User(Index).strComment
End If
Next
Close
End Sub
Private Sub butAbout_Click()
Load frmAbout
frmAbout.Show vbModal
Private Sub butAdd_Click()
ReDim Preserve User(UBound(User) + 1)
lngIndex = UBound(User)
Load frmEdit
frmEdit.Show vbModal
Private Sub butDelete_Click()
If lstMain.GetSelected > lstMain.GetAll Then Exit Sub
With User(lstMain.GetSelected)
.strName = vbNullString
.strOtchectvo = vbNullString
.strFamilia = vbNullString
.strAdress = vbNullString
.strKvartira = vbNullString
.strDoma = vbNullString
.strComment = vbNullString
.strPhone = vbNullString
End With
SaveData
GetData
Private Sub butDial_Click()
If User(lstMain.GetSelected).strPhone = vbNullString Then Exit Sub
If blnDial = False Then
Open "COM" & Reg.RegRead("HKCU\Book\Port") For Output As #1
If Reg.RegRead("HKCU\Book\DialMode") = 0 Then
Print #1, "ATDT" & User(lstMain.GetSelected).strPhone
Else
Print #1, "ATDP" & User(lstMain.GetSelected).strPhone
blnDial = True
Print #1, "CLOSE"
blnDial = False
Private Sub butEdit_Click()
lngIndex = lstMain.GetSelected
frmEdit.txtName = User(lstMain.GetSelected).strName
frmEdit.txtOtchectvo = User(lstMain.GetSelected).strOtchectvo
frmEdit.txtFamilia = User(lstMain.GetSelected).strFamilia
frmEdit.txtAdress = User(lstMain.GetSelected).strAdress
frmEdit.txtdoma = User(lstMain.GetSelected).strDoma
frmEdit.txtkvartira = User(lstMain.GetSelected).strKvartira
frmEdit.txtPhone = User(lstMain.GetSelected).strPhone
frmEdit.txtComment = User(lstMain.GetSelected).strComment
Private Sub butExit_Click()
Unload Me
Private Sub butOptions_Click()
Load frmOptions
frmOptions.Show vbModal
Private Sub Command1_Click()
bPoisk = True
If Dir(Path & "search.dat") <> "" Then Kill (Path & "search.dat")
butAdd.Visible = False
butEdit.Visible = True
butDelete.Visible = False
butAbout.Visible = False
butDial.Visible = False
butOptions.Visible = False
frmEdit.Show
Private Sub Command2_Click()
bPoisk = False
butAdd.Visible = True
butDelete.Visible = True
butAbout.Visible = True
' butDial.Visible = True
butOptions.Visible = True
Private Sub Form_DblClick()
WindowState = vbMinimized
Private Sub Form_Load()
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
Public Sub GetData()
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
If Not Exist(Path & "data.dat") Then Exit Sub
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
Slider.SetMax lstMain.GetMax
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
If lngWidth <= 6630 Then
lngWidth = 6630
Height = lngHeight
Width = lngWidth
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
Private Sub Form_Unload(Cancel As Integer)
' SaveData
If blnDial Then butDial_Click
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
Private Sub lstMain_Click(Button As Integer)
If Not Button = vbRightButton Then Exit Sub
PopupMenu mnuMain
Private Sub mnuAdd_Click()
butAdd_Click
Private Sub mnuDelete_Click()
butDelete_Click
Private Sub mnuDial_Click()
Страницы: 1, 2, 3