Files
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Inv/frmOrdersBK.frm
Mike Swanson 5359e7c49e feat(valleywide): recover VWP Orders VB6 source from D: backup drive
Recovered Darv's VB6 source for the Valley Wide Plastering Orders
application from the D: backup drive (label "Backup", 8 TB, 5.3 TB used).
This is the first time we've had the actual source — prior session only
had a single frmPayroll.frm from the AD server.

Three project variants identified across two snapshots:
- Full-Project/   (2,129 files, 124 MB) — D:\Office-Estimates\Darv\Full\Project\
- Kingston-Project/ (2,189 files, 130 MB) — D:\Office-Estimates\Darv\Kingston\Project\
- Source/         (170 files, 559 MB)   — D:\Office-Estimates\Darv\Source\ wholesale
- SOURCE-HOLD/    (3 files, 1 MB)       — D:\Office-Estimates\Darv\SOURCE HOLD\

Latest ORDERS_C.vbp date is 2020-06-09 (Kingston snapshot). Production
Orders_10A.exe was live as of April 2024 — open question whether newer
source exists on other backup drives Mike will scan next.

Also includes per-category and per-keyword analysis CSVs from a WizTree
file-list export, plus the analyzer script that produced them
(re-runnable for the next drive's CSV).

VMs (VWIN7-DW.vdi 8.3 GB + XP-for-ORDERS_copy.vdi 2.8 GB), the live
VWP.mdb, and the 393 MB raw WizTree CSV stay on disk only — gitignored.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-16 17:36:27 -07:00

1279 lines
36 KiB
Plaintext

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "CRYSTL32.OCX"
Begin VB.Form frmOrders
Caption = "Orders Information"
ClientHeight = 7935
ClientLeft = 60
ClientTop = 345
ClientWidth = 11415
Icon = "frmOrders.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 7935
ScaleWidth = 11415
StartUpPosition = 3 'Windows Default
Visible = 0 'False
Begin VB.CommandButton cmdFindPO
Caption = "PO"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 795
Left = 2820
Picture = "frmOrders.frx":0442
Style = 1 'Graphical
TabIndex = 44
Top = 5820
Width = 675
End
Begin Crystal.CrystalReport crOrder
Left = 10200
Top = 180
_ExtentX = 741
_ExtentY = 741
_Version = 348160
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton Command2
Caption = "Setup S&W AR Transfer"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 9660
TabIndex = 42
TabStop = 0 'False
Top = 7140
Width = 1455
End
Begin VB.CommandButton cmdPrint
Caption = "&Print Invoice"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 7560
TabIndex = 41
TabStop = 0 'False
Top = 7140
Width = 1455
End
Begin VB.TextBox txtVendorInv
Height = 375
Left = 4020
TabIndex = 40
TabStop = 0 'False
Top = 6660
Width = 1755
End
Begin VB.CommandButton cmdAP
Caption = "Setup &AP Transfer"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 9660
TabIndex = 38
TabStop = 0 'False
Top = 6120
Width = 1455
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 9660
TabIndex = 37
TabStop = 0 'False
Top = 5100
Width = 1455
End
Begin VB.CommandButton cmdUpdate
Caption = "&Update Total"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 7560
TabIndex = 36
TabStop = 0 'False
Top = 6120
Width = 1455
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 7560
TabIndex = 8
Top = 5100
Width = 1455
End
Begin VB.TextBox txtPrice
Alignment = 1 'Right Justify
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 7
Top = 2460
Width = 2175
End
Begin VB.TextBox txtAQty
Alignment = 1 'Right Justify
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 6
Top = 1980
Width = 1035
End
Begin VB.ListBox lstMaterials
Height = 4155
Left = 2100
TabIndex = 10
Top = 720
Width = 4155
End
Begin VB.ListBox lstOrders
Height = 4155
Left = 60
TabIndex = 3
TabStop = 0 'False
Top = 720
Width = 1995
End
Begin VB.Label lblLocked
Caption = "This Invoice Has Been Transfered To AP And Is Now Locked"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1575
Left = 4800
TabIndex = 43
Top = 4980
Visible = 0 'False
Width = 2595
End
Begin VB.Label lblVendorInv
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Vendor Invoice #:"
Height = 195
Left = 2640
TabIndex = 39
Top = 6735
Width = 1275
End
Begin VB.Label lblD_Update
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6780
TabIndex = 35
Top = 4440
Width = 4575
End
Begin VB.Label lblD_Create
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6780
TabIndex = 34
Top = 3720
Width = 4575
End
Begin VB.Label lblD_Flag
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 33
Top = 2940
Width = 3855
End
Begin VB.Label lblD_OQty
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 32
Top = 1500
Width = 1035
End
Begin VB.Label lblUpdate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Updated:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6780
TabIndex = 31
Top = 4140
Width = 975
End
Begin VB.Label lblCreate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Created:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6780
TabIndex = 30
Top = 3420
Width = 900
End
Begin VB.Label lblPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Price:"
Height = 195
Left = 6930
TabIndex = 29
Top = 2640
Width = 405
End
Begin VB.Label lblAQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Actual Qty:"
Height = 195
Left = 6555
TabIndex = 28
Top = 2040
Width = 780
End
Begin VB.Label lblOQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Original Qty:"
Height = 195
Left = 6480
TabIndex = 27
Top = 1500
Width = 855
End
Begin VB.Label lblD_Desc
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 26
Top = 1020
Width = 3855
End
Begin VB.Label lblD_InvNo
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 25
Top = 540
Width = 1695
End
Begin VB.Label lblInv_No
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory:"
Height = 195
Left = 6630
TabIndex = 24
Top = 660
Width = 705
End
Begin VB.Label lblD_Type
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 23
Top = 7500
Width = 3555
End
Begin VB.Label lblD_Supplier
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 22
Top = 7080
Width = 4575
End
Begin VB.Label lblD_Percent
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 21
Top = 6660
Width = 1035
End
Begin VB.Label lblD_Amount
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 20
Top = 6240
Width = 1545
End
Begin VB.Label lblD_SPO
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 19
Top = 5820
Width = 1545
End
Begin VB.Label lblD_PO
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 18
Top = 5400
Width = 3555
End
Begin VB.Label lblD_ODate
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 17
Top = 4980
Width = 2115
End
Begin VB.Label lblSPO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Special PO #:"
Height = 195
Left = 120
TabIndex = 16
Top = 5925
Width = 990
End
Begin VB.Label lblType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Type:"
Height = 195
Left = 270
TabIndex = 15
Top = 7560
Width = 840
End
Begin VB.Label lblSupplier
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Supplier:"
Height = 195
Left = 495
TabIndex = 14
Top = 7155
Width = 615
End
Begin VB.Label lblPercent
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Percentage:"
Height = 195
Left = 240
TabIndex = 13
Top = 6735
Width = 870
End
Begin VB.Label lblAmount
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Amount:"
Height = 195
Left = 90
TabIndex = 12
Top = 6330
Width = 1020
End
Begin VB.Label lblPO
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PO Number:"
Height = 195
Left = 240
TabIndex = 11
Top = 5505
Width = 870
End
Begin VB.Label lblO_Date
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Order Date:"
Height = 195
Left = 285
TabIndex = 9
Top = 5100
Width = 825
End
Begin VB.Line Line1
BorderWidth = 2
X1 = 6360
X2 = 6360
Y1 = 60
Y2 = 7920
End
Begin VB.Label lblTotal
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7500
TabIndex = 5
Top = 60
Width = 1695
End
Begin VB.Label lblInvTotal
AutoSize = -1 'True
Caption = "PO Total:"
Height = 195
Left = 6720
TabIndex = 4
Top = 120
Width = 675
End
Begin VB.Label lblMatList
AutoSize = -1 'True
Caption = "Materials"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2160
TabIndex = 2
Top = 480
Width = 780
End
Begin VB.Label lblPOList
AutoSize = -1 'True
Caption = "PO Number"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 1
Top = 480
Width = 975
End
Begin VB.Label lblProjLot
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 60
TabIndex = 0
Top = 60
Width = 6195
End
End
Attribute VB_Name = "frmOrders"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSORDER As Recordset
Dim moRSOrdMat As Recordset
Dim moRSProj As Recordset
Dim moRS As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean
Dim mboolCopy As Boolean, mintBOOKMARK As Integer, mintBOOKMARK2 As Integer
Dim mstrType As String, mstrMODEL As String
Dim mlngORDERID As Long, mdblTOTAL As Double
Dim mstrSQL As String
Private Sub OrderLoad()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strSQLL As String
Dim strLine As String
On Error GoTo Error_EH
If gintORDER = 9 Then
strSQL = "SELECT * from tblOrders WHERE Lot_id = " & gintLOTID & " ORDER BY PO_Num"
End If
If gintORDER = 8 Then
strSQL = "SELECT * from tblOrders WHERE PO_Num = '" & gstrPONUM & "'"
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstOrders.Clear
Do Until oRS.EOF
With lstOrders
strLine = oRS!po_Num ' & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!order_id
End With
oRS.MoveNext
Loop
oRS.Close
If lstOrders.ListCount Then
lstOrders.ListIndex = 0
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String
On Error GoTo Error_EH
gintCOPY = 1
strSQL = "{tblORDERS.order_id} = " & mlngORDERID
crOrder.ReportFileName = App.Path & "\POPrice.rpt"
crOrder.GroupSelectionFormula = strSQL
crOrder.CopiesToPrinter = gintCOPY
' crOrder.Destination = crptToWindow
crOrder.Destination = crptToPrinter
crOrder.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo - Module PrintJCRpt"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdUpdate_Click()
Dim intBOOK As Integer
mintBOOKMARK = lstOrders.ListIndex
intBOOK = lstMaterials.ListIndex
moRSORDER!orderamt = Field2Str2(lblTotal)
moRSORDER.Update
Call OrderLoad
Call OrderMatLoad
cmdUpdate.Enabled = False
lstOrders.ListIndex = mintBOOKMARK
lstMaterials.ListIndex = intBOOK
mintBOOKMARK = 0
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If cmdSave.Enabled Then
strMSG = "PO Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
Call FormSave
Case vbNo
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
If moRSORDER.State = adStateOpen Then
moRSORDER.Close
End If
If moRSOrdMat.State = adStateOpen Then
moRSOrdMat.Close
End If
If moRS.State = adStateOpen Then
moRS.Close
End If
If moRSProj.State = adStateOpen Then
moRSProj.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
Else
End If
End Sub
Private Sub OrderMatLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String, lngRET As Long, aTabs(1) As Long
Dim dblSUM As Double
On Error GoTo Error_EH
aTabs(0) = 130
aTabs(1) = 155
mdblTOTAL = 0
strSQL = "SELECT Item_id, Inv_no, Desc, A_Qty, Price from tblOrdMatrl WHERE Order_id = " & mlngORDERID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lngRET = SendMessage(lstMaterials.hwnd, LB_SETTABSTOPS, 2, aTabs(0))
lstMaterials.Clear
Do Until oRS.EOF
With lstMaterials
strLine = oRS!Desc & vbTab & oRS!a_qty & vbTab & Format(oRS!price, "#,#.00")
.AddItem strLine
.ItemData(.NewIndex) = oRS!Item_ID
End With
dblSUM = (Field2Str2(oRS!a_qty) * Field2Str2(oRS!price))
mdblTOTAL = mdblTOTAL + dblSUM
oRS.MoveNext
Loop
oRS.Close
If lstMaterials.ListCount Then
lstMaterials.ListIndex = 0
Else
lstMaterials.Clear
Call FormClearOrdMat
End If
lblTotal = Format(mdblTOTAL, "#,#.00")
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module OrderMatLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Load()
' Set moRSORDER = New Recordset
' Set moRSOrdMat = New Recordset
' If gbytSECURITY < 3 Then
' cmdUpdate.Visible = True
' End If
Call ProjLoad
Call OrderLoad
' lstOrders.SetFocus
' Call ListLoad
' Call MatLoad
' Call OptLoad
' Call OptMatLoad
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
mlngORDERID = moRSORDER!order_id
lblProjLot = Trim$(moRSProj!proj_code) & " " & Trim$(moRSProj!proj_desc) & " " & moRS!lot_no
With moRSORDER
txtVendorInv = Field2Str(!sup_inv)
lblD_ODate = Field2Str(!order_date)
lblD_PO = Field2Str(!po_Num)
lblD_Supplier = Field2Str(!supplier)
lblD_SPO = Field2Integer(!ponum)
lblD_Percent = Field2Str(!percentage)
lblD_Amount = Format(Field2Str2(!orderamt), "#,#.00")
If !m_type = "H" Then
lblD_Type = "ORDER REPRINTED"
ElseIf !m_type = "L" Then
lblD_Type = "LATH ORDER"
ElseIf !m_type = "A" Then
lblD_Type = "SAND ORDER"
ElseIf !m_type = "B" Then
lblD_Type = "BROWN ORDER"
ElseIf !m_type = "T" Then
lblD_Type = "TEXTURE ORDER"
ElseIf !m_type = "R" Then
lblD_Type = "SPECIAL PO"
ElseIf !m_type = "P" Then
lblD_Type = "PREORDER"
ElseIf !m_type = "S" Then
lblD_Type = "SCRATCH ORDER"
Else
lblD_Type = "UNKNOWN"
End If
If !ap_trans Then
lblLocked.Visible = True
txtVendorInv.Enabled = False
txtAQty.Enabled = False
txtPrice.Enabled = False
End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowOrdMat()
On Error GoTo Error_EH
mboolSHOW = True
With moRSOrdMat
lblD_InvNo = Field2Integer(!inv_no)
lblD_Desc = Field2Str(!Desc)
lblD_OQty = Field2Str(!o_qty)
txtPrice = Format$(Field2Str2(!price), "##,###.00")
txtAQty = Field2Integer(!a_qty)
If !X_flag Then
lblD_Flag = "This Order Not Delivered"
Else
lblD_Flag = ""
End If
lblD_Create = Field2Str(!Create)
lblD_Update = Field2Str(!Update) & " " & Field2Str(!U_USER)
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module FormShowMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
lblD_ODate = ""
lblD_PO = ""
lblSupplier = ""
lblD_SPO = ""
lblD_Percent = ""
lblD_Amount = ""
lblD_Type = ""
End Sub
Private Sub FormClearOrdMat()
lblD_InvNo = ""
lblD_Desc = ""
lblD_OQty = 0
txtPrice = 0
txtAQty = 0
lblD_Flag = ""
lblCreate = ""
lblUpdate = ""
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
' If mboolAdding Then
' moRS.AddNew
' moRS!mod_elv = Str2Field(txtNewModel.Text)
' moRS!proj_id = gintPROJID
' moRS!createuser = gstrLOGIN
' End If
Call FieldsSave
moRSOrdMat.Update
' If mboolAdding Then
' mboolAdding = False
' cmdExit.Caption = "E&xit"
' End If
Call OrderMatLoad
' Call ToggleButtons
Exit Sub
Error_EH:
Call ErrorHandler(moRS.ActiveConnection)
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblOrders "
strSQL = strSQL & "WHERE order_id = " & _
lstOrders.ItemData(lstOrders.ListIndex)
Set moRSORDER = New Recordset
moRSORDER.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSORDER.EOF Then
FormFind = False
Else
FormFind = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form Orders - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindOrdMat() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblOrdMatrl "
strSQL = strSQL & "WHERE Item_ID = " & lstMaterials.ItemData(lstMaterials.ListIndex)
Set moRSOrdMat = New Recordset
moRSOrdMat.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSOrdMat.EOF Then
FormFindOrdMat = False
Else
FormFindOrdMat = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form Orders - Module FormFindOrdMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRSOrdMat
!a_qty = Single2Field(txtAQty)
!price = Format(Single2Field(txtPrice), "#,#.00")
!Update = Date
!U_USER = gstrLOGIN
End With
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
If lstOrders.ListCount = 0 Then
If gintORDER = 9 Then
intResponse = MsgBox("No Orders Have Been Processed For This Lot", vbOKOnly + vbQuestion, "Add Records")
ElseIf gintORDER = 8 Then
intResponse = MsgBox("No Orders Have Been Processed For This Lot", vbOKOnly + vbQuestion, "Add Records")
End If
' If intResponse = vbYes Then
' strSQL = "SELECT * FROM tblplans WHERE est_id = 1"
' Set moRS = New Recordset
' moRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' txtProject = Trim$(moRSProj!proj_code) & " " & moRSProj!proj_desc
' Call cmdNewPlan_Click
' cmdCopyTakeoff.Enabled = True
' Else
Unload Me
' End If
End If
End Sub
Private Sub lstMaterials_DblClick()
If Not moRSORDER!ap_trans Then
cmdSave.Enabled = True
End If
End Sub
Private Sub lstOrders_Click()
On Error GoTo Error_EH
If lstOrders.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
Call OrderMatLoad
If lstMaterials.ListIndex <> -1 Then
If FormFindOrdMat() Then
Call FormShowOrdMat
Else
lstMaterials.Clear
Call FormClearOrdMat
End If
End If
Else
lstOrders.Clear
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module lstOrders_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstMaterials_Click()
On Error GoTo Error_EH
If lstMaterials.ListIndex <> -1 Then
If FormFindOrdMat() Then
Call FormShowOrdMat
Else
lstMaterials.Clear
Call FormClearOrdMat
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module lstMaterials_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ProjLoad()
Dim strSQL As String
Dim strSql2 As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID
Set moRSProj = New Recordset
moRSProj.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
strSql2 = "SELECT * FROM tblLotInfo WHERE Lot_id = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly
Exit Sub
Error_EH:
gstrMODULE = "Form Orders - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
Dim intBOOK As Integer
mintBOOKMARK = lstOrders.ListIndex
intBOOK = lstMaterials.ListIndex
cmdExit.Enabled = True
cmdSave.Enabled = False
cmdUpdate.Enabled = True
Call FormSave
lstOrders.ListIndex = mintBOOKMARK
lstMaterials.ListIndex = intBOOK
mintBOOKMARK = 0
End Sub
Private Sub txtAQty_GotFocus()
Call FieldSelect(txtAQty)
End Sub
Private Sub txtPrice_GotFocus()
Call FieldSelect(txtPrice)
End Sub
Private Sub txtVendorInv_Change()
cmdUpdate.Enabled = True
End Sub
Private Sub txtVendorInv_GotFocus()
Call FieldSelect(txtVendorInv)
End Sub
Private Sub txtVendorInv_LostFocus()
txtVendorInv = UCase(txtVendorInv)
cmdUpdate.SetFocus
End Sub