VERSION 5.00 Begin VB.Form frmInvTake Caption = "Take Off Inventory List" ClientHeight = 5115 ClientLeft = 60 ClientTop = 345 ClientWidth = 11880 BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 5115 ScaleWidth = 11880 StartUpPosition = 3 'Windows Default Begin VB.ComboBox cboInvTYpe BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "frmInvTake.frx":0000 Left = 9600 List = "frmInvTake.frx":0013 Style = 2 'Dropdown List TabIndex = 29 Top = 420 Width = 2175 End Begin VB.ComboBox cboMetal BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "frmInvTake.frx":0056 Left = 7920 List = "frmInvTake.frx":0060 Style = 2 'Dropdown List TabIndex = 12 Top = 2580 Width = 1215 End Begin VB.ComboBox cboMType BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "frmInvTake.frx":0071 Left = 7920 List = "frmInvTake.frx":0073 Style = 2 'Dropdown List TabIndex = 11 Top = 2220 Width = 1215 End Begin VB.ComboBox cboDFlag BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "frmInvTake.frx":0075 Left = 7920 List = "frmInvTake.frx":007F Style = 2 'Dropdown List TabIndex = 10 Top = 1860 Width = 1215 End Begin VB.TextBox txtMLength BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 7920 TabIndex = 13 Top = 2940 Width = 855 End Begin VB.TextBox txtQty BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 7920 TabIndex = 9 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 = 675 Left = 10680 TabIndex = 18 TabStop = 0 'False Top = 3360 Width = 1155 End Begin VB.ListBox lstInv BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 4545 Left = 120 Sorted = -1 'True TabIndex = 17 Top = 420 Width = 2955 End Begin VB.CommandButton cmdDeleteInv Caption = "&Delete TO 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 = 675 Left = 9300 TabIndex = 16 TabStop = 0 'False Top = 3360 Width = 1215 End Begin VB.CommandButton cmdSaveInv Caption = "&Save TO 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 = 675 Left = 8020 TabIndex = 14 Top = 3360 Width = 1155 End Begin VB.CommandButton cmdAddInv Caption = "&Add TO 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 = 675 Left = 6720 TabIndex = 15 TabStop = 0 'False Top = 3360 Width = 1155 End Begin VB.TextBox txtPrice Alignment = 1 'Right Justify BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 7920 MaxLength = 8 TabIndex = 8 Top = 1140 Width = 855 End Begin VB.TextBox txtDesc BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 7920 MaxLength = 30 TabIndex = 7 Top = 780 Width = 3855 End Begin VB.TextBox txtInvNo BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 7920 MaxLength = 5 TabIndex = 6 Top = 420 Width = 855 End Begin VB.ListBox lstInventory BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 4545 Left = 3240 Sorted = -1 'True TabIndex = 1 Top = 420 Width = 3375 End Begin VB.Label lblInvType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Inv. Type: " BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 8880 TabIndex = 28 Top = 480 Width = 765 End Begin VB.Label lblInstruct Caption = "CTRL S to Save CTRL A to Add CTRL D to Delete" Height = 675 Left = 10140 TabIndex = 27 Top = 1260 Width = 1575 End Begin VB.Label lblLogin BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 7920 TabIndex = 26 Top = 60 Width = 855 End Begin VB.Label lblEstimator Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Estimator:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 7140 TabIndex = 25 Top = 120 Width = 690 End Begin VB.Label lblHelp Caption = $"frmInvTake.frx":0093 Height = 855 Left = 6780 TabIndex = 24 Top = 4140 Width = 4935 End Begin VB.Label lblMetalLength Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Length:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6840 TabIndex = 23 Top = 3000 Width = 975 End Begin VB.Label lblMetal Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Flag:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 7035 TabIndex = 22 Top = 2640 Width = 780 End Begin VB.Label lblMType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Material Type:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6810 TabIndex = 21 Top = 2280 Width = 1005 End Begin VB.Label lblDFlag Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Delivery Flag:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6855 TabIndex = 20 Top = 1920 Width = 960 End Begin VB.Label lblTOQty Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Takeoff Qty:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6930 TabIndex = 19 Top = 1560 Width = 885 End Begin VB.Label lblPrice Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Takeoff Cost:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6855 TabIndex = 5 Top = 1200 Width = 960 End Begin VB.Label lblDesc Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Description:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6975 TabIndex = 4 Top = 840 Width = 840 End Begin VB.Label lblInvNo Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Inventory #:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6960 TabIndex = 3 Top = 480 Width = 855 End Begin VB.Label lblInventory AutoSize = -1 'True Caption = "Takeoff 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 = 240 Left = 3300 TabIndex = 2 Top = 120 Width = 2430 End Begin VB.Label lblInvList AutoSize = -1 'True Caption = "Full Inventory 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 = 240 Left = 180 TabIndex = 0 Top = 120 Width = 1815 End End Attribute VB_Name = "frmInvTake" 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, mboolUPDATE As Boolean Dim mboolAdding As Boolean Dim mdblQTY As Double, mintINDEX As Integer 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, TPrice from tblInvtake WHERE estimator = '" & gstrLOGIN & "'" & " AND Inv_Type = " & gbytINV_TYPE 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!tprice), "##,##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: gstrMODULE = "Form InvTake - Module LoadInventory" Call ErrorHandler2 gstrMODULE = "" 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 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 WHERE Inv_Type = " & gbytINV_TYPE 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: gstrMODULE = "Form InvTake - Module LoadMInventory" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormClear() txtInvNo = 0 txtDesc = "" txtPrice = 0 txtQty = 0 txtMLength = 0 cboDFlag.ListIndex = -1 cboMType.ListIndex = -1 cboMetal.ListIndex = -1 End Sub Private Function FormFind() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblInvTake " strSQL = strSQL & "WHERE estimator = '" & gstrLOGIN & "' AND INV_NO = " & lstInventory.ItemData(lstInventory.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 InvTake - 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 On Error GoTo Error_EH mboolSHOW = True With moRSMat txtInvNo = Field2Str(!inv_no) txtDesc = Field2Str(!Desc) txtPrice = Format$(Field2Str(!tprice), "##,###.00") txtQty = Field2Str2(!qty) txtMLength = Field2Str2(!calc_amt) If !d_flag = "S" Then cboDFlag.Text = "Supplier" Else cboDFlag.Text = "Yard" End If strTYPE = Field2Str(!m_type) Call FindType(cboMType, strTYPE) ' If !m_type = "L" Then ' cboMType.Text = "Lath" ' ElseIf !m_type = "B" Then ' cboMType.Text = "Brown" ' ElseIf !m_type = "S" Then ' cboMType.Text = "Scratch" ' ElseIf !m_type = "T" Then ' cboMType.Text = "Texture" ' ElseIf !m_type = "C" Then ' cboMType.Text = "CMU" ' ElseIf !m_type = "P" Then ' cboMType.Text = "PreOrder" ' End If If !calc_flag = "M" Then cboMetal.Text = "Metal" Else cboMetal.Text = "None" End If End With mboolSHOW = False ' cboInvType.Enabled = True ' cboInvType.ListIndex = gbytInv_Type ' cboInvType.ListIndex = 1 ' cboInvType.Enabled = False Exit Sub Error_EH: gstrMODULE = "Form InvTake - Module FormShow" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FieldsSave() On Error GoTo Error_EH With moRSMat !estimator = gstrLOGIN !inv_no = Str2Field(txtInvNo) !Desc = Str2Field(txtDesc) !tprice = Str2Field(txtPrice) !qty = Str2Field(txtQty) !calc_amt = Str2Field(txtMLength) !l_y_date = Now() !m_type = Left$(cboMType.Text, 1) 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 !inv_type = gbytINV_TYPE End With Exit Sub Error_EH: gstrMODULE = "Form InvTake - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdAddInv_Click() cmdAddInv.Enabled = False cmdSaveInv.Enabled = True cmdDeleteInv.Enabled = False mboolAdding = True mboolUPDATE = False 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() mintINDEX = lstInventory.ListIndex cmdSaveInv.Enabled = False cmdDeleteInv.Enabled = False cmdAddInv.Enabled = True Call FormSave Call LoadInventory If (lstInventory.ListCount - 1) = mintINDEX Then lstInventory.ListIndex = mintINDEX Else lstInventory.ListIndex = mintINDEX + 1 End If mboolUPDATE = True lstInventory.SetFocus End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown If Shift = 4 Then Exit Sub End If ShiftDown = (Shift And vbShiftMask) > 0 AltDown = (Shift And vbAltMask) > 0 CtrlDown = (Shift And vbCtrlMask) > 0 If KeyCode = vbKeyA Then ' Display key combinations. If CtrlDown Then Call cmdAddInv_Click End If Exit Sub End If If KeyCode = vbKeyD Then ' Display key combinations. If CtrlDown Then Call cmdDeleteInv_Click End If Exit Sub End If If KeyCode = vbKeyS Then ' Display key combinations. If CtrlDown Then Call cmdSaveInv_Click End If 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 cboInvTYpe.ListIndex = gbytINV_TYPE cboInvTYpe.Enabled = False lblLogin = gstrLOGIN Call MTypeLoad(cboMType) Call LoadInventory Call LoadMInventory mboolUPDATE = True 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, strSql2 As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblInvtry where Inv_no = " & lstInv.ItemData(lstInv.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If moRSMat.State = adStateClosed Then strSql2 = "SELECT * FROM tblInvTake WHERE Inv_Type = " & gbytINV_TYPE Set moRSMat = New Recordset moRSMat.Open strSql2, goConn, adOpenKeyset, adLockOptimistic End If With oRS moRSMat.AddNew moRSMat!estimator = gstrLOGIN moRSMat!inv_no = Field2Str2(!inv_no) moRSMat!calc_amt = Field2Str(!calc_amt) moRSMat!Desc = Field2Str(!Desc) moRSMat!d_flag = Field2Str(!d_flag) moRSMat!m_type = Field2Str(!m_type) moRSMat!calc_flag = Field2Str(!calc_flag) moRSMat!l_y_date = Now() moRSMat!tprice = Field2Str2(!tprice) moRSMat!inv_type = Field2Str2(!inv_type) moRSMat.Update End With oRS.Close Call LoadInventory Exit Sub Error_EH: gstrMODULE = "Form InvTake - Module lstInv_DblClick" Call ErrorHandler2 gstrMODULE = "" 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 txtQty.SetFocus Exit Sub Error_EH: If Err = 5 Then Resume Next Else gstrMODULE = "Form InvTake - Module lstInventory_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End If End Sub Private Sub lstInventory_DblClick() Call cmdDeleteInv_Click 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 txtPrice_GotFocus() Call FieldSelect(txtPrice) End Sub Private Sub txtQty_GotFocus() Call FieldSelect(txtQty) mdblQTY = Field2Str2(txtQty) End Sub Private Sub txtMLength_GotFocus() Call FieldSelect(txtMLength) End Sub Private Sub txtQty_LostFocus() If mboolUPDATE Then If mdblQTY <> Field2Str2(txtQty) Then cmdSaveInv.Enabled = True cmdSaveInv.SetFocus End If End If End Sub