Caáu truùc chöông trình :

Chöông trình treân form Main:

Option Explicit
Dim i%
Dim hMenu, hSubMenu, menuID, x

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetSubMenu Lib "user32" _

(ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function GetMenuItemID Lib "user32" _

(ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" _

(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
ByVal wIDNewItem As Long, ByVal lpString As String) As Long

Private Declare Function SetMenuItemBitmaps Lib "user32" _

 (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Private Declare Function GetMenuCheckMarkDimensions Lib "user32" () As Long

Private Declare Function GetDC Lib "user32" _

(ByVal hwnd As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" _

(ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" _

(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function SelectObject Lib "gdi32" _

(ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function CreateBitmap Lib "gdi32" _

(ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function PatBlt Lib "gdi32" _

(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long

Private Declare Function GetSystemMetrics Lib "user32" _

(ByVal nIndex As Long) As Long

Private Sub abLOK_Click()

On Error GoTo None
Close #2
SelectFile
DataFile = [Link]
If optNSave(1).Value = True Then
If optNOver(0).Value = True Then
Open DataFile For Append As #2
Else
Open DataFile For Output As #2
End If
End If
None:
End Sub
Private Sub abNOK_Click()
On Error GoTo None
Close #1
SelectFile
DataFile = [Link]
If optNSave(1).Value = True Then
If optNOver(0).Value = True Then
Open DataFile For Append As #1
Else
Open DataFile For Output As #1
End If
End If
None:
End Sub

Private Sub abNVOK_Click()

On Error GoTo None
Close #3
SelectFile
DataFile = [Link]
If optNSave(1).Value = True Then
If optNOver(0).Value = True Then
Open DataFile For Append As #3
Else
Open DataFile For Output As #3
End If
End If
None:
End Sub

Private Sub Form_Load()

hMenu = GetMenu(hwnd)
hSubMenu = GetSubMenu(hMenu, 0) '1 for "Other" menu etcetera
menuID = GetMenuItemID(hSubMenu, 2)
x = SetMenuItemBitmaps(hMenu, menuID, 0, [Link](2).Picture, 0&)

[Link] ([Link] - Width) / 2, ([Link] - Height) / 2

optNSave(1).Value = True
optLSave(1).Value = True
optNVSave(1).Value = True

ForceKey
[Link] = False
[Link] = False
End Sub

Public Sub IniComPort()

Dim PortNumber, Baund As String

If [Link] = True Then

M = MsgBox(" Coång ñang môû ", vbOKOnly, "SelectCom")
[Link] = False
End If

PortNumber = Right([Link], 1)
[Link] = PortNumber
Baund = [Link]
[Link] = Baund + ",N,8,1"
[Link] = 0
'[Link] = 1 'Doc mot byte tai thoi diem mo port
[Link] = 256
'luu du lieu vao duoi dang text
[Link] = comInputModeText
[Link] = comNone
[Link] = 256
[Link] = False
[Link] = 0
[Link] = 0

End Sub

Private Sub ForceKey()

[Link] = False
[Link] _
([Link] - Width) / 2, ([Link] - Height) / 2
[Link] = 1
'NewNode
End Sub

Private Sub CboBaudrate_DropDown()

If [Link] = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub
Private Sub cboChonCong_DropDown()
If [Link] = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub

Private Sub cboDataBit_dropdown()

If [Link] = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub

Private Sub cboParity_DropDown()

If [Link] = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub

Private Sub cboStopBit_DropDown()

If [Link] = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub

Private Sub ebThemNode_Click()

'[Link] (" asd")
On Error GoTo None
[Link]
None:
End Sub
Private Sub imgOpenPort_Click()
[Link] = False
[Link] = True
[Link] = True
[Link] = False
[Link] = True
DSbar
End Sub

Private Sub imgClosePort_Click()

[Link] = True
[Link] = True
[Link] = False
[Link] = True
[Link] = False
ESbar
End Sub
Private Sub cmdChonCong_Click()
On Error GoTo Quit
'[Link] = True
IniComPort
[Link] = True
[Link] = True
[Link] = False

ESbar
[Link] = False
[Link] = True
Exit Sub
Quit:
M = MsgBox("COM Busy ... ", vbOKOnly, "Select other COM ")
'cmd1ChonCong_Click
End Sub
Private Sub cmd1ChonCong_Click()
[Link] = False
[Link] = False
[Link] = True
[Link] = False
[Link] = False
[Link] = True
DSbar
End Sub

Private Sub ESbar()

With SBar
With .Panels(1)
 .Text = " Connecting ..."
.ToolTipText = " Ñang Keát Noái "
End With

With .Panels(2)
.Text = " PortOpen "
.ToolTipText = " Coång Ñaõ Môû "
End With
End With
End Sub
Private Sub DSbar()
With SBar
With .Panels(1)
.Text = " DisConnecting "
.ToolTipText = " Chöa Keát Noái "
End With

With .Panels(2)
.Text = " ClosePort "
.ToolTipText = " Coång Ñang Ñoùng "
End With
End With
End Sub

Private Sub mnuAddNodes_Click()

[Link]
End Sub

Private Sub mnuAdd_Click()

[Link]
[Link]
End Sub

Private Sub mnuLed_Click()

[Link]
[Link]
End Sub

Private Sub mnuMNhanVien_Click()

[Link]
[Link]
End Sub

Private Sub mnuNhiet_Click()

[Link]
[Link]
End Sub

Private Sub mnunodes_Click()

On Error GoTo NoneOpenComm
If [Link] = False Then
M = MsgBox(" Baïn Chöa Môû Coång ", vbOKOnly, "Môû Coång")
End If
NoneOpenComm:
End Sub

Private Sub mnuNoiDung_Click()

[Link]
[Link]
End Sub

Private Sub mnuRun_Click()

If [Link] = False Then

M = MsgBox(" Baïn Chöa Môû Coång ", vbOKOnly, "Môû Coång")
Exit Sub
End If
End Sub

Private Sub mnuStart_Click()

'[Link] = True
[Link] = True
End Sub

Private Sub mnuStop_Click()

[Link] = False
[Link] = True
[Link] = True
[Link] = False
[Link] = True
DSbar
End Sub

Private Sub cmdChonAddr_Click()

AddrNhiet = Left([Link], 3)
AddrLed = Left([Link], 3)
AddrMaVach = Left([Link], 3)
'[Link] = Str(Asc(AddrNhiet))
If AddrNhiet = AddrLed Or AddrNhiet = AddrMaVach Then
M = MsgBox("Baïn Choïn Truøng Ñòa Chæ, Môøi Baïn Choïn Laïi", vbOKOnly,
"Select Again")
End If
If AddrLed = AddrMaVach Then
M = MsgBox("Baïn Choïn Truøng Ñòa Chæ, Môøi Baïn Choïn Laïi", vbOKOnly,
"Select Again")
End If

End Sub

Private Sub WriteResultsToFile()

'Save received data and time in a file.
Dim count As Integer
For count = 1 To NumNode
'Skip if the node isn't selected (active) on the Nodes form.
If [Link](count) = 1 Then
Write #2, _
count, _
[Link](count), _
Nodes.DataOut1(count), _
Nodes.DataOut2(count), _
Nodes.DataIn1(count), _
Nodes.DataIn2(count), _
[Link](count)
End If
Next count
End Sub

Sub SelectFile()
With [Link]
.Filter = "All files (*.txt)|*.txt"
.FileName = DataFile
.Flags = cdlOFNPathMustExist
.Flags = cdlOFNOverwritePrompt
.Flags = cdlOFNCreatePrompt
'Get the selected file from the common dialog box.
.ShowOpen
End With
End Sub

Private Sub mnuLSaveAs_Click()

mnuLSave_Click
End Sub

Private Sub mnuLSave_Click()

Dim n As Integer
 On Error GoTo ErSave
If [Link] = "" Then
M = MsgBox("Baïn Khoâng Coù Gì Ñeå Save haû !", vbOKOnly, "Save Empty")
Else
lap:
[Link] = "Text files (*.TXT)|*.TXT"
[Link] = ""
[Link] = 2
'Hay [Link]
If [Link] <> "" Then
Source = [Link]
If Dir([Link]) <> "" Then
n = MsgBox("Do you want to replace the existing " + _
[Link] + " ?", vbYesNoCancel + vbQuestion, "Save")
Select Case n
Case 6:
Save
[Link] ([Link])
[Link]
Case 7:
GoTo lap
End Select
Else
Save
[Link] ([Link])
[Link]
End If
End If
End If
ErSave:
Exit Sub

End Sub

Private Sub mnuThoat_Click()

Unload Me
'cmdChonCong_Click
End Sub

Private Sub optLSave_Click(Index As Integer)

If optLSave(0).Value = True Then
optLSave(1).Value = False
optLOver(0).Enabled = False
optLOver(1).Enabled = False
[Link] = False
 Else
optLSave(1).Value = True
optLOver(0).Enabled = True
optLOver(1).Enabled = True
optLOver(0).Value = True
[Link] = True
End If
End Sub

Private Sub optNSave_Click(Index As Integer)

If optNSave(0).Value = True Then

optNSave(1).Value = False
optNOver(0).Enabled = False
optNOver(1).Enabled = False
[Link] = False
Else
optNSave(1).Value = True
optNOver(0).Enabled = True
optNOver(1).Enabled = True
optNOver(0).Value = True
[Link] = True
End If
End Sub

Private Sub optNVSave_Click(Index As Integer)

If optNVSave(0).Value = True Then
optNVSave(1).Value = False
optNVOver(0).Enabled = False
optNVOver(1).Enabled = False
[Link] = False
Else
optNVSave(1).Value = True
optNVOver(0).Enabled = True
optNVOver(1).Enabled = True
optNVOver(0).Value = True
[Link] = True
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As [Link])

If [Link] = False Then

M = MsgBox(" Baïn Chöa Môû Coång ", vbOKOnly, "Môû Coång")
GoTo NoneOpenComm
 End If

Select Case [Link]

Case "Nhiet"
mnuNhiet_Click
Case "Led"
mnuLed_Click
Case "NhanVien"
mnuMNhanVien_Click
Case "Add"
mnuAdd_Click
Case "Play"
mnuStart_Click
Case "Stop"
mnuStop_Click
Case "Help"
mnuNoiDung_Click
End Select
NoneOpenComm:
End Sub

‘**************************************************************
Form Led
Dim i As Integer
Private Sub Command1_Click()
Dim S As Double
[Link] = False
S = Shell("E:\[Link]")
End Sub

Private Sub Form_Load()

[Link] ([Link] - Width) / 2, ([Link] - Height) / 2
End Sub

Private Sub LText1_Change()

On Error GoTo None
[Link] = " "
i = Len([Link])
[Link] = Mid(UCase([Link]), i, 1)
[Link] = [Link]
None:
End Sub
Private Sub cmdHienThi_Click()
'Close #2
[Link] = "$"
[Link] = " "
'Write #2, [Link]

End Sub

Private Sub ebClear_Click()

[Link] = " "
[Link] = ""
End Sub

Private Sub mnuLMain_Click()

[Link]
[Link]
End Sub

Private Sub mnuLNhanVien_Click()

[Link]
[Link]
End Sub

Private Sub mnuLNhiet_Click()

[Link]
[Link]
End Sub

Private Sub mnuLOpen_Click()

On Error GoTo ErOpen
With [Link]
.Filter = "Text Files (*.TXT)|*.TXT|"
.FilterIndex = 2
.ShowOpen
'Hay [Link] = 1

Set txtfile = [Link](.FileName)

Set ts = [Link](ForReading)
[Link] = [Link]
[Link]
End With
ErOpen:
Exit Sub
End Sub

Private Sub mnuLSave_Click()

Dim n As Integer

On Error GoTo ErSave

If [Link] = "" Then
M = MsgBox("Baïn Khoâng Coù Gì Ñeå Save haû !", vbOKOnly, "Save Empty")
Else
lap:
[Link] = "Text files (*.TXT)|*.TXT"
[Link] = ""
[Link] = 2
'Hay [Link]
If [Link] <> "" Then
Source = [Link]
If Dir([Link]) <> "" Then
n = MsgBox("Do you want to replace the existing " + _
[Link] + " ?", vbYesNoCancel + vbQuestion, "Save")
Select Case n
Case 6:
Save
[Link] ([Link])
'Write #2, [Link]
[Link]
Case 7:
 GoTo lap
End Select
Else
Save
[Link] ([Link])
'Write #2, [Link]
[Link]
End If
End If
End If
ErSave:
Exit Sub
End Sub

Private Sub mnuLThoaùt_Click()

Unload Me
[Link]
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As [Link])

Select Case [Link]
Case "Save"
mnuLSave_Click
Case "Open"
mnuLOpen_Click
Case "Main"
mnuLMain_Click
Case "Nhiet"
mnuLNhiet_Click
Case "nhanvien"
mnuLNhanVien_Click

End Select
End Sub
‘*************************************************************
From Quan ly nhan vien

Option Explicit

Private Type typID

ID(0 To numID) As Double
NameNV(0 To numID) As String
End Type
Dim NhanVien As typID

Dim ID1, ID2, ID3, ID4, ID5, ID6, ID7, ID8, ID9, ID10, ID11, ID12, ID13, ID14, ID15
As String

Private Sub cmdTimerID_Click()

[Link] = True
End Sub

Private Sub Form_Load()

DisIni
DisUpdate
[Link] _
([Link] - Width) / 2, ([Link] - Height) / 2
'[Link] = True
End Sub
Private Sub DisIni()
With MSNVTime
.TextMatrix(0, 0) = " Maõ Soá (ID)"
 .TextMatrix(0, 1) = " Hoï vaø Teân"
.TextMatrix(0, 2) = " Giôø Laøm"
End With
End Sub
Private Sub DisUpdate()
For i = 1 To numID
[Link](i) = [Link](2 * i)
' [Link](i) = [Link](i + 2)
Next i
For j = 1 To numID
'[Link](i) = [Link](2 * i)
[Link](j) = [Link](2 * j + 1)
Next j
End Sub
Private Sub Form_Resize()
With [Link]
'.Top = 1000
'.Left = 500
'.Width =
.ColWidth(0) = .Width * 0.2
.ColWidth(1) = .Width * 0.4
.ColWidth(2) = .Width * 0.365
End With
End Sub

Private Sub mnuGioTrongNgay_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLAddr_Click()

[Link] = 2
[Link]
[Link]
End Sub

Private Sub mnuQLAppend_Click()

On Error GoTo None
SelectFile
DataFile = [Link]
Open DataFile For Append As #3
None:
M = MsgBox("Baïn Khoâng Save ?", vbOKCancel, "Quaûn Lyù Nhaân Vieân")
End Sub
Private Sub mnuQLFind_Click()
[Link]
'[Link]
End Sub

Private Sub mnuQLLed_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLList_Click()

[Link]
End Sub

Private Sub mnuQLMain_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLNhiet_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLOpen_Click()

On Error GoTo ErOpen
With [Link]
.Filter = "Text Files (*.TXT)|*.TXT|"
.FilterIndex = 3
.ShowOpen
'Hay [Link] = 1

Set txtfile = [Link](.FileName)

Set ts = [Link](ForReading)
[Link]
[Link] = [Link]
[Link] = False
[Link] = True
'[Link] = [Link]
[Link]
End With
ErOpen:
Exit Sub
End Sub
Private Sub mnuQLOverrite_Click()
On Error GoTo NoneO
SelectFile
DataFile = [Link]
Open DataFile For Output As #3
NoneO:
M = MsgBox("Baïn Khoâng Save ?", vbOKCancel, "Quaûn Lyù Nhaân Vieân")
End Sub

Private Sub mnuQLThem_Click()

[Link]
'[Link]
End Sub

Private Sub mnuQLThoat_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLTime_Click()

[Link] = False
[Link]
[Link]
End Sub

Private Sub tmrNhanID_Timer()

'[Link] = 0
[Link] = "!"
[Link] = [Link] & [Link]
DisCheck
[Link] = ""
'HideDis
'ddd
End Sub
Private Sub HideDis(i As Byte)
'[Link] = "!"
'[Link] = [Link] & [Link]
With rtxGio
'.SelText = "Ngaøy: " & Format(dddd) & vbCrLf
'For i = 1 To numID
.SelStart = Len(.Text)
.SelText = [Link](i, 0) & Chr(vbKeyTab) & " " _
& [Link](i, 1) & Chr(vbKeyTab) & " "_
& [Link](i, 2) & Chr(vbKeyTab) & Chr(vbKeyTab) & vbCrLf
 'Next i
'Next i
End With
End Sub
Private Sub DisCheck()
With MSNVTime
Select Case [Link]
Case [Link](1)
[Link] = "#"
[Link] = "@"
.TextMatrix(1, 0) = [Link](1)
.TextMatrix(1, 1) = [Link](1)
.TextMatrix(1, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (1)
[Link] = ""
Case [Link](2)
[Link] = "#"
[Link] = "@"
.TextMatrix(2, 0) = [Link](2)
.TextMatrix(2, 1) = [Link](2)
.TextMatrix(2, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (2)
[Link] = ""
Case [Link](3)
[Link] = "#"
[Link] = "@"
.TextMatrix(3, 0) = [Link](3)
.TextMatrix(3, 1) = [Link](3)
.TextMatrix(3, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (3)
[Link] = ""
Case [Link](4)
[Link] = "#"
[Link] = "@"
.TextMatrix(4, 0) = [Link](4)
.TextMatrix(4, 1) = [Link](4)
.TextMatrix(4, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (4)
[Link] = ""
Case [Link](5)
[Link] = "#"
[Link] = "@"
.TextMatrix(5, 0) = [Link](5)
.TextMatrix(5, 1) = [Link](5)
.TextMatrix(5, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (5)
[Link] = ""
Case [Link](6)
[Link] = "#"
[Link] = "@"
.TextMatrix(6, 0) = [Link](6)
.TextMatrix(6, 1) = [Link](6)
.TextMatrix(6, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (6)
[Link] = ""
Case [Link](7)
[Link] = "#"
[Link] = "@"
.TextMatrix(7, 0) = [Link](7)
.TextMatrix(7, 1) = [Link](7)
.TextMatrix(7, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (7)
[Link] = ""
Case [Link](8)
[Link] = "#"
[Link] = "@"
.TextMatrix(8, 0) = [Link](8)
.TextMatrix(8, 1) = [Link](8)
.TextMatrix(8, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (8)
[Link] = ""
Case [Link](9)
[Link] = "#"
[Link] = "@"
.TextMatrix(9, 0) = [Link](9)
.TextMatrix(9, 1) = [Link](9)
.TextMatrix(9, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (9)
[Link] = ""
Case [Link](10)
[Link] = "#"
[Link] = "@"
.TextMatrix(10, 0) = [Link](10)
.TextMatrix(10, 1) = [Link](10)
.TextMatrix(10, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (10)
[Link] = ""
Case [Link](11)
[Link] = "#"
[Link] = "@"
.TextMatrix(11, 0) = [Link](11)
.TextMatrix(11, 1) = [Link](11)
 .TextMatrix(11, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (11)
[Link] = ""
Case [Link](12)
[Link] = "#"
[Link] = "@"
.TextMatrix(12, 0) = [Link](12)
.TextMatrix(12, 1) = [Link](12)
.TextMatrix(12, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (12)
[Link] = ""
Case [Link](13)
[Link] = "#"
[Link] = "@"
.TextMatrix(13, 0) = [Link](13)
.TextMatrix(13, 1) = [Link](13)
.TextMatrix(13, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (13)
[Link] = ""
Case [Link](14)
[Link] = "#"
[Link] = "@"
.TextMatrix(14, 0) = [Link](14)
.TextMatrix(14, 1) = [Link](14)
.TextMatrix(14, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (14)
[Link] = ""
Case [Link](15)
[Link] = "#"
[Link] = "@"
.TextMatrix(15, 0) = [Link](15)
.TextMatrix(15, 1) = [Link](15)
.TextMatrix(15, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (15)
[Link] = ""
End Select
End With
End Sub
Private Sub ddd()
For i = 1 To numID
Select Case [Link]
Case [Link](i)
[Link] = "#"
[Link] = "@"
[Link](i, 0) = [Link](i)
[Link](i, 1) = [Link](i)
 [Link](i, 2) = Time
End Select
Next i
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Save data
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub SelectFile()
With [Link]
.Filter = "All files (*.txt)|*.txt"
.FileName = DataFile
.Flags = cdlOFNPathMustExist
.Flags = cdlOFNOverwritePrompt
.Flags = cdlOFNCreatePrompt
'Get the selected file from the common dialog box.
.ShowOpen
End With
End Sub

Private Sub mnuLSaveAs_Click()

mnuLSave_Click
End Sub

Private Sub mnuLSave_Click()

Dim n As Integer

On Error GoTo ErSave

If [Link] = "" Then
M = MsgBox("Baïn Khoâng Coù Gì Ñeå Save haû !", vbOKOnly, "Save Empty")
Else
lap:
[Link] = "Text files (*.TXT)|*.TXT"
[Link] = ""
[Link] = 2
'Hay [Link]
If [Link] <> "" Then
Source = [Link]
If Dir([Link]) <> "" Then
n = MsgBox("Do you want to replace the existing " + _
[Link] + " ?", vbYesNoCancel + vbQuestion, "Save")
Select Case n
Case 6:
Save
[Link] ([Link])
[Link]
Case 7:
 GoTo lap
End Select
Else
Save
[Link] ([Link])
[Link]
End If
End If
End If
ErSave:
Exit Sub

End Sub

‘************************************************************
Them so nhan vien

Public Key As String

Private Sub ADONavBar1_Error(Number As Variant, Description As Variant, Source As
Variant)
 '
MsgBox CStr(Number) & vbCrLf & Description & vbCrLf & Source, vbCritical,
"ADONavBar Error!"
'
End Sub
Private Sub ADOActionBar1_Error(Number As Variant, Description As Variant, Source
As Variant)
'
MsgBox CStr(Number) & vbCrLf & Description & vbCrLf & Source, vbCritical,
"ADOActionBar Error!"
'
End Sub

Private Sub cmdFind_Click()

'
' call find pop-up dialog
'
[Link] = ""
'
[Link] vbModal
'
If [Link] <> "" Then
With [Link]
.MoveFirst
.Find "ID='" & [Link] & "'"
End With
End If
'
Unload FindNhanVien
'
End Sub

Private Sub cmdList_Click()

[Link]
End Sub

Private Sub Form_Resize()

'
' adjust custom ADO button controls
'
With Me.ADOActionBar1
.Width = [Link]
 .Height = 600
.Left = 0
.Top = 0
End With
'
With Me.ADONavBar1
.Width = [Link]
.Height = 600
.Left = 0
.Top = [Link] - 600
End With
'
End Sub
Private Sub Form_Load()
'
' set starting mode
'
[Link] = [Link]
'
With ADOActionBar1
.ADORecordset = [Link]
.FormMode = Edit
End With
'
[Link] ([Link] - Width) / 2, ([Link] - Height) / 2
End Sub

Private Sub mnuNVExit_Click()

[Link]
[Link]
End Sub

Private Sub mnuNVLed_Click()

[Link]
[Link]
End Sub

Private Sub mnuNVMain_Click()

[Link]
[Link]
End Sub

Private Sub mnuNVNhanVien_Click()

[Link]
[Link]
End Sub

Private Sub mnuNVNhiet_Click()

[Link]
[Link]
End Sub

‘*******************************************
‘Tim nhan vien

Private Sub Form_Load()

[Link] ([Link] - Width) / 2, ([Link] - Height) / 2
End Sub

Private Sub Form_Resize()

'
' adjust grid and columns
'
With Me.MSHFlexGrid1
.Left = 0
.Top = 0
.Height = [Link]
.Width = [Link]
.ColWidth(0) = .Width * 0.33
.ColWidth(1) = .Width * 0.67
End With
'
End Sub

Private Sub MSHFlexGrid1_DblClick()

'
' pass selected record to caller
'
With Me.MSHFlexGrid1
If .Col = 0 Then
 [Link] = .Text
[Link]
End If
End With
'
[Link]
End Sub

‘**************************************************
‘ Danh sach nhan vien

Private Sub Command1_Click()

[Link](11) = [Link]
End Sub
Private Sub Form_Load()
With Me
.Left = 0
.Top = 0
.Width = 12000
.Height = 9000
End With

With MSHFlexGrid1
.ColWidth(0) = .Width * 0.2
.ColWidth(1) = .Width * 0.13
End With
[Link] ([Link] - Width) / 2, ([Link] - Height) / 2
End Sub
Private Sub Form_Resize()

'
' adjust grid to form
'
With Me.MSHFlexGrid1
.Left = 0
.Top = 0
.Width = [Link]
.Height = [Link]
 End With
End Sub

‘*******************************************************
‘ Quan ly gio trong ngay

Option Explicit

Private Type typID

ID(1 To numID) As Double
NameNV(1 To numID) As String
End Type
Dim NhanVien As typID

Private Sub Command1_Click()

[Link] = False
[Link] = True
End Sub
Private Sub Form_Resize()
With Me.MSHFlexGrid1
'.Top = 1000
'.Left = 500
'.Width =
.ColWidth(0) = .Width * 0.2
.ColWidth(1) = .Width * 0.4
.ColWidth(2) = .Width * 0.39
End With
End Sub
Private Sub Form_Load()
[Link] = False
[Link] = False
With MSHFlexGrid1
.TextMatrix(0, 0) = " Maõ Soá"
.TextMatrix(0, 1) = " Hoï vaø Teân"
.TextMatrix(0, 2) = " Giôø Laøm"
End With
[Link] = "Maõ Soá" & Chr(vbKeyTab) & "Hoï vaø Teân" _
& Chr(vbKeyTab) & Chr(vbKeyTab) & "Giôø Laøm" & vbCrLf

[Link] = [Link] & [Link]

[Link] ([Link] - Width) / 2, ([Link] - Height) / 2
End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo None
Write #3, [Link]
[Link]
None:
End Sub

Private Sub mnuQLGLed_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLGMain_Click()

[Link]
[Link]
[Link]
End Sub

Private Sub mnuQLGNhanVien_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLGNhiet_Click()

[Link]
[Link]
End Sub

Private Sub mnuQLGOpen_Click()

On Error GoTo ErOpen
[Link] = False
[Link] = True
With [Link]
.Filter = "Text Files (*.TXT)|*.TXT|"
.FilterIndex = 3
.ShowOpen
'Hay [Link] = 1

Set txtfile = [Link](.FileName)

Set ts = [Link](ForReading)
[Link] = [Link]
[Link]
End With
ErOpen:
Exit Sub
End Sub

Private Sub mnuQLGThoat_Click()

Unload Me
'Write #3, [Link]
[Link]
End Sub

Private Sub tmrQLGioTrongNgay_Timer()

With rtxGioTrongNgay
'.SelStart = Len(.Text)
.SelText = [Link](0, 0) & Chr(vbKeyTab) _
& [Link](0, 1) & Chr(vbKeyTab) _
& [Link](0, 2) & Chr(vbKeyTab) &
Chr(vbKeyTab) & vbCrLf
For j = 1 To 2
'For i = 3 To numID Step 3
.SelStart = Len(.Text)
.SelText = [Link](j, 0) & Chr(vbKeyTab) _
 & [Link](j, 1) & Chr(vbKeyTab) _
& [Link](j, 2) & Chr(vbKeyTab) &
Chr(vbKeyTab) & vbCrLf
'Next i
Next j
End With
End Sub

‘******************************************************
‘ Chinh gio

Dim TDATA1, TDATA2, TDATA3, TDATA4 As String

Dim n As Integer

Private Sub ebChinhGio_Click()

If [Link] = "" Or [Link] = "" Then

M = MsgBox("Môøi Baïn Nhaäp Ñaày Ñuû", vbOKOnly, "Chænh Giôø")

Else
[Link]
[Link]
[Link] = True
End If
End Sub

Private Sub Form_Load()

[Link] = "i"
delay (200)
[Link] = "T"
delay (200)
[Link] = "O"
delay (200)
[Link] ([Link] - Width) / 2, ([Link] - Height) / 2
End Sub
Private Sub sbReset_MouseDown(Button As Integer, Shift As Integer, x As Single, y As
Single)
[Link] = "i"
delay (500)
[Link] = "T"
delay (500)
[Link] = "O"
delay (500)
'[Link] = ""
'[Link] = ""
End Sub

Private Sub txtGio_Change()

[Link] = ""
n = Len([Link])
[Link] = Mid(UCase([Link]), n, 1)
[Link] = [Link]
TDATA1 = Mid([Link], 1, 1)
TDATA2 = Mid([Link], 2, 1)
End Sub

Private Sub txtPhut_Change()

[Link] = ""
n = Len([Link])
[Link] = Mid(UCase([Link]), n, 1)
[Link] = [Link]
End Sub

‘***********************************************************
‘ Form Nhiet
Private Sub Form_Load()
[Link] _
([Link] - Width) / 2, ([Link] - Height) / 2
End Sub

Private Sub mnuNCont_Click()

[Link]
End Sub

Private Sub mnuNHthang_Click()

[Link]
[Link]
End Sub

Private Sub mnuNLed_Click()

[Link]
[Link]
End Sub

Private Sub mnuNMain_Click()

[Link]
[Link]
End Sub

Private Sub mnuNNhanVien_Click()

[Link]
[Link]
End Sub

Private Sub mnuNOpen_Click()

On Error GoTo ErOpen
With [Link]
.Filter = "Text Files (*.*)|*.*|"
.FilterIndex = 1
.ShowOpen
'Hay [Link] = 1

Set txtfile = [Link](.FileName)

Set ts = [Link](ForReading)
'[Link] = [Link]
[Link]
End With
ErOpen:
Exit Sub
End Sub

Private Sub mnuNPrint_Click()

M = MsgBox("Môøi Baïn Laép Ñaët Maùy In Vaøo ", vbOKOnly, "Thu Thaäp Nhieät
Ñoä")
End Sub

Private Sub mnuNSave_Click()

Dim n As Integer

On Error GoTo ErSave

If [Link] = "" Then
M = MsgBox("Baïn Khoâng Coù Gì Ñeå Save haû !", vbOKOnly, "Save Empty")
Else
lap:
[Link] = "Text files (*.*)|*.*"
[Link] = ""
[Link] = 2
'Hay [Link]
If [Link] <> "" Then
Source = [Link]
If Dir([Link]) <> "" Then
n = MsgBox("Do you want to replace the existing " + _
 [Link] + " ?", vbYesNoCancel + vbQuestion, "Save")
Select Case n
Case 6:
Save
[Link] ([Link])
'Write #2, [Link]
[Link]
Case 7:
GoTo lap
End Select
Else
Save
[Link] ([Link])
'Write #2, [Link]
[Link]
End If
End If
End If
ErSave:
Exit Sub
End Sub

Private Sub mnuNTgiac_Click()

[Link]
[Link]
End Sub

Private Sub mnuNThoat_Click()

[Link]
[Link]
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As [Link])

Select Case [Link]
Case "n1"
mnuNOpen_Click
Case "n2"
mnuNSave_Click
Case "n3"
mnuNPrint_Click
Case "n4"
mnuNMain_Click
Case "n5"
mnuNLed_Click
Case "n6"
mnuNNhanVien_Click
 Case "n7"
mnuNTgiac_Click
Case "n8"
mnuNHthang_Click
Case "n9"
mnuNCont_Click
End Select
End Sub

‘*********************************************************
‘ Chon ham lien thuoc dang tam giac

Option Explicit
'Hang so
Const max_input = 4
Const max_output = 2
Const max_mf_in = 5
Const max_mf_out = 7
Const max_rule = 625
'Cau truc du lieu
Private Type mfType
Name As String
Shape As Byte
Par(1 To 4) As Double
End Type

Dim InType(1 To max_input) As Double

Dim inVar(1 To max_input) As Double

'Dim outVar(1 To max_output) As Double

Dim RuleType(1 To max_input + max_output) As Byte
Dim r(1 To max_input + max_output) As Byte
'Dim Weight As Double

'Cac bien
Dim n_in As Byte
Dim n_out As Byte
Dim n_mf_in(1 To max_input) As Byte
Dim n_mf_out(1 To max_output) As Byte
Dim n_rule As Integer

Dim mf_in(1 To max_input, 1 To max_mf_in) As mfType

Dim mf_out(1 To max_output, 1 To max_mf_out) As mfType
Dim Rule(1 To max_rule, 1 To max_input + max_output) As Byte
'Khoi dong cac bien

'Nhap tu giao dien

'n_in=2
'n_out=1
'n_mf_in(1)=3 so tap mo o ngo vao 1
'n_mf_in(2)=3 so tap mo o ngo vao 2
'n_mf_out(1)=5 so tap mo o ngo ra la 5
'n_rule=9

Private Sub KD3()

n_in = txtnIn
n_out = txtnOut
n_mf_in(1) = 3
n_mf_in(2) = 3
n_mf_out(1) = 5
'For i = 1 To max_input
'n_mf_in(i) = txtmfin
'Next i
'For j = 1 To max_output
'n_mf_out(j) = txtmfout
'Next j
n_rule = 9 'n_mf_in(1) ^ n_in

'Khoi dong gia tri ban dau cho cac tap mo o ngo vao 1

mf_in(1, 1).Name = "NE"

mf_in(1, 1).Shape = 1
mf_in(1, 1).Par(1) = -2
mf_in(1, 1).Par(2) = -1
mf_in(1, 1).Par(3) = 0

mf_in(1, 2).Name = "ZE"

mf_in(1, 2).Shape = 1
mf_in(1, 2).Par(1) = -1
mf_in(1, 2).Par(2) = 0
mf_in(1, 2).Par(3) = 1

mf_in(1, 3).Name = "PO"

mf_in(1, 3).Shape = 1
mf_in(1, 3).Par(1) = 0
mf_in(1, 3).Par(2) = 1
mf_in(1, 3).Par(3) = 2

'Khoi dong gia tri ban dau cho cac tap mo o ngo vao 2
mf_in(2, 1).Name = "NE"
mf_in(2, 1).Shape = 1
mf_in(2, 1).Par(1) = -2
mf_in(2, 1).Par(2) = -1
mf_in(2, 1).Par(3) = 0

mf_in(2, 2).Name = "ZE"

mf_in(2, 2).Shape = 1
mf_in(2, 2).Par(1) = -1
mf_in(2, 2).Par(2) = 0
mf_in(2, 2).Par(3) = 1

mf_in(2, 3).Name = "PO"

mf_in(2, 3).Shape = 1
mf_in(2, 3).Par(1) = 0
mf_in(2, 3).Par(2) = 1
mf_in(2, 3).Par(3) = 2

'Khoi dong gia tri ban dau cho cac tap mo o ngo vao 2
mf_out(1, 1).Name = "NB"
mf_out(1, 1).Shape = 0
mf_out(1, 1).Par(1) = -1

mf_out(1, 1).Name = "NS"

mf_out(1, 1).Shape = 0
mf_out(1, 1).Par(1) = -0.5

mf_out(1, 1).Name = "ZE"

mf_out(1, 1).Shape = 0
mf_out(1, 1).Par(1) = 0

mf_out(1, 1).Name = "PS"

mf_out(1, 1).Shape = 0
mf_out(1, 1).Par(1) = 0.5

mf_out(1, 1).Name = "PB"

mf_out(1, 1).Shape = 0
mf_out(1, 1).Par(1) = 1

'He qui tac mo

'Neu nhiet la ZE va Nhietdot la ZE thi voltage la ZE
Rule(1, 1) = 1
Rule(1, 2) = 2
Rule(1, 3) = 3

'Neu nhiet la ZE va Nhietdot la NE thi voltage la NS

Rule(2, 1) = 2
Rule(2, 2) = 3
Rule(2, 3) = 4

'Neu nhiet la ZE va Nhietdot la PO thi voltage la PS

Rule(1, 1) = 2
Rule(1, 2) = 3
Rule(1, 3) = 4

'Neu nhiet la NE va Nhietdot la ZE thi voltage la NS

Rule(1, 1) = 1
Rule(1, 2) = 2
Rule(1, 3) = 2

End Sub
'Ham mo hoa doi voi ham lien thuoc dang tam giac
Private Function mftri(xx As Double, ll As Double, cc As Double, rr As Double) As
Double
If ((xx <= ll) Or (xx >= rr)) Then
mftri = 0
End If
If ((xx > ll) And (xx <= cc)) Then
mftri = (xx - ll) / (cc - ll)
End If
If ((xx > cc) And (xx < rr)) Then
mftri = (rr - xx) / (rr - cc)
End If
End Function
'Ket qua suy dien cua 1 quy tac mo
'(dung toan tu PROD de thuc hien toan tu AND)
'Private Sub one_rule_inference(r, inVar)
Private Sub rWeight(r, inVar)
'Dim outVar(1 To max_output) As Double
Dim riWeight As Double
Dim x, y As Byte
'Dim r(1 To max_input + max_output) As Byte

riWeight = 1

For x = 1 To n_in
If mf_in(i, r(i)).Shape = 1 Then
riWeight = riWeight * mftri(inVar(i), mf_in(i, r(i)).Par(1), mf_in(i, r(i)).Par(2), mf_in(i,
r(i).Par(3)))
End If
Next x
rWeight = riWeight
End Sub
Private Sub routVar(r, inVar)
Dim Weight As Double
Weight = rWeight(r, inVar)
For y = 1 To n_out
If mf_out(i, r(n_in + i)).Shape = 0 Then
OutVar = mf_out(i, r(n_in + i)).Par(1) * Weight
End If
Next y
'Ngoai ra con cac dang ham lien thuoc khac
routVar = OutVar
End Sub

'Ket qua suy dien cua he qui tac mo

Private Sub all_rule_inference(inVar)
Dim wtsum, Weight As Double
Dim tempOut(1 To max_output) As Double
Dim OutVar(1 To max_output) As Double
Dim x, y As Byte

For x = 1 To n_out
OutVar(x) = 0
wtsum = 0
For x = 1 To n_rule
Weight = rWeight(Rule(i), inVar)
tempOut = routVar(Rule(i), inVar)
wtsum = wtsum + Weight
For y = 1 To n_out
OutVar(y) = OutVar(y) + tempOut(y)
Next y
Next x

For x = 1 To n_out
OutVar(x) = OutVar(x) / Weight
Next x
all_rule_inference = OutVar
End Sub

Private Sub chkBangLuat_Click()

On Error GoTo ErOpen
With [Link]
.Filter = "Text Files (*.TXT)|*.TXT|"
.FilterIndex = 4
.ShowOpen
'Hay [Link] = 1

Set txtfile = [Link](.FileName)

Set ts = [Link](ForReading)
[Link] = [Link]
[Link]
End With

ErOpen:
Exit Sub
'With [Link]
'.FileName = "c:\[Link]"
'Set txtfile = [Link]([Link])
'Set ts = [Link](ForReading)
'[Link] = [Link]
'End With
[Link] = 1
End Sub

Private Sub Command1_Click()

KD3
End Sub

Private Sub ebBangLuatOK_Click()

[Link]
[Link]
End Sub

Private Sub Form_Load()

With MSBangDK
.ColWidth(0) = 1300
.ColWidth(1) = 1300
.ColWidth(2) = 1500
.TextMatrix(0, 0) = "ET"
.TextMatrix(0, 1) = "DET"
.TextMatrix(0, 2) = "OUT"
End With
[Link] _
([Link] - Width) / 2, ([Link] - Height) / 2

End Sub

Phaàn source chöông trình coù treân ñóa CD, xem seõ deã daøng
vaø ñaày ñuû hôn.