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>
This commit is contained in:
2026-05-16 17:36:02 -07:00
parent 7386460f55
commit 5359e7c49e
4426 changed files with 4478036 additions and 0 deletions

View File

@@ -0,0 +1,892 @@
VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmAR2
Caption = "Accounts Receivable"
ClientHeight = 4950
ClientLeft = 60
ClientTop = 345
ClientWidth = 7530
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 4950
ScaleWidth = 7530
StartUpPosition = 3 'Windows Default
Begin LpLib.fpList lstHeader
Height = 2835
Left = 195
TabIndex = 17
Top = 585
Width = 4470
_Version = 196608
_ExtentX = 7885
_ExtentY = 5001
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 6
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmAR2.frx":0000
End
Begin VB.TextBox txtTax
Height = 315
Left = 5580
TabIndex = 16
Top = 3000
Width = 495
End
Begin Crystal.CrystalReport crAR
Left = 165
Top = 60
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "RePrint Invoice"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6180
TabIndex = 14
Top = 3675
Width = 1275
End
Begin VB.ComboBox cboARCode
Height = 315
Left = 2955
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 1
Top = 195
Width = 4515
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6180
TabIndex = 13
Top = 4395
Width = 1275
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6180
TabIndex = 12
Top = 2955
Width = 1275
End
Begin VB.CheckBox chkReady
Alignment = 1 'Right Justify
Caption = "Ready to Transfer to CMS:"
Height = 315
Left = 5190
TabIndex = 7
Top = 2415
Width = 2205
End
Begin VB.TextBox txtItemAmt
Alignment = 1 'Right Justify
Height = 315
Left = 6240
MaxLength = 11
TabIndex = 6
Top = 1935
Width = 1200
End
Begin VB.TextBox txtSalesCode
Height = 315
Left = 6240
MaxLength = 7
TabIndex = 5
Top = 1515
Width = 1200
End
Begin VB.TextBox txtDueDate
Alignment = 1 'Right Justify
Height = 315
Left = 6240
MaxLength = 10
TabIndex = 4
Top = 1095
Width = 1200
End
Begin VB.TextBox txtInvDate
Alignment = 1 'Right Justify
Height = 315
Left = 6240
MaxLength = 10
TabIndex = 3
Top = 675
Width = 1200
End
Begin VB.ListBox lstDetail
Height = 1230
Left = 180
TabIndex = 2
Top = 3660
Width = 5895
End
Begin VB.Label lblTax
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Tax Code"
Height = 195
Left = 4830
TabIndex = 15
Top = 3090
Width = 690
End
Begin VB.Label lblSalesCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CMS Sales Code:"
Height = 195
Left = 4920
TabIndex = 11
Top = 1620
Width = 1245
End
Begin VB.Label lblItemAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Item Amount:"
Height = 195
Left = 5235
TabIndex = 10
Top = 2040
Width = 930
End
Begin VB.Label lblDueDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Payment Due Date:"
Height = 195
Left = 4770
TabIndex = 9
Top = 1200
Width = 1395
End
Begin VB.Label lblInvDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Date:"
Height = 195
Left = 5190
TabIndex = 8
Top = 780
Width = 960
End
Begin VB.Label lblARCode
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Builder's CMS AR Code:"
Height = 195
Left = 1200
TabIndex = 0
Top = 240
Width = 1710
End
End
Attribute VB_Name = "frmAR2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSDetail As Recordset
Dim moRSProj As Recordset
Dim mboolSHOW As Boolean, mboolUPDATE As Boolean, mstrType As String, mstrPO_NUM As String
Dim mstrINVNO As String, mstrPROJLOT As String, mlngTRANSID As Long
Dim mlngINVID As Long, mintBOOKMARK As Integer, mintBOOK As Integer
Dim msglItemAmt As Single, msglInvTotal As Single, mlngTRANS2 As Long
Private Sub HeaderLoad()
Dim oRS As Recordset
Dim strSQL As String
'Dim strTYPE As String
Dim strLine As String
On Error GoTo Error_EH
' strTYPE = Trim(Left(cboARCode, 7))
' strSQL = "SELECT Invoice_date, Invoice_no, lot_id, trans_id, header, shipped, customer_no, non_tax_amt from tblARInvoice WHERE shipped and header and customer_no = '" & Trim(Left(cboARCode, 7)) & "' and not done"
' strSQL = "SELECT Invoice_date, Invoice_no, lot_id, trans_id, header, shipped, customer_no, non_tax_amt FROM tblARInvoice WHERE shipped and header and customer_no = '" & Trim(Left(cboARCode, 7)) & "' and not done"
strSQL = "SELECT * FROM tblARInvoice WHERE shipped and header and customer_no = '" & Trim(Left(cboARCode, 7)) & "' and not done"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstHeader.Clear
' strTYPE = oRS.RecordCount
Do Until oRS.EOF
With lstHeader
strLine = ""
strLine = Field2Str2(oRS!Trans_ID) & vbTab & Field2Str(oRS!invoice_no) & vbTab & Field2Str(oRS!invoice_date) & vbTab
' strLine = Field2Str2(oRS!Lot_id) & vbTab & Field2Str(oRS!invoice_no) & vbTab & Field2Str(oRS!invoice_date) & vbTab
strLine = strLine & Format(Field2Str2(oRS!non_tax_amt), "#,#.00;(#,#.00)") & vbTab & Format(Field2Str2(oRS!Lot_ID), "000000") & vbTab & (Field2Str(oRS!po_num))
' strLine = strLine & Format(Field2Str2(oRS!non_tax_amt), "#,#.00;(#,#.00)") & vbTab & Format(Field2Str2(oRS!Lot_id), "000000") & vbTab & Format(Field2Str(oRS!po_num))
' strLine = ""
' strLine = Field2Str(oRS!invoice_no) & " " & Field2Str(oRS!invoice_date) & vbTab
' strLine = strLine & Format(Field2Str2(oRS!non_tax_amt), "Currency") & " " & Format(Field2Str2(oRS!Lot_id), "000000")
.AddItem strLine
' .AddItem strLine
' .ItemData(.NewIndex) = oRS!Trans_ID
' .ItemData(.NewIndex) = oRS!Lot_ID
End With
oRS.MoveNext
Loop
oRS.Close
If lstHeader.ListCount Then
lstHeader.ListIndex = 0
Else
gintLOTID = 0
lstHeader.ListIndex = -1
cmdPrint.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Repair - Module HeaderLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub DetailLoad()
Dim oRS As Recordset, strSalesCode As String
Dim strSQL As String, strLine As String
On Error GoTo Error_EH
' lstHeader.col = 1
lstHeader.col = 0
mlngTRANS2 = Field2Str2(lstHeader.ColText)
' strSQL = "SELECT trans_ID, sales_code, lot_id, header, shipped, description, amount from tblARInvoice WHERE shipped and lot_id = " & gintLOTID & " and not done"
strSQL = "SELECT trans_ID, sales_code, lot_id, header, shipped, description, amount, PO_NUM from tblARInvoice WHERE shipped and PO_NUM = '" & mstrPO_NUM & "' and not done"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' msglInvTotal = 0
lstDetail.Clear
Do Until oRS.EOF
strSalesCode = Field2Str(oRS!sales_code)
If Len(strSalesCode) = 0 Then
strSalesCode = "BLANK"
' Else
End If
strLine = ""
' msglInvTotal = msglInvTotal + field2single(oRS!amount)
If Len(Format(Field2Str2(oRS!amount), "currency")) > 7 Then
strLine = Field2Str(oRS!sales_code) & vbTab & Format(Field2Str2(oRS!amount), "currency") & vbTab & Field2Str(oRS!Description)
Else
strLine = Field2Str(oRS!sales_code) & vbTab & Format(Field2Str2(oRS!amount), "currency") & vbTab & vbTab & Field2Str(oRS!Description)
End If
lstDetail.AddItem strLine
lstDetail.ItemData(lstDetail.NewIndex) = Field2Long(oRS!Trans_ID)
oRS.MoveNext
Loop
oRS.Close
If lstDetail.ListCount Then
lstDetail.ListIndex = 0
Else
lstDetail.ListIndex = -1
End If
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module DetailLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cboARCode_Change()
lstHeader.Clear
lstDetail.Clear
Call HeaderLoad
End Sub
Private Sub cboARCode_Click()
lstHeader.Clear
lstDetail.Clear
Call HeaderLoad
End Sub
Private Sub chkReady_Click()
cmdSave.Enabled = True
End Sub
Private Sub cmdPrint_Click()
Dim oRS As Recordset, strSQL As String, strSELECT As String
On Error GoTo Error_EH
gintCOPY = 1
strSQL = "SELECT trans_id, ProjLot, PO_Num FROM tblARINVOICE WHERE trans_id = " & lstDetail.ItemData(lstDetail.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
gstrPONUM = Field2Str(oRS!po_num)
mstrPROJLOT = Field2Str(oRS!ProjLot)
Call LotChange(mstrPROJLOT, "RePrint AR Invoice")
strSELECT = "{tblARInvoice.po_num} = '" & gstrPONUM & "'"
' strSELECT = "{tblARInvoice.invoice_no}='" & mstrINV & "'"
crAR.ReportFileName = App.Path & "\invoice.rpt"
crAR.ReplaceSelectionFormula (strSELECT)
' crAR.CopiesToPrinter = gintCOPY
crAR.CopiesToPrinter = 1
crAR.Destination = crptToWindow
' crar.Destination = crptToPrinter
crAR.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form LotInfo - Module PrintStoneInv"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
If Not cmdSave.Enabled Then
' Call DataHasChanged
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
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 = "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 moRSProj.State = adStateOpen Then
moRSProj.Close
End If
If moRSDetail.State = adStateOpen Then
moRSDetail.Close
End If
Exit Sub
Error_EH:
If Err.Number = 91 Then
Resume Next
End If
gstrMODULE = "Form Repair - Module Form QueryUnload"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
mintBOOKMARK = lstDetail.ListIndex
mintBOOK = lstHeader.ListIndex
cmdExit.Enabled = True
cmdSave.Enabled = False
Call FormSave
lstHeader.ListIndex = mintBOOK
lstDetail.Enabled = True
lstDetail.ListIndex = mintBOOKMARK
mintBOOKMARK = 0
End Sub
Private Sub Form_Load()
Call ARCodeLoad
End Sub
Private Sub ProjLoad()
Dim strSQL 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
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ARCodeLoad()
Dim oRS As Recordset
Dim strSQL As String, intRows As Integer, strLine As String
Dim row, col As Long
On Error GoTo Error_EH
strSQL = "SELECT Bill_Id, Cust_no, Name FROM tblARMaster"
' strSQL = "SELECT Bill_Id, Cust_no, Name FROM tblARMaster"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
Do Until oRS.EOF
strLine = Field2Str(oRS!Cust_NO) & " - " & Field2Str(oRS!Name)
cboARCode.AddItem strLine
cboARCode.ItemData(cboARCode.NewIndex) = Field2Long(oRS!Bill_ID)
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module ARCodeLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
With moRSDetail
txtInvDate = Field2Str(!invoice_date)
txtDueDate = Field2Str(!inv_due_date)
txtItemAmt = Format(Field2Str2(!amount), "#,#.00;(#,#.00)")
' txtItemAmt = Format(Field2Str2(!amount), "Standard")
txtSalesCode = Field2Str(!sales_code)
If Len(txtSalesCode) = 0 Then
txtSalesCode = "BLANK"
txtSalesCode.BackColor = &H80FFFF
txtSalesCode.ForeColor = &HFF&
Else
txtSalesCode.BackColor = &H80000005
txtSalesCode.ForeColor = &H80000008
txtSalesCode.FontBold = False
End If
txtTAX = Field2Str(!taxcode)
If txtTAX = "AZ" Then
txtTAX.BackColor = &H80FFFF
txtTAX.ForeColor = &HFF&
txtTAX.FontBold = True
Else
txtTAX.BackColor = &H80000005
txtTAX.ForeColor = &H80000008
txtTAX.FontBold = False
End If
chkReady = Field2CheckBox(!ready)
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
Call FieldsSave
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module FormSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindDetail() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblARInvoice "
strSQL = strSQL & "WHERE trans_id = " & lstDetail.ItemData(lstDetail.ListIndex)
Set moRSDetail = New Recordset
moRSDetail.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSDetail.EOF Then
FormFindDetail = False
Else
FormFindDetail = True
msglInvTotal = moRSDetail!non_tax_amt
mstrType = moRSDetail!inv_type
gintPROJID = moRSDetail!PROJ_ID
Call ProjLoad
End If
Exit Function
Error_EH:
gstrMODULE = "Form AR - Module FormFindDetail"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub lstDetail_Click()
If lstDetail.ListIndex <> -1 Then
If FormFindDetail() Then
Call FormShow
End If
End If
End Sub
Private Sub FieldsSave()
Dim strSQL As String, lngTRANSID As Long
Dim oRS As Recordset, sglTOTAL As Single
On Error GoTo Error_EH
With moRSDetail
!invoice_date = Str2Field(txtInvDate)
!inv_due_date = Str2Field(txtDueDate)
!price = Str2Field(txtItemAmt)
!amount = Str2Field(txtItemAmt)
!sales_code = Str2Field(txtSalesCode)
.Update
End With
strSQL = "SELECT sum(amount) as sgltotal FROM tblARInvoice WHERE PO_NUM = '" & mstrPO_NUM & "' and lot_id = " & gintLOTID & " and not done"
' strSQL = "SELECT sum(amount) as sgltotal FROM tblARInvoice WHERE Trans_ID = " & mlngTRANSID & " and lot_id = " & gintLOTID & " and not done"
' strSQL = "SELECT sum(amount) as sgltotal FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID & " and not done"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
msglInvTotal = Field2Str2(oRS!sglTOTAL)
strSQL = "SELECT * FROM tblARInvoice WHERE PO_NUM = '" & mstrPO_NUM & "' and lot_id = " & gintLOTID
' strSQL = "SELECT * FROM tblARInvoice WHERE Trans_ID = " & mlngTRANSID & " and lot_id = " & gintLOTID
' strSQL = "SELECT * FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
Do Until oRS.EOF
With oRS
!invoice_date = Str2Field(txtInvDate)
!inv_due_date = Str2Field(txtDueDate)
!ready = chkReady
!non_tax_amt = msglInvTotal
!taxcode = Str2Field(txtTAX)
If Field2Str2(moRSProj!retention) > 0 Then
!retention_amt = Format(((msglInvTotal * Field2Str2(moRSProj!retention) / 100)), "#.00")
Else
!retention_amt = 0
End If
.Update
End With
oRS.MoveNext
Loop
Call HeaderLoad
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
' If lstHeader.ListCount = 0 Then
' intResponse = MsgBox("No Invoices For This Builder - Select A Different Builder.", vbExclamation + vbOKOnly, "Exit Form")
' Unload Me
' End If
End Sub
Private Sub FormClear()
txtInvDate = ""
txtDueDate = ""
txtSalesCode = ""
txtItemAmt = ""
chkReady = vbUnchecked
End Sub
Private Sub lstDetail_DblClick()
cmdSave.Enabled = True
End Sub
Private Sub lstHeader_Click()
On Error GoTo Error_EH
If lstHeader.ListIndex <> -1 Then
lstHeader.col = 0
mlngTRANSID = Field2Str2(lstHeader.ColText)
cmdPrint.Enabled = True
lstHeader.col = 4
gintLOTID = lstHeader.ColText
lstHeader.col = 5
mstrPO_NUM = Field2Str(lstHeader.ColText)
' gintLOTID = lstHeader.ItemData(lstHeader.ListIndex)
Call DetailLoad
If lstDetail.ListIndex <> -1 Then
Else
lstDetail.Clear
Call FormClear
End If
Else
cmdPrint.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form AR - Module lstHeader_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstHeader_DblClick()
cmdSave.Enabled = True
End Sub
Private Sub txtDueDate_GotFocus()
Call FieldSelect(txtDueDate)
End Sub
Private Sub txtDueDate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtDueDate, "/", 1)
If lngPOS = 0 Then
If Len(txtDueDate) > 0 Then
txtDueDate = Format(txtDueDate, "00/00/####")
If Not IsDate(txtDueDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtDueDate.SetFocus
End If
End If
ElseIf IsDate(txtDueDate) Then
Exit Sub
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtDueDate.SetFocus
End If
End Sub
Private Sub txtInvDate_GotFocus()
Call FieldSelect(txtInvDate)
End Sub
Private Sub txtInvDate_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtInvDate, "/", 1)
If lngPOS = 0 Then
If Len(txtInvDate) > 0 Then
txtInvDate = Format(txtInvDate, "00/00/####")
If Not IsDate(txtInvDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtInvDate.SetFocus
End If
End If
ElseIf IsDate(txtInvDate) Then
Exit Sub
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtInvDate.SetFocus
End If
End Sub
Private Sub txtItemAmt_GotFocus()
Call FieldSelect(txtItemAmt)
msglItemAmt = Single2Field(txtItemAmt)
End Sub
Private Sub txtItemAmt_LostFocus()
If msglItemAmt < Field2Str2(txtItemAmt) Then
msglInvTotal = msglInvTotal + Field2Str2(txtItemAmt)
txtItemAmt = Format(txtItemAmt, "#,#.00")
ElseIf msglItemAmt > Field2Str2(txtItemAmt) Then
msglInvTotal = msglInvTotal - Field2Str2(txtItemAmt)
txtItemAmt = Format(txtItemAmt, "#,#.00")
ElseIf msglItemAmt = Field2Str(txtItemAmt) Then
txtItemAmt = Format(txtItemAmt, "#,#.00")
End If
End Sub
Private Sub txtSalesCode_GotFocus()
Call FieldSelect(txtSalesCode)
End Sub
Private Sub txtSalesCode_LostFocus()
txtSalesCode = UCase(txtSalesCode)
End Sub
Private Sub txtTax_GotFocus()
Call FieldSelect(txtTAX)
End Sub
Private Sub txtTax_LostFocus()
If Not IsNull(txtTAX) Or txtTAX = "" Then
txtTAX = UCase(txtTAX)
Else
MsgBox "You Must Enter A Sales Tax Code", vbOKOnly, "No Tax Code"
txtTAX.SetFocus
End If
End Sub

View File

@@ -0,0 +1,684 @@
VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Begin VB.Form frmInvPrice
Caption = "Supplier Inventory Prices"
ClientHeight = 5265
ClientLeft = 60
ClientTop = 345
ClientWidth = 11235
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5265
ScaleWidth = 11235
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdPrint
Caption = "Print Inv List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 6780
TabIndex = 16
Top = 2400
Width = 1155
End
Begin Crystal.CrystalReport crInvList
Left = 10485
Top = 2535
_ExtentX = 741
_ExtentY = 741
_Version = 348160
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 8400
TabIndex = 15
Top = 2400
Width = 1155
End
Begin VB.ListBox lstInv
Height = 2205
Left = 120
Sorted = -1 'True
TabIndex = 14
Top = 2880
Visible = 0 'False
Width = 2955
End
Begin VB.CommandButton cmdDeleteInv
Caption = "&Delete Inventory"
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 = 555
Left = 10020
TabIndex = 13
Top = 1740
Width = 1155
End
Begin VB.CommandButton cmdSaveInv
Caption = "&Save Inventory"
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 = 555
Left = 8400
TabIndex = 11
Top = 1740
Width = 1155
End
Begin VB.CommandButton cmdAddInv
Caption = "&Add Inventory"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 6780
TabIndex = 12
Top = 1740
Width = 1155
End
Begin VB.CommandButton cmdFindInv
Height = 435
Left = 8700
Picture = "frmInvPrice.frx":0000
Style = 1 'Graphical
TabIndex = 8
Top = 1245
Visible = 0 'False
Width = 435
End
Begin VB.TextBox txtPrice
Alignment = 1 'Right Justify
Height = 315
Left = 7620
MaxLength = 8
TabIndex = 10
Top = 1260
Width = 855
End
Begin VB.TextBox txtDesc
Height = 315
Left = 7620
MaxLength = 30
TabIndex = 9
Top = 840
Width = 3555
End
Begin VB.TextBox txtInvNo
Height = 315
Left = 7620
MaxLength = 18
TabIndex = 7
Top = 420
Width = 2625
End
Begin VB.ListBox lstInventory
Height = 4740
Left = 3240
Sorted = -1 'True
TabIndex = 2
Top = 420
Width = 3375
End
Begin VB.ListBox lstSupplier
Height = 2400
Left = 120
Sorted = -1 'True
TabIndex = 0
Top = 420
Width = 2955
End
Begin VB.Label lblPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "VWP Cost:"
Height = 195
Left = 6735
TabIndex = 6
Top = 1320
Width = 780
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
Height = 195
Left = 6675
TabIndex = 5
Top = 900
Width = 840
End
Begin VB.Label lblInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory #:"
Height = 195
Left = 6660
TabIndex = 4
Top = 480
Width = 855
End
Begin VB.Label lblInventory
Caption = "Inventory Items"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3300
TabIndex = 3
Top = 120
Width = 1815
End
Begin VB.Label lblSupplier
Caption = "Supplier"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 180
TabIndex = 1
Top = 120
Width = 1095
End
End
Attribute VB_Name = "frmInvPrice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSMat As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean
Private Sub LoadInventory()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc, Price from tblInvPrice WHERE sup_no = " & lstSupplier.ItemData(lstSupplier.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInventory.Clear
Do Until oRS.EOF
With lstInventory
strLine = oRS!inv_no & vbTab & Format$(Field2Str(oRS!price), "##,##0.00") & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstInventory.ListCount Then
lstInventory.ListIndex = 0
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub LoadSupplier()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblSupplier WHERE type <> 'A'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstSupplier.Clear
Do Until oRS.EOF
With lstSupplier
strLine = oRS!Type & vbTab & oRS!supplier
.AddItem strLine
.ItemData(.NewIndex) = oRS!sup_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstSupplier.ListCount Then
lstSupplier.ListIndex = 0
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub cmdFindInv_Click()
Dim oRS As Recordset
Dim strSQL As String, lngFind As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblInvtry WHERE Inv_no = " & txtInvNo.Text
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.RecordCount > 0 Then
With oRS
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice.SetFocus
End With
Else
lstInv.Visible = True
Call LoadMInventory
lngFind = Field2Str(txtInvNo)
' Call ListFindItem2(lstInv, lngFind) '*** need to FIX
End If
oRS.Close
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub LoadMInventory()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc from tblInvtry"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInv.Clear
Do Until oRS.EOF
With lstInv
strLine = oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstInv.ListCount Then
lstInv.ListIndex = -1
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub FormClear()
txtInvNo = ""
txtDesc = ""
txtPrice = ""
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblInvPrice WHERE Sup_no = " & lstSupplier.ItemData(lstSupplier.ListIndex) & " AND INV_NO = " & lstInventory.ItemData(lstInventory.ListIndex)
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
moRSMat.Open strSQL, goConn, _
adOpenKeyset, adLockOptimistic
If moRSMat.EOF Then
FormFind = False
Else
FormFind = True
End If
Exit Function
Error_EH:
moRSMat.Update
Resume Next
End Function
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
If mboolAdding Then
moRSMat.AddNew
End If
' Store the controls to the recordset
Call FieldsSave
moRSMat.Update
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
Call ErrorHandler(moRSMat.ActiveConnection)
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
With moRSMat
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice = Format$(Field2Str(!price), "##,###.00")
End With
mboolSHOW = False
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRSMat
!inv_no = Str2Field(txtInvNo)
!Desc = Str2Field(txtDesc)
!price = Str2Field(txtPrice)
!sup_no = lstSupplier.ItemData(lstSupplier.ListIndex)
!l_update = Now()
!LUUser = gstrLOGIN
End With
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub cmdAddInv_Click()
cmdAddInv.Enabled = False
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = False
mboolAdding = True
Call FormClear
txtInvNo.SetFocus
cmdFindInv.Visible = True
End Sub
Private Sub cmdDeleteInv_Click()
cmdDeleteInv.Enabled = False
cmdSaveInv.Enabled = False
cmdAddInv.Enabled = True
moRSMat.Delete
Call LoadInventory
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String, strMSG As String, strSql2 As String
Dim oRS As Recordset, intResponse As Integer
strSQL = "SELECT * FROM tblInvPrice WHERE Sup_No = " & lstSupplier.ItemData(lstSupplier.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' intCount = oRS.RecordCount
strSql2 = "{tblinvprice.sup_no} = " & lstSupplier.ItemData(lstSupplier.ListIndex)
strMSG = "Do you want to print to the Printer?" & vbLf & vbCr
' strMSG = strMSG & intCount & " Checks did not match - Do You Want A Report"
intResponse = MsgBox(strMSG, vbYesNo, "Print to Printer")
gintCOPY = 1
crInvList.ReportFileName = App.Path & "\InvListByVendor.rpt"
crInvList.ReplaceSelectionFormula (strSql2)
If intResponse = vbYes Then
crInvList.Destination = crptToPrinter
Else
crInvList.Destination = crptToWindow
End If
crInvList.CopiesToPrinter = gintCOPY
crInvList.WindowState = crptMaximized
crInvList.Action = 1
crInvList.Reset
' Else
' Exit Sub
' End If
End Sub
Private Sub cmdSaveInv_Click()
cmdSaveInv.Enabled = False
cmdDeleteInv.Enabled = False
cmdAddInv.Enabled = True
cmdFindInv.Visible = False
Call FormSave
Call LoadInventory
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
If Not cmdSaveInv.Enabled Then
cmdSaveInv.Enabled = True
cmdAddInv.Enabled = False
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
Set moRSMat = New Recordset
Call LoadSupplier
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 cmdSaveInv.Enabled Then
strMSG = "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
End Select
End If
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
Else
End If
End Sub
Private Sub lstInv_DblClick()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc FROM tblInvtry where Inv_no = " & lstInv.ItemData(lstInv.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
With oRS
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
End With
oRS.Close
txtPrice.SetFocus
lstInv.Visible = False
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub lstInventory_Click()
On Error GoTo Error_EH
If lstInventory.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
End If
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub lstInventory_DblClick()
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = True
cmdAddInv.Enabled = False
End Sub
Private Sub lstSupplier_Click()
On Error GoTo Error_EH
If lstSupplier.ListIndex <> -1 Then
Call LoadInventory
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub txtDesc_GotFocus()
Call FieldSelect(txtDesc)
End Sub
Private Sub txtInvNo_GotFocus()
Call FieldSelect(txtInvNo)
End Sub
Private Sub txtPrice_GotFocus()
Call FieldSelect(txtPrice)
End Sub

View File

@@ -0,0 +1,927 @@
VERSION 5.00
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmInventory
Caption = "Inventory Prices"
ClientHeight = 3690
ClientLeft = 60
ClientTop = 345
ClientWidth = 8355
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 3690
ScaleWidth = 8355
StartUpPosition = 3 'Windows Default
Begin LpLib.fpCombo cboMType
Height = 315
Left = 4680
TabIndex = 24
Top = 2235
Width = 1215
_Version = 196608
_ExtentX = 2143
_ExtentY = 556
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Text = "cboMType"
Columns = 2
Sorted = 0
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
WrapList = 0 'False
WrapWidth = 0
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
DataFieldList = ""
ColumnEdit = -1
ColumnBound = -1
Style = 0
MaxDrop = 8
ListWidth = -1
EditHeight = -1
GrayAreaColor = -2147483633
ListLeftOffset = 0
ComboGap = -2
MaxEditLen = 150
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= 0 'False
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
EnableClickEvent= -1 'True
ListPosition = 0
ButtonThreeDAppearance= 0
OLEDragMode = 0
OLEDropMode = 0
Redraw = -1 'True
AutoSearchFill = 0 'False
AutoSearchFillDelay= 500
EditMarginLeft = 1
EditMarginTop = 1
EditMarginRight = 0
EditMarginBottom= 3
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
AutoMenu = -1 'True
EditAlignH = 0
EditAlignV = 0
ColDesigner = "frmInventory.frx":0000
End
Begin VB.CommandButton cmdCopy
Caption = "Copy Inventory"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 5880
TabIndex = 23
Top = 3000
Visible = 0 'False
Width = 1155
End
Begin VB.ComboBox cboInvType
Height = 315
ItemData = "frmInventory.frx":02FE
Left = 4680
List = "frmInventory.frx":0311
Style = 2 'Dropdown List
TabIndex = 22
Top = 60
Width = 3555
End
Begin VB.CommandButton cmdUpdate
Caption = "Update TO Cost"
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 = 555
Left = 5880
TabIndex = 20
Top = 1200
Width = 1155
End
Begin VB.TextBox txtLength
Alignment = 1 'Right Justify
Height = 315
Left = 4680
TabIndex = 10
Top = 2940
Width = 855
End
Begin VB.ComboBox cboMetal
Height = 315
ItemData = "frmInventory.frx":0354
Left = 4680
List = "frmInventory.frx":035E
Style = 2 'Dropdown List
TabIndex = 9
Top = 2580
Width = 1215
End
Begin VB.ComboBox cboDFlag
Height = 315
ItemData = "frmInventory.frx":036F
Left = 4680
List = "frmInventory.frx":0379
Style = 2 'Dropdown List
TabIndex = 8
Top = 1860
Width = 1215
End
Begin VB.TextBox txtTOCost
Alignment = 1 'Right Justify
Height = 315
Left = 4680
TabIndex = 7
Top = 1500
Width = 855
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 7080
TabIndex = 14
TabStop = 0 'False
Top = 3000
Width = 1155
End
Begin VB.CommandButton cmdDeleteInv
Caption = "&Delete Inventory"
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 = 555
Left = 7080
TabIndex = 13
TabStop = 0 'False
Top = 2400
Width = 1155
End
Begin VB.CommandButton cmdSaveInv
Caption = "&Save Inventory"
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 = 555
Left = 7080
TabIndex = 11
Top = 1800
Width = 1155
End
Begin VB.CommandButton cmdAddInv
Caption = "&Add Inventory"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 7080
TabIndex = 12
TabStop = 0 'False
Top = 1200
Width = 1155
End
Begin VB.TextBox txtPrice
Alignment = 1 'Right Justify
Height = 315
Left = 4680
MaxLength = 8
TabIndex = 6
Top = 1125
Width = 855
End
Begin VB.TextBox txtDesc
Height = 315
Left = 4680
MaxLength = 30
TabIndex = 5
Top = 780
Width = 3555
End
Begin VB.TextBox txtInvNo
Height = 315
Left = 4680
MaxLength = 18
TabIndex = 4
Top = 420
Width = 2625
End
Begin LpLib.fpList lstInventory
Height = 3210
Left = 45
TabIndex = 25
Top = 360
Width = 3360
_Version = 196608
_ExtentX = 5927
_ExtentY = 5662
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 2
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 210
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmInventory.frx":038D
End
Begin VB.Label lblInvType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory Type:"
Height = 195
Left = 3465
TabIndex = 21
Top = 120
Width = 1110
End
Begin VB.Label lblLength
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Length:"
Height = 195
Left = 3600
TabIndex = 19
Top = 3000
Width = 975
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Flag:"
Height = 195
Left = 3795
TabIndex = 18
Top = 2640
Width = 780
End
Begin VB.Label lblMType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Type:"
Height = 195
Left = 3570
TabIndex = 17
Top = 2280
Width = 1005
End
Begin VB.Label lblDFlag
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Delivery Flag:"
Height = 195
Left = 3615
TabIndex = 16
Top = 1920
Width = 960
End
Begin VB.Label lblTOCost
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Takeoff Cost:"
Height = 195
Left = 3615
TabIndex = 15
Top = 1560
Width = 960
End
Begin VB.Label lblPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Yard Cost:"
Height = 195
Left = 3840
TabIndex = 3
Top = 1200
Width = 735
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
Height = 195
Left = 3735
TabIndex = 2
Top = 840
Width = 840
End
Begin VB.Label lblInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inventory #:"
Height = 195
Left = 3720
TabIndex = 1
Top = 480
Width = 855
End
Begin VB.Label lblInventory
Caption = "Inventory Items"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 0
Top = 120
Width = 1815
End
End
Attribute VB_Name = "frmInventory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSMat As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean, mintBOOKMARK As Integer
Dim moRSYS As Recordset
Private Sub LoadInventory()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc from tblInvtry WHERE Inv_Type = " & cboInvType.ListIndex
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInventory.Clear
Do Until oRS.EOF
With lstInventory
strLine = oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
.ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstInventory.ListCount Then
lstInventory.ListIndex = 0
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Inventory - Module LoadInventory"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
txtInvNo = ""
txtDesc = ""
txtPrice = ""
txtTOCost = ""
txtLength = ""
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblInvtry "
strSQL = strSQL & "WHERE INV_NO = " & lstInventory.ItemData(lstInventory.ListIndex)
strSQL = strSQL & " AND INV_TYPE = " & cboInvType.ListIndex
Set moRSMat = New Recordset
moRSMat.Open strSQL, goConn, _
adOpenKeyset, adLockOptimistic
If moRSMat.EOF Then
FormFind = False
Else
FormFind = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form Inventory - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
If mboolAdding Then
moRSMat.AddNew
End If
' Store the controls to the recordset
Call FieldsSave
moRSMat.Update
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
Call ErrorHandler(moRSMat.ActiveConnection)
Exit Sub
End Sub
Private Sub FormShow()
Dim strTYPE As String, strINDEX As String
On Error GoTo Error_EH
mboolSHOW = True
With moRSMat
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice = Format$(Field2Str(!price), "##,###.00")
txtTOCost = Format$(Field2Str(!tprice), "##,###.00")
txtLength = Field2Str2(!calc_amt)
If !d_flag = "S" Then
cboDFlag.Text = "Supplier"
Else
cboDFlag.Text = "Yard"
End If
strTYPE = Field2Str(!m_type)
' If cboMType = "" Then
If strTYPE = "L" Then
' cboMType.Index = 1
cboMType.Text = "Lath"
' cboMType.
' ctlAny.List = "Lath"
' ctlAny.ListIndex = 0
ElseIf strTYPE = "B" Then
' ctlAny.ListIndex = 1
cboMType.Text = "Brown"
ElseIf strTYPE = "S" Then
' ctlAny.ListIndex = 1
cboMType.Text = "Scratch"
ElseIf strTYPE = "T" Then
' ctlAny.ListIndex = 1
cboMType.Text = "Texture"
ElseIf strTYPE = "C" Then
' ctlAny.ListIndex = 1
cboMType.Text = "CMU"
ElseIf strTYPE = "P" Then
' ctlAny.ListIndex = 1
cboMType.Text = "PreOrder"
ElseIf strTYPE = "V" Then
' ctlAny.ListIndex = 1
cboMType.Text = "Veneer-Stone"
ElseIf strTYPE = "W" Then
' ctlAny.ListIndex = 1
cboMType.Text = "Wrap Typar"
ElseIf strTYPE = "Z" Then
' ctlAny.ListIndex = 1
cboMType.Text = "Z-PreCast"
ElseIf strTYPE = "E" Then
' ctlAny.ListIndex = 1
cboMType.Text = "E-Synthetic"
ElseIf strTYPE = "J" Then
cboMType.Text = "J-PaintPrep"
ElseIf strTYPE = "K" Then
cboMType.Text = "K-P-Interior"
ElseIf strTYPE = "N" Then
cboMType.Text = "N-P-Exterior"
ElseIf strTYPE = "M" Then
cboMType.Text = "M-PaintFinal"
Else
cboMType.ListIndex = -1
End If
' Else
' Call FindType3(strINDEX, strTYPE)
' cboMType.ListIndex = CLng(strINDEX)
' Call FindType(cboMType, strTYPE)
' End If
If !calc_flag = "M" Then
cboMetal.Text = "Metal"
Else
cboMetal.Text = "None"
End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form Inventory - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRSMat
!inv_no = Str2Field(txtInvNo)
!Desc = Str2Field(txtDesc)
!price = Str2Field(txtPrice)
!tprice = Str2Field(txtTOCost)
!l_u_date = Now()
!LUUser = gstrLOGIN
!calc_amt = Str2Field(txtLength)
!m_type = Left$(cboMType.Text, 1)
!inv_type = cboInvType.ListIndex
If cboDFlag.Text = "Supplier" Then
!d_flag = "S"
ElseIf cboDFlag.Text = "Yard" Then
!d_flag = "Y"
End If
If cboMetal.Text = "Metal" Then
!calc_flag = "M"
Else
!calc_flag = ""
!calc_amt = 0
End If
End With
Exit Sub
Error_EH:
gstrMODULE = "Form Inventory - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cboInvType_Change()
Call LoadInventory
End Sub
Private Sub cboInvType_Click()
Call LoadInventory
End Sub
Private Sub cmdAddInv_Click()
cmdAddInv.Enabled = False
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = False
mboolAdding = True
Call FormClear
txtInvNo.SetFocus
End Sub
Private Sub cmdDeleteInv_Click()
cmdDeleteInv.Enabled = False
cmdSaveInv.Enabled = False
cmdAddInv.Enabled = True
moRSMat.Delete
Call LoadInventory
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSaveInv_Click()
mintBOOKMARK = lstInventory.ListIndex
cmdSaveInv.Enabled = False
cmdDeleteInv.Enabled = False
cmdAddInv.Enabled = True
Call FormSave
Call LoadInventory
lstInventory.ListIndex = mintBOOKMARK
lstInventory.SetFocus
End Sub
Private Sub cmdUpdate_Click()
txtTOCost = Round((Field2Str2(txtPrice) * Field2Str2(moRSYS!TOMMU)), 2)
Call cmdSaveInv_Click
End Sub
Private Sub Form_Activate()
Call MTypeLoad(cboMType)
Call LoadInventory
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
' If Not cmdSaveInv.Enabled Then
' cmdSaveInv.Enabled = True
' cmdAddInv.Enabled = False
' End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
Dim strSQL As String
Set moRSMat = New Recordset
Set moRSYS = New Recordset
cboInvType.ListIndex = 0
strSQL = "SELECT * FROM tblSYSInfo"
moRSYS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' Call MTypeLoad(cboMType)
' Call LoadInventory
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 cmdSaveInv.Enabled Then
strMSG = "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
End Select
End If
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
Else
End If
End Sub
Private Sub lstInventory_Click()
On Error GoTo Error_EH
If lstInventory.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Inventory - Module lstInventory_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstInventory_DblClick()
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = True
cmdAddInv.Enabled = False
End Sub
Private Sub txtDesc_GotFocus()
Call FieldSelect(txtDesc)
End Sub
Private Sub txtDesc_LostFocus()
txtDesc = UCase(txtDesc)
End Sub
Private Sub txtInvNo_GotFocus()
Call FieldSelect(txtInvNo)
End Sub
Private Sub txtLength_GotFocus()
Call FieldSelect(txtLength)
End Sub
Private Sub txtPrice_GotFocus()
Call FieldSelect(txtPrice)
End Sub
Private Sub txtPrice_LostFocus()
If Field2Str2(txtTOCost) = 0 Then
txtTOCost = Round((Field2Str2(txtPrice) * Field2Str2(moRSYS!TOMMU)), 2)
End If
End Sub
Private Sub txtTOCost_GotFocus()
Call FieldSelect(txtTOCost)
End Sub

View File

@@ -0,0 +1,697 @@
VERSION 5.00
Begin VB.Form frmPOInfo
Caption = "Special PO Information"
ClientHeight = 4875
ClientLeft = 60
ClientTop = 345
ClientWidth = 9855
LinkTopic = "Form1"
ScaleHeight = 4875
ScaleWidth = 9855
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 915
Left = 8040
TabIndex = 26
Top = 3540
Width = 1395
End
Begin VB.ListBox lstPOMaterial
Height = 2595
Left = 60
TabIndex = 12
Top = 2220
Width = 3915
End
Begin VB.Label lblProjLot
Alignment = 2 'Center
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 = 120
TabIndex = 27
Top = 0
Width = 9675
End
Begin VB.Label lblD_MatPrice
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 = 5280
TabIndex = 25
Top = 4320
Width = 1155
End
Begin VB.Label lblD_MType
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 = 5280
TabIndex = 24
Top = 3900
Width = 1575
End
Begin VB.Label lblD_DType
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 = 5280
TabIndex = 23
Top = 3480
Width = 1575
End
Begin VB.Label lblD_Qty
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 = 5280
TabIndex = 22
Top = 3060
Width = 1155
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 = 5280
TabIndex = 21
Top = 2640
Width = 4515
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 = 5280
TabIndex = 20
Top = 2220
Width = 1155
End
Begin VB.Label lblMatPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Mat. Price:"
Height = 195
Left = 4410
TabIndex = 19
Top = 4380
Width = 765
End
Begin VB.Label lblMType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Type:"
Height = 195
Left = 4170
TabIndex = 18
Top = 3960
Width = 1005
End
Begin VB.Label lblDType
Caption = "Delivery Type:"
Height = 195
Left = 4140
TabIndex = 17
Top = 3540
Width = 1035
End
Begin VB.Label lblQty
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Quantity:"
Height = 195
Left = 4545
TabIndex = 16
Top = 3120
Width = 630
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Description:"
Height = 195
Left = 4335
TabIndex = 15
Top = 2700
Width = 840
End
Begin VB.Label lblInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Inv No:"
Height = 195
Left = 4650
TabIndex = 14
Top = 2280
Width = 525
End
Begin VB.Label lblMaterial
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material:"
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 = 60
TabIndex = 13
Top = 1980
Width = 750
End
Begin VB.Line Line1
BorderWidth = 2
X1 = 0
X2 = 9840
Y1 = 1920
Y2 = 1920
End
Begin VB.Label lblD_Notes
BorderStyle = 1 'Fixed Single
Height = 1035
Left = 6120
TabIndex = 11
Top = 780
Width = 3735
End
Begin VB.Label lblD_PayYds
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1680
TabIndex = 10
Top = 1500
Width = 1395
End
Begin VB.Label lblD_PayDesc
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1680
TabIndex = 9
Top = 1140
Width = 3735
End
Begin VB.Label lblD_InvDesc
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1680
TabIndex = 8
Top = 780
Width = 3735
End
Begin VB.Label lblPayYds
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Yards:"
Height = 195
Left = 870
TabIndex = 7
Top = 1560
Width = 765
End
Begin VB.Label lblNotes
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Notes:"
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 = 6120
TabIndex = 6
Top = 480
Width = 570
End
Begin VB.Label lblPayDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Description:"
Height = 195
Left = 480
TabIndex = 5
Top = 1200
Width = 1155
End
Begin VB.Label lblInvDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invoice Description:"
Height = 195
Left = 225
TabIndex = 4
Top = 840
Width = 1410
End
Begin VB.Label lblPOType
BorderStyle = 1 'Fixed Single
Height = 315
Left = 3600
TabIndex = 3
Top = 420
Width = 2475
End
Begin VB.Label lblPODate
BorderStyle = 1 'Fixed Single
Height = 315
Left = 2220
TabIndex = 2
Top = 420
Width = 1320
End
Begin VB.Label lblPONum
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1260
TabIndex = 1
Top = 420
Width = 915
End
Begin VB.Label lblPOInfo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PO Information:"
Height = 195
Left = 60
TabIndex = 0
Top = 480
Width = 1095
End
End
Attribute VB_Name = "frmPOInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mboolSHOW As Boolean
Dim moRSPO As Recordset, moRSPOMAT As Recordset
Private Function FormFindPO() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPOrder "
strSQL = strSQL & "WHERE ponum = " & gintPONUM
Set moRSPO = New Recordset
moRSPO.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPO.EOF Then
FormFindPO = False
Else
FormFindPO = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form POInfo - Module FindPO"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindPOMat() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPOrdMat "
strSQL = strSQL & "WHERE ponum = " & gintPONUM & " and Inv_No = " & lstPOMaterial.ItemData(lstPOMaterial.ListIndex)
Set moRSPOMAT = New Recordset
moRSPOMAT.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPOMAT.EOF Then
FormFindPOMat = False
Else
FormFindPOMat = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form POInfo - Module FormFindPOMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShowPO()
On Error GoTo Error_EH
mboolSHOW = True
With moRSPO
lblPONum = Field2Long(!ponum)
lblD_InvDesc = Field2Str(!towhom)
lblD_PayDesc = Field2Str(!Desc)
lblD_Notes = Field2Str(!notes)
lblPODate = Field2Str(!Date)
lblD_PayYds = Field2Str2(!yards)
gstrPO = Field2Str(!potype)
End With
Select Case gstrPO
Case "L"
lblInvDesc = "Invoice Description:"
lblD_InvDesc.Visible = True
lblInvDesc.Visible = True
lblPayDesc = "Pay Description:"
lblD_PayDesc.Visible = True
lblPayDesc.Visible = True
lblPayYds = "Pay Yards:"
lblD_PayYds.Visible = True
lblPayYds.Visible = True
lblPOType = "Lot Material"
Case "Y"
lblInvDesc.Visible = False
lblD_InvDesc.Visible = False
lblPayDesc = "Supplier:"
lblD_PayDesc.Visible = True
lblPayYds.Visible = False
lblD_PayYds.Visible = False
lblPOType = "Yard Stock"
Case "V"
lblInvDesc = "Mileage:"
lblD_InvDesc.Visible = True
lblPayDesc = "Supplier:"
lblD_PayDesc.Visible = True
lblPayYds.Visible = False
lblD_PayYds.Visible = False
lblPOType = "Vehicle/Equip."
Case "M"
lblInvDesc = "Person Requesting:"
lblD_InvDesc.Visible = True
lblPayDesc = "Supplier:"
lblD_PayDesc.Visible = True
lblPayYds.Visible = False
lblD_PayYds.Visible = False
lblPOType = "Misc. Items"
End Select
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form POInfo - Module FormShowPO"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowPOMat()
On Error GoTo Error_EH
mboolSHOW = True
With moRSPOMAT
lblD_InvNo = Field2Long(!Inv_No)
lblD_Desc = Field2Str(!Desc)
lblD_Qty = Field2Str(!qty)
If !d_flag = "S" Then
lblD_DType = "Supplier"
Else
lblD_DType = "Yard"
End If
If !m_type = "L" Then
lblD_MType = "Lath"
ElseIf !m_type = "B" Then
lblD_MType = "Brown"
ElseIf !m_type = "S" Then
lblD_MType = "Scratch"
ElseIf !m_type = "T" Then
lblD_MType = "Texture"
ElseIf !m_type = "C" Then
lblD_MType = "CMU"
ElseIf !m_type = "P" Then
lblD_MType = "PreOrder"
End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form POInfo - Module FormShowPOMat"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub POMatLoad()
Dim oRS As Recordset
Dim strSQL As String, intINVNO As Integer
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT PONum, Inv_no, Desc, Qty, D_Flag, M_Type FROM tblPOrdMat WHERE PONum = " & gintPONUM & " ORDER BY Inv_No"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPOMaterial.Clear
Do Until oRS.EOF
With lstPOMaterial
strLine = oRS("D_Flag") & " " & oRS("M_Type") & " " & oRS("Qty") & vbTab & oRS("Inv_No") & vbTab & oRS("desc")
.AddItem strLine
.ItemData(.NewIndex) = Field2Long(oRS("inv_no"))
End With
oRS.MoveNext
Loop
oRS.Close
If lstPOMaterial.ListCount Then
lstPOMaterial.ListIndex = 0
Else
lblD_InvNo = ""
lblD_Desc = ""
lblD_Qty = ""
lblD_DType = ""
lblD_MType = ""
lblD_MatPrice = ""
End If
Exit Sub
Error_EH:
gstrMODULE = "Form POInfo - Module POMatLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo Error_EH
If FormFindPO() Then
Call FormShowPO
Call POMatLoad
If lstPOMaterial.ListIndex <> -1 Then
If FormFindPOMat() Then
Call FormShowPOMat
Else
lstPOMaterial.Clear
lblD_InvNo = ""
lblD_Desc = ""
lblD_Qty = ""
lblD_DType = ""
lblD_MType = ""
lblD_MatPrice = ""
End If
End If
Else
MsgBox "No PO Information Was Found -- Call Darv", vbOKOnly, "No PO Info"
Unload Me
End If
Call FindProjLot
Exit Sub
Error_EH:
gstrMODULE = "Form POInfo - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstPOMaterial_Click()
On Error GoTo Error_EH
If lstPOMaterial.ListIndex <> -1 Then
If FormFindPOMat() Then
Call FormShowPOMat
Else
lstPOMaterial.Clear
lblD_InvNo = ""
lblD_Desc = ""
lblD_Qty = ""
lblD_DType = ""
lblD_MType = ""
lblD_MatPrice = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form POInfo - Module lstPOMaterial_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FindProjLot()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblProject "
strSQL = strSQL & "WHERE Proj_id = " & Field2Long(moRSPO!proj_id)
' strSQL = strSQL & "WHERE Proj_id = " & Field2Integer(moRSPO!proj_id)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If oRS.EOF Then
Else
lblProjLot = Trim$(Field2Str(oRS!proj_code)) & " " & Trim$(Field2Str(oRS!proj_desc))
End If
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblLotInfo "
strSQL = strSQL & "WHERE Lot_id = " & Field2Long(moRSPO!Lot_id)
' strSQL = strSQL & "WHERE Lot_id = " & Field2Integer(moRSPO!Lot_id)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If oRS.EOF Then
Else
lblProjLot = lblProjLot & " -- " & Trim$(Field2Str(oRS!lot_no))
End If
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblOrders "
strSQL = strSQL & "WHERE ponum = " & gintPONUM
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If oRS.EOF Then
lblProjLot = lblProjLot & " -- NO PO PRINTED"
Else
lblProjLot = lblProjLot & " -- " & Trim$(Field2Str(oRS!po_num))
End If
Exit Sub
Error_EH:
gstrMODULE = "Form POInfo - Module FindPO"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub