📄 frmcollection.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmCollection
Caption = "Collection"
ClientHeight = 6735
ClientLeft = 60
ClientTop = 450
ClientWidth = 9555
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6735
ScaleWidth = 9555
Begin VB.PictureBox Picture1
Align = 2 'Align Bottom
BorderStyle = 0 'None
Height = 380
Left = 0
ScaleHeight = 375
ScaleWidth = 9555
TabIndex = 2
Top = 6360
Width = 9555
Begin VB.PictureBox Picture2
BorderStyle = 0 'None
Height = 345
Left = 3000
ScaleHeight = 345
ScaleWidth = 4155
TabIndex = 3
Top = 0
Width = 4150
Begin VB.CommandButton btnFirst
Height = 315
Left = 2760
Style = 1 'Graphical
TabIndex = 7
ToolTipText = "First 250"
Top = 10
Width = 315
End
Begin VB.CommandButton btnPrev
Height = 315
Left = 3075
Style = 1 'Graphical
TabIndex = 6
ToolTipText = "Previous 250"
Top = 10
Width = 315
End
Begin VB.CommandButton btnLast
Height = 315
Left = 3705
Style = 1 'Graphical
TabIndex = 5
ToolTipText = "Last 250"
Top = 10
Width = 315
End
Begin VB.CommandButton btnNext
Height = 315
Left = 3390
Style = 1 'Graphical
TabIndex = 4
ToolTipText = "Next 250"
Top = 10
Width = 315
End
Begin VB.Label lblPageInfo
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "0 - 0 of 0"
Height = 255
Left = 120
TabIndex = 8
Top = 60
Width = 2535
End
End
Begin VB.Label lblCurrentRecord
AutoSize = -1 'True
Caption = "Selected Record: 0"
Height = 195
Left = 120
TabIndex = 9
Top = 60
Width = 1365
End
End
Begin VB.PictureBox picLine
Align = 2 'Align Bottom
BackColor = &H80000014&
BorderStyle = 0 'None
Height = 15
Index = 0
Left = 0
ScaleHeight = 15
ScaleWidth = 9555
TabIndex = 1
Top = 6330
Width = 9555
End
Begin VB.PictureBox picLine
Align = 2 'Align Bottom
BackColor = &H80000010&
BorderStyle = 0 'None
Height = 15
Index = 1
Left = 0
ScaleHeight = 15
ScaleWidth = 9555
TabIndex = 0
Top = 6345
Width = 9555
End
Begin MSComctlLib.ListView lvList
Height = 3435
Left = 0
TabIndex = 10
Top = 390
Width = 7260
_ExtentX = 12806
_ExtentY = 6059
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 7
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Route"
Object.Width = 3246
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Truck No"
Object.Width = 4480
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Booking"
Object.Width = 4410
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Collection"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "Delivery Date"
Object.Width = 6068
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "Status"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 6
Text = "Receipt Batch ID"
Object.Width = 2540
EndProperty
End
Begin VB.Label lblTitle
BackStyle = 0 'Transparent
Caption = "Collection"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000014&
Height = 210
Left = 75
TabIndex = 11
Top = 90
Width = 4815
End
Begin VB.Shape shpBar
BackColor = &H80000010&
BackStyle = 1 'Opaque
BorderColor = &H80000010&
Height = 240
Left = 0
Top = 90
Width = 6915
End
End
Attribute VB_Name = "frmCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim CURR_COL As Integer
Dim RSCollection As New Recordset
Dim RecordPage As New clsPaging
Dim SQLParser As New clsSQLSelectParser
'Procedure used to filter records
Public Sub FilterRecord(ByVal srcCondition As String)
SQLParser.RestoreStatement
SQLParser.wCondition = srcCondition
ReloadRecords SQLParser.SQLStatement
End Sub
Public Sub CommandPass(ByVal srcPerformWhat As String)
On Error GoTo err
Select Case srcPerformWhat
Case "Edit"
If lvList.ListItems.Count > 0 Then
If isRecordExist("Receipts_Batch", "ReceiptBatchID", CLng(LeftSplitUF(lvList.SelectedItem.Tag))) = False Then
MsgBox "This record has been removed by other user.Click 'OK' button to refresh the records.", vbExclamation
RefreshRecords
Exit Sub
Else
With frmCollectionAE
Dim blnStatus As Boolean
blnStatus = getValueAt("SELECT ReceiptBatchID,Status FROM Receipts_Batch WHERE ReceiptBatchID=" & CLng(LeftSplitUF(lvList.SelectedItem.Tag)), "Status")
If blnStatus Then 'true
.State = adStateViewMode
Else
.State = adStateEditMode
End If
.PK = CLng(LeftSplitUF(lvList.SelectedItem.Tag))
.show vbModal
RefreshRecords
' .State = adStateEditMode
' .PK = CLng(LeftSplitUF(lvList.SelectedItem.Tag))
' .show vbModal
End With
End If
End If
Case "Search"
With frmSearch
Set .srcForm = Me
Set .srcColumnHeaders = lvList.ColumnHeaders
.show vbModal
End With
Case "Delete"
If lvList.ListItems.Count > 0 Then
If isRecordExist("Collection", "ReceiptBatchID", CLng(LeftSplitUF(lvList.SelectedItem.Tag))) = False Then
MsgBox "This record has been removed by other user.Click 'OK' button to refresh the records.", vbExclamation
RefreshRecords
Exit Sub
Else
If getValueAt("SELECT ReceiptBatchID,Lock FROM Collection WHERE ReceiptBatchID=" & CLng(LeftSplitUF(lvList.SelectedItem.Tag)) & "", "Lock") = "Y" Then
MsgBox "The selected collection record cannot be remove or void because it is already been recorded in van remmitance.", vbExclamation
Exit Sub
Else
Dim ANS As Integer
ANS = MsgBox("Are you sure you want to void the selected record?" & vbCrLf & vbCrLf & "WARNING: You cannot undo this operation.This will permanently remove the record.", vbCritical + vbYesNo, "Confirm Record")
Me.MousePointer = vbHourglass
If ANS = vbYes Then
'Details of the selected record
Dim rsD As New Recordset
Dim tA As Long 'Temporary amount
'Set the recordset
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -