📄 frmledgerae.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmLedgerAE
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 7200
ClientLeft = 0
ClientTop = 0
ClientWidth = 9255
LinkTopic = "Form1"
ScaleHeight = 7200
ScaleWidth = 9255
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox picLine
Align = 2 'Align Bottom
BackColor = &H80000010&
BorderStyle = 0 'None
Height = 15
Index = 1
Left = 0
ScaleHeight = 15
ScaleWidth = 9255
TabIndex = 12
Top = 6795
Width = 9255
End
Begin VB.PictureBox picLine
Align = 2 'Align Bottom
BackColor = &H80000014&
BorderStyle = 0 'None
Height = 15
Index = 0
Left = 0
ScaleHeight = 15
ScaleWidth = 9255
TabIndex = 11
Top = 6810
Width = 9255
End
Begin VB.PictureBox Picture1
Align = 2 'Align Bottom
BorderStyle = 0 'None
Height = 375
Left = 0
ScaleHeight = 375
ScaleWidth = 9255
TabIndex = 3
Top = 6825
Width = 9255
Begin VB.PictureBox Picture2
BorderStyle = 0 'None
Height = 345
Left = 3000
ScaleHeight = 345
ScaleWidth = 4155
TabIndex = 4
Top = 0
Width = 4150
Begin VB.CommandButton btnNext
Height = 315
Left = 3390
Style = 1 'Graphical
TabIndex = 8
ToolTipText = "Next 250"
Top = 10
Width = 315
End
Begin VB.CommandButton btnLast
Height = 315
Left = 3705
Style = 1 'Graphical
TabIndex = 7
ToolTipText = "Last 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 btnFirst
Height = 315
Left = 2760
Style = 1 'Graphical
TabIndex = 5
ToolTipText = "First 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 = 9
Top = 60
Width = 2535
End
End
Begin VB.Label lblCurrentRecord
AutoSize = -1 'True
Caption = "Selected Record: 0"
Height = 195
Left = 120
TabIndex = 10
Top = 60
Width = 1365
End
End
Begin VB.CommandButton btnClose
Caption = "Close"
Height = 375
Left = 7890
TabIndex = 0
Top = 6240
Width = 1185
End
Begin MSComctlLib.ListView lvList
Height = 5025
Left = 270
TabIndex = 1
Top = 900
Width = 8685
_ExtentX = 15319
_ExtentY = 8864
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 6
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Date"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 1
Text = "Ref No"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 2
Text = "Debit"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 3
Text = "Credit"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 4
Text = "Balance"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "ClientID"
Object.Width = 0
EndProperty
End
Begin VB.Shape Shape2
Height = 525
Left = 60
Top = 6150
Width = 9135
End
Begin VB.Shape Shape1
Height = 6015
Left = 60
Top = 60
Width = 9135
End
Begin VB.Label lblCustomer
Caption = "Customer Name:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 270
TabIndex = 2
Top = 300
Width = 8655
End
End
Attribute VB_Name = "frmLedgerAE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public State As FormState 'Variable used to determine on how the form used
Public PK As String
Public strCustomer As String
Dim CURR_COL As Integer
Dim rsCustomers 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
'Procedure for reloadingrecords
Public Sub ReloadRecords(ByVal srcSQL As String)
'-In this case I used SQL because it is faster than Filter function of VB
'-when hundling millions of records.
On Error GoTo err
With rsLocalForwarder
If .State = adStateOpen Then .Close
.Open srcSQL
End With
RecordPage.Refresh
FillList 1
Exit Sub
err:
If err.Number = -2147217913 Then
srcSQL = Replace(srcSQL, "'", "", , , vbTextCompare)
Resume
ElseIf err.Number = -2147217900 Then
MsgBox "Invalid search operation.", vbExclamation
SQLParser.RestoreStatement
srcSQL = SQLParser.SQLStatement
Resume
Else
prompt_err err, Name, "ReloadRecords"
End If
End Sub
Private Sub btnClose_Click()
Unload Me
End Sub
Private Sub btnFirst_Click()
If RecordPage.PAGE_CURRENT <> 1 Then FillList 1
End Sub
Private Sub btnLast_Click()
If RecordPage.PAGE_CURRENT <> RecordPage.PAGE_TOTAL Then FillList RecordPage.PAGE_TOTAL
End Sub
Private Sub btnNext_Click()
If RecordPage.PAGE_CURRENT <> RecordPage.PAGE_TOTAL Then FillList RecordPage.PAGE_NEXT
End Sub
Private Sub btnPrev_Click()
If RecordPage.PAGE_CURRENT <> 1 Then FillList RecordPage.PAGE_PREVIOUS
End Sub
Private Sub btnRecOp_Click()
frmCustomerRecOp.show vbModal
End Sub
Private Sub Form_Activate()
HighlightInWin Me.Name: MAIN.ShowTBButton "", True
End Sub
Private Sub Form_Deactivate()
MAIN.HideTBButton "", True
End Sub
Private Sub Form_Load()
'Set the graphics for the controls
With MAIN
'For listview
Set lvList.SmallIcons = .i16x16
Set lvList.Icons = .i16x16
btnFirst.Picture = .i16x16.ListImages(3).Picture
btnPrev.Picture = .i16x16.ListImages(4).Picture
btnNext.Picture = .i16x16.ListImages(5).Picture
btnLast.Picture = .i16x16.ListImages(6).Picture
btnFirst.DisabledPicture = .i16x16g.ListImages(3).Picture
btnPrev.DisabledPicture = .i16x16g.ListImages(4).Picture
btnNext.DisabledPicture = .i16x16g.ListImages(5).Picture
btnLast.DisabledPicture = .i16x16g.ListImages(6).Picture
End With
lblCustomer.Caption = lblCustomer.Caption & " " & strCustomer
With SQLParser
.Fields = "Date, RefNo, Debit, Credit, Balance, ClientID, LedgerID"
.Tables = "qry_Clients_Ledger"
.SortOrder = "LedgerID ASC"
.wCondition = "ClientID = " & PK
.SaveStatement
End With
If rsCustomers.State = 1 Then rsCustomers.Close
rsCustomers.CursorLocation = adUseClient
rsCustomers.Open SQLParser.SQLStatement, CN, adOpenStatic, adLockReadOnly
With RecordPage
.Start rsCustomers, 75
FillList 1
End With
End Sub
Private Sub FillList(ByVal whichPage As Long)
RecordPage.CurrentPosition = whichPage
Screen.MousePointer = vbHourglass
Me.Enabled = False
Call pageFillListView(lvList, rsCustomers, RecordPage.PageStart, RecordPage.PageEnd, 15, 2, False, True, , , , "LedgerID")
Me.Enabled = True
Screen.MousePointer = vbDefault
SetNavigation
'Display the page information
lblPageInfo.Caption = "Record " & RecordPage.PageInfo
'Display the selected record
'lvList_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmLedgerAE = Nothing
End Sub
Private Sub SetNavigation()
With RecordPage
If .PAGE_TOTAL = 1 Then
btnFirst.Enabled = False
btnPrev.Enabled = False
btnNext.Enabled = False
btnLast.Enabled = False
ElseIf .PAGE_CURRENT = 1 Then
btnFirst.Enabled = False
btnPrev.Enabled = False
btnNext.Enabled = True
btnLast.Enabled = True
ElseIf .PAGE_CURRENT = .PAGE_TOTAL And .PAGE_CURRENT > 1 Then
btnFirst.Enabled = True
btnPrev.Enabled = True
btnNext.Enabled = False
btnLast.Enabled = False
Else
btnFirst.Enabled = True
btnPrev.Enabled = True
btnNext.Enabled = True
btnLast.Enabled = True
End If
End With
End Sub
Private Sub Picture1_Resize()
Picture2.Left = Picture1.ScaleWidth - Picture2.ScaleWidth
End Sub
'Private Sub Form_Load()
' Dim rs As New Recordset
'
' rs.CursorLocation = adUseClient
' rs.Open "SELECT * FROM qry_Clients_Ledger WHERE ClientID=" & Text1.Text, CN, adOpenStatic, adLockOptimistic
'
' With Listview1
'
' Do While Not rs.EOF
' Dim itmX As ListItem
' Set itmX = .ListItems. _
' Add(, , rs!Date) ' Author.
' itmX.SubItems(1) = CStr(rs!RefNo)
' itmX.SubItems(2) = CStr(rs!Debit)
' itmX.SubItems(3) = CStr(rs!Credit)
' itmX.SubItems(4) = toMoney(rs!Balance)
'
' rs.MoveNext
' Loop
' End With
'End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -