Những ứng dụng Visual Basic có thể đáp ứng một số lượng lớn sự kiện chuột, bàn phím. Ví dụ FORM, hộp ảnh và những điều khiển ảnh có thể phát hiện vị trí con trỏ chuột có thể quyết định phím trái hay phím phải được nhấn,và có thể đáp ứng được những tổ hợp của phím chuột với phím Shift, Ctrl hay Alt. Sử dụng những điều khiển phím, ta có thể lập trình những điều khiển và FORM để đáp ứng các hành động phím hoặc phiên dịch bộ mã Ascii của ký tự.
 
                
              
                                            
                                
            
 
            
                
153 trang | 
Chia sẻ: maiphuongdc | Lượt xem: 1611 | Lượt tải: 0
              
            Bạn đang xem trước 20 trang tài liệu Đề tài Phân tích hệ thống thông tin quản lý bán hàng, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trên
, SQLTimkiemKH
 If dataKhachhangLoc.Recordset.RecordCount = 0 Then
 MsgBox "Không tìm thấy khách hàng có mã: " & cboKhachhangLocMa.Text & "", vbInformation, "Thông báo"
 cboKhachhangLocMa.SelStart = 0
 cboKhachhangLocMa.SelLength = Len(cboKhachhangLocMa.Text)
 Exit Sub
 Else
 lblKQTK.Visible = True
 End If
loi:
End Sub
Private Sub Form_Load()
 Dim SQL As String
 SQL = "Select KhachhangID From tblKhachhang"
 HienForm Me
 CauhinhLuoiPhu VSFlexGridKhachhangLoc
 KhoitaoADODB SQL
 With cboKhachhangLocMa
 .AddItem "Tất cả"
 End With
 With rsado
 Do Until .EOF = True
 cboKhachhangLocMa.AddItem .Fields("KhachhangID").Value
 .MoveNext
 Loop
 .Close
 End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
 cnado.Close
 Set cnado = Nothing
End Sub
Option Explicit
Private Sub cmdBangtinh_Click()
 On Error GoTo loi
 Shell "C:\WINDOWS\CALC.EXE", vbMaximizedFocus
loi:
Exit Sub
End Sub
Private Sub cmdBCBHTheoHH_Click()
 rptBCBHTheoHH.Show
End Sub
Private Sub cmdBCBHTheoNCC_Click()
 rptBCBHTheoNCC.Show
End Sub
Private Sub cmdBCBHTheonhom_Click()
 rptBCBHTheoNhomHH.Show
End Sub
Private Sub cmdBCBHTheoNV_Click()
 rptBCBHTheoNV.Show
End Sub
Private Sub cmdBCBHTheoQui_Click()
 imgMuiten.Visible = True
 frmQui.Show
End Sub
Private Sub cmdBCDSSP_Click()
 frmBCHang.Show
 imgMuiten1.Visible = True
End Sub
Private Sub cmdBCBHTheothang_Click()
 rptBCBHTheoThang.Show
End Sub
Private Sub cmdBCDSHH_Click()
 imgMuiten1.Visible = True
 frmBCHang.Show
End Sub
Private Sub cmdBCDSKhach_Click()
 rptDSKhachhang.Show
End Sub
Private Sub cmdExcel_Click()
 On Error GoTo loi
 Shell "C:\Program Files\Microsoft Office\Office\EXCEL.EXE", vbMaximizedFocus
loi:
 Exit Sub
End Sub
Private Sub cmdHanghoa_Click()
 frmSanpham.Show
End Sub
Private Sub cmdLuuDL_Click()
 On Error GoTo loi
 Dim Ten As String
 With comdHopthoai
 .CancelError = True
 .DialogTitle = "Bạn phải đặt tên File thì mới Backup được dữ liêu"
 .Filter = "Text Files(*.txt)|*.txt|Microsoft Words(*.doc)|*.doc|All Files(*.*)|*.*"
 .FilterIndex = 1
 .MaxFileSize = 200
 .InitDir = "C:\QLKH\Backup"
 .ShowSave
 Screen.MousePointer = 99
 Screen.MouseIcon = LoadPicture("C:\QLKH\GRAPHICS\CURSORS\Wait07.cur")
 Ten = frmChitietHD.VSFlexGrid1ChitietHD.Name
 frmChitietHD.VSFlexGrid1ChitietHD.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 Ten = frmHDBanhang.VSFlexGrid1HD.Name
 frmHDBanhang.VSFlexGrid1HD.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 Ten = frmKhachhang.VSFlexGridKhachhang.Name
 frmKhachhang.VSFlexGridKhachhang.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 Ten = frmNguoigui.VSFlexGrid1NgGui.Name
 frmNguoigui.VSFlexGrid1NgGui.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 Ten = frmNhaCCap.VSFlexGrid1Ncc.Name
 frmNhaCCap.VSFlexGrid1Ncc.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 Ten = frmNhanvienbanhang.VSFlexGrid1Nnbh.Name
 frmNhanvienbanhang.VSFlexGrid1Nnbh.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 Ten = frmNhomSP.VSFlexGrid1NhomHH.Name
 frmNhomSP.VSFlexGrid1NhomHH.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 Ten = frmSanpham.VSFlexGrid1SP.Name
 frmSanpham.VSFlexGrid1SP.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll
 MousePointer = 0
 End With
loi:
End Sub
Private Sub cmdLuuDL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthich
 .Visible = True
 .Caption = "Cho phép bạn lưu bảng dữ liệu lên tệp *.txt với tên tệp được đặt tự động"
 End With
End Sub
Private Sub cmdNapDL_Click()
 frmXemDLCu.Show
End Sub
Private Sub cmdNapDL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthich
 .Visible = True
 .Caption = "Cho phép bạn xem dữ liệu đẫ được backup lên tệp *.txt"
 End With
End Sub
Private Sub cmdNhapCTietHD_Click()
 frmChitietHD.Show
End Sub
Private Sub cmdNhapHDBH_Click()
 frmHDBanhang.Show
End Sub
Private Sub cmdNhapKhachhang_Click()
 frmKhachhang.Show
End Sub
Private Sub cmdNhapNCC_Click()
 frmNhaCCap.Show
End Sub
Private Sub cmdNhapNguoigui_Click()
 frmNguoigui.Show
End Sub
Private Sub cmdNhapNhomSP_Click()
 frmNhomSP.Show
End Sub
Private Sub cmdThoatCT_Click()
 Unload Me
End Sub
Private Sub cmdQLNSD_Click()
 MsgBox "Tính năng này sẽ được phát triển trong phiên bản sau", vbInformation, "Thông báo"
End Sub
Private Sub cmdQLNSD_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthich
 .Visible = True
 .Caption = "Tính năng này chưa được nghiên cứu,xin bạn hãy chờ đến phiên bản sau"
 End With
End Sub
Private Sub cmdThoat_Click()
 Unload Me
End Sub
Private Sub cmdTonghop_Click()
 imgMuiten2.Visible = True
 frmTonghop.Show
End Sub
Private Sub cmdTonghop_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthichTH
 .Visible = True
 .Caption = "Cho phép ta xem thông tin dưới dạng lưới cô đọng hoặc có thể xuất dữ liệu lên Excel"
 End With
End Sub
Private Sub cmdTrogiup_Click()
 MsgBox "Tính năng này sẽ được phát triển trong phiên bản sau.", vbInformation, "Thông báo"
End Sub
Private Sub cmdTrogiup_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthich
 .Visible = True
 .Caption = "Tính năng này chưa có"
 End With
End Sub
Private Sub cmdWord_Click()
 On Error GoTo loi
 Shell "C:\Program Files\Microsoft Office\Office\WINWORD.EXE", vbMaximizedFocus
loi:
 Exit Sub
End Sub
Private Sub cmdXemTT_Click()
 frmTreeView.Show
End Sub
Private Sub cmdXemTT_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthichTT
 .Visible = True
 .Caption = "Cung cấp thông tin một cách trực quan về kết quả bán hàng của từng nhân viên,hàng hoá v.v..."
 End With
End Sub
Private Sub cmdXoaDL_Click()
 If MsgBox("Thực hiện công việc này sẽ làm cho dữ liệu bị xoá hết.Bạn có muốn tiếp tục hay không?", vbYesNo + vbCritical, "Thông báo") = vbYes Then
 XoaTatCaDL frmChitietHD.dataCTHD
 XoaTatCaDL frmHDBanhang.dataHDBH
 XoaTatCaDL frmNhanvienbanhang.dataNvbh
 XoaTatCaDL frmKhachhang.dataKhachhang
 XoaTatCaDL frmNguoigui.dataNguoigui
 XoaTatCaDL frmSanpham.dataSanpham
 XoaTatCaDL frmNhaCCap.dataNhaCC
 XoaTatCaDL frmSanpham.dataSanpham
 Else
 Exit Sub
 End If
End Sub
Private Sub cmdXoaDL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthich
 .Visible = True
 .Caption = "Nghịch vào đây sẽ rất nguy hiển,dữ liệu sẽ bị mất tất,hãy cẩn thận nhé."
 End With
End Sub
Private Sub cmnNhapNVBH_Click()
 frmNhanvienbanhang.Show
End Sub
Private Sub Form_Load()
 HienForm Me
 Me.tabLienket.Tab = 0
 lblChuchay.Top = 120
 lblChuchay.Left = Picture2.Width
End Sub
Private Sub Form_Unload(Cancel As Integer)
 Unload frmQui
 Unload frmBCHang
 Unload frmTonghop
 Unload frmDothi
 Unload frmXemDLCu
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthichTT
 .Visible = False
 End With
End Sub
Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthichTH
 .Visible = False
 End With
End Sub
Private Sub Image3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 With lblChuthich
 .Visible = False
 End With
End Sub
Private Sub Timer1_Timer()
 Dim X As Integer
 X = 15
 If lblChuchay.Left > -lblChuchay.Width Then
 lblChuchay.Left = lblChuchay.Left - X
 Else
 lblChuchay.Left = frmLienket.Picture2.Width
 'Timer1_Timer
 End If
End Sub
Option Explicit
Private GuiTT As String
Private Sub cmdLocnhanh_Click()
 frmNguoiguiLoc.Show
End Sub
Private Sub cmdLuu_Click()
 'Gọi thủ tục KhoitaolucLuu
 KhoitaoControlsLucLuu Me
 With dataNguoigui.Recordset
 .Fields("MaNGui").Value = txtNgGuiMa.Text
 .Fields("TenCtyGui").Value = txtNgGuiTenCty.Text
 .Fields("Dienthoai").Value = txtNgGuiDThoai.Text
 .Fields("Fax").Value = txtNgGuiFax.Text
 .Fields("Email").Value = txtNgGuiE_mail.Text
 .Fields("Wedside").Value = txtNgGuiSide.Text
 .Update
 End With
 dataNguoigui.Refresh
 'Gọi thủ tục
 dataNguoigui.Recordset.MoveLast
 Vohieuhoa Me
End Sub
Private Sub cmdThem_Click()
 Dim SQLMatudong As String
 SQLMatudong = "Select Max([MaNGui]) as Lonnhat From tblNguoigui"
 'Gọi thủ tục tạo data kết nối cho txtNguoiguiMa
 Ketnoi dataMatudong, SQLMatudong
 dataNguoigui.Recordset.AddNew
 'Gọi thủ tục để khởi tạo Controls lúc thêm
 KhoitaoControlsLucThem Me
 'Tự động điền mã vào txtNguoiguimMa
 If dataNguoigui.Recordset.RecordCount = 0 Then
 txtNgGuiMa.Text = "1"
 dataNguoigui.Caption = "1"
 Else
 With dataMatudong
 txtNgGuiMa.Text = "" & .Recordset.Fields("Lonnhat").Value + 1
 dataNguoigui.Caption = "" & .Recordset.Fields("Lonnhat").Value + 1
 End With
 End If
 txtNgGuiTenCty.SetFocus
 lblMatudong.Visible = True
End Sub
Private Sub cmdXoa_Click()
 If dataNguoigui.Recordset.RecordCount > 0 Then
 If dataNguoiguiCtietHD.Recordset.RecordCount > 0 Then
 MsgBox "Bạn không thể xoá được bản ghi này,vì nó còn xuất hiện trong bảng con.", vbInformation, "Thông báo"
 Exit Sub
 Else
 'Gọi thủ tục xoá
 Xoa dataNguoigui
 dataNguoigui.Recordset.MoveLast
 End If
 Else
 MsgBox "Không có dữ liệu để xoá.", vbInformation, "Thông báo"
 Exit Sub
 End If
End Sub
Private Sub dataNguoigui_Reposition()
 On Error GoTo loi
 Dim SQLNguoiguiCTHD As String
 SQLNguoiguiCTHD = "Select *" & _
 " From tblHoadon" & _
 " Where NGuiID=" & dataNguoigui.Recordset.Fields("MaNGui").Value & ""
 'Gọi thủ tục tạo data kết nối cho lưới phụ
 Ketnoi dataNguoiguiCtietHD, SQLNguoiguiCTHD
 With dataNguoigui
 .Caption = "" & .Recordset.Fields("MaNGui").Value
 End With
 With VSFlexGrid1NgGuiCTHD
 .MergeCells = flexMergeRestrictColumns
 .MergeCol(5) = True
 End With
loi:
End Sub
Private Sub Form_Load()
 Dim SQLNguoigui As String
 SQLNguoigui = "Select * From tblNguoigui"
 'Gọi thủ tục HienForm
 HienForm Me
 'Gọi thủ tục vô hiệu hoá các điều khiển không cần thiết
 Vohieuhoa Me
 'Gọi thủ tục khởi tạo data kết nối
 Ketnoi dataNguoigui, SQLNguoigui
 'Gọi thủ tục định dạng lưới
 CauhinhLuoiChinh VSFlexGrid1NgGui
 CauhinhLuoiPhu VSFlexGrid1NgGuiCTHD
End Sub
Private Sub txtNgGuiDThoai_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNgGuiDThoai, KeyAscii
 If KeyAscii = 13 Then
 txtNgGuiFax.SetFocus
 End If
End Sub
Private Sub txtNgGuiDThoai_LostFocus()
 BuocphaidienDL txtNgGuiDThoai, True
End Sub
Private Sub txtNgGuiE_mail_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNgGuiE_mail, KeyAscii
 If KeyAscii = 13 Then
 txtNgGuiSide.SetFocus
 End If
End Sub
Private Sub txtNgGuiE_mail_LostFocus()
 BuocphaidienDL txtNgGuiE_mail, False
End Sub
Private Sub txtNgGuiFax_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNgGuiFax, KeyAscii
 If KeyAscii = 13 Then
 txtNgGuiE_mail.SetFocus
 End If
End Sub
Private Sub txtNgGuiFax_LostFocus()
 BuocphaidienDL txtNgGuiFax, True
End Sub
Private Sub txtNgGuiSide_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNgGuiSide, KeyAscii
 If KeyAscii = 13 Then
 cmdLuu.SetFocus
 End If
End Sub
Private Sub txtNgGuiSide_LostFocus()
 BuocphaidienDL txtNgGuiSide, False
End Sub
Private Sub txtNgGuiTenCty_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNgGuiTenCty, KeyAscii
 If KeyAscii = 13 Then
 txtNgGuiDThoai.SetFocus
 End If
End Sub
Private Sub txtNgGuiTenCty_LostFocus()
 BuocphaidienDL txtNgGuiTenCty, True
End Sub
Private Sub VSFlexGrid1NgGui_AfterEdit(ByVal Row As Long, ByVal Col As Long)
 On Error GoTo loi
 With VSFlexGrid1NgGui
 If (.Col 0) And (.Cell(flexcpText, .RowSel, .ColSel) GuiTT) Then
 If MsgBox("Bạn có muốn lưu ô này vào trong CSDL hay không?", vbYesNo, "Thông báo") = vbNo Then
 .Cell(flexcpText, .RowSel, .ColSel) = GuiTT
 Exit Sub
 Else
 .Cell(flexcpForeColor, .RowSel, .ColSel) = vbRed
 End If
 Else
 Exit Sub
 End If
 End With
loi:
 If Col = 0 Then
 MsgBox "Bạn không thể thay đổi dữ liệu trên cột này.", vbInformation, "Thông báo"
 With VSFlexGrid1NgGui
 .Cell(flexcpForeColor, .RowSel, .ColSel) = vbBlack
 End With
 Exit Sub
 End If
End Sub
Private Sub VSFlexGrid1NgGui_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
 With VSFlexGrid1NgGui
 GuiTT = .Cell(flexcpText, .RowSel, .ColSel)
 End With
End Sub
Private Sub VSFlexGrid1NgGui_EnterCell()
 'Gọi thủ tục
 VaoO VSFlexGrid1NgGui, Label1
End Sub
Private Sub VSFlexGrid1NgGui_LeaveCell()
 'Gọi thủ tục
 RoikhoiO VSFlexGrid1NgGui
End Sub
Private Sub VSFlexGrid1NgGui_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'Gọi thủ tục
 HienToolTipText VSFlexGrid1NgGui
End Sub
Private Sub VSFlexGrid1NgGuiCTHD_EnterCell()
 VaoO VSFlexGrid1NgGuiCTHD, Label1
End Sub
Private Sub VSFlexGrid1NgGuiCTHD_LeaveCell()
 RoikhoiO VSFlexGrid1NgGuiCTHD
End Sub
Private Sub VSFlexGrid1NgGuiCTHD_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 HienToolTipText VSFlexGrid1NgGuiCTHD
End Sub
Option Explicit
Private Sub cmdTimkiem_Click()
 On Error GoTo loi
 Dim SQLTkiemNGui As String
 If cboLocNGuima.Text = "Tất cả" Then
 SQLTkiemNGui = "Select * From tblNguoigui"
 Else
 SQLTkiemNGui = "Select *" & _
 " From tblNguoigui" & _
 " Where MaNGui=" & cboLocNGuima.Text & ""
 End If
 Ketnoi dataNGuiLoc, SQLTkiemNGui
 If dataNGuiLoc.Recordset.RecordCount = 0 Then
 MsgBox "Không tìm thấy người gửi có mã: " & cboLocNGuima.Text & "", vbInformation, "Thông báo"
 cboLocNGuima.SelStart = 0
 cboLocNGuima.SelLength = Len(cboLocNGuima.Text)
 Exit Sub
 Else
 lblKQTK.Visible = True
 End If
loi:
End Sub
Private Sub Form_Load()
 Dim SQL As String
 SQL = "Select * From tblNguoigui"
 HienForm Me
 CauhinhLuoiPhu VSFlexGridNguiTK
 KhoitaoADODB SQL
 With cboLocNGuima
 .AddItem "Tất cả"
 End With
 With rsado
 Do While .EOF = False
 cboLocNGuima.AddItem .Fields("MaNGui").Value
 .MoveNext
 Loop
 .Close
 End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
 cnado.Close
 Set cnado = Nothing
End Sub
Option Explicit
Private GuiTT As String
Private Sub cboNCCNuoc_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress cboNCCNuoc, KeyAscii
 If KeyAscii = 13 Then
 meditDthoaiNcc.SetFocus
 End If
End Sub
Private Sub cboNCCNuoc_LostFocus()
 BuocphaidienDL cboNCCNuoc, True
End Sub
Private Sub cboNCCTpho_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress cboNCCTpho, KeyAscii
 If KeyAscii = 13 Then
 cboNCCVung.SetFocus
 End If
End Sub
Private Sub cboNCCTpho_LostFocus()
 BuocphaidienDL cboNCCTpho, True
End Sub
Private Sub cboNCCVung_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress cboNCCVung, KeyAscii
 If KeyAscii = 13 Then
 txtNCCmavung.SetFocus
 End If
End Sub
Private Sub cboNCCVung_LostFocus()
 BuocphaidienDL cboNCCVung, True
End Sub
Private Sub cmdLocnhanh_Click()
 frmNhaCCLoc.Show
End Sub
Private Sub cmdLuu_Click()
 'Gọi thủ tục khởi tạo Controls lúc luu
 KhoitaoControlsLucLuu Me
 With dataNhaCC.Recordset
 .Fields("MaNhaCC").Value = txtNCCma.Text
 .Fields("TenCtyNcc").Value = txtNCCten.Text
 .Fields("TenDTNcc").Value = txtNCCTenDT.Text
 .Fields("ChucdanhDTNcc").Value = txtNCCChucdanh.Text
 .Fields("DiachiNcc").Value = rtxtDiachiNcc.Text
 .Fields("ThanhphoNcc").Value = cboNCCTpho.Text
 .Fields("VungNcc").Value = cboNCCVung.Text
 .Fields("MavungNcc").Value = txtNCCmavung.Text
 .Fields("NuocNcc").Value = cboNCCNuoc.Text
 .Fields("DienthoaiNcc").Value = meditDthoaiNcc.Text
 .Fields("FaxNcc").Value = txtNCCFax.Text
 .Fields("WedsideNcc").Value = txtNCCWed.Text
 .Fields("EmailNcc").Value = txtNCCEmail.Text
 .Update
 End With
 dataNhaCC.Refresh
 'Gọi thủ tục Vohieuhoa
 dataNhaCC.Recordset.MoveLast
 Vohieuhoa Me
End Sub
Private Sub cmdThem_Click()
 Dim SQLMatudong As String
 SQLMatudong = "Select Max([MaNhaCC]) as Lonnhat From tblNhacungcap"
 'Gọi thủ tục tạo Data kết nối để tạo nguồn kết nối cho txtNccma
 Ketnoi dataMatudong, SQLMatudong
 dataMatudong.Refresh
 dataNhaCC.Recordset.AddNew
 'Gọi hàm để qui định thuộc tính các Controls lúc Thêm
 KhoitaoControlsLucThem Me
 If dataNhaCC.Recordset.RecordCount = 0 Then
 txtNCCma.Text = "1"
 dataNhaCC.Caption = "1"
 Else
 With dataMatudong
 txtNCCma.Text = "" & .Recordset.Fields("Lonnhat").Value + 1
 dataNhaCC.Caption = "Nhà CC: " & .Recordset.Fields("Lonnhat").Value + 1
 End With
 End If
 txtNCCten.SetFocus
 lblTudong.Visible = True
End Sub
Private Sub cmdXoa_Click()
 If dataNhaCC.Recordset.RecordCount > 0 Then
 If dataNccChitietSp.Recordset.RecordCount > 0 Then
 MsgBox "Bạn không thể xoá bản ghi này vì nó còn xuất hiện trong bảng con.", vbInformation, "Thông báo"
 Exit Sub
 Else
 'Gọi thủ tục Xoa
 Xoa dataNhaCC
 dataNhaCC.Recordset.MoveLast
 End If
 Else
 MsgBox "Không có dữ liệu để xoá.", vbInformation, "Thông báo"
 Exit Sub
 End If
End Sub
Private Sub dataNhaCC_Reposition()
 On Error GoTo loi
 Dim SQLNccCTietSP As String
 SQLNccCTietSP = "Select *" & _
 " From tblSanpham" & _
 " Where NhaCCID=" & dataNhaCC.Recordset.Fields("MaNhaCC").Value & ""
 'Gọi thủ tục khởi tạo data kết nỗi cho lưới chi tiết
 Ketnoi dataNccChitietSp, SQLNccCTietSP
 dataNccChitietSp.Refresh
 With dataNhaCC
 .Caption = "" & .Recordset.Fields("ManhaCC").Value
 End With
 With VSFlexGrid1NccCtietSP
 .MergeCells = flexMergeRestrictColumns
 .MergeCol(2) = True
 End With
loi:
End Sub
Private Sub Form_Load()
 Dim SQLNhaCC As String
 SQLNhaCC = "Select * From tblNhacungcap Order By NuocNcc"
 'Gọi thủ tục Vohieuhoa các Controls
 Vohieuhoa Me
 'Gọi thủ tục hiện Form
 HienForm Me
 'Gọi thủ tục tạo data kết nối với nguồn dữ liệu
 Ketnoi dataNhaCC, SQLNhaCC
 optTron(1).Value = True
 'Cấu hình thuộc tính cho lưới
 CauhinhLuoiChinh VSFlexGrid1Ncc
 CauhinhLuoiPhu VSFlexGrid1NccCtietSP
 With cboNCCTpho
 .AddItem "Hà Nội"
 .AddItem "Hải Phòng"
 .AddItem "Tp HCM"
 .AddItem "Đà Nẵng"
 .AddItem "Nam Định"
 End With
 With cboNCCVung
 .AddItem "Bắc"
 .AddItem "Trung"
 .AddItem "Nam"
 .AddItem "Hải đảo"
 .AddItem "Miền Núi"
 End With
 With cboNCCNuoc
 .AddItem "Việt Nam"
 .AddItem "Trung Quốc"
 .AddItem "Thái Lan"
 .AddItem "Indonesia"
 .AddItem "Malaysia"
 End With
End Sub
Private Sub meditDthoaiNcc_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress meditDthoaiNcc, KeyAscii
 If KeyAscii = 13 Then
 txtNCCFax.SetFocus
 End If
End Sub
Private Sub meditDthoaiNcc_LostFocus()
 BuocphaidienDL meditDthoaiNcc, True
End Sub
Private Sub optTron_Click(Index As Integer)
 Select Case Index
 Case 1
 optTron(0).Value = False
 With VSFlexGrid1Ncc
 .MergeCells = flexMergeNever
 End With
 Case 0
 optTron(1).Value = False
 With VSFlexGrid1Ncc
 .MergeCells = flexMergeRestrictColumns
 .MergeCol(8) = True
 End With
 Case Else
 End Select
End Sub
Private Sub rtxtDiachiNcc_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress rtxtDiachiNcc, KeyAscii
 If KeyAscii = 13 Then
 cboNCCTpho.SetFocus
 End If
End Sub
Private Sub rtxtDiachiNcc_LostFocus()
 BuocphaidienDL rtxtDiachiNcc, True
End Sub
Private Sub txtNCCChucdanh_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCChucdanh, KeyAscii
 If KeyAscii = 13 Then
 rtxtDiachiNcc.SetFocus
 End If
End Sub
Private Sub txtNCCDThoai_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCDThoai, KeyAscii
 If KeyAscii = 13 Then
 txtNCCFax.SetFocus
 End If
End Sub
Private Sub txtNCCChucdanh_LostFocus()
 BuocphaidienDL txtNCCChucdanh, True
End Sub
Private Sub txtNCCEmail_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCEmail, KeyAscii
 If KeyAscii = 13 Then
 txtNCCWed.SetFocus
 End If
End Sub
Private Sub txtNCCEmail_LostFocus()
 BuocphaidienDL txtNCCEmail, False
End Sub
Private Sub txtNCCFax_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCFax, KeyAscii
 If KeyAscii = 13 Then
 txtNCCEmail.SetFocus
 End If
End Sub
Private Sub txtNCCFax_LostFocus()
 BuocphaidienDL txtNCCFax, True
End Sub
Private Sub txtNCCma_KeyPress(KeyAscii As Integer)
 'Gọi thủ tục PheChuan
 PheChuanKeyPress txtNCCma, KeyAscii
 If KeyAscii = 13 Then
 txtNCCten.SetFocus
 End If
End Sub
Private Sub txtNCCmavung_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCmavung, KeyAscii
 If KeyAscii = 13 Then
 cboNCCNuoc.SetFocus
 End If
End Sub
Private Sub txtNCCmavung_LostFocus()
 BuocphaidienDL txtNCCmavung, True
End Sub
Private Sub txtNCCten_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCten, KeyAscii
 If KeyAscii = 13 Then
 txtNCCTenDT.SetFocus
 End If
End Sub
Private Sub txtNCCten_LostFocus()
 BuocphaidienDL txtNCCten, True
End Sub
Private Sub txtNCCTenDT_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCTenDT, KeyAscii
 If KeyAscii = 13 Then
 txtNCCChucdanh.SetFocus
 End If
End Sub
Private Sub txtNCCTenDT_LostFocus()
 BuocphaidienDL txtNCCTenDT, True
End Sub
Private Sub txtNCCWed_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress txtNCCWed, KeyAscii
 If KeyAscii = 13 Then
 cmdLuu.SetFocus
 End If
End Sub
Private Sub txtNCCWed_LostFocus()
 BuocphaidienDL txtNCCWed, False
End Sub
Private Sub VSFlexGrid1Ncc_AfterEdit(ByVal Row As Long, ByVal Col As Long)
 On Error GoTo loi
 With VSFlexGrid1Ncc
 If (.Col 0) And (.Cell(flexcpText, .RowSel, .ColSel) GuiTT) Then
 If MsgBox("Bạn có muốn lưu ô này vào trong CSDL hay không?", vbYesNo, "Thông báo") = vbNo Then
 .Cell(flexcpText, .RowSel, .ColSel) = GuiTT
 Exit Sub
 Else
 .Cell(flexcpForeColor, .RowSel, .ColSel) = vbRed
 End If
 End If
 End With
loi:
 If Col = 0 Then
 MsgBox "Bạn không thể thay đổi dữ liệu trên cột này.", vbInformation, "Thông báo"
 With VSFlexGrid1Ncc
 .Cell(flexcpForeColor, .RowSel, .ColSel) = vbBlack
 End With
 Exit Sub
 End If
End Sub
Private Sub VSFlexGrid1Ncc_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
 With VSFlexGrid1Ncc
 GuiTT = .Cell(flexcpText, .RowSel, .ColSel)
 End With
End Sub
Private Sub VSFlexGrid1Ncc_EnterCell()
 'Gọi thủ tục VaoO
 VaoO VSFlexGrid1Ncc, Label1
End Sub
Private Sub VSFlexGrid1Ncc_LeaveCell()
 'Gọi thủ tục RoiO
 RoikhoiO VSFlexGrid1Ncc
End Sub
Private Sub VSFlexGrid1Ncc_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'Gọi thủ tục HienToolTip
 HienToolTipText VSFlexGrid1Ncc
End Sub
Private Sub VSFlexGrid1NccCtietSP_EnterCell()
 VaoO VSFlexGrid1NccCtietSP, Label1
End Sub
Private Sub VSFlexGrid1NccCtietSP_LeaveCell()
 RoikhoiO VSFlexGrid1NccCtietSP
End Sub
Private Sub VSFlexGrid1NccCtietSP_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'Gọi thủ tục hiện ToolTip
 HienToolTipText VSFlexGrid1NccCtietSP
End Sub
Option Explicit
Private Sub cmdTimkiem_Click()
 On Error GoTo loi
 Dim SQLLocNCC As String
 If cboLocNCCma.Text = "Tất cả" Then
 SQLLocNCC = "Select * From tblNhacungcap"
 Else
 SQLLocNCC = "Select *" & _
 " From tblNhacungcap" & _
 " Where MaNhaCC=" & cboLocNCCma.Text & ""
 End If
 Ketnoi dataLocNCC, SQLLocNCC
 If dataLocNCC.Recordset.RecordCount = 0 Then
 MsgBox "Không tìm thấy nhà cung cấp có mã: " & cboLocNCCma.Text & "", vbInformation, "Thông báo"
 cboLocNCCma.SelStart = 0
 cboLocNCCma.SelLength = Len(cboLocNCCma.Text)
 Exit Sub
 Else
 lblKQTK.Visible = True
 End If
loi:
End Sub
Private Sub Form_Load()
 Dim SQL As String
 SQL = "Select MaNhaCC From tblNhacungcap"
 HienForm Me
 CauhinhLuoiPhu VSFlexGridNCCloc
 KhoitaoADODB SQL
 With cboLocNCCma
 .AddItem "Tất cả"
 End With
 With rsado
 Do While .EOF = False
 cboLocNCCma.AddItem .Fields("MaNhaCC").Value
 .MoveNext
 Loop
 .Close
 End With
End Sub
Option Explicit
Private GuiTT As String
Private Sub cboNuocNvbh_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress cboNuocNvbh, KeyAscii
 If KeyAscii = 13 Then
 txtDthoaiNvbh.SetFocus
 End If
End Sub
Private Sub cboNuocNvbh_LostFocus()
 BuocphaidienDL cboNuocNvbh, True
End Sub
Private Sub cboTphoNvbh_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress cboTphoNvbh, KeyAscii
 If KeyAscii = 13 Then
 cboVungNvbh.SetFocus
 End If
End Sub
Private Sub cboTphoNvbh_LostFocus()
 BuocphaidienDL cboTphoNvbh, True
End Sub
Private Sub cboVungNvbh_KeyPress(KeyAscii As Integer)
 PheChuanKeyPress cboVungNvbh, KeyAscii
 If KeyAscii = 13 Then
 txtMavungNvbh.SetFocus
 End If
End Sub
Private Sub cboVungNvbh_LostFocus()
 BuocphaidienDL cboVungNvbh, True
End Sub
Private Sub cmdChonhinh_Click()
 On Error GoTo loi
 With Hopthoai
 'Thuộc tính này sẽ bẫy lỗi khi ta Cancel hộp thoại,tức là nếu
 'ta qui định thuộc tính này là True thì lỗi sẽ xẩy ra nếu ta Cancel
 .CancelError = True
 .DialogTitle = "Chọn hình"
 .Filter = "JPG Files(*.jpg)|*.jpg|Bitmap Files(*.bmp)|*.bmp"
 .FilterIndex = 1
 .MaxFileSize = 150
 .InitDir = "C:\QLBH\Hinh"
 .
            Các file đính kèm theo tài liệu này:
27566.DOC