Đề tài Quản lý thu mua chè làm Đề tài cho Luận văn tốt nghiệp của mình

1) imgNav.ListImages.Add , , LoadResPicture("foward_click", 1) Call DefControls NewH = True End Sub Private Sub Check1_Click() On Error Resume Next If Check1.Value = True Then chkTyleChe.Value = 0 sFrame.Width = 6435 frmLoai2.Visible = True chkTyleChe.Enabled = True txtTyleChe.Enabled = True Else chkTyleChe.Enabled = False chkTyleChe.Value = 0 sFrame.Width = 3435 frmLoai2.Visible = False txtTyleChe.Text = "100" txtTyleChe.Enabled = False End If End Sub Public Sub TinhTien() On Error Resume Next Dim KNuoc As Double 'Khoi luong nuoc trong che Dim Ktruoc As Double 'Khoi luong ban dau Dim Ksau As Double 'Khoi luong sau Dim Che1 As Double 'Khoi luong loai1 Dim Che2 As Double 'Khoi luong loai2 Dim Tong 'As Double Dim Baobi As Double ' khoi luong bao bi '########################################## 'Cong thuc tinh ' Khoi luong nuoc = (Khoi luong ban dau - Khoi luong bao bi ) * (Ty le nuoc) ' Khoi luong sau = (Khoi luong truoc) - (Khoi luong nuoc) - (Bao bi) '------------------------------------------------------------------------- Ktruoc = CDbl(txtKhoiLuongTruoc.Text) Baobi = CDbl(txtBaoBi.Text) KNuoc = (Ktruoc - Baobi) * CDbl(txtTylenuoc.Text) / 100 If chkTyleNuoc.Value = 0 And chkBaobi.Value = 0 Then lblKhoiLuongSau.Caption = Ktruoc End If If chkTyleNuoc.Value = 1 And chkBaobi.Value = 0 Then lblKhoiLuongSau.Caption = Ktruoc - KNuoc End If If chkTyleNuoc.Value = 0 And chkBaobi.Value = 1 Then lblKhoiLuongSau.Caption = Ktruoc - Baobi End If If chkTyleNuoc.Value = 1 And chkBaobi.Value = 1 Then lblKhoiLuongSau.Caption = Ktruoc - KNuoc - Baobi End If Ksau = CDbl(lblKhoiLuongSau.Caption) If Check1.Value = 0 Then Che1 = Ksau Che2 = 0 Else Che1 = Ksau * CDbl(txtTyleChe.Text) / 100 Che2 = Ksau - (Ksau * CDbl(txtTyleChe.Text) / 100) End If Tong = (Che1 * CDbl(txtGia1.Text)) + (Che2 * CDbl(txtGia2.Text)) Tong = Round(Tong, 0) '---------------------------------------------------------------------- 'Quy t¾c lµm trßn : cã 2 lo¹i lµm trßn do biÕn RoundUp (Boolean) quyÕt ®Þnh ' +> RoundUp=True : lµm trßn lªn . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn lªn 1000 ' NÕu sè lÎ < 500 thi trßn thµnh 500 ' +> RoundUp=False : lµm trßn xuèng . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn xuèng 500 ' NÕu sè lÎ < 500 thi trßn thµnh 0 '---------------------------------------------------------------------- If (Tong Mod 1000) > 500 Then If RoundUp = True Then ' Lµm trßn lªn Tong = Tong - (Tong Mod 1000) + 1000 Else ' lµm trßn xuèng Tong = Tong - (Tong Mod 1000) + 500 End If End If If (Tong Mod 1000) < 500 Then If RoundUp = True Then Tong = Tong - (Tong Mod 1000) + 500 Else Tong = Tong - (Tong Mod 1000) End If End If ' Hµm FormatMoney sÏ ®­a ra ®Þnh d¹ng kiÓu tiÒn . 'VD 1110000 sÏ ®­îc chuyÓn thµnh 1,100,000 lblThanhTien.Caption = FormatMoney(Tong) If lblThanhTien.Caption = "" Then lblThanhTien.Caption = "0" End If End Sub Private Sub DisplayPos(CurP As Integer) On Error Resume Next Dim i As Byte With lv.ListItems(CurP) txtKhoiLuongTruoc.Text = .SubItems(1) For i = 0 To 3 If cmbLoai1.list(i) = .SubItems(2) Then cmbLoai1.Text = cmbLoai1.list(i) Exit For End If Next i txtTyleChe.Text = .SubItems(3) If .SubItems(4) "" Then Check1.Value = True For i = 0 To 3 If cmbLoai2.list(i) = .SubItems(4) Then cmbLoai2.Text = cmbLoai2.list(i) Exit For End If Next i lblTyle.Caption = .SubItems(5) Else Check1.Value = False End If Check1_Click If .SubItems(6) "0" Then txtBaoBi.Text = .SubItems(6) Else txtBaoBi.Text = "0" chkBaobi.Value = 0 End If If .SubItems(7) "0" Then txtTylenuoc.Text = .SubItems(7) Else txtTylenuoc.Text = "0" chkTyleNuoc.Value = 0 End If lblKhoiLuongSau.Caption = .SubItems(8) lblThanhTien.Caption = .SubItems(9) End With End Sub Private Sub SaveData() ' On Error Resume Next Dim maKH As String Dim tien As String maKH = AutoKH With RsHoaDon .AddNew .Fields(0) = lblMaHD.Caption .Fields(1) = maKH .Fields(2) = UserName .Fields(3) = Date .Fields(5) = CDbl(lblTongKL.Caption) .Fields(4) = CDbl(lblTongtien.Caption) If HDNo = True Then RsTongTien.MoveFirst .Fields(6) = CDbl(lblTongtien.Caption) - CDbl(RsTongTien.Fields(0)) RsTongTien.Fields(0) = "0" RsTongTien.update ElseIf HDNo = False Then With RsTongTien .MoveFirst tien = .Fields(0) .MoveFirst .Fields(0) = CDbl(tien) - CDbl(lblTongtien.Caption) .update End With End If .update End With If lblA.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i A", lblA.Caption) End If If lblB.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i B", lblB.Caption) End If If lblC.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i C", lblC.Caption) End If If lblD.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i D", lblD.Caption) End If With rsKhachHang .AddNew .Fields(0) = maKH .Fields(1) = txtTenKH.Text .Fields(2) = txtDiachi.Text .update End With End Sub Private Sub newHang() ' Khoi tao lai cac Control khi chon nhap them hang On Error Resume Next EditHD = False txtBaoBi.Text = "0" txtKhoiLuongTruoc.Text = "0" txtTylenuoc.Text = "0" chkBaobi.Value = False chkTyleNuoc.Value = False Check1.Value = 0 Check1_Click txtKhoiLuongTruoc.SetFocus End Sub Private Sub DefControls() EditHD = False lblNote.Caption = "" lblMaHD.Caption = AutoKey sFrame.Width = 3435 frmLoai2.Visible = False End Sub Private Sub EnableCont() On Error Resume Next txtKhoiLuongTruoc.Enabled = True Check1.Enabled = True chkTyleNuoc.Enabled = True chkBaobi.Enabled = True cmbLoai1.Enabled = True End Sub Private Sub ReOrder() On Error Resume Next Dim i As Integer Call ReSum If lv.ListItems.Count <= 0 Then Exit Sub End If For i = 1 To lv.ListItems.Count lv.ListItems(i).Text = i Next i End Sub Private Sub ReSum() On Error Resume Next lblA.Caption = "0" lblB.Caption = "0" lblC.Caption = "0" lblD.Caption = "0" lblTongBB.Caption = "0" lblTongKL.Caption = "0" lblTongtien.Caption = "0" If lv.ListItems.Count <= 0 Then Exit Sub End If Dim i As Integer Dim A As Double Dim B As Double Dim C As Double Dim D As Double Dim Per As Double A = 0 B = 0 C = 0 D = 0 For i = 1 To lv.ListItems.Count With lv.ListItems(i) Per = CDbl(.SubItems(3)) / 100 If .SubItems(2) = cmbLoai1.list(0) Then A = A + (Per * .SubItems(8)) End If If .SubItems(2) = cmbLoai1.list(1) Then B = B + Per * .SubItems(8) End If If .SubItems(2) = cmbLoai1.list(2) Then C = C + Per * .SubItems(8) End If If .SubItems(2) = cmbLoai1.list(3) Then D = D + Per * .SubItems(8) End If If Per < 100 Then ' Che bi lan Per = CDbl(.SubItems(5)) / 100 If .SubItems(4) = cmbLoai1.list(0) Then A = A + (Per * .SubItems(8)) End If If .SubItems(4) = cmbLoai1.list(1) Then B = B + Per * .SubItems(8) End If If .SubItems(4) = cmbLoai1.list(2) Then C = C + Per * .SubItems(8) End If If .SubItems(4) = cmbLoai1.list(3) Then D = D + Per * .SubItems(8) End If End If lblTongBB.Caption = CDbl(lblTongBB.Caption) + CDbl(lv.ListItems(i).SubItems(6)) lblTongKL.Caption = CDbl(lblTongKL.Caption) + CDbl(lv.ListItems(i).SubItems(8)) lblTongtien.Caption = CDbl(lblTongtien.Caption) + CDbl(lv.ListItems(i).SubItems(9)) End With Next i lblA.Caption = A lblB.Caption = B lblC.Caption = C lblD.Caption = D End Sub Private Sub SaveND(rsND As ADODB.Recordset, Ma As String, Loai As String, Kl As String) Dim P As Double If Loai = "Lo¹i A" Then P = GiaA End If If Loai = "Lo¹i B" Then P = GiaB End If If Loai = "Lo¹i C" Then P = GiaC End If If Loai = "Lo¹i D" Then P = GiaD End If With rsND .AddNew .Fields(0) = Ma ' Ma hoa don .Fields(1) = Loai ' Loai che .Fields(2) = P ' Gia che .Fields(7) = Kl ' Khoi luong .Fields(8) = CDbl(P) * CDbl(Kl) .update End With End Sub Private Sub update(mahd As String) Dim gia, klt, klt1, tt As Double Dim i As Integer Dim Sql As String Dim cmd As ADODB.Command If lv.ListItems.Count = 0 Then Exit Sub End If 'Call GetOldData Set cmd = New ADODB.Command For i = 1 To lv.ListItems.Count If lv.ListItems(i).SubItems(4) = "" Then If lv.ListItems(i).SubItems(2) = "Lo¹i A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i D" Then gia = GiaD End If Sql = "insert into tbl_noidungmua(mahd,loaiche,giache,khoiluongbd,phantramche,tylenuoc,baobi,khoiluongsau,giatri) values('" & mahd & "','" & lv.ListItems(i).SubItems(2) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(3) & "','" & lv.ListItems(i).SubItems(6) & "','" & lv.ListItems(i).SubItems(7) & "','" & "','" & lv.ListItems(i).SubItems(8) & "','" & lv.ListItems(i).SubItems(9) & "')" MsgBox Sql With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With End If If lv.ListItems(i).SubItems(4) "" Then If lv.ListItems(i).SubItems(2) = "Lo¹i A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i D" Then gia = GiaD End If klt = (CDbl(lv.ListItems(i).SubItems(1)) * CDbl(lv.ListItems(i).SubItems(3))) / 100 tt = klt * gia Sql = "insert into tbl_noidungmua values('" & mahd & "','" & lv.ListItems(i).SubItems(2) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(3) & "','" & lv.ListItems(i).SubItems(6) & "','" & lv.ListItems(i).SubItems(7) & "','" & CStr(klt) & "','" & CStr(tt) & "')" With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With If lv.ListItems(i).SubItems(4) = "Lo¹i A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(4) = "Lo¹i B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(4) = "Lo¹i C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(4) = "Lo¹i D" Then gia = GiaD End If klt1 = CDbl(lv.ListItems(i).SubItems(1)) - klt tt = klt1 * gia Sql = "insert into tbl_noidungmua values('" & mahd & "','" & lv.ListItems(i).SubItems(4) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(5) & "','" & "0" & "','" & "0" & "','" & CStr(klt1) & "','" & CStr(tt) & "')" With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With End If Next i Set cmd = Nothing End Sub frmPrice(Form cập nhật giá chè): Dim ValA As Boolean Dim ValB As Boolean Dim ValC As Boolean Dim ValD As Boolean Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdClose_Click() '------- Refresh lai gia With frmNhap.cmbLoai1 If .Text = .list(0) Then .Text = .list(1) ElseIf .Text = .list(1) Then .Text = .list(2) ElseIf .Text = .list(2) Then .Text = .list(3) ElseIf .Text = .list(3) Then .Text = .list(1) End If End With With frmNhap.cmbLoai2 If .Text = .list(0) Then .Text = .list(1) ElseIf .Text = .list(1) Then .Text = .list(2) ElseIf .Text = .list(2) Then .Text = .list(3) ElseIf .Text = .list(3) Then .Text = .list(1) End If End With '------------------------------------- Unload Me End Sub Private Sub cmdSave_Click() If txtNewA.Text = "" Or _ txtNewB.Text = "" Or _ txtNewC.Text = "" Or _ txtNewD.Text = "" Then MsgboxC "Kh«ng thÓ l­u gi¸ c¸c lo¹i chÌ !" Exit Sub End If SavePrice ValA, lblA, txtNewA SavePrice ValB, Me.lblB, Me.txtNewB SavePrice ValC, Me.lblC, Me.txtNewC SavePrice ValD, Me.lblD, Me.txtNewD txtNewA.Enabled = False txtNewB.Enabled = False txtNewC.Enabled = False txtNewD.Enabled = False End Sub Private Sub Form_Load() Call GetOldPrice imgList.ListImages.Add , , LoadResPicture("save1", 1) imgList.ListImages.Add , , LoadResPicture("no", 1) imgList.ListImages.Add , , LoadResPicture("close", 1) Set cmdSave.Picture = imgList.Overlay(1, 1) Set cmdCancel.Picture = imgList.Overlay(2, 2) Set cmdClose.Picture = imgList.Overlay(3, 3) Call InitTitleBar(Me) End Sub Private Sub imgA_Click() If ValA = False Then ValA = True imgA.Picture = imgChecked.Picture imgA.Refresh txtNewA.Enabled = True txtNewA.SetFocus Else ValA = False imgA.Picture = imgUnCheck.Picture imgA.Refresh txtNewA_LostFocus cmdCancel.SetFocus txtNewA.Enabled = False txtNewA.Text = GiaA End If SaveButton End Sub Private Sub imgA_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgA.Picture = imgTemp.Picture End Sub Private Sub lblA_Click() imgA_Click End Sub Private Sub imgb_Click() If ValB = False Then ValB = True imgB.Picture = imgChecked.Picture imgB.Refresh txtNewB.Enabled = True txtNewB.SetFocus Else ValB = False imgB.Picture = imgUnCheck.Picture imgB.Refresh txtNewB_LostFocus cmdCancel.SetFocus txtNewB.Enabled = False txtNewB.Text = GiaB End If SaveButton End Sub Private Sub imgb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgB.Picture = imgTemp.Picture End Sub Private Sub lblb_Click() imgb_Click End Sub Private Sub lblb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgb_MouseDown Button, Shift, X, Y End Sub Private Sub imgC_Click() If ValC = False Then ValC = True imgC.Picture = imgChecked.Picture imgC.Refresh txtNewC.Enabled = True txtNewC.SetFocus Else ValC = False imgC.Picture = imgUnCheck.Picture imgC.Refresh txtNewC_LostFocus cmdCancel.SetFocus txtNewC.Text = GiaC txtNewC.Enabled = False End If SaveButton End Sub Private Sub imgC_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgC.Picture = imgTemp.Picture End Sub Private Sub lblc_Click() imgC_Click End Sub Private Sub lblc_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgC_MouseDown Button, Shift, X, Y End Sub Private Sub imgD_Click() If ValD = False Then ValD = True imgD.Picture = imgChecked.Picture imgD.Refresh txtNewD.Enabled = True txtNewD.SetFocus Else ValD = False imgD.Picture = imgUnCheck.Picture imgD.Refresh txtNewD_LostFocus cmdCancel.SetFocus txtNewD.Text = GiaD txtNewD.Enabled = False End If SaveButton End Sub Private Sub imgD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgD.Picture = imgTemp.Picture End Sub Private Sub lblD_Click() imgD_Click End Sub Private Sub lblD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgD_MouseDown Button, Shift, X, Y End Sub Private Sub txtNewA_Change() With txtNewA If .Text = "" Then Exit Sub End If .Text = Format(.Text, "#,###") .SelStart = Len(.Text) If Len(.Text) > 7 Then MsgboxC "Gi¸ 1kg chÌ kh«ng ®­îc lín h¬n 6 sè" .Text = "0" Exit Sub End If End With End Sub Private Sub txtNewD_KeyPress(KeyAscii As MSForms.ReturnInteger) txtNewA_KeyPress KeyAscii End Sub Private Sub txtNewD_LostFocus() With txtNewD .BackColor = C3 .SelStart = 0 .SelLength = 0 End With End Sub Private Sub SavePrice(Save As Boolean, Lbl As VB.Label, Tx As MSForms.TextBox) If Save = False Then Exit Sub End If With RsGiaChe .AddNew .Fields(1) = Lbl.Caption .Fields(2) = Tx.Text .Fields(3) = Date If UserName = "" Then .Fields(4) = "Error !" Else .Fields(4) = UserName End If .update End With With RsOldData If .RecordCount <= 0 Then .AddNew End If .MoveFirst .Fields(0) = "Lo¹i A" .Fields(1) = CDbl(txtNewA.Text) GiaA = CDbl(txtNewA.Text) .MoveNext .Fields(0) = "Lo¹i B" .Fields(1) = CDbl(txtNewB.Text) GiaB = CDbl(txtNewB.Text) .MoveNext .Fields(0) = "Lo¹i C" .Fields(1) = CDbl(txtNewC.Text) GiaC = CDbl(txtNewC.Text) .MoveNext .Fields(0) = "Lo¹i D" .Fields(1) = CDbl(txtNewD.Text) GiaD = CDbl(txtNewD.Text) .update End With End Sub Public Sub SaveButton() If ValA = False And ValB = False And ValC = False And ValD = False Then cmdSave.Enabled = False Else cmdSave.Enabled = True End If End Sub Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub pTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub frmThanhToanNo (Form thanh toán nợ): Const CB_SHOWDROPDOWN = &H14F Dim Tmp Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdThanhToan_Click() Dim max As Integer If (Text3.Text = "") Or (Text5.Text = "") Then Exit Sub End If If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(0) = Text1.Text Then If CDbl(Text3.Text) >= CDbl(Text5.Text) Then RsHoaDon.Fields(6).Value = CDbl(Text3.Text) - CDbl(Text5.Text) If RsNo.RecordCount <= 0 Then RsNo.AddNew RsNo.Fields(0).Value = Text1.Text RsNo.Fields(1).Value = Date RsNo.Fields(2).Value = CDbl(Text5.Text) RsNo.Fields(3).Value = max + 1 RsNo.update Else RsNo.MoveFirst Do Until RsNo.EOF = True If RsNo.Fields(0).Value = Text1.Text Then max = 1 If max < RsNo.Fields(3).Value Then max = RsNo.Fields(3).Value End If RsNo.MoveNext Loop RsNo.AddNew RsNo.Fields(0).Value = Text1.Text RsNo.Fields(1).Value = Date RsNo.Fields(2).Value = CDbl(Text5.Text) RsNo.Fields(3).Value = max + 1 RsNo.update End If ElseIf CDbl(Text3.Text) < CDbl(Text5.Text) Then frmMsgOk.lblTitle = "Chó ý" frmMsgOk.lblPrompt = " Sè thanh to¸n kh«ng ®­îc lín h¬n sè nî" frmMsgOk.Show Text5.Text = "" End If End If RsHoaDon.MoveNext Loop Call Create_List Call Clear_Text End Sub Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub list_DblClick() Dim Stt As Integer If Text1.Text "" Then SendStr = Text1.Text frmXemNo.Show Else Exit Sub End If End Sub Private Sub list_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim Stt As Integer Text5.Enabled = True For Stt = 1 To list.ListItems.Count If list.ListItems(Stt).Selected = True Then Text1.Text = list.ListItems(Stt).SubItems(1) Text2.Text = list.ListItems(Stt).SubItems(2) Text3.Text = list.ListItems(Stt).SubItems(3) End If Next If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(0) = Text1.Text Then If rsKhachHang.RecordCount <= 0 Then Exit Sub End If rsKhachHang.MoveFirst Do Until rsKhachHang.EOF = True If rsKhachHang.Fields(0) = RsHoaDon.Fields(1) Then Text6.Text = rsKhachHang.Fields(2) End If rsKhachHang.MoveNext Loop End If RsHoaDon.MoveNext Loop End Sub Private Sub MyButton1_Click() Unload Me End Sub Private Sub pTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub Form_Load() Call InitTitleBar(Me) Call Create_List Call CreateRs Text4.Text = "H«m nay, ngµy " & DatePart("d", Date) & " th¸ng " & DatePart("m", Date) & " n¨m " & DatePart("yyyy", Date) Text5.Enabled = False End Sub Public Sub Create_List() Dim Stt As Integer list.ColumnHeaders.Clear list.ColumnHeaders.Add 1, , "Sè TT", 400 list.ColumnHeaders.Add 2, , "M· Ho¸ ®¬n", 1600 list.ColumnHeaders.Add 3, , "Tªn ng­êi b¸n", 1500 list.ColumnHeaders.Add 4, , "Sè tiÒn nî", 1000, 1 list.FullRowSelect = True list.ListItems.Clear If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(6) > 0 Then If rsKhachHang.RecordCount <= 0 Then Exit Sub End If rsKhachHang.MoveFirst Do Until rsKhachHang.EOF = True If (RsHoaDon.Fields(1) = rsKhachHang.Fields(0)) Then Stt = Stt + 1 list.ListItems.Add , , Stt list.ListItems(Stt).SubItems(1) = RsHoaDon.Fields(0) list.ListItems(Stt).SubItems(2) = rsKhachHang.Fields(1) list.ListItems(Stt).SubItems(3) = Format(RsHoaDon.Fields(6), "#,###") End If rsKhachHang.MoveNext Loop End If RsHoaDon.MoveNext Loop '------------ Text5.Enabled = False End Sub Private Sub Text5_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then Exit Sub End If If KeyAscii = 13 Then Call cmdThanhToan_Click End If If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0 End If End Sub frmMainAdmin (Form chính của Administrator): Dim C As Boolean Public Sub InitForm() bottom1.BackColor = ColorMain SetParent frmMenu.hWnd, frameMenu.hWnd frmMenu.Show MoveWindow frmMenu.hWnd, 0, -30, frmMenu.Width, frmMenu.Height, 1 ani1.LoadFile App.Path & "\animation\daihung1.gif", False End Sub Private Sub cmdLog_Click() If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If '-------------------- Unload prj_BuyTea.frmNhap Set frmNhap = Nothing Unload prj_BuyTea.frmThanhToanNo Set frmThanhToanNo = Nothing Unload prj_BuyTea.frmPrice Set frmPrice = Nothing Unload prj_BuyTea.frmMainUser Set frmMainUser = Nothing Unload prj_BuyTea.frmChangePass Set frmChangePass = Nothing Unload prj_BuyTea.Rpt_HoaDon Set Rpt_HoaDon = Nothing Unload prj_BuyTea.frmBaocao Set frmBaocao = Nothing Unload prj_BuyTea.frm_DoThi Set frm_DoThi = Nothing Unload prj_BuyTea.frmDataMan Set frmDataMan = Nothing Unload prj_BuyTea.frmMoney Set frmMoney = Nothing Unload prj_BuyTea.frmUserMan Set frmUserMan = Nothing Unload prj_BuyTea.frmMenu Set Menu = Nothing Unload prj_BuyTea.Form1 Set Form1 = Nothing Unload prj_BuyTea.frmXemNo Set frmXemNo = Nothing '--------------- Unload Me Set frmMainAdmin = Nothing frmLogin.Show End Sub Private Sub Form_Load() Call InitForm End Sub Private Sub cmdThoat_Click() Dim ans ans = MsgboxC("B¹n cã muèn tho¸t khái ch­¬ng tr×nh kh«ng ?", vbYesNo, "Tho¸t khái ch­¬ng tr×nh !") If ans = vbYes Then If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If End End If End Sub Private Sub tmTime_Timer() Dim H As String Dim M As String H = Hour(Now) If Minute(Now) < 10 Then M = "0" & Minute(Now) Else M = Minute(Now) End If If C = False Then lblTime.Caption = H & ":" & M C = True Else lblTime.Caption = H & " " & M C = False End If End Sub frmUserMan (Form Quản lý User): Dim uName As String ' User Name Dim uEdit As Boolean Private Sub DefaultCtl() lblNote.Caption = "" imgListUser.ListImages.Add , "user0", LoadResPicture("user0", 1) imgListUser.ListImages.Add , "user1", LoadResPicture("user1", 1) imgListUser.ListImages.Add , "user2", LoadResPicture("user2", 1) End Sub Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdAbort_Click() Call ButtonEnabled(True) Call LockText End Sub Private Sub cmdDel_Click() If uName = "administrator" Then MsgboxC "Th«ng tin vÒ nhµ qu¶n lý kh«ng thÓ bÞ xo¸ . Xin vui lßng chän mét ng­êi kh¸c !", vbCritical Exit Sub End If Dim ans As Byte ans = MsgboxC("B¹n cã muèn xo¸ tªn truy nhËp : '" & uName & "' kh«ng ?", vbYesNo) If ans = vbYes Then If RsUser.RecordCount <= 0 Then Exit Sub End If RsUser.MoveFirst Do While Not RsUser.EOF If RsUser.Fields(0) = uName Then RsUser.Delete RsUser.update txtUserName.Text = "" txtPass.Text = "" txtConf.Text = "" chkNo.Value = False chkGia.Value = False Exit Do End If RsUser.MoveNext Loop Call CreateLV End If End Sub Private Sub cmdEdit_Click() If uName = "administrator" Then MsgboxC "Th«ng tin vÒ nhµ qu¶n lý kh«ng thÓ bÞ thay ®æi. §Ó ®æi mËt khÈu xin chän môc §æi mËt khÈu !", vbCritical Exit Sub End If If uName = "" Then MsgboxC "B¹n ph¶i chän mét ng­êi dïng trong danh s¸ch trªn !", vbInformation Exit Sub End If cmdEdit.Visible = False Call ButtonEnabled(False) lvUser2.Enabled = False txtUserName.Enabled = True txtPass.Enabled = True txtConf.Enabled = True chkNo.Enabled = True chkGia.Enabled = True Call EditUser(uName) uEdit = True End Sub Private Sub cmdMain_Click()