Tải bản đầy đủ (.doc) (44 trang)

CHƯƠNG TRÌNH TRÊN PC

Bạn đang xem bản rút gọn của tài liệu. Xem và tải ngay bản đầy đủ của tài liệu tại đây (250.19 KB, 44 trang )

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 = cdl.FileName
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 = cdl.FileName

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 = cdl.FileName
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, img.ListImages(2).Picture, 0&)
Main.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
optNSave(1).Value = True

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


tmrTran.Enabled = False
QLNhanVien.tmrNhanID.Enabled = False
End Sub
Public Sub IniComPort()
Dim PortNumber, Baund As String
If MSC.PortOpen = True Then
M = MsgBox(" Coång ñang môû ", vbOKOnly, "SelectCom")
MSC.PortOpen = False
End If
PortNumber = Right(cboChonCong.Text, 1)
MSC.CommPort = PortNumber
Baund = CboBaudrate.Text
MSC.Settings = Baund + ",N,8,1"
MSC.InputLen = 0
'MSC.InputLen = 1 'Doc mot byte tai thoi diem mo port
MSC.InBufferSize = 256
'luu du lieu vao duoi dang text
MSC.InputMode = comInputModeText
MSC.Handshaking = comNone
MSC.OutBufferSize = 256
MSC.EOFEnable = False
MSC.RThreshold = 0
MSC.SThreshold = 0
End Sub
Private Sub ForceKey()

cmd1ChonCong.Visible = False
Main.Move _
(Screen.Width - Width) / 2, (Screen.Height - Height) / 2
TabMain.Tab = 1
'NewNode
End Sub
Private Sub CboBaudrate_DropDown()
If MSC.PortOpen = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub


Private Sub cboChonCong_DropDown()
If MSC.PortOpen = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub
Private Sub cboDataBit_dropdown()
If MSC.PortOpen = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:

End If
End Sub
Private Sub cboParity_DropDown()
If MSC.PortOpen = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub
Private Sub cboStopBit_DropDown()
If MSC.PortOpen = False Then
GoTo thoat
Else
cmd1ChonCong_Click
thoat:
End If
End Sub

Private Sub ebThemNode_Click()
'CboNode.AddItem (" asd")
On Error GoTo None
frmThemNode.Show
None:
End Sub


Private Sub imgOpenPort_Click()
MSC.PortOpen = False
imgOpenPort.Visible = True

imgClosePort.Visible = True
cmd1ChonCong.Visible = False
cmdChonCong.Visible = True
DSbar
End Sub
Private Sub imgClosePort_Click()
MSC.PortOpen = True
imgOpenPort.Visible = True
imgClosePort.Visible = False
cmd1ChonCong.Visible = True
cmdChonCong.Visible = False
ESbar
End Sub
Private Sub cmdChonCong_Click()
On Error GoTo Quit
'QLNhanVien.tmrNhanID = True
IniComPort
MSC.PortOpen = True
cmd1ChonCong.Visible = True
cmdChonCong.Visible = False
ESbar
imgClosePort.Visible = False
imgOpenPort.Visible = True
Exit Sub
Quit:
M = MsgBox("COM Busy ... ", vbOKOnly, "Select other COM ")
'cmd1ChonCong_Click
End Sub
Private Sub cmd1ChonCong_Click()
QLNhanVien.tmrNhanID = False

MSC.PortOpen = False
cmdChonCong.Visible = True
cmd1ChonCong.Visible = False
imgOpenPort.Visible = False
imgClosePort.Visible = True
DSbar
End Sub
Private Sub ESbar()
With SBar
With .Panels(1)


.Text = " Connecting ..."
.ToolTipText = " Đang Kết Nối "
End With
With .Panels(2)
.Text = " PortOpen "
.ToolTipText = " Cổng Đã Mở "
End With
End With
End Sub
Private Sub DSbar()
With SBar
With .Panels(1)
.Text = " DisConnecting "
.ToolTipText = " Chưa Kết Nối "
End With
With .Panels(2)
.Text = " ClosePort "
.ToolTipText = " Cổng Đang Đóng "

End With
End With
End Sub
Private Sub mnuAddNodes_Click()
frmNodes.Show
End Sub
Private Sub mnuAdd_Click()
frmThemNode.Show
Main.Hide
End Sub
Private Sub mnuLed_Click()
Led.Show
Main.Hide
End Sub
Private Sub mnuMNhanVien_Click()
QLNhanVien.Show
Main.Hide
End Sub
Private Sub mnuNhiet_Click()
Nhiet.Show
Main.Hide


End Sub
Private Sub mnunodes_Click()
On Error GoTo NoneOpenComm
If MSC.PortOpen = False Then
M = MsgBox(" Bạn Chưa Mở Cổng ", vbOKOnly, "Mở Cổng")
End If
NoneOpenComm:

End Sub
Private Sub mnuNoiDung_Click()
frmHelp.Show
Main.Hide
End Sub
Private Sub mnuRun_Click()
If MSC.PortOpen = False Then
M = MsgBox(" Bạn Chưa Mở Cổng ", vbOKOnly, "Mở Cổng")
Exit Sub
End If
End Sub
Private Sub mnuStart_Click()
'tmrTran.Enabled = True
QLNhanVien.tmrNhanID = True
End Sub
Private Sub mnuStop_Click()
MSC.PortOpen = False
imgOpenPort.Visible = True
imgClosePort.Visible = True
cmd1ChonCong.Visible = False
cmdChonCong.Visible = True
DSbar
End Sub
Private Sub cmdChonAddr_Click()
AddrNhiet = Left(CboAddrNhiet.Text, 3)
AddrLed = Left(CboAddrLed.Text, 3)
AddrMaVach = Left(CboAddrMaVach.Text, 3)
'Text2.Text = Str(Asc(AddrNhiet))
If AddrNhiet = AddrLed Or AddrNhiet = AddrMaVach Then
M = MsgBox("Bạn Chọn Trùng Đòa Chỉ, Mời Bạn Chọn Lạ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 Nodes.Active(count) = 1 Then
Write #2, _
count, _
Nodes.LastAccess(count), _
Nodes.DataOut1(count), _
Nodes.DataOut2(count), _
Nodes.DataIn1(count), _
Nodes.DataIn2(count), _
Nodes.Status(count)
End If
Next count
End Sub
Sub SelectFile()
With Main.cdl
.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 txtNhapChu.Text = "" Then
M = MsgBox("Baùn Khoõng Coự Gỡ ẹeồ Save haỷ !", vbOKOnly, "Save Empty")
Else
lap:
cdlQLNhanVien.Filter = "Text files (*.TXT)|*.TXT"
cdlQLNhanVien.FileName = ""
cdlQLNhanVien.Action = 2
'Hay cdl.ShowSave
If cdlQLNhanVien.FileName <> "" Then
Source = cdlQLNhanVien.FileName
If Dir(cdlQLNhanVien.FileName) <> "" Then
n = MsgBox("Do you want to replace the existing " + _
cdlQLNhanVien.FileName + " ?", vbYesNoCancel + vbQuestion, "Save")
Select Case n

Case 6:
Save
ts.Write (txtNhapChu.Text)
ts.Close
Case 7:
GoTo lap
End Select
Else
Save
ts.Write (txtNhapChu.Text)
ts.Close
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
abLOK.Enabled = False


Else

optLSave(1).Value = True
optLOver(0).Enabled = True
optLOver(1).Enabled = True
optLOver(0).Value = True
abLOK.Enabled = 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
abNOK.Enabled = False
Else
optNSave(1).Value = True
optNOver(0).Enabled = True
optNOver(1).Enabled = True
optNOver(0).Value = True
abNOK.Enabled = 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
abNVOK.Enabled = False
Else
optNVSave(1).Value = True
optNVOver(0).Enabled = True

optNVOver(1).Enabled = True
optNVOver(0).Value = True
abNVOK.Enabled = True
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
If MSC.PortOpen = False Then
M = MsgBox(" Baïn Chöa Môû Coång ", vbOKOnly, "Môû Coång")
GoTo NoneOpenComm


End If
Select Case Button.Key
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
Main.MSC.PortOpen = False
S = Shell("E:\Send1.exe")
End Sub
Private Sub Form_Load()
Led.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
End Sub
Private Sub LText1_Change()
On Error GoTo None
LText2.Text = " "
i = Len(LText1.Text)
LText2.Text = Mid(UCase(LText1.Text), i, 1)
Main.MSC.Output = LText2.Text
None:
End Sub
Private Sub cmdHienThi_Click()
'Close #2
Main.MSC.Output = "$"
LText2.Text = " "
'Write #2, LText1.Text
End Sub
Private Sub ebClear_Click()
LText1.Text = " "
LText2.Text = ""

End Sub
Private Sub mnuLMain_Click()
Main.Show
Led.Hide
End Sub
Private Sub mnuLNhanVien_Click()
QLNhanVien.Show
Led.Hide
End Sub
Private Sub mnuLNhiet_Click()
Nhiet.Show


Led.Hide
End Sub
Private Sub mnuLOpen_Click()
On Error GoTo ErOpen
With Main.cdl
.Filter = "Text Files (*.TXT)|*.TXT|"
.FilterIndex = 2
.ShowOpen
'Hay cdl.Action = 1
Set txtfile = tsv.GetFile(.FileName)
Set ts = txtfile.OpenAsTextStream(ForReading)
LText1.Text = ts.ReadAll
ts.Close
End With
ErOpen:
Exit Sub
End Sub

Private Sub mnuLSave_Click()
Dim n As Integer
On Error GoTo ErSave
If LText1.Text = "" Then
M = MsgBox("Baùn Khoõng Coự Gỡ ẹeồ Save haỷ !", vbOKOnly, "Save Empty")
Else
lap:
Main.cdl.Filter = "Text files (*.TXT)|*.TXT"
Main.cdl.FileName = ""
Main.cdl.Action = 2
'Hay cdl.ShowSave
If Main.cdl.FileName <> "" Then
Source = Main.cdl.FileName
If Dir(Main.cdl.FileName) <> "" Then
n = MsgBox("Do you want to replace the existing " + _
Main.cdl.FileName + " ?", vbYesNoCancel + vbQuestion, "Save")
Select Case n
Case 6:
Save
ts.Write (LText1.Text)
'Write #2, LText1.Text
ts.Close
Case 7:


GoTo lap
End Select
Else
Save
ts.Write (LText1.Text)

'Write #2, LText1.Text
ts.Close
End If
End If
End If
ErSave:
Exit Sub
End Sub
Private Sub mnuLThoaùt_Click()
Unload Me
Main.Show
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
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()
tmrNhanID.Enabled = True
End Sub
Private Sub Form_Load()
DisIni
DisUpdate
QLNhanVien.Move _
(Screen.Width - Width) / 2, (Screen.Height - Height) / 2
'tmrNhanID.Enabled = True
End Sub
Private Sub DisIni()
With MSNVTime
.TextMatrix(0, 0) = " Maõ Soá (ID)"


.TextMatrix(0, 1) = " Họ và Tên"
.TextMatrix(0, 2) = " Giờ Làm"
End With
End Sub
Private Sub DisUpdate()
For i = 1 To numID

NhanVien.ID(i) = FindNhanVien.MSHFlexGrid1.TextArray(2 * i)
' NhanVien.NameNV(i) = FindNhanVien.MSHFlexGrid1.TextArray(i + 2)
Next i
For j = 1 To numID
'NhanVien.ID(i) = FindNhanVien.MSHFlexGrid1.TextArray(2 * i)
NhanVien.NameNV(j) = FindNhanVien.MSHFlexGrid1.TextArray(2 * j + 1)
Next j
End Sub
Private Sub Form_Resize()
With Me.MSNVTime
'.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()
QLGioTrongNgay.Show
QLNhanVien.Hide
End Sub
Private Sub mnuQLAddr_Click()
Main.TabMain.Tab = 2
Main.Show
QLNhanVien.Show
End Sub
Private Sub mnuQLAppend_Click()
On Error GoTo None
SelectFile

DataFile = Main.cdl.FileName
Open DataFile For Append As #3
None:
M = MsgBox("Bạn Không Save ?", vbOKCancel, "Quản Lý Nhân Viên")
End Sub


Private Sub mnuQLFind_Click()
FindNhanVien.Show
'NhanVien.Show
End Sub
Private Sub mnuQLLed_Click()
Led.Show
QLNhanVien.Hide
End Sub
Private Sub mnuQLList_Click()
ListNhanVien.Show
End Sub
Private Sub mnuQLMain_Click()
Main.Show
QLNhanVien.Hide
End Sub
Private Sub mnuQLNhiet_Click()
Nhiet.Show
QLNhanVien.Hide
End Sub
Private Sub mnuQLOpen_Click()
On Error GoTo ErOpen
With Main.cdl
.Filter = "Text Files (*.TXT)|*.TXT|"

.FilterIndex = 3
.ShowOpen
'Hay cdl.Action = 1
Set txtfile = tsv.GetFile(.FileName)
Set ts = txtfile.OpenAsTextStream(ForReading)
QLGioTrongNgay.Show
QLGioTrongNgay.txtQLGio.Text = ts.ReadAll
QLGioTrongNgay.rtxGioTrongNgay.Visible = False
QLGioTrongNgay.txtQLGio.Visible = True
'rtxGio.Text = ts.ReadAll
ts.Close
End With
ErOpen:
Exit Sub
End Sub


Private Sub mnuQLOverrite_Click()
On Error GoTo NoneO
SelectFile
DataFile = Main.cdl.FileName
Open DataFile For Output As #3
NoneO:
M = MsgBox("Bạn Không Save ?", vbOKCancel, "Quản Lý Nhân Viên")
End Sub
Private Sub mnuQLThem_Click()
frmNhanVien.Show
'QLNhanVien.Hide
End Sub
Private Sub mnuQLThoat_Click()

Main.Show
QLNhanVien.Hide
End Sub
Private Sub mnuQLTime_Click()
tmrNhanID.Enabled = False
ChinhGio.Show
QLNhanVien.Hide
End Sub
Private Sub tmrNhanID_Timer()
'Main.MSC.InputLen = 0
Main.MSC.Output = "!"
Text1.Text = Text1.Text & Main.MSC.Input
DisCheck
Text1.Text = ""
'HideDis
'ddd
End Sub
Private Sub HideDis(i As Byte)
'Main.MSC.Output = "!"
'Text1.Text = Text1.Text & Main.MSC.Input
With rtxGio
'.SelText = "Ngày: " & Format(dddd) & vbCrLf
'For i = 1 To numID
.SelStart = Len(.Text)
.SelText = MSNVTime.TextMatrix(i, 0) & Chr(vbKeyTab) & " " _
& MSNVTime.TextMatrix(i, 1) & Chr(vbKeyTab) & "
"_
& MSNVTime.TextMatrix(i, 2) & Chr(vbKeyTab) & Chr(vbKeyTab) & vbCrLf



'Next i
'Next i
End With
End Sub
Private Sub DisCheck()
With MSNVTime
Select Case Text1.Text
Case NhanVien.ID(1)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(1, 0) = NhanVien.ID(1)
.TextMatrix(1, 1) = NhanVien.NameNV(1)
.TextMatrix(1, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (1)
Text1.Text = ""
Case NhanVien.ID(2)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(2, 0) = NhanVien.ID(2)
.TextMatrix(2, 1) = NhanVien.NameNV(2)
.TextMatrix(2, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (2)
Text1.Text = ""
Case NhanVien.ID(3)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(3, 0) = NhanVien.ID(3)
.TextMatrix(3, 1) = NhanVien.NameNV(3)
.TextMatrix(3, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (3)

Text1.Text = ""
Case NhanVien.ID(4)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(4, 0) = NhanVien.ID(4)
.TextMatrix(4, 1) = NhanVien.NameNV(4)
.TextMatrix(4, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (4)
Text1.Text = ""
Case NhanVien.ID(5)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(5, 0) = NhanVien.ID(5)
.TextMatrix(5, 1) = NhanVien.NameNV(5)
.TextMatrix(5, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (5)


Text1.Text = ""
Case NhanVien.ID(6)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(6, 0) = NhanVien.ID(6)
.TextMatrix(6, 1) = NhanVien.NameNV(6)
.TextMatrix(6, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (6)
Text1.Text = ""
Case NhanVien.ID(7)
Main.MSC.Output = "#"
Main.MSC.Output = "@"

.TextMatrix(7, 0) = NhanVien.ID(7)
.TextMatrix(7, 1) = NhanVien.NameNV(7)
.TextMatrix(7, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (7)
Text1.Text = ""
Case NhanVien.ID(8)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(8, 0) = NhanVien.ID(8)
.TextMatrix(8, 1) = NhanVien.NameNV(8)
.TextMatrix(8, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (8)
Text1.Text = ""
Case NhanVien.ID(9)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(9, 0) = NhanVien.ID(9)
.TextMatrix(9, 1) = NhanVien.NameNV(9)
.TextMatrix(9, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (9)
Text1.Text = ""
Case NhanVien.ID(10)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(10, 0) = NhanVien.ID(10)
.TextMatrix(10, 1) = NhanVien.NameNV(10)
.TextMatrix(10, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (10)
Text1.Text = ""
Case NhanVien.ID(11)

Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(11, 0) = NhanVien.ID(11)
.TextMatrix(11, 1) = NhanVien.NameNV(11)


.TextMatrix(11, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (11)
Text1.Text = ""
Case NhanVien.ID(12)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(12, 0) = NhanVien.ID(12)
.TextMatrix(12, 1) = NhanVien.NameNV(12)
.TextMatrix(12, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (12)
Text1.Text = ""
Case NhanVien.ID(13)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(13, 0) = NhanVien.ID(13)
.TextMatrix(13, 1) = NhanVien.NameNV(13)
.TextMatrix(13, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (13)
Text1.Text = ""
Case NhanVien.ID(14)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(14, 0) = NhanVien.ID(14)
.TextMatrix(14, 1) = NhanVien.NameNV(14)

.TextMatrix(14, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (14)
Text1.Text = ""
Case NhanVien.ID(15)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
.TextMatrix(15, 0) = NhanVien.ID(15)
.TextMatrix(15, 1) = NhanVien.NameNV(15)
.TextMatrix(15, 2) = Format(Time) & " " & Format(Now, "m/d/yy")
HideDis (15)
Text1.Text = ""
End Select
End With
End Sub
Private Sub ddd()
For i = 1 To numID
Select Case Text1.Text
Case NhanVien.ID(i)
Main.MSC.Output = "#"
Main.MSC.Output = "@"
MSNVTime.TextMatrix(i, 0) = NhanVien.ID(i)
MSNVTime.TextMatrix(i, 1) = NhanVien.NameNV(i)


MSNVTime.TextMatrix(i, 2) = Time
End Select
Next i
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Save data

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub SelectFile()
With Main.cdl
.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 txtNhapChu.Text = "" Then
M = MsgBox("Baùn Khoõng Coự Gỡ ẹeồ Save haỷ !", vbOKOnly, "Save Empty")
Else
lap:
cdlQLNhanVien.Filter = "Text files (*.TXT)|*.TXT"
cdlQLNhanVien.FileName = ""
cdlQLNhanVien.Action = 2
'Hay cdl.ShowSave
If cdlQLNhanVien.FileName <> "" Then
Source = cdlQLNhanVien.FileName
If Dir(cdlQLNhanVien.FileName) <> "" Then
n = MsgBox("Do you want to replace the existing " + _

cdlQLNhanVien.FileName + " ?", vbYesNoCancel + vbQuestion, "Save")
Select Case n
Case 6:
Save
ts.Write (txtNhapChu.Text)
ts.Close
Case 7:


GoTo lap
End Select
Else
Save
ts.Write (txtNhapChu.Text)
ts.Close
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)



Tài liệu bạn tìm kiếm đã sẵn sàng tải về

Tải bản đầy đủ ngay
×