?? frmtransaction.frm
字號:
' Start Calculate DateDue
For loop1 = 1 To Lines
ReDim Preserve DateDue(loop1)
DateDue(loop1) = vr_engine.Transaction_GetDateDue(MSFlexGrid1.TextMatrix(loop1, 1), Format(Now, "mm/dd/yyyy"))
Next loop1
' End Calculate DateDue
'Start - Rcpt Header
Printer.Print ""
Printer.Print "" ' You can put your company name here.
Printer.Print Tab(LeftMargin); "______________________________________________________________________________________________"
Printer.Print Tab(LeftMargin); "INVOICE No. : " & UCase(Trim(txtInvoiceNumber.Text))
Printer.Print Tab(LeftMargin); "NAME : " & UCase(txtName.Text) & " __________"
Printer.Print Tab(LeftMargin); "DATE : " & UCase(txtDate.Text)
Printer.Print Tab(LeftMargin); "CASHIER : " & UCase(Mid(gVarFirstName, 1, 1)) & ". " & UCase(gVarFamilyName) & " __________"
Printer.Print Tab(LeftMargin); "=============================================================================================="
Printer.Print Tab(LeftMargin); "Date Due Item Code Film Title Amount "
'End - Rcpt Header
'Detailed Section
For loop2 = 1 To Lines
''Printer.Print Tab(LeftMargin); "FEB. 25, 2002"; Tab(LeftMargin + 16); "VHS-0001"; Tab(LeftMargin + 32); "FErdies' Wave Fage"; Tab(LeftMargin + 85 - Len("50.45")); "50.45"
Printer.Print Tab(LeftMargin); UCase(Format(DateDue(loop2), "mmm. dd, yyyy")); Tab(LeftMargin + 16); MSFlexGrid1.TextMatrix(loop2, 1); Tab(LeftMargin + 32); MSFlexGrid1.TextMatrix(loop2, 2); Tab(LeftMargin + 85 - Len(MSFlexGrid1.TextMatrix(loop2, 3))); MSFlexGrid1.TextMatrix(loop2, 3)
If loop2 = Lines Then
Printer.Print Tab(LeftMargin); "----------------------------------------------------------------------------------------------"
Printer.Print Tab(LeftMargin); "TOTAL : "; Tab(LeftMargin + 34); Trim(str(Lines)) & " - Item(s)"; Tab(LeftMargin + 85 - Len("P " & Trim(txtTotalAmountDue.Text))); "P " & Trim(txtTotalAmountDue.Text)
Printer.Print Tab(LeftMargin); "______________________________________________________________________________________________"
End If
Next loop2
'End Detiled Section
Printer.EndDoc
MSFlexGrid1.SetFocus
MousePointer = vbDefault
End Sub
Private Sub cmdRefreshList_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.Transaction_LoadNameOfMembers(lstMembers, ArrayOFNamesAndID(), MembersID())
lblDisplay2.Caption = "從名單列表里選擇租借者: "
If lstMembers.Enabled = True Then lstMembers.SetFocus
End Sub
Private Sub cmdSave_Click()
'--------------------------------------------
Dim MsgResponse
MsgResponse = MsgBox("是否要打印收據?", vbYesNoCancel, App.Title)
If MsgResponse = vbCancel Then
MSFlexGrid1.SetFocus
Exit Sub
End If
If MsgResponse = vbYes Then
Call cmdPrint_Click
End If
'--------------------------------------------
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Select Case PrevTransMode
Case False
Call vr_engine.CheckIfTransactionDBExistIfNotCreate '檢查Transaction數據庫文件是否存在
Call vr_engine.Transaction_ChkForMembersFIleDBFolderIfNotCreate '檢查MembersRecords文件夾是否存在
Call vr_engine.Transaction_ChkIfBorrowedItemsHistoryDBExistIfNotCreate '檢查BIH數據庫文件是否存在
' ' Call vr_engine.Transaction_CheckForMembersRecordsIfNotExistsCreate(App.Path & "\Transaction\MembersRecords\", "Decastro.mdb")
Call vr_engine.Transaction_SaveNewTransaction(MSFlexGrid1, txtDate, gVarFirstName & " " & Mid(gVarMiddleName, 1, 1) & ". " & gVarFamilyName, gVarUserID, txtInvoiceNumber, txtName, txtTotalAmountDue, txtAmountPaid, txtChange, ArrayOFNamesAndID(lstMembers.ListIndex + 1) & ".mdb", MembersID(lstMembers.ListIndex + 1), txtsl)
Call cmdCancel_Click
Case True
' Start -- Chk 4 deleted prv itemcodes
Dim delcount As Integer
Dim loop1, loop2 As Integer
Dim DelFlag As Boolean
delcount = 0
For loop1 = 1 To UBound(PrevTransItems())
DelFlag = True
For loop2 = 1 To MSFlexGrid1.Rows - 1
If Trim(MSFlexGrid1.TextMatrix(loop2, 1)) = Trim(PrevTransItems(loop1)) Then
DelFlag = False
End If
Next loop2
If DelFlag = True Then
delcount = delcount + 1
ReDim Preserve DeletedItems(delcount)
DeletedItems(delcount) = PrevTransItems(loop1)
'' Stores deleted items in array -- not used
''Debug.Print DeletedItems(delcount)
End If
Next loop1
' End -- Chk 4 deleted prv itemcodes
'Save Edited Previous Transaction
Call vr_engine.Transaction_UpdatePrevTrasaction(MSFlexGrid1, txtDate, gVarFirstName & " " & Mid(gVarMiddleName, 1, 1) & ". " & gVarFamilyName, gVarUserID, txtInvoiceNumber, txtName, txtTotalAmountDue, txtAmountPaid, txtChange, Trim(txtName.Text) & " ID - " & MemberID_FindMode & ".mdb", MemberID_FindMode, PrevTransItems(), DeletedItems())
Call cmdCancel_Click
End Select
MsgBox PrevTransMode '作用未明,標記以觀后變
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF9 Then
If txtAmountPaid.Enabled = True Then txtAmountPaid.SetFocus
End If
If KeyCode = vbKeyF1 Then
If cmdNew.Enabled = True Then Call cmdNew_Click
End If
If KeyCode = vbKeyF2 Then
If cmdFind.Enabled = True Then Call cmdFind_Click
End If
If KeyCode = vbKeyF3 Then
If cmdEdit.Enabled = True Then Call cmdEdit_Click
End If
If KeyCode = vbKeyF4 Then
If cmdSave.Enabled = True Then Call cmdSave_Click
End If
If KeyCode = vbKeyF5 Then
If cmdCancel.Enabled = True Then Call cmdCancel_Click
End If
If KeyCode = vbKeyF6 Then
If cmdDelete.Enabled = True Then Call cmdDelete_Click
End If
If KeyCode = vbKeyF7 Then
If cmdPrint.Enabled = True Then Call cmdPrint_Click
End If
End Sub
Private Sub Form_Load()
MSFlexGrid1.ColAlignment(0) = 5
MSFlexGrid1.ColAlignment(1) = 5
MSFlexGrid1.ColAlignment(2) = 5
MSFlexGrid1.ColAlignment(3) = 5
MSFlexGrid1.ColAlignment(4) = 5
MSFlexGrid1.Rows = 2
MSFlexGrid1.ColWidth(0) = 800
MSFlexGrid1.ColWidth(1) = 1250
MSFlexGrid1.ColWidth(2) = 3200
MSFlexGrid1.ColWidth(3) = 1100
MSFlexGrid1.TextMatrix(0, 0) = "No."
MSFlexGrid1.TextMatrix(0, 1) = "項目編號"
MSFlexGrid1.TextMatrix(0, 2) = "標題"
MSFlexGrid1.TextMatrix(0, 3) = "租金額"
MSFlexGrid1.TextMatrix(0, 4) = "租借數目"
End Sub
Private Sub lblDisplay2_Change()
If IsNumeric(lblDisplay2.Caption) = True Then lblDisplay2.Caption = Format(lblDisplay2.Caption, "##,##0.00")
End Sub
Private Sub lstMembers_Click()
If Trim(lstMembers.Text) <> "" Then lblDisplay2.Caption = lstMembers.Text
''MsgBox ArrayOFNamesAndID(lstMembers.ListIndex + 1)
End Sub
Private Sub lstMembers_DblClick() '雙擊選擇租借者
Dim vr_rental As VRENTAL_ENGINE
Set vr_rental = New VRENTAL_ENGINE
Dim InvNum As String
Dim intInvNum As Long
'' Start -- Chk if Members has Unreturned Items
Call vr_rental.Transaction_CheckIfMemberHasUnreturnedItems(App.Path & "\Transaction\MembersRecords\" & ArrayOFNamesAndID(lstMembers.ListIndex + 1) & ".mdb")
'' End -- Chk if Members has Unreturned Items
txtDate.Text = Format(Now, "mmm. dd, yyyy")
'' Load Invoice Number
If vr_rental.ReportFileStatus(App.Path & "\InvoiceNumber.txt") = True Then
Open App.Path & "\InvoiceNumber.txt" For Input As #1
Line Input #1, InvNum
Close #1
If IsNumeric(InvNum) = True Then
intInvNum = Int(Val(InvNum)) + 1
Else
Open App.Path & "\InvoiceNumber.txt" For Output As #1
Print #1, "1"
Close #1
intInvNum = 1
End If
Else
Open App.Path & "\InvoiceNumber.txt" For Output As #1
Print #1, "1"
Close #1
intInvNum = 1
End If
txtInvoiceNumber.Text = str(intInvNum)
'' End Load Invoice Number
lblDisplay1.Caption = "總金額為:"
lblDisplay2.Caption = "0.00"
txtName.Text = lstMembers.Text
lstMembers.Enabled = False
cmdRefreshList.Enabled = False
cboItemCode.Enabled = True
cmdAddItem.Enabled = True
cboItemCode.SetFocus
Dim mySQL As String '用以搜索折扣價================================================
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim connectString As String
Set adoConnection = New ADODB.Connection
Set adoRecordset = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\MembersDB.mdb" & ";Persist Security Info=False;Jet OLEDB:Database password=AdmiN"
adoConnection.Open connectString
If lstMembers.ListIndex >= 9 Then
mySQL = "Select * FROM [MembersInfo] WHERE [ID NUMBER] = " & Val(Mid(Trim(lstMembers.Text), 3, 2))
Else: mySQL = "Select * FROM [MembersInfo] WHERE [ID NUMBER] = " & Val(Mid(Trim(lstMembers.Text), 3, 1))
End If
adoRecordset.Open mySQL, adoConnection, adOpenStatic, adLockOptimistic, adCmdText
If adoRecordset.RecordCount <> 0 Then
txtzksp.Text = Format(str(1 - 0.1 * Val(adoRecordset.Fields("會員等級"))), "0.00")
Else
Set adoRecordset = Nothing
Set adoConnection = Nothing
Exit Sub
End If '======================================================
End Sub
Private Sub lstMembers_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn And Trim(lstMembers.Text) <> "" Then
Dim vr_rental As VRENTAL_ENGINE
Set vr_rental = New VRENTAL_ENGINE
Dim InvNum As String
Dim intInvNum As Long
'' Start -- Chk if Members has Unreturned Items
Call vr_rental.Transaction_CheckIfMemberHasUnreturnedItems(App.Path & "\Transaction\MembersRecords\" & ArrayOFNamesAndID(lstMembers.ListIndex) & ".mdb")
'' End -- Chk if Members has Unreturned Items
txtDate.Text = Format(Now, "mmm. dd, yyyy")
'' Load Invoice Number
If vr_rental.ReportFileStatus(App.Path & "\InvoiceNumber.txt") = True Then
Open App.Path & "\InvoiceNumber.txt" For Input As #1
Line Input #1, InvNum
Close #1
If IsNumeric(InvNum) = True Then
intInvNum = Int(Val(InvNum)) + 1
Else
Open App.Path & "\InvoiceNumber.txt" For Output As #1
Print #1, "1"
Close #1
intInvNum = 1
End If
Else
Open App.Path & "\InvoiceNumber.txt" For Output As #1
Print #1, "1"
Close #1
intInvNum = 1
End If
txtInvoiceNumber.Text = str(intInvNum)
'' End Load Invoice Number
lblDisplay1.Caption = "總金額為:"
lblDisplay2.Caption = "0.00"
txtName.Text = lstMembers.Text
lstMembers.Enabled = False
cmdRefreshList.Enabled = False
cboItemCode.Enabled = True
cmdAddItem.Enabled = True
cboItemCode.SetFocus
End If
Dim mySQL As String '用以搜索折扣價================================================
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim connectString As String
Set adoConnection = New ADODB.Connection
Set adoRecordset = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\MembersDB.mdb" & ";Persist Security Info=False;Jet OLEDB:Database password=AdmiN"
adoConnection.Open connectString
mySQL = "Select * FROM [MembersInfo] WHERE 姓氏 = '" & Mid(Trim(txtName.Text), 1, 1) & "'"
adoRecordset.Open mySQL, adoConnection, adOpenStatic, adLockOptimistic, adCmdText
If adoRecordset.RecordCount <> 0 Then
txtzksp.Text = Format(str(1 - 0.1 * Val(adoRecordset.Fields("會員等級"))), "0.00")
txtzhekou.Text = Format(Val(txtTotalAmountDue.Text) * Val(txtzksp.Text), "0.00")
Else
Set adoRecordset = Nothing
Set adoConnection = Nothing
Exit Sub
End If '======================================================
End Sub
Private Sub txtAmountPaid_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then Call txtAmountPaid_LostFocus
End Sub
Private Sub txtAmountPaid_LostFocus()
If Trim(txtAmountPaid.Text) = "" Then
txtChange.Text = ""
Else
If IsNumeric(Trim(txtAmountPaid.Text)) Then
txtAmountPaid.Text = Format(txtAmountPaid.Text, "0.00")
If IsNumeric(txtTotalAmountDue.Text) Then
txtChange.Text = str(Val(Val(txtAmountPaid.Text) - Val(txtzhekou)))
txtChange.Text = Format(txtChange.Text, "0.00")
End If
Else
MsgBox "非法輸入!", vbInformation, "Amount paid is invalid. "
txtAmountPaid.Text = ""
txtChange.Text = ""
txtAmountPaid.SetFocus
End If
End If
End Sub
Private Sub txtChange_Change()
txtChange.Text = Format(txtChange.Text, "0.00")
If Val(txtChange.Text) < 0 Or Trim(txtChange.Text) = "" Then
cmdSave.Enabled = False
cmdPrint.Enabled = False
lblDisplay1.Caption = "總金額為:"
Else
If Val(txtTotalAmountDue.Text) > 0 Then
If cboItemCode.Enabled = True Then
cmdSave.Enabled = True
cmdPrint.Enabled = True
End If
lblDisplay1.Caption = "找零:"
lblDisplay2.Caption = txtChange.Text
Else
cmdSave.Enabled = False
cmdPrint.Enabled = False
lblDisplay1.Caption = "總金額為:"
End If
End If
End Sub
Private Sub txtcxid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If (Val(txtcxid.Text) - 1) < lstMembers.ListCount Then
lstMembers.ListIndex = Val(txtcxid.Text) - 1
txtcxid.Locked = True
Else: MsgBox "對不起,你輸入的ID不存在,請重新輸入!", , "輸入無效!"
txtcxid.Locked = False
End If
End If
End Sub
Private Sub txtsl_LostFocus()
If IsNumeric(Trim(txtsl.Text)) Then
If Val(txtsl.Text) > 50 Then
MsgBox "租借數目項的最大數目為50,請重新返回輸入! ", vbInformation, "注意!"
txtsl.SetFocus
End If
Else: MsgBox "非法輸入文本!,請返回檢查后輸入!"
txtsl.Text = ""
txtsl.SetFocus
End If
End Sub
Private Sub txtTotalAmountDue_Change()
lblDisplay2.Caption = txtTotalAmountDue.Text
txtTotalAmountDue.Text = Format(txtTotalAmountDue.Text, "0.00")
If IsNumeric(txtTotalAmountDue.Text) Then
txtAmountPaid.Locked = False
Else
txtAmountPaid.Locked = True
End If
If IsNumeric(txtTotalAmountDue.Text) = True And IsNumeric(txtAmountPaid.Text) = True Then
txtChange.Text = str(Val(Val(txtAmountPaid.Text) - Val(txtTotalAmountDue.Text)))
txtTotalAmountDue.Text = Format(txtTotalAmountDue.Text, "0.00")
End If
txtzhekou.Text = Format(str(Val(txtTotalAmountDue) * Val(txtzksp.Text)), "0.00")
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -