📄 frmdownlist.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmDownList
Caption = "Download Order Status"
ClientHeight = 7230
ClientLeft = 60
ClientTop = 345
ClientWidth = 9585
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 7230
ScaleWidth = 9585
WindowState = 2 'Maximized
Begin VB.Frame Frame1
Height = 975
Left = 240
TabIndex = 1
Top = 600
Width = 8775
Begin VB.OptionButton Option4
Caption = "Completed"
Height = 255
Left = 5160
TabIndex = 5
Top = 600
Width = 1815
End
Begin VB.OptionButton Option3
Caption = "In Transit"
Height = 330
Left = 5160
TabIndex = 4
Top = 240
Width = 1815
End
Begin VB.OptionButton Option2
Caption = "Ready for Delivery"
Height = 300
Left = 120
TabIndex = 3
Top = 520
Width = 2295
End
Begin VB.OptionButton Option1
Caption = "All"
Height = 375
Left = 120
TabIndex = 2
Top = 120
Width = 855
End
End
Begin MSComctlLib.ListView lsvDownList
Height = 5415
Left = 240
TabIndex = 0
Top = 1680
Width = 8775
_ExtentX = 15478
_ExtentY = 9551
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 315
Left = 960
TabIndex = 6
Top = 240
Width = 1455
_ExtentX = 2566
_ExtentY = 556
_Version = 393216
Format = 24641537
CurrentDate = 37132
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 315
Left = 3120
TabIndex = 7
Top = 240
Width = 1455
_ExtentX = 2566
_ExtentY = 556
_Version = 393216
Format = 24641537
CurrentDate = 37132
End
Begin VB.Label Label2
Caption = "~"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 135
Left = 2640
TabIndex = 9
Top = 360
Width = 255
End
Begin VB.Label Label1
Caption = "Date"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 8
Top = 240
Width = 615
End
End
Attribute VB_Name = "frmDownList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public lprocode As Long, lcuscode As Long
Public sprodesc As String, scusdesc As String
Public lsalonum As Long, lpicknum As Long, lsalolin As Long
Public dquantity As Double, smeaunit As String
Private sType As String
Private Sub cmdselect_Click()
End Sub
Private Sub cmdfind_Click()
End Sub
Private Sub Form_Load()
Me.Left = 1000
Me.Top = 1000
Call Inilsv
DTPicker1.Value = Date
DTPicker2.Value = Date
' Call setOrderInfo
End Sub
Private Sub setOrderInfo(ByVal sType As String)
Dim sSQL As String, sprocode As String
Dim ItemX As ListItem
Dim rstOrderInfo As Recordset
Dim iCount As Long
Dim lstartdate As Long, lenddate As Long
lstartdate = ChangeDate(DTPicker1.Value)
lenddate = ChangeDate(DTPicker2.Value)
If sType = "" Then
sSQL = "select a.itecode,a.itedesc,a.cuscode,b.cusdesc,a.salonum,a.picknum,a.salolin,a.sugoqty,a.meaunit from Orderd a,appcus b where a.cuscode=b.cuscode and a.salolnc>=" & lstartdate & " and a.salolnc<=" & lenddate & " and a.salotyp in('DO','TO','CMP') order by a.itecode,a.cuscode,a.salonum,a.salolin "
ElseIf sType = "TO" Then
sSQL = "select c.tripsno,a.itecode,a.itedesc,a.cuscode,b.cusdesc,a.salonum,a.picknum,a.salolin,a.sugoqty,a.meaunit from Orderd a,appcus b,ttosta c ,triphead d where c.tripsno=d.tripsno and a.cuscode=b.cuscode and a.salonum=c.salonum and a.salolin=c.salolin and a.salotyp='" & sType & "' and d.tripdate1>=" & lstartdate & " and d.tripdate1<=" & lenddate & " order by c.tripsno,a.itecode,a.cuscode,a.salonum,a.salolin "
ElseIf sType = "CMP" Then
sSQL = "select c.tripsno,a.itecode,a.itedesc,a.cuscode,b.cusdesc,a.salonum,a.picknum,a.salolin,a.sugoqty,a.meaunit from Orderd a,appcus b,ttosta c ,triphead d where c.tripsno=d.tripsno and a.cuscode=b.cuscode and a.salonum=c.salonum and a.salolin=c.salolin and a.salotyp='" & sType & "' and d.tripdate2>=" & lstartdate & " and d.tripdate2<=" & lenddate & " order by c.tripsno,a.itecode,a.cuscode,a.salonum,a.salolin "
ElseIf sType = "DO" Then
sSQL = "select a.itecode,a.itedesc,a.cuscode,b.cusdesc,a.salonum,a.picknum,a.salolin,a.sugoqty,a.meaunit from Orderd a,appcus b where a.cuscode=b.cuscode and a.salolnc>=" & lstartdate & " and a.salolnc<=" & lenddate & " and a.salotyp='" & sType & "' order by a.itecode,a.cuscode,a.salonum,a.salolin "
End If
Set rstOrderInfo = Acs_cnt.Execute(sSQL)
lsvDownList.ListItems.Clear
If sType = "" Or sType = "DO" Then
With rstOrderInfo
Do While Not .EOF
iCount = iCount + 1
Set ItemX = lsvDownList.ListItems.Add(, "K" & iCount, "")
ItemX.SubItems(1) = .Fields("itecode")
ItemX.SubItems(2) = .Fields("itedesc")
ItemX.SubItems(3) = .Fields("cuscode")
ItemX.SubItems(4) = .Fields("cusdesc")
ItemX.SubItems(5) = .Fields("salonum")
ItemX.SubItems(6) = .Fields("picknum")
ItemX.SubItems(7) = .Fields("salolin")
ItemX.SubItems(8) = .Fields("sugoqty")
ItemX.SubItems(9) = .Fields("meaunit")
.MoveNext
Loop
End With
ElseIf sType = "TO" Or sType = "CMP" Then
With rstOrderInfo
Do While Not .EOF
iCount = iCount + 1
Set ItemX = lsvDownList.ListItems.Add(, "K" & iCount, .Fields("tripsno"))
ItemX.SubItems(1) = .Fields("itecode")
ItemX.SubItems(2) = .Fields("itedesc")
ItemX.SubItems(3) = .Fields("cuscode")
ItemX.SubItems(4) = .Fields("cusdesc")
ItemX.SubItems(5) = .Fields("salonum")
ItemX.SubItems(6) = .Fields("picknum")
ItemX.SubItems(7) = .Fields("salolin")
ItemX.SubItems(8) = .Fields("sugoqty")
ItemX.SubItems(9) = .Fields("meaunit")
.MoveNext
Loop
End With
End If
rstOrderInfo.Close
Set rstOrderInfo = Nothing
If lsvDownList.ListItems.Count > 0 Then
lsvDownList.ListItems(1).Selected = True
End If
End Sub
Private Sub Inilsv()
With lsvDownList
.FullRowSelect = True
.MultiSelect = False
.LabelEdit = lvwManual
.ColumnHeaders.Add , "K1", "Trips Number", 0
.ColumnHeaders.Add , "K2", "Product Code", 1500
.ColumnHeaders.Add , "K3", "Product Desc", 1800
.ColumnHeaders.Add , "K4", "Customer Code", 1600
.ColumnHeaders.Add , "K5", "Customer Desc", 2000
.ColumnHeaders.Add , "K6", "Order Number", 1500
.ColumnHeaders.Add , "K7", "Pick Slip Number", 1900
.ColumnHeaders.Add , "K8", "Order Line Number", 2000
.ColumnHeaders.Add , "K9", "Quantity", 1200
.ColumnHeaders.Add , "K10", "Unit of Measurement", 2200
End With
End Sub
Private Sub lsvDownList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
lsvDownList.SortKey = ColumnHeader.Index - 1
lsvDownList.Sorted = True
End Sub
Private Sub Option1_Click()
sType = ""
lsvDownList.ColumnHeaders.Item(1).Width = 0
Call setOrderInfo(sType)
End Sub
Private Sub Option2_Click()
sType = "DO"
lsvDownList.ColumnHeaders.Item(1).Width = 0
Call setOrderInfo(sType)
End Sub
Private Sub Option3_Click()
sType = "TO"
lsvDownList.ColumnHeaders.Item(1).Width = 1500
Call setOrderInfo(sType)
End Sub
Private Sub Option4_Click()
sType = "CMP"
lsvDownList.ColumnHeaders.Item(1).Width = 1500
Call setOrderInfo(sType)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -