CHƯƠNG TRÌNH TRÊN PC

44 129 0
CHƯƠNG TRÌNH TRÊN PC

Đang tải... (xem toàn văn)

Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống

Thông tin tài liệu

Cấu trúc chương trình : Chương trình 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) / 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(" Cổng 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 = 'MSC.InputLen = '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 = MSC.SThreshold = End Sub Private Sub ForceKey() cmd1ChonCong.Visible = False Main.Move _ (Screen.Width - Width) / 2, (Screen.Height - Height) / TabMain.Tab = '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("Bạn Chọn Trùng Đòa Chỉ, Mời Bạn Chọn Lạ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 = To NumNode 'Skip if the node isn't selected (active) on the Nodes form If Nodes.Active(count) = 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 End With End Sub ‘******************************************************* ‘ Quan ly gio 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) = " Mã Số" TextMatrix(0, 1) = " Họ Tên" TextMatrix(0, 2) = " Giờ Làm" End With rtxGioTrongNgay.SelText = "Mã Số" & Chr(vbKeyTab) & "Họ Tên" _ & Chr(vbKeyTab) & Chr(vbKeyTab) & "Giờ Làm" & vbCrLf rtxGioTrongNgay.Text = rtxGioTrongNgay.SelText & QLNhanVien.rtxGio.Text QLGioTrongNgay.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 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 = ShowOpen 'Hay cdl.Action = 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 = To 'For i = To numID Step 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 Bạn Nhập Đầy Đủ", 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) / 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) / 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 = ShowOpen 'Hay cdl.Action = 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 Bạn Lắp Đặt Máy In Vào ", vbOKOnly, "Thu Thập Nhiệt Độ") End Sub Private Sub mnuNSave_Click() Dim n As Integer On Error GoTo ErSave If TC.Canvas = "" Then M = MsgBox("Bạn Không Có Gì Để Save !", vbOKOnly, "Save Empty") Else lap: Main.cdl.Filter = "Text files (*.*)|*.*" Main.cdl.FileName = "" Main.cdl.Action = '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 = Const max_output = Const max_mf_in = Const max_mf_out = 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, To max_mf_in) As mfType Dim mf_out(1 To max_output, To max_mf_out) As mfType Dim Rule(1 To max_rule, 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 'n_mf_in(2)=3 so tap mo o ngo vao 'n_mf_out(1)=5 so tap mo o ngo la 'n_rule=9 Private Sub KD3() n_in = txtnIn n_out = txtnOut n_mf_in(1) = n_mf_in(2) = n_mf_out(1) = 'For i = To max_input 'n_mf_in(i) = txtmfin 'Next i 'For j = To max_output 'n_mf_out(j) = txtmfout 'Next j n_rule = 'n_mf_in(1) ^ n_in 'Khoi dong gia tri ban dau cho cac tap mo o ngo vao mf_in(1, 1).Name = "NE" mf_in(1, 1).Shape = mf_in(1, 1).Par(1) = -2 mf_in(1, 1).Par(2) = -1 mf_in(1, 1).Par(3) = mf_in(1, 2).Name = "ZE" mf_in(1, 2).Shape = mf_in(1, 2).Par(1) = -1 mf_in(1, 2).Par(2) = mf_in(1, 2).Par(3) = mf_in(1, 3).Name = "PO" mf_in(1, 3).Shape = mf_in(1, 3).Par(1) = mf_in(1, 3).Par(2) = mf_in(1, 3).Par(3) = 'Khoi dong gia tri ban dau cho cac tap mo o ngo vao mf_in(2, 1).Name = "NE" mf_in(2, 1).Shape = mf_in(2, 1).Par(1) = -2 mf_in(2, 1).Par(2) = -1 mf_in(2, 1).Par(3) = mf_in(2, 2).Name = "ZE" mf_in(2, 2).Shape = mf_in(2, 2).Par(1) = -1 mf_in(2, 2).Par(2) = mf_in(2, 2).Par(3) = mf_in(2, 3).Name = "PO" mf_in(2, 3).Shape = mf_in(2, 3).Par(1) = mf_in(2, 3).Par(2) = mf_in(2, 3).Par(3) = 'Khoi dong gia tri ban dau cho cac tap mo o ngo vao mf_out(1, 1).Name = "NB" mf_out(1, 1).Shape = mf_out(1, 1).Par(1) = -1 mf_out(1, 1).Name = "NS" mf_out(1, 1).Shape = mf_out(1, 1).Par(1) = -0.5 mf_out(1, 1).Name = "ZE" mf_out(1, 1).Shape = mf_out(1, 1).Par(1) = mf_out(1, 1).Name = "PS" mf_out(1, 1).Shape = mf_out(1, 1).Par(1) = 0.5 mf_out(1, 1).Name = "PB" mf_out(1, 1).Shape = mf_out(1, 1).Par(1) = 'He qui tac mo 'Neu nhiet la ZE va Nhietdot la ZE thi voltage la ZE Rule(1, 1) = Rule(1, 2) = Rule(1, 3) = 'Neu nhiet la ZE va Nhietdot la NE thi voltage la NS Rule(2, 1) = Rule(2, 2) = Rule(2, 3) = 'Neu nhiet la ZE va Nhietdot la PO thi voltage la PS Rule(1, 1) = Rule(1, 2) = Rule(1, 3) = 'Neu nhiet la NE va Nhietdot la ZE thi voltage la NS Rule(1, 1) = Rule(1, 2) = Rule(1, 3) = 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 = End If If ((xx > ll) And (xx cc) And (xx < rr)) Then mftri = (rr - xx) / (rr - cc) End If End Function 'Ket qua suy dien cua 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 = For x = To n_in If mf_in(i, r(i)).Shape = 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 = To n_out If mf_out(i, r(n_in + i)).Shape = Then OutVar = mf_out(i, r(n_in + i)).Par(1) * Weight End If Next y 'Ngoai 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 = To n_out OutVar(x) = wtsum = For x = To n_rule Weight = rWeight(Rule(i), inVar) tempOut = routVar(Rule(i), inVar) wtsum = wtsum + Weight For y = To n_out OutVar(y) = OutVar(y) + tempOut(y) Next y Next x For x = 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 = ShowOpen 'Hay cdl.Action = 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 = 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) / End Sub Phần source chương trình có đóa CD, xem dễ dàng đầy đủ [...]... 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... 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... 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("Bạn Không Có Gì Để Save hả !", vbOKOnly, "Save Empty") Else lap: cdlQLNhanVien.Filter = "Text files (*.TXT)|*.TXT" cdlQLNhanVien.FileName = "" cdlQLNhanVien.Action = 2 'Hay...On Error GoTo ErSave If txtNhapChu.Text = "" Then M = MsgBox("Bạn Không Có Gì Để Save hả !", vbOKOnly, "Save Empty") Else lap: cdlQLNhanVien.Filter = "Text files (*.TXT)|*.TXT" cdlQLNhanVien.FileName = "" cdlQLNhanVien.Action = 2 'Hay .. .Chương trình form Main: Option Explicit Dim i% Dim hMenu, hSubMenu, menuID, x Private Declare Function... 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... 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

Ngày đăng: 20/11/2015, 00:13

Tài liệu cùng người dùng

  • Đang cập nhật ...

Tài liệu liên quan