📄 frmorderlist.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmOrderlist
BorderStyle = 1 'Fixed Single
Caption = "Order List"
ClientHeight = 6015
ClientLeft = 2040
ClientTop = 1830
ClientWidth = 7260
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmOrderList.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6015
ScaleWidth = 7260
Begin VB.CommandButton cmdCancel
Caption = "Cancel"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 480
Left = 4560
TabIndex = 3
Top = 5400
Width = 1185
End
Begin VB.CommandButton cmdOk
Caption = "OK"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 480
Left = 1440
TabIndex = 2
Top = 5400
Width = 1185
End
Begin MSComctlLib.ListView lsvOrder
Height = 2265
Left = 240
TabIndex = 1
Top = 120
Width = 5625
_ExtentX = 9922
_ExtentY = 3995
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin MSComctlLib.ListView lsvOrderD
Height = 2745
Left = 240
TabIndex = 0
Top = 2520
Width = 6825
_ExtentX = 12039
_ExtentY = 4842
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
End
Attribute VB_Name = "frmOrderlist"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public plDealerID As Long
Public pnCount As Integer
Public pcolTkt As New Collection
Const LineWidth = 400
Const ColWidth = 2000
Private bFormLoad As Boolean
Private Sub cmdCancel_Click()
Me.Tag = vbCancel
Me.Hide
End Sub
Private Sub cmdOK_Click()
Dim sSQL As String, sStr As String
Dim nloop As Long
Dim lsugonum As Long
Dim rstOrderd As Recordset
Dim ItemX As ListItem
Dim iRow As Long
If Printer.Orientation = 1 Then
Printer.Orientation = 2
ElseIf Printer.Orientation = 0 Then
Exit Sub
End If
For nloop = 1 To lsvOrder.ListItems.Count
Set ItemX = lsvOrder.ListItems(nloop)
If ItemX.Checked = True Then
lsugonum = ItemX.SubItems(2)
sSQL = "select a.*,b.maxleve,b.safleve,b.actleve,b.orderso,b.orderdo,b.orderto,c.cusdesc from orderd a,appcut b, appcus c where a.cuscode=c.cuscode and a.itecode=b.procode and a.sugonum=" & lsugonum & ""
Set rstOrderd = Acs_cnt.Execute(sSQL)
With rstOrderd
'Print Head
sStr = "Suggested Order"
Call PrintString(8000, 1000, 14, sStr)
sStr = "Company:" & gsCmpDesc
Call PrintString(500, 1500, 12, sStr)
sStr = "Enity:" & gsEntDesc
Call PrintString(500, 2000, 12, sStr)
sStr = "Report Date:" & Format(Date, "dd/mm/yyyy")
Call PrintString(12000, 2000, 12, sStr)
sStr = "Customer Code/Desc:" & rstOrderd!cuscode & "/" & rstOrderd!Cusdesc
Call PrintString(500, 2500, 12, sStr)
sStr = "Report Time:" & Format(Time, "hh:mm")
Call PrintString(12000, 2500, 12, sStr)
sStr = "Product Code/Desc:"
Call PrintString(500, 3000, 12, sStr)
sStr = "Max Tank Lvl"
Call PrintString(3000, 3000, 12, sStr)
sStr = "Safety Stock"
Call PrintString(5000, 3000, 12, sStr)
sStr = "Curr Tank Lvl"
Call PrintString(7000, 3000, 12, sStr)
sStr = "In-Transit Level"
Call PrintString(9000, 3000, 12, sStr)
sStr = "Order Num"
Call PrintString(11000, 3000, 12, sStr)
sStr = "Ln Num"
Call PrintString(12000, 3000, 12, sStr)
sStr = "Qty"
Call PrintString(13000, 3000, 12, sStr)
sStr = "EOQ Order"
Call PrintString(14000, 3000, 12, sStr)
iRow = 0
Do While Not .EOF
'Print Detail
iRow = iRow + 1
sStr = rstOrderd!Itecode & "/" & rstOrderd!Itedesc
Call PrintString(500, 3000 + iRow * LineWidth, 12, sStr)
sStr = rstOrderd!maxleve
Call PrintString(3000, 3000 + iRow * LineWidth, 12, sStr)
sStr = rstOrderd!safleve
Call PrintString(5000, 3000 + iRow * LineWidth, 12, sStr)
sStr = rstOrderd!actleve
Call PrintString(7000, 3000 + iRow * LineWidth, 12, sStr)
sStr = rstOrderd!orderso + rstOrderd!orderdo + rstOrderd!orderto
Call PrintString(9000, 3000 + iRow * LineWidth, 12, sStr)
sStr = lsugonum
Call PrintString(11000, 3000 + iRow * LineWidth, 12, sStr)
sStr = rstOrderd!sugolin
Call PrintString(12000, 3000 + iRow * LineWidth, 12, sStr)
sStr = rstOrderd!sugoqty
Call PrintString(13000, 3000 + iRow * LineWidth, 12, sStr)
.MoveNext
Loop
End With
'Print Detail
sStr = "Verified by(OPS):"
Call PrintString(500, 3000 + (iRow + 2) * LineWidth, 12, sStr)
sStr = "Date:"
Call PrintString(10000, 3000 + (iRow + 2) * LineWidth, 12, sStr)
sStr = "Confirmed by(Sales):"
Call PrintString(500, 3000 + (iRow + 3) * LineWidth, 12, sStr)
sStr = "Date:"
Call PrintString(10000, 3000 + (iRow + 3) * LineWidth, 12, sStr)
Printer.NewPage
Printer.EndDoc
End If
Next nloop
End Sub
Private Sub PrintString(ByVal X As Long, ByVal Y As Long, lFontSize As Long, sStr As String)
Printer.CurrentX = X
Printer.CurrentY = Y
Printer.FontSize = 12
Printer.Print sStr
End Sub
Private Sub Form_Load()
Me.Tag = vbCancel
bFormLoad = True
pnCount = 0
InitForm
bFormLoad = False
End Sub
Private Sub InitForm()
Call Initlsvorder
Call InitlsvorderD
Call RefreshLsv
End Sub
Private Sub Initlsvorder()
With lsvOrder
.CheckBoxes = True
.FullRowSelect = True
.MultiSelect = False
.LabelEdit = lvwManual
.ColumnHeaders.Add , "K1", "Order Date", 1500
.ColumnHeaders.Add , "K2", "Customer Code", 1800
.ColumnHeaders.Add , "K3", "Order Number", .Width - 3400
End With
End Sub
Private Sub InitlsvorderD()
With lsvOrderD
.FullRowSelect = True
.LabelEdit = lvwManual
.ColumnHeaders.Add , "K1", "Line Number", 1400
.ColumnHeaders.Add , "K2", "Product Code", 1600
.ColumnHeaders.Add , "K3", "Product Desc", 2600
.ColumnHeaders.Add , "K4", "Quantity", .Width - 5700
End With
End Sub
Private Sub RefreshLsv()
Dim rstOrder As ADODB.Recordset
Dim ItemX As MSComctlLib.ListItem
Dim iCount As Long
Dim sSQL As String
lsvOrder.ListItems.Clear
iCount = 0
sSQL = " select distinct sugolnc,cuscode,sugonum from orderd where sugolnc>0"
Set rstOrder = Acs_cnt.Execute(sSQL)
With rstOrder
Do While Not .EOF
iCount = iCount + 1
Set ItemX = lsvOrder.ListItems.Add(, "K" & iCount, .Fields("sugolnc"))
ItemX.SubItems(1) = .Fields("cuscode")
ItemX.SubItems(2) = .Fields("sugonum")
.MoveNext
Loop
End With
rstOrder.Close
Set rstOrder = Nothing
With lsvOrder
If .ListItems.Count > 0 Then
.ListItems(1).Selected = True
Call ShowOrderDetail(.SelectedItem.SubItems(2))
End If
End With
End Sub
Private Sub ShowOrderDetail(ByVal lsugonum As Long)
Dim sSQL As String
Dim ItemX As MSComctlLib.ListItem
Dim rstDetail As Recordset
lsvOrderD.ListItems.Clear
sSQL = "select * from orderd where sugolnc>0 and sugonum=" & lsugonum
Set rstDetail = Acs_cnt.Execute(sSQL)
With rstDetail
Do While Not .EOF
Set ItemX = lsvOrderD.ListItems.Add(, "K" & .Fields("sugolin"), .Fields("sugolin"))
ItemX.SubItems(1) = .Fields("itecode")
ItemX.SubItems(2) = .Fields("itedesc")
ItemX.SubItems(3) = .Fields("sugoqty")
.MoveNext
Loop
End With
rstDetail.Close
Set rstDetail = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
pnCount = 0
If Not pcolTkt Is Nothing Then Set pcolTkt = Nothing
End Sub
Private Sub txtCode_KeyUp(KeyCode As Integer, Shift As Integer)
Dim lDealerID As Long
If bFormLoad Then Exit Sub
If KeyCode <> vbKeyReturn Then Exit Sub
End Sub
Private Sub lsvOrder_ItemClick(ByVal Item As MSComctlLib.ListItem)
Call ShowOrderDetail(lsvOrder.SelectedItem.SubItems(2))
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -