📄 frmcosting.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmCosting
Caption = "Receiving"
ClientHeight = 7785
ClientLeft = 60
ClientTop = 345
ClientWidth = 9510
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form4"
MDIChild = -1 'True
ScaleHeight = 7785
ScaleWidth = 9510
WindowState = 2 'Maximized
Begin VB.CommandButton cmdtrip
Caption = "Trips List"
Height = 420
Left = 3240
TabIndex = 12
Top = 800
Width = 1335
End
Begin VB.Frame Frame2
Appearance = 0 'Flat
BackColor = &H80000004&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 2655
Left = 120
TabIndex = 7
Top = 1320
Width = 9135
Begin MSComctlLib.ListView lsvttosta
Height = 2655
Left = 0
TabIndex = 8
Top = 0
Width = 9135
_ExtentX = 16113
_ExtentY = 4683
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Begin VB.TextBox txttripsno
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1560
TabIndex = 0
Top = 840
Width = 1215
End
Begin VB.Frame Frame1
Height = 900
Left = 120
TabIndex = 3
Top = 4005
Width = 9015
Begin VB.TextBox txtkilomet
Height = 320
Left = 7440
TabIndex = 2
Top = 360
Width = 975
End
Begin VB.TextBox txtdeliqty
Height = 320
Left = 1920
TabIndex = 1
Top = 360
Width = 1215
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
Caption = "Kilometers(KM)"
Height = 255
Left = 5760
TabIndex = 6
Top = 375
Width = 1455
End
Begin VB.Label Label2
Caption = "Delivered Qty"
Height = 255
Left = 360
TabIndex = 5
Top = 360
Width = 1455
End
Begin VB.Label lblunit
AutoSize = -1 'True
Height = 210
Left = 3240
TabIndex = 4
Top = 360
Width = 105
End
End
Begin PrjLDS.UserControl1 UserControl11
Height = 615
Left = 0
TabIndex = 9
Top = 0
Width = 11895
_ExtentX = 16986
_ExtentY = 1085
End
Begin VB.Label lblstatus
Caption = "status"
Height = 375
Left = 8520
TabIndex = 11
Top = 6000
Visible = 0 'False
Width = 615
End
Begin VB.Label Label1
Caption = "Trips Number"
Height = 255
Left = 240
TabIndex = 10
Top = 840
Width = 1335
End
End
Attribute VB_Name = "frmCosting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mkey As String
Private Sub Initialize()
On Error GoTo Fail
With lsvttosta
.ColumnHeaders.Add , , "No.", 600
.ColumnHeaders.Add , , "Customer Code", 1600
.ColumnHeaders.Add , , "Product Code", 1500
.ColumnHeaders.Add , , "Order Number", 1500
.ColumnHeaders.Add , , "Line Number", 1400
.ColumnHeaders.Add , , "ID", 0
.ColumnHeaders.Add , , "Pick Slip Number", 1900
.ColumnHeaders.Add , , "Status", 1000
.ColumnHeaders.Add , , "MeaUnit", 0
.LabelEdit = lvwManual
.FullRowSelect = True
.HideSelection = False
.View = lvwReport
End With
Me.KeyPreview = True
Exit Sub
Fail:
err.Raise err.Number, , err.Description
End Sub
Private Sub iniText()
txttripsno.Text = ""
End Sub
Private Sub InitToolBar()
With UserControl11
.DisplayButton "New", "New", True, , "New"
.DisplayButton "Find", "Find", True, , "Find"
.DisplayButton "Save", "Save", False, , "Save"
.DisplayButton "Cancel", "Cancel", False, , "Cancel"
.DisplayButton "Modify", "Modify", False, , "Modify"
.DisplayButton "Close", "Close", True, , "Close"
End With
End Sub
Private Sub SetToolBar(ByVal mkey As String)
Select Case mkey
Case "new"
With UserControl11
.DisplayButton "New", "New", False, , "New"
.DisplayButton "Find", "Find", False, , "Find"
.DisplayButton "Modify", "Modify", False, , "Modify"
.DisplayButton "Save", "Save", True, , "Save"
.DisplayButton "Cancel", "Cancel", True, , "Cancel"
.DisplayButton "Close", "Close", False, , "Close"
End With
Case "modify"
With UserControl11
.DisplayButton "New", "New", False, , "New"
.DisplayButton "Find", "Find", False, , "Find"
.DisplayButton "Modify", "Modify", False, , "Modify"
.DisplayButton "Save", "Save", True, , "Save"
.DisplayButton "Cancel", "Cancel", True, , "Cancel"
.DisplayButton "Close", "Close", True, , "Close"
End With
Case "cancel"
With UserControl11
.DisplayButton "New", "New", False, , "New"
.DisplayButton "Find", "Find", True, , "Find"
.DisplayButton "Modify", "Modify", False, , "Modify"
.DisplayButton "Save", "Save", False, , "Save"
.DisplayButton "Cancel", "Cancel", False, , "Cancel"
.DisplayButton "Close", "Close", True, , "Close"
End With
Case "find"
With UserControl11
.DisplayButton "Find", "Find", True, , "Find"
.DisplayButton "Save", "Save", False, , "Save"
.DisplayButton "Cancel", "Cancel", True, , "Cancel"
.DisplayButton "Close", "Close", True, , "Close"
End With
Case "save"
With UserControl11
.DisplayButton "New", "New", True, , "New"
.DisplayButton "Find", "Find", True, , "Find"
.DisplayButton "Save", "Save", False, , "Save"
.DisplayButton "Modify", "Modify", False, , "Modify"
.DisplayButton "Cancel", "Cancel", False, , "Cancel"
.DisplayButton "Close", "Close", True, , "Close"
End With
End Select
End Sub
Private Function save() As Boolean
On Error GoTo err
save = False
If LCase(lblstatus.Caption) = "new" Then
If saveinfo = True Then
save = True
Else
save = False
End If
ElseIf LCase(lblstatus.Caption) = "modify" Then
If ModifyInfo = True Then
save = True
Else
save = False
End If
End If
Exit Function
err:
End Function
Private Function saveinfo() As Boolean
On Error GoTo err
Dim sSQL As String, sSQL1 As String, sSQL2 As String, sSQL3 As String
Dim dkilomet As Double, ddeliqty As Double
Dim lID As Long, lsalonum As Long, lsalolin As Long
Dim soquantity As Double, doquantity As Double, toquantity As Double
Dim lcuscode As Long, lprocode As Long
Dim rstTemp As Recordset
saveinfo = False
If lsvttosta.ListItems.Count <= 0 Then
Exit Function
End If
lID = lsvttosta.SelectedItem.SubItems(5)
lcuscode = lsvttosta.SelectedItem.SubItems(1)
lprocode = lsvttosta.SelectedItem.SubItems(2)
lsalonum = lsvttosta.SelectedItem.SubItems(3)
lsalolin = lsvttosta.SelectedItem.SubItems(4)
dkilomet = ChgDouble(txtkilomet.Text)
ddeliqty = ChgDouble(txtdeliqty.Text)
sSQL1 = "update ttosta set deliqty=" & ddeliqty & ",kilomet=" & dkilomet & " where id=" & lID
sSQL2 = "update orderd set salotyp='CMP' where Salonum=" & lsalonum & " and Salolin=" & lsalolin & ""
Acs_cnt.BeginTrans
Acs_cnt.Execute (sSQL1)
Acs_cnt.Execute (sSQL2)
Acs_cnt.CommitTrans
soquantity = 0
doquantity = 0
toquantity = 0
sSQL = "select cuscode,itecode,salotyp,sum(sugoqty) as ordernum from orderd " & _
" where salotyp in('SO','DO','TO') and itecode=" & lprocode & " and cuscode=" & lcuscode & " group by cuscode,itecode,salotyp"
Set rstTemp = Acs_cnt.Execute(sSQL)
With rstTemp
Do While Not .EOF
If rstTemp!salotyp = "SO" Then
soquantity = rstTemp!ordernum
ElseIf rstTemp!salotyp = "DO" Then
doquantity = rstTemp!ordernum
ElseIf rstTemp!salotyp = "TO" Then
toquantity = rstTemp!ordernum
End If
.MoveNext
Loop
End With
sSQL = "update appcut set orderso=" & soquantity & ",orderdo=" & doquantity & ",orderto=" & toquantity & " where procode=" & lprocode & ""
Acs_cnt.BeginTrans
Acs_cnt.Execute (sSQL)
Acs_cnt.CommitTrans
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -