Mạng thu thập dữ liệu và quang báo

push acc CJNE A,#3FH,T_NHAY_KEP MOV R0,#0 LAP_DAU_HOI: MOV A,R0 MOV DPTR,#DAU_HOI MOVC A,@A+DPTR CJNE R0,#5,LAP_DAU_HOI CALL INC_DPTR ;************************************************** ;* NHAY_KEP * ;**************************************************** T_NHAY_KEP: pop acc push acc CJNE A,#22H,T_PHAY MOV R0,#0 LAP_NHAY_KEP: MOV A,R0 MOV DPTR,#NHAY_KEP MOVC A,@A+DPTR CJNE R0,#5,LAP_NHAY_KEP CALL INC_DPTR ;******************************************************** ;* PHAY * ;******************************************************** T_PHAY: pop acc push acc CJNE A,#2CH,T_CHAM MOV R0,#0 LAP_PHAY: MOV A,R0 MOV DPTR,#PHAY MOVC A,@A+DPTR CJNE R0,#5,LAP_PHAY CALL INC_DPTR ;******************************************************** ;* CHAM * ;******************************************************** T_CHAM: pop acc push acc CJNE A,#2EH,T_MO_NGOAC MOV R0,#0 LAP_CHAM: MOV A,R0 MOV DPTR,#CHAM MOVC A,@A+DPTR CJNE R0,#5,LAP_CHAM CALL INC_DPTR ;******************************************************** ;* MO_NGOAC * ;******************************************************** T_MO_NGOAC: pop acc push acc CJNE A,#28H,T_DONG_NGOAC MOV R0,#0 LAP_MO_NGOAC: MOV A,R0 MOV DPTR,#MO_NGOAC MOVC A,@A+DPTR CJNE R0,#5,LAP_MO_NGOAC CALL INC_DPTR ;******************************************************** ;* DONG_NGOAC * ;******************************************************** T_DONG_NGOAC: pop acc push acc CJNE A,#29H,T_SAO MOV R0,#0 LAP_DONG_NGOAC: MOV A,R0 MOV DPTR,#DONG_NGOAC MOVC A,@A+DPTR CJNE R0,#5,LAP_DONG_NGOAC CALL INC_DPTR ;******************************************************** ;* SAO * ;******************************************************** T_SAO: pop acc push acc CJNE A,#2AH,T_TIM MOV R0,#0 LAP_SAO: MOV A,R0 MOV DPTR,#SAO MOVC A,@A+DPTR CJNE R0,#5,LAP_SAO CALL INC_DPTR ;******************************************************* ;* TIM * ;******************************************************* T_TIM: pop acc push acc CJNE A,#7BH,T_RO MOV R0,#0 LAP_TIM: MOV A,R0 MOV DPTR,#TIM MOVC A,@A+DPTR CJNE R0,#5,LAP_TIM CALL INC_DPTR ;******************************************************* ;* RO * ;******************************************************* T_RO: pop acc push acc CJNE A,#7CH,T_RO_CONG MOV R0,#0 LAP_RO: MOV A,R0 MOV DPTR,#RO MOVC A,@A+DPTR CJNE R0,#5,LAP_RO CALL INC_DPTR ;******************************************************* ;* RO_CONG * ;******************************************************* T_RO_CONG: pop acc push acc CJNE A,#7DH,T_NONEWORDS MOV R0,#0 LAP_RO_CONG: MOV A,R0 MOV DPTR,#RO_CONG MOVC A,@A+DPTR CJNE R0,#5,LAP_RO_CONG CALL INC_DPTR ;******************************************************* ;* NONEWORDS * ;******************************************************* T_NONEWORDS: pop acc JMP WORD_CON ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;*Tro den data ke cua bang SaveWords ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ INC_DPTR: INC R2 CJNE R2,#00H,CON_INC_DPTR INC R1 CON_INC_DPTR: MOV DPH, R1 MOV DPL, R2 ;JMP WORD_CON RET ;*************************************** ; DISLED: ;*************************************** ;LOOP: DISLED: MOV R0, #0 MOV 3AH, #5 MOV 3BH, #0AH MOV 3CH, #0FH MOV 3DH, #14H LOOP1: ; Xuat led MOV DPTR, #0800H ; Tai addr 1CE0 MOV 3EH, R0 CALL INCDPTR MOV DPTR, #0A000H ; Addr 1 tu trai sang MOVX @DPTR, A MOV R7, 3AH MOV 3EH, R7 MOV DPTR, #0800H ; Tai addr 1CE0 CALL INCDPTR MOV DPTR, #8000H ; Addr 1 tu trai sang MOVX @DPTR, A INC R7 MOV 3AH, R7 MOV R7, 3BH MOV 3EH, R7 MOV DPTR, #0800H ; Tai addr 1CE0 CALL INCDPTR MOV DPTR, #6000H ; Addr 1 tu trai sang MOVX @DPTR, A INC R7 MOV 3BH, R7 MOV R7, 3CH MOV 3EH, R7 MOV DPTR, #0800H ; Tai addr 1CE0 CALL INCDPTR MOV DPTR, #4000H ; Addr 1 tu trai sang MOVX @DPTR, A INC R7 MOV 3CH, R7 MOV R7, 3DH MOV 3EH, R7 MOV DPTR, #0800H ; Tai addr 1CE0 CALL INCDPTR MOV DPTR, #2000H ; Addr 1 tu trai sang MOVX @DPTR, A INC R7 MOV 3DH, R7 ; COT MOV A, R0 MOV DPTR, #COT MOVC A, @A+DPTR MOV DPTR, #0C000H MOVX @DPTR, A ;CALL DELAY_3ms ;DELAY_3ms: MOV R1, #8 NHAN: MOV R7, #250 DJNZ R7, $ DJNZ R1, NHAN ;RET ; Xong ScanCot INC R0 CJNE R0, #5, LOOP1 CALL LEDRTI RET ;*************************************** ; LEDRTI: ;*************************************** LEDRTI: MOV 30H, #01H MOV 31H, #00H MOV B, 41H mov R2, 40H mov R3, 41H CALL CON_HIF RET CON_HIF: MOV DPL, 41H MOV DPH, 40H MOVX A, @DPTR CALL DEC_DPTR MOVX @DPTR, A MOV R3, 31H CJNE R6, #0FFH,HI_FF INC 40H HI_FF: INC B MOV 41H, B ;SS MOV A, R3 MOV 53H, B MOV R6, B CJNE R6, #0FFH, SSFF MOV 41H, #0FFH MOV 40H, #08H SSFF: CJNE A, 43H, EXITSS MOV A, R2 MOV 42H, 40H ;CO TROUB CJNE A, 42H, EXITSS MOV DPL, #0FFH MOV DPH, #08H MOVX A, @DPTR MOV DPL, R4 MOV DPH, R5 MOVX @DPTR, A JMP SHIFTONE EXITSS: JMP CON_HIF SHIFTONE: MOV DPL, R2 MOV DPH, R3 MOVX A, @DPTR CALL DEC_DPTR MOVX @DPTR, A RET ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ DEC_DPTR: MOV R5, DPL MOV R4, DPH DEC R5 MOV DPL, R5 CJNE R5, #0FFH, EXIT_DEC MOV R5, #0FFH DEC R4 MOV DPL, R5 MOV DPH, R4 EXIT_DEC: RET ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ INCDPTR: MOV A, #0 CONIC: CJNE A, 3EH, NCDPRAB MOVX A, @DPTR RET NCDPRAB: INC DPTR INC A JMP CONIC ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;++++++++++++++++++++++++++++++++++++++++++++ ;************************** ; Bang co dinh chua trong ROM ;************************** COT: DB 0FEH, 0FDH, 0FBH, 0F7H, 0EFH K_TRANG: DB 00H, 00H, 00H, 00H, 00H SO_0: DB 3EH, 41H, 41H, 41H, 3EH SO_1: DB 44H, 42H, 7FH, 40H, 40H SO_2: DB 32H, 49H, 49H, 49H, 46H SO_3: DB 22H, 41H, 49H, 49H, 36H SO_4: DB 0FH, 08H, 08H, 08H, 7FH SO_5: DB 4FH, 49H, 49H, 49H, 79H SO_6: DB 3FH, 49H, 49H, 49H, 32H SO_7: DB 00H, 01H, 01H, 01H, 7FH SO_8: DB 36H, 49H, 49H, 49H, 36H SO_9: DB 26H, 49H, 49H, 49H, 3EH CHU_A: DB 7EH, 09H, 09H, 09H, 7EH CHU_B: DB 7EH, 49H, 49H, 49H, 36H CHU_C: DB 3EH, 41H, 41H, 41H, 22H CHU_D: DB 7FH, 41H, 41H, 41H, 3EH CHU_E: DB 7FH, 49H,49H, 49H, 00H CHU_F: DB 7FH, 09H, 09H, 09H, 00H CHU_G: DB 3EH, 41H, 49H, 49H, 3AH CHU_H: DB 7FH, 08H, 08H, 08H, 7FH CHU_I: DB 00H, 41H, 7FH, 41H, 00H CHU_J: DB 20H, 41H, 3FH, 41H, 20H CHU_K: DB 7FH, 08H, 14H, 22H, 41H CHU_L: DB 7FH, 40H, 40H, 40H, 40H CHU_M: DB 7FH, 02H, 04H, 02H, 7FH CHU_N: DB 7FH, 02H, 04H, 08H, 7FH CHU_O: DB 3EH, 41H, 41H, 41H, 3EH CHU_P: DB 7FH, 09H, 09H, 09H, 06H CHU_Q: DB 3EH, 41H, 51H, 61H, 7EH CHU_R: DB 7FH, 09H, 19H, 29H, 46H CHU_S: DB 26H, 49H, 49H, 49H, 36H CHU_T: DB 01H, 01H, 7FH, 01H, 01H CHU_U: DB 3FH, 40H, 40H, 40H, 3FH CHU_V: DB 1FH, 20H, 40H, 20H, 1FH CHU_W: DB 1FH, 20H, 78H, 20H, 1FH CHU_X: DB 22H, 14H, 18H, 14H, 22H CHU_Y: DB 27H, 48H, 48H, 48H, 3FH CHU_Z: DB 22H, 32H, 2AH, 26H, 22H HAI_CHAM: DB 00H, 00H, 36H, 00H, 00H CHAM_PHAY: DB 00H, 00H, 56H, 30H, 00H NHO_HON: DB 00H, 08H, 14H, 22H, 00H BANG: DB 00H, 14H, 14H, 14H, 00H LON_HON: DB 00H, 22H, 14H, 08H, 00H DAU_HOI: DB 06H, 01H, 39H, 09H, 06H NHAY_KEP: DB 00H, 04H, 02H, 04H, 02H PHAY: DB 00H, 50H, 30H, 00H, 00H CHAM: DB 60H, 60H, 60H, 00H, 00H MO_NGOAC: DB 3EH, 4EH, 00H, 00H, 00H DONG_NGOAC: DB 00H, 00H, 00H, 4EH, 3EH SAO: DB 2AH, 14H, 3EH, 14H, 2AH TIM: DB 0CH, 12H, 24H, 12H, 0CH ; Shift {, 7B RO: DB 08H, 24H, 22H, 24H, 08H ; Shift | , 7C RO_CONG: DB 08H, 2CH, 3EH, 2CH, 08H ; Shift } , 7D ;======================================= ;========== END ; Doan chuong trinh tren kit thu thap nhiet do ; Doan chuong trinh an phim va truyen data len PC giong ; kit Nhan Vien ;~~~~~~ ; Gia tri tam ;~~~~~~~~~~~ TEMP_UNIT EQU 30H TEMP_TEN EQU 31H TEMP_HUNDR EQU 32H TEMP_THOU EQU 33H TEMP_POL EQU 34H THOUHUND EQU 35H TENUNIT EQU 36H ;************************************* ; Khoi dong 8255 ;************************************* MOV DPTR, #0A003H MOV A, #10000000B MOVX @DPTR, A ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; SAVEDATA: Lay gia tri tu 8255 luu vao o nho tam, xu ly ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ MOV DPTR, #0A000H MOV A, #12H MOVX @DPTR,A ; Tro Port A MOV TEMP_UNIT, A ;MOV TEMP_UNIT, #12H MOV DPTR, #0A001H MOV A, #02H MOVX @DPTR, A ; Tro Port B MOV TEMP_TEN, A ;MOV TEMP_TEN, #99H MOV DPTR, #0A002H MOV A, #78H MOVX @DPTR, A ; ; Tro Port C MOV TEMP_HUNDR, A ;MOV TEMP_HUNDR, #30H CALL SETTLEDATA MOV A, TEMP_POL CJNE A, #01H, ADDTOREAL CALL CONV_NEG ; Co cuc tinh INC R2 MOV TENUNIT, R2 MOV THOUHUND, R3 JMP OUTLED ADDTOREAL: CALL CONV_POS MOV TENUNIT, R2 MOV THOUHUND, R3 OUTLED: ;**************************************** ; OUTLED: ;**************************************** MOV A, TENUNIT ANL A, #0FH MOV DPTR, #TAB7SEG MOVC A, @A+DPTR MOV DPTR, #4000H MOVX @DPTR, A MOV DPTR, #6000H MOV A, #01H MOVX @DPTR, A CALL DELAY MOV A, TENUNIT SWAP A ANL A, #0FH MOV DPTR, #TAB7SEG MOVC A, @A+DPTR MOV DPTR, #4000H MOVX @DPTR, A MOV DPTR, #6000H MOV A, #02H MOVX @DPTR, A CALL DELAY MOV A, THOUHUND ANL A, #0FH MOV DPTR, #TAB7SEG MOVC A, @A+DPTR MOV DPTR, #4000H MOVX @DPTR, A MOV DPTR, #6000H MOV A, #04H MOVX @DPTR, A CALL DELAY MOV A, THOUHUND SWAP A ANL A, #0FH MOV DPTR, #TAB7SEG MOVC A, @A+DPTR MOV DPTR, #4000H MOVX @DPTR, A MOV DPTR, #6000H MOV A, #08H MOVX @DPTR, A CALL DELAY JMP OUTLED ;*************************************** ; SETTLEDATA: Doan chuong trinh xu ly so ;*************************************** SETTLEDATA: ;~~~~~~~~~ ; Xu ly hang don vi ;~~~~~~~~~~~~~~~~ MOV B,TEMP_UNIT ; Mov hang don vi vao B ANL B, #7FH ; Che bit AB(Hang nghin) MOV R0, #0 ; Bat dau kiem tra hang don vi la so may LOOP_UNIT: MOV A, R0 MOV DPTR, #TAB7SEG MOVC A, @A+DPTR CJNE A, B, CHECK_UNIT ; So sanh voi so trong bang, neu bang, gia tri do MOV A, R0 ; chinh la gia tri R0 MOV R2, A ; Mov donvi vao R2 JMP SETTLE_TEN CHECK_UNIT: INC R0 JMP LOOP_UNIT ;~~~~~~~~~ ; Xu ly hang chuc ;~~~~~~~~~~~~~~~~ SETTLE_TEN: MOV B,TEMP_TEN ; Mov hang chuc vao B ANL B, #7FH ; Che bit POL(Cuc Tinh) MOV R0, #0 ; Bat dau kiem tra hang chuc la so may LOOP_TEN: MOV A, R0 MOV DPTR, #TAB7SEG MOVC A, @A+DPTR CJNE A, B, CHECK_TEN ; So sanh voi so trong bang, neu bang, gia tri do ;MOV UNIT, R0 ; chinh la gia tri R0 MOV A, R0 ;ANL A, #0FH SWAP A ; A chua hang chuc, nam o byte cao CLR C ; Cac so tu 0 - 9 ADD A, R2 ; R2 chua hang don vi, nam o byte thap ;************************************** MOV R2, A ; R2 chua hang chuc va hang don vi ;************************************** JMP SETTLE_HUNDR CHECK_TEN: INC R0 JMP LOOP_TEN ;~~~~~~~~~ ; Xu ly hang tram ;~~~~~~~~~~~~~~~~ SETTLE_HUNDR: MOV B,TEMP_HUNDR ; Mov hang tram vao B ANL B, #7FH ; MOV R0, #0 ; Bat dau kiem tra hang tram la so may LOOP_HUNDR: MOV A, R0 MOV DPTR, #TAB7SEG MOVC A, @A+DPTR CJNE A, B, CHECK_HUNDR ; So sanh voi so trong bang, neu bang, gia tri do MOV A, R0 ; chinh la gia tri R0 MOV R3, A ; R3 chua hang tram, nam chi o byte thap(do 0-9) JMP SETTLE_THOU CHECK_HUNDR: INC R0 JMP LOOP_HUNDR ;~~~~~~~~ ; Xu ly hang ngan ;~~~~~~~~~~~~~~ ;Lay data tu o nho tam don vi (TEMP_UNIT) SETTLE_THOU: MOV A, TEMP_UNIT ANL A, #80H JNZ THOU ; do ngo ra cua 7107 tich cuc thap MOV TEMP_THOU, #1 ;Neu A =0 thi co hang nghin(save vao THOU =1) MOV A, #00010000B ADD A, R3 ;******************************************* MOV R3, A ;******************************************* JMP SETTLE_POL THOU: MOV TEMP_THOU, #0 ;Neu A = 1 thi khong co hang nghin ;~~~~~~~ ; Kiem tra cuc tinh ;~~~~~~~~~~~~~ ;Lay data tu o nho tam hang chuc SETTLE_POL: MOV A, TEMP_TEN ANL A, #80H JNZ POL ; do ngo ra cua 7107 tich cuc thap MOV TEMP_POL, #1 ; A= 0 co cuc tinh ( o nho tam POL =1 ) RET POL: MOV TEMP_POL, #0 RET ;************************************* ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Tru 2 so thap phan 4 chu so : ; R3 chua hang nghin va hang tram, R2 chua hang chuc va hang don vi( none settle) ; R3:R2=1A:9A - INC(R3):R2 . Day chinh la gia tri thuc ngo vao Analog ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;REAL_IN: CONV_NEG: MOV A, R2 ANL A, #01H JNZ SS_1mV INC R2 SS_1mV: MOV A, #9AH SUBB A, R2 MOV R2, A INC R3 MOV A, #1AH SUBB A, R3 MOV R3,A RET ;************************************** ;~~~~~~~~~~~~~~~~~~~~~~ ; Cong 2 so thap phan 4 chu so ; R3:R2=20:00+R3:R2 ;~~~~~~~~~~~~~~~~~~~~~~ CONV_POS: MOV A, #00H ADD A, R2 MOV R2, A MOV A, #20H ADD A, R3 MOV R3, A RET ;********************************** DELAY: MOV R2,#6 LAP: MOV R3,#250 DJNZ R3,$ DJNZ R2,LAP RET TAB7SEG: DB 40H, 79H, 24H, 30H, 19H, 12H, 02H, 78H, 00H, 10H DB 08H, 03H, 46H, 21H, 06H, 0EH END 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 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() 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(" Baïn Chöa Môû Coång ", vbOKOnly, "Môû Coå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(" Baïn Chöa Môû Coång ", vbOKOnly, "Môû Coå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("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 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) = " Hoï vaø Teân" .TextMatrix(0, 2) = " Giôø Laø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("Baïn Khoâng Save ?", vbOKCancel, "Quaûn Lyù Nhaân Vieâ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("Baïn Khoâng Save ?", vbOKCancel, "Quaûn Lyù Nhaân Vieâ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 = "Ngaø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) ' 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 ' Me.Key = "" ' FindNhanVien.Show vbModal ' If Me.Key "" Then With deNhanVien.rscomNhanVien .MoveFirst .Find "ID='" & Me.Key & "'" End With End If ' Unload FindNhanVien ' End Sub Private Sub cmdList_Click() ListNhanVien.Show End Sub Private Sub Form_Resize() ' ' adjust custom ADO button controls ' With Me.ADOActionBar1 .Width = Me.ScaleWidth .Height = 600 .Left = 0 .Top = 0 End With ' With Me.ADONavBar1 .Width = Me.ScaleWidth .Height = 600 .Left = 0 .Top = Me.ScaleHeight - 600 End With ' End Sub Private Sub Form_Load() ' ' set starting mode ' ADONavBar1.ADORecordset = deNhanVien.rscomNhanVien ' With ADOActionBar1 .ADORecordset = deNhanVien.rscomNhanVien .FormMode = Edit End With ' frmNhanVien.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub Private Sub mnuNVExit_Click() Main.Show frmNhanVien.Hide End Sub Private Sub mnuNVLed_Click() Led.Show frmNhanVien.Hide End Sub Private Sub mnuNVMain_Click() Main.Show frmNhanVien.Hide End Sub Private Sub mnuNVNhanVien_Click() QLNhanVien.Show frmNhanVien.Hide End Sub Private Sub mnuNVNhiet_Click() Nhiet.Show frmNhanVien.Hide End Sub ‘******************************************* ‘Tim nhan vien Private Sub Form_Load() FindNhanVien.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub Private Sub Form_Resize() ' ' adjust grid and columns ' With Me.MSHFlexGrid1 .Left = 0 .Top = 0 .Height = Me.ScaleHeight .Width = Me.ScaleWidth .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 frmNhanVien.Key = .Text Me.Hide End If End With ' frmNhanVien.Show End Sub ‘************************************************** ‘ Danh sach nhan vien Private Sub Command1_Click() MSHFlexGrid1.TextArray(11) = Text1.Text 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 ListNhanVien.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub Private Sub Form_Resize() ' ' adjust grid to form ' With Me.MSHFlexGrid1 .Left = 0 .Top = 0 .Width = Me.ScaleWidth .Height = Me.ScaleHeight 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() txtQLGio.Visible = False rtxGioTrongNgay.Visible = 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() tmrQLGioTrongNgay.Enabled = False txtQLGio.Visible = False With MSHFlexGrid1 .TextMatrix(0, 0) = " Maõ Soá" .TextMatrix(0, 1) = " Hoï vaø Teân" .TextMatrix(0, 2) = " Giôø Laøm" End With rtxGioTrongNgay.SelText = "Maõ Soá" & Chr(vbKeyTab) & "Hoï vaø Teân" _ & Chr(vbKeyTab) & Chr(vbKeyTab) & "Giôø Laøm" & vbCrLf rtxGioTrongNgay.Text = rtxGioTrongNgay.SelText & QLNhanVien.rtxGio.Text QLGioTrongNgay.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub Private Sub Form_Unload(Cancel As Integer) On Error GoTo None Write #3, QLNhanVien.rtxGio.Text QLNhanVien.Show None: End Sub Private Sub mnuQLGLed_Click() Led.Show QLGioTrongNgay.Hide End Sub Private Sub mnuQLGMain_Click() QLGioTrongNgay.Hide QLNhanVien.Hide Main.Show End Sub Private Sub mnuQLGNhanVien_Click() QLNhanVien.Show QLGioTrongNgay.Hide End Sub Private Sub mnuQLGNhiet_Click() Nhiet.Show QLGioTrongNgay.Hide End Sub Private Sub mnuQLGOpen_Click() On Error GoTo ErOpen rtxGioTrongNgay.Visible = False txtQLGio.Visible = True 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) txtQLGio.Text = ts.ReadAll ts.Close End With ErOpen: Exit Sub End Sub Private Sub mnuQLGThoat_Click() Unload Me 'Write #3, rtxGioTrongNgay.Text QLNhanVien.Show End Sub Private Sub tmrQLGioTrongNgay_Timer() With rtxGioTrongNgay '.SelStart = Len(.Text) .SelText = QLNhanVien.MSNVTime.TextMatrix(0, 0) & Chr(vbKeyTab) _ & QLNhanVien.MSNVTime.TextMatrix(0, 1) & Chr(vbKeyTab) _ & QLNhanVien.MSNVTime.TextMatrix(0, 2) & Chr(vbKeyTab) & Chr(vbKeyTab) & vbCrLf For j = 1 To 2 'For i = 3 To numID Step 3 .SelStart = Len(.Text) .SelText = QLNhanVien.MSNVTime.TextMatrix(j, 0) & Chr(vbKeyTab) _ & QLNhanVien.MSNVTime.TextMatrix(j, 1) & Chr(vbKeyTab) _ & QLNhanVien.MSNVTime.TextMatrix(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 txtGio.Text = "" Or txtPhut.Text = "" Then M = MsgBox("Môøi Baïn Nhaäp Ñaày Ñuû", vbOKOnly, "Chænh Giôø") Else ChinhGio.Hide QLNhanVien.Show QLNhanVien.tmrNhanID.Enabled = True End If End Sub Private Sub Form_Load() Main.MSC.Output = "i" delay (200) Main.MSC.Output = "T" delay (200) Main.MSC.Output = "O" delay (200) ChinhGio.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub Private Sub sbReset_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Main.MSC.Output = "i" delay (500) Main.MSC.Output = "T" delay (500) Main.MSC.Output = "O" delay (500) 'txtGio.Text = "" 'txtPhut.Text = "" End Sub Private Sub txtGio_Change() Text1.Text = "" n = Len(txtGio.Text) Text1.Text = Mid(UCase(txtGio.Text), n, 1) Main.MSC.Output = Text1.Text TDATA1 = Mid(txtGio.Text, 1, 1) TDATA2 = Mid(txtGio.Text, 2, 1) End Sub Private Sub txtPhut_Change() Text1.Text = "" n = Len(txtPhut.Text) Text1.Text = Mid(UCase(txtPhut.Text), n, 1) Main.MSC.Output = Text1.Text End Sub ‘*********************************************************** ‘ Form Nhiet Private Sub Form_Load() Nhiet.Move _ (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub Private Sub mnuNCont_Click() frmHelp.Show End Sub Private Sub mnuNHthang_Click() HinhThang.Show Nhiet.Hide End Sub Private Sub mnuNLed_Click() Nhiet.Hide Led.Show End Sub Private Sub mnuNMain_Click() Nhiet.Hide Main.Show End Sub Private Sub mnuNNhanVien_Click() Nhiet.Hide QLNhanVien.Show End Sub Private Sub mnuNOpen_Click() On Error GoTo ErOpen With Main.cdl .Filter = "Text Files (*.*)|*.*|" .FilterIndex = 1 .ShowOpen 'Hay cdl.Action = 1 Set txtfile = tsv.GetFile(.FileName) Set ts = txtfile.OpenAsTextStream(ForReading) 'TC.Repaint = ts.ReadAll ts.Close 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 TC.Canvas = "" Then M = MsgBox("Baïn Khoâng Coù Gì Ñeå Save haû !", vbOKOnly, "Save Empty") Else lap: Main.cdl.Filter = "Text files (*.*)|*.*" 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 mnuNTgiac_Click() ThongSoFz.Show Nhiet.Hide End Sub Private Sub mnuNThoat_Click() Nhiet.Hide Main.Show End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Key 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 = 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 Main.cdl .Filter = "Text Files (*.TXT)|*.TXT|" .FilterIndex = 4 .ShowOpen 'Hay cdl.Action = 1 Set txtfile = tsv.GetFile(.FileName) Set ts = txtfile.OpenAsTextStream(ForReading) Text1.Text = ts.ReadAll ts.Close End With ErOpen: Exit Sub 'With Main.cdl '.FileName = "c:\as.txt" 'Set txtfile = tsv.GetFile(Main.cdl.FileName) 'Set ts = txtfile.OpenAsTextStream(ForReading) 'Text1.Text = ts.ReadAll 'End With chkBangLuat.Value = 1 End Sub Private Sub Command1_Click() KD3 End Sub Private Sub ebBangLuatOK_Click() ThongSoFz.Hide Nhiet.Show 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 ThongSoFz.Move _ (Screen.Width - Width) / 2, (Screen.Height - 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.