Банк Рефератов - Адресная книга на языке Visual Basic - скачать рефераты, бесплатно рефераты

Главная: Рефераты

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

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

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

If InStr(Trim(txtName.Text), sInfo) <> 0 Then

bInform = True

iCount = 0

Else

iCount = iCount + 1

End If

'Очество

Case 2

If InStr(Trim(txtOtchectvo.Text), sInfo) <> 0 Then

bInform = True

iCount = 0

Else

iCount = iCount + 1

End If

'Фамилия

Case 3

If InStr(Trim(txtFamilia.Text), sInfo) <> 0 Then

bInform = True

iCount = 0

Else

iCount = iCount + 1

End If

'Адрес

Case 4

If InStr(Trim(txtAdress.Text), sInfo) <> 0 Then

bInform = True

iCount = 0

Else

iCount = iCount + 1

End If

'Дом

Case 5

If InStr(Trim(txtdoma.Text), sInfo) <> 0 Then

bInform = True

iCount = 0

Else

iCount = iCount + 1

End If

'Квартира

Case 6

If InStr(Trim(txtkvartira.Text), sInfo) <> 0 Then

bInform = True

iCount = 0

Else

iCount = iCount + 1

End If

'Телефон

Case 7

If InStr(Trim(txtPhone.Text), sInfo) <> 0 Then

bInform = True

iCount = 0

Else

iCount = iCount + 1

End If

'Комментарий

Case 8

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)

Close #iFileNum

End If

Erase arrRecord

bInform = False

iCountLine = 0

iCount = 1

End If

Loop

'Показываем результат поиска

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

End If

If chkOnTop.Value = 1 Then

SetTop frmMain.hWnd, True

Else

SetTop frmMain.hWnd, False

End If

Unload Me

End Sub

Private Sub Form_Load()

On Error Resume Next

txtPort = Reg.RegRead("HKCU\Book\Port")

chkOnTop.Value = Reg.RegRead("HKCU\Book\OnTop")

optDialMode(Reg.RegRead("HKCU\Book\DialMode")).Value = True

If Reg.RegRead("HKCU\Book\OnTop") = True Then SetTop hWnd, True

End Sub

Private Sub Form_Unload(Cancel As Integer)

If Not IsNumeric(txtPort) Then

MsgBox "Поле номера порта модема должно быть цифровым"

Cancel = True

End If

End Sub

Private Sub txtPort_KeyPress(KeyAscii As Integer)

If Not IsNumeric(Chr(KeyAscii)) And Not KeyAscii = 8 Then KeyAscii = 0

End Sub

FrmAbout

Option Explicit

Private Sub butOk_Click()

Unload Me

End Sub

ModMain

Option Explicit

Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As Rect, ByVal edge As Long, ByVal grfFlags As Long) As Long

Public Declare Function SystemParametersInfoA Lib "user32" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long

Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long

Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Type Rect

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Public Type UserInfo

strName As String

strOtchectvo As String

strFamilia As String

strAdress As String

strDoma As String

strKvartira As String

strPhone As String

strComment As String

End Type

Public User() As UserInfo

Public lngIndex As Long

Public Reg As Object

Public blnDial As Boolean

Public Const Square As Long = &H1 Or &H2 Or &H4 Or &H8

'Для поиска

Public bPoisk As Boolean

Sub Main()

Set Reg = CreateObject("WSCRIPT.SHELL")

If App.PrevInstance = True Then

MsgBox "Программа уже запущенна..."

Else

Load frmMain

frmMain.Show

End If

End Sub

Public Sub SetTop(hWnd As Long, Top As Boolean)

Select Case Top

Case True

SetWindowPos hWnd, -1, 0, 0, 0, 0, 1 Or 2 Or 16

Case False

SetWindowPos hWnd, -2, 0, 0, 0, 0, 1 Or 2 Or 16

End Select

End Sub

Public Function Path() As String

If Right(App.Path, 1) = "\" Then Path = App.Path Else Path = App.Path & "\"

End Function

Public Function Exist(strFileName As String) As Boolean

If Dir(strFileName) = vbNullString Then Exist = False Else Exist = True

End Function

Использованные источники и литература

1. Программа помощи VB

2. Материалы сайта http://azbukavb.narod.ru/

3. Материалы сайта http://void.ru

4. Материалы сайта www.FileArea.co.il

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