📄 frmtraffic.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTraffic
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "查看运单"
ClientHeight = 6825
ClientLeft = 45
ClientTop = 435
ClientWidth = 11895
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 7913.043
ScaleMode = 0 'User
ScaleWidth = 11895
Begin VB.CommandButton cmdNext
Caption = "下一页"
Height = 259
Left = 10680
TabIndex = 7
Top = 840
Width = 800
End
Begin VB.CommandButton cmdForWard
Caption = "上一页"
Height = 259
Left = 9720
TabIndex = 6
Top = 840
Width = 800
End
Begin VB.CommandButton Command4
Caption = "查 询"
Height = 328
Left = 7800
TabIndex = 5
Top = 720
Width = 900
End
Begin VB.CommandButton Command3
Caption = "删 除"
Height = 328
Left = 6240
TabIndex = 4
Top = 720
Width = 900
End
Begin VB.CommandButton Command2
Caption = "修 改"
Height = 328
Left = 4680
TabIndex = 3
Top = 720
Width = 900
End
Begin VB.CommandButton Command1
Caption = "新 增"
Height = 328
Left = 3120
TabIndex = 2
Top = 720
Width = 900
End
Begin VB.Frame Frame1
Height = 5295
Left = 360
TabIndex = 1
Top = 1200
Width = 11175
Begin MSComctlLib.ListView lsvTraffic
Height = 4815
Left = 240
TabIndex = 8
Top = 240
Width = 10755
_ExtentX = 18971
_ExtentY = 8493
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
AllowReorder = -1 'True
FullRowSelect = -1 'True
_Version = 393217
SmallIcons = "ilst16x16"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
End
Begin VB.Label Label2
AutoSize = -1 'True
Height = 180
Left = 9000
TabIndex = 9
Top = 240
Width = 90
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "查 看 运 单"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 4680
TabIndex = 0
Top = 240
Width = 2400
End
End
Attribute VB_Name = "frmTraffic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim total As Integer
Dim MaxPage As Integer
Dim NowPage As Integer
Dim arrProduct
Dim arrstation
Dim arrclient
Private Sub cmdForWard_Click()
NowPage = NowPage - 1
Call GotoPage(NowPage, arrTraffic)
End Sub
Private Sub cmdNext_Click()
NowPage = NowPage + 1
Call GotoPage(NowPage, arrTraffic)
End Sub
Private Sub Command1_Click()
frmTrafficAdd.Show
End Sub
Private Sub Command2_Click()
If IsNumeric(lsvTraffic.SelectedItem.Tag) Then
frmTrafficUpdate.updateid = sys.TextTolong(lsvTraffic.SelectedItem.Tag)
frmTrafficUpdate.Show
Else
MsgBox "请先选择要修改的记录!"
End If
End Sub
Private Sub Command3_Click()
If IsNumeric(lsvTraffic.SelectedItem.Tag) Then
Dim MyVar
MyVar = MsgBox("确认删除该条记录？", vbOKCancel, "信息提示")
If MyVar = vbOK Then
Dim strsql
strsql = "DELETE FROM TRAFFIC WHERE ID=" & sys.TextTolong(lsvTraffic.SelectedItem.Tag)
sys.DB.ExecuteSQL (strsql)
Call query
End If
Else
MsgBox "请先选择要删除的记录!"
End If
End Sub
Private Sub Command4_Click()
Dim frmQ As New frmQuery
frmQ.Show
frmQ.parentFrm = "frmTraffic"
End Sub
Private Sub Form_Load()
Me.Top = 0
Me.Left = 0
Me.Width = MainForm.Width * 0.8
Me.Height = MainForm.Height * 0.7
Call query
End Sub
Public Sub query(Optional ByVal strsql As String = "SELECT * FROM TRAFFIC ORDER BY ID DESC")
'查询运单
Dim inum As Integer
Dim rs As New ADODB.Recordset
ReDim arrTraffic(8, 0)
'禁止向前，向后翻页
cmdForWard.Enabled = False
cmdNext.Enabled = False
Set rs = sys.DB.OpenRecordSet(strsql)
rs.PageSize = 50
If Not (rs.BOF) Or (rs.EOF) Then
'计算翻页
MaxPage = rs.PageCount - 1
total = rs.RecordCount
NowPage = 0
'取出记录集
inum = 0
Do While Not rs.EOF
ReDim Preserve arrTraffic(8, inum)
arrTraffic(0, inum) = rs.Fields("ID")
arrTraffic(1, inum) = rs.Fields("CARNUM")
arrTraffic(2, inum) = rs.Fields("DATENUM")
arrTraffic(3, inum) = rs.Fields("PRODUCTNAME")
arrTraffic(4, inum) = rs.Fields("SENDSTATION")
arrTraffic(5, inum) = rs.Fields("RECEIVESTATION")
arrTraffic(6, inum) = rs.Fields("SENDER")
arrTraffic(7, inum) = rs.Fields("WEIGHT")
arrTraffic(8, inum) = rs.Fields("TOTAL")
inum = inum + 1
rs.MoveNext
Loop
'初始化品名
ReDim arrProduct(1, 0)
strsql = "SELECT * FROM PRODUCT"
Set rs = sys.DB.OpenRecordSet(strsql)
If Not (rs.BOF) Or (rs.EOF) Then
inum = 0
Do While Not rs.EOF
ReDim Preserve arrProduct(1, inum)
arrProduct(0, inum) = rs("ID")
arrProduct(1, inum) = rs("NAME")
rs.MoveNext
inum = inum + 1
Loop
End If
'初始化车站
ReDim arrstation(1, 0)
strsql = "SELECT * FROM STATION ORDER BY NAME"
Set rs = sys.DB.OpenRecordSet(strsql)
If Not (rs.BOF) Or (rs.EOF) Then
inum = 0
Do While Not rs.EOF
ReDim Preserve arrstation(1, inum)
arrstation(0, inum) = rs("ID")
arrstation(1, inum) = rs("NAME")
rs.MoveNext
inum = inum + 1
Loop
End If
'初始化客户
ReDim arrclient(1, 0)
strsql = "SELECT * FROM CLIENT ORDER BY NAME"
Set rs = sys.DB.OpenRecordSet(strsql)
If Not (rs.BOF) Or (rs.EOF) Then
inum = 0
Do While Not rs.EOF
ReDim Preserve arrclient(1, inum)
arrclient(0, inum) = rs("ID")
arrclient(1, inum) = rs("NAME")
rs.MoveNext
inum = inum + 1
Loop
End If
Call GotoPage(NowPage, arrTraffic)
End If
End Sub
Private Sub GotoPage(ByVal pg As Integer, ByVal arr)
'清除原有
lsvTraffic.ListItems.Clear
With lsvTraffic
lsvTraffic.ColumnHeaders.Clear
.ColumnHeaders.Add , , "序号", 600
.ColumnHeaders.Add , , "日期", 1200
.ColumnHeaders.Add , , "品名", 1200
.ColumnHeaders.Add , , "车号", 1200
.ColumnHeaders.Add , , "发站", 1200
.ColumnHeaders.Add , , "到站", 1200
.ColumnHeaders.Add , , "发货人", 1200
.ColumnHeaders.Add , , "重量", 1200
.ColumnHeaders.Add , , "运费", 1200
.GridLines = True
.ColumnHeaders.Item(1).Alignment = lvwColumnLeft
.ColumnHeaders.Item(2).Alignment = lvwColumnCenter
.ColumnHeaders.Item(3).Alignment = lvwColumnCenter
.ColumnHeaders.Item(4).Alignment = lvwColumnCenter
.ColumnHeaders.Item(5).Alignment = lvwColumnCenter
.ColumnHeaders.Item(6).Alignment = lvwColumnCenter
.ColumnHeaders.Item(7).Alignment = lvwColumnCenter
.ColumnHeaders.Item(8).Alignment = lvwColumnCenter
.ColumnHeaders.Item(9).Alignment = lvwColumnCenter
End With
Dim iq As Integer
Dim ia As Integer
For iq = 0 To 49
Set Item = lsvTraffic.ListItems.Add(, , "")
If 50 * pg + iq <= UBound(arr, 2) Then
Item.Tag = sys.StrToText(arr(0, 50 * pg + iq))
Item.Text = sys.StrToText(50 * pg + iq + 1)
Item.SubItems(1) = sys.StrToText(arr(2, 50 * pg + iq))
For ia = 0 To UBound(arrProduct, 2)
If arrProduct(0, ia) = sys.TextTolong(arr(3, 50 * pg + iq)) Then
Item.SubItems(2) = arrProduct(1, ia)
End If
Next
Item.SubItems(3) = sys.StrToText(arr(1, 50 * pg + iq))
For ia = 0 To UBound(arrstation, 2)
If arrstation(0, ia) = sys.TextTolong(arr(4, 50 * pg + iq)) Then
Item.SubItems(4) = arrstation(1, ia)
End If
Next
For ia = 0 To UBound(arrstation, 2)
If arrstation(0, ia) = sys.TextTolong(arr(5, 50 * pg + iq)) Then
Item.SubItems(5) = arrstation(1, ia)
End If
Next
For ia = 0 To UBound(arrclient, 2)
If arrclient(0, ia) = sys.TextTolong(arr(6, 50 * pg + iq)) Then
Item.SubItems(6) = arrclient(1, ia)
End If
Next
Item.SubItems(7) = sys.StrToText(arr(7, 50 * pg + iq))
Item.SubItems(8) = sys.StrToText(arr(8, 50 * pg + iq))
End If
Next
If pg > 0 Then
cmdForWard.Enabled = True
Else
cmdForWard.Enabled = False
End If
If pg < MaxPage Then
cmdNext.Enabled = True
Else
cmdNext.Enabled = False
End If
Label2.Caption = "共" & total & "条记录 共" & MaxPage + 1 & "页 当前第" & NowPage + 1 & "页"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -