Рефераты. Адресная книга на языке Visual Basic

Приложение

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

End Sub

Private Sub butAdd_Click()

ReDim Preserve User(UBound(User) + 1)

lngIndex = UBound(User)

Load frmEdit

frmEdit.Show vbModal

End Sub

Private Sub butDelete_Click()

On Error Resume Next

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

End Sub

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

End If

Close

blnDial = True

Else

Open "COM" & Reg.RegRead("HKCU\Book\Port") For Output As #1

Print #1, "CLOSE"

Close

blnDial = False

End If

End Sub

Private Sub butEdit_Click()

lngIndex = lstMain.GetSelected

Load frmEdit

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

frmEdit.Show vbModal

End Sub

Private Sub butExit_Click()

Unload Me

End Sub

Private Sub butOptions_Click()

Load frmOptions

frmOptions.Show vbModal

End Sub

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

End Sub

Private Sub Command2_Click()

bPoisk = False

butAdd.Visible = True

butEdit.Visible = True

butDelete.Visible = True

butAbout.Visible = True

' butDial.Visible = True

butOptions.Visible = True

GetData

End Sub

Private Sub Form_DblClick()

WindowState = vbMinimized

End Sub

Private Sub Form_Load()

On Error Resume Next

GetData

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()

Страницы: 1, 2, 3



2012 © Все права защищены
При использовании материалов активная ссылка на источник обязательна.