Luận văn Quản lý thu mua chè

ua tiÕp vµ nî phÇn cßn l¹i hay kh«ng ?", vbYesNo If MsgAns = vbNo Then Exit Sub ElseIf MsgAns = vbYes Then HDNo = True End If End If Call SaveData '--------------- In hoa don --------------------- If chkKoIn.Value = 0 Then With Rpt_HoaDon .lblNgay.Caption = Date .lblDiachi.Caption = txtDiachi.Text .lblMaHD.Caption = lblMaHD.Caption .lblTenKH.Caption = txtTenKH.Text .lblKhoiLuongSau.Caption = lblTongKL.Caption .lblTongtien.Caption = lblTongtien.Caption .lblUser.Caption = UserName .lblKlA.Caption = lblA.Caption .lblKlB.Caption = lblB.Caption .lblKlC.Caption = lblC.Caption .lblKlD.Caption = lblD.Caption RsOldData.MoveFirst Do Until RsOldData.EOF If RsOldData.Fields(0) = "Lo¹i A" Then .lblGiaA = RsOldData.Fields(1) .lblTienA = Format(CDbl(.lblGiaA) * CDbl(.lblKlA), "#,###") End If If RsOldData.Fields(0) = "Lo¹i B" Then .lblGiaB = RsOldData.Fields(1) .lblTienB = Format(CDbl(.lblGiaB) * CDbl(.lblKlB), "#,###") End If If RsOldData.Fields(0) = "Lo¹i C" Then .lblGiaC = RsOldData.Fields(1) .lblTienC = Format(CDbl(.lblGiaC) * CDbl(.lblKlC), "#,###") End If If RsOldData.Fields(0) = "Lo¹i D" Then .lblGiaD = RsOldData.Fields(1) .lblTienD = Format(CDbl(.lblGiaD) * CDbl(.lblKlD), "#,###") End If RsOldData.MoveNext Loop .Show End With End If Call cmdNew_Click 'Call update(lblMaHD) End Sub Private Sub cmdSave_Click() On Error Resume Next If txtKhoiLuongTruoc.Text = "0" Then MsgboxC "Kh«ng thÓ nhËp tiÕp hµng nÕu kh«ng cã ®ñ d÷ liÖu !", vbInformation txtKhoiLuongTruoc.SetFocus Exit Sub End If If curPos = 0 Then Exit Sub End If If NewH = True Then lv.ListItems.Add , , lv.ListItems.Count + 1 curPos = lv.ListItems.Count NewH = False End If Call addHang(curPos) End Sub Private Sub Form_Load() On Error Resume Next curPos = 1 '****** Add combo cmbLoai1.AddItem "Lo¹i A" cmbLoai1.AddItem "Lo¹i B" cmbLoai1.AddItem "Lo¹i C" cmbLoai1.AddItem "Lo¹i D" cmbLoai2.AddItem "Lo¹i A" cmbLoai2.AddItem "Lo¹i B" cmbLoai2.AddItem "Lo¹i C" cmbLoai2.AddItem "Lo¹i D" cmbLoai1.Text = cmbLoai1.list(0) cmbLoai2.Text = cmbLoai2.list(1) '************************ lblMaHD.Caption = AutoKey imgNav.ListImages.Add , , LoadResPicture("back_dis", 1) imgNav.ListImages.Add , , LoadResPicture("foward_dis", 1) imgNav.ListImages.Add , , LoadResPicture("back", 1) imgNav.ListImages.Add , , LoadResPicture("foward", 1) imgNav.ListImages.Add , , LoadResPicture("back_click", 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: 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: 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 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 = Nothin