VERSION 5.00 Begin VB.Form frmFoam2 Caption = "Lath and Stucco Crews" ClientHeight = 7830 ClientLeft = 60 ClientTop = 345 ClientWidth = 9645 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 7830 ScaleWidth = 9645 StartUpPosition = 3 'Windows Default Begin VB.TextBox txtEmpNo Alignment = 1 'Right Justify Height = 315 Left = 6420 TabIndex = 17 Top = 1800 Width = 975 End Begin VB.CommandButton cmdExit Caption = "&Exit" Height = 555 Left = 8220 TabIndex = 28 TabStop = 0 'False Top = 5280 Width = 1395 End Begin VB.CommandButton cmdSave Caption = "&Save" Enabled = 0 'False Height = 555 Left = 6600 TabIndex = 26 Top = 5280 Width = 1395 End Begin VB.CommandButton cmdAdd Caption = "&Add" Enabled = 0 'False Height = 555 Left = 5040 TabIndex = 27 TabStop = 0 'False Top = 5280 Width = 1395 End Begin VB.TextBox txtDA Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 24 Top = 4320 Visible = 0 'False Width = 975 End Begin VB.TextBox txtQU Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 23 Top = 3960 Visible = 0 'False Width = 975 End Begin VB.TextBox txtSB Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 25 Top = 4680 Visible = 0 'False Width = 975 End Begin VB.TextBox txtMN Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 22 Top = 3600 Visible = 0 'False Width = 975 End Begin VB.TextBox txtSM Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 21 Top = 3240 Visible = 0 'False Width = 975 End Begin VB.TextBox txtSA Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 20 Top = 2880 Visible = 0 'False Width = 975 End Begin VB.TextBox txtPrimRate Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 19 Top = 2520 Visible = 0 'False Width = 975 End Begin VB.TextBox txtMetal Alignment = 1 'Right Justify Height = 315 Left = 6420 MaxLength = 9 TabIndex = 18 Top = 2160 Visible = 0 'False Width = 975 End Begin VB.TextBox txtPhone Alignment = 1 'Right Justify Height = 285 Left = 6420 MaxLength = 10 TabIndex = 16 Top = 1440 Width = 1575 End Begin VB.TextBox txtCrewBoss Height = 315 Left = 6060 MaxLength = 30 TabIndex = 15 Top = 1020 Width = 3435 End Begin VB.ComboBox cboType BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 ItemData = "frmFoam2.frx":0000 Left = 3180 List = "frmFoam2.frx":000A Style = 2 'Dropdown List TabIndex = 2 Top = 60 Width = 1755 End Begin VB.ListBox lstCrew Height = 7275 Left = 60 Sorted = -1 'True TabIndex = 0 Top = 480 Width = 4875 End Begin VB.Label lblEmpNo Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Employee No:" Height = 195 Left = 5340 TabIndex = 30 Top = 1860 Width = 990 End Begin VB.Label lblInstructions Caption = $"frmFoam2.frx":001C BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1515 Left = 5220 TabIndex = 29 Top = 6120 Width = 4155 End Begin VB.Label lblDA Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Dash Rate:" Height = 195 Left = 5550 TabIndex = 14 Top = 4380 Visible = 0 'False Width = 810 End Begin VB.Label lblCrewId 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 = 315 Left = 6420 TabIndex = 13 Top = 600 Width = 975 End Begin VB.Label lblQU Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Quernavaca Rate:" Height = 195 Left = 5040 TabIndex = 12 Top = 4020 Visible = 0 'False Width = 1320 End Begin VB.Label lblSB Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Synthetic Rate:" Height = 195 Left = 5265 TabIndex = 11 Top = 4740 Visible = 0 'False Width = 1095 End Begin VB.Label lblMN Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Monterrey Rate:" Height = 195 Left = 5220 TabIndex = 10 Top = 3615 Visible = 0 'False Width = 1140 End Begin VB.Label lblSmooth Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Smooth Rate:" Height = 195 Left = 5385 TabIndex = 9 Top = 3330 Visible = 0 'False Width = 975 End Begin VB.Label lblSand Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Sand Rate:" Height = 195 Left = 5550 TabIndex = 8 Top = 2970 Visible = 0 'False Width = 810 End Begin VB.Label lblMetal Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Rate:" Height = 195 Left = 5535 TabIndex = 7 Top = 2265 Visible = 0 'False Width = 825 End Begin VB.Label lblPrimRate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Lath Rate:" Height = 195 Left = 5610 TabIndex = 6 Top = 2625 Visible = 0 'False Width = 750 End Begin VB.Label lblPhone Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Phone #:" Height = 195 Left = 5700 TabIndex = 5 Top = 1500 Width = 660 End Begin VB.Label lblName Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew Leader:" Height = 195 Left = 5055 TabIndex = 4 Top = 1080 Width = 945 End Begin VB.Label lblCrewNum Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew #:" Height = 195 Left = 5805 TabIndex = 3 Top = 660 Width = 555 End Begin VB.Label lblType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Select The Crew Type To Display A List:" ForeColor = &H000000FF& Height = 195 Left = 120 TabIndex = 1 Top = 120 Width = 2865 End End Attribute VB_Name = "frmFoam2" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRSCREW As Recordset Dim mboolAdding As Boolean Private Sub cboType_Change() Call CrewLoad If Len(cboType.Text) <> 0 Then cmdAdd.Enabled = True End If End Sub Private Sub cboType_Click() Call CrewLoad If Len(cboType.Text) <> 0 Then cmdAdd.Enabled = True End If End Sub Private Sub cmdAdd_Click() cmdAdd.Enabled = False cmdSave.Enabled = True mboolAdding = True Call FormClear txtCrewBoss.SetFocus End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdSave_Click() cmdAdd.Enabled = True cmdSave.Enabled = False Call FormSave End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH Exit Sub Error_EH: gstrMODULE = "FormCrews - Module Form_Activate" Call ErrorHandler2 gstrMODULE = "" Exit Sub 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 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() On Error GoTo Error_EH Call CrewLoad If lstCrew.ListIndex <> -1 Then If FormFindCrew() Then Call FormShowCrew End If End If ' Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "FormCrews - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT crew_id, crew_boss from tblCrew WHERE type = '" & Left$(cboType, 1) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstCrew.Clear Do Until oRS.EOF With lstCrew If Len(Field2Str(oRS!crew_boss)) < 14 Then strLine = Format(Field2Str(oRS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!crew_id) ElseIf Len(Field2Str(oRS!crew_boss)) > 20 Then strLine = Format(Field2Str(oRS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!crew_id) Else strLine = Format(Field2Str(oRS!crew_boss), "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") & vbTab & Field2Str(oRS!crew_id) End If .AddItem strLine .ItemData(.NewIndex) = oRS!crew_id End With oRS.MoveNext Loop If lstCrew.ListCount Then lstCrew.ListIndex = 0 Else lstCrew.ListIndex = -1 Call FormClear End If Exit Sub Error_EH: gstrMODULE = "FormCrews - Module CrewLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Function FormFindCrew() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblCrew " strSQL = strSQL & "WHERE crew_Id = " & lstCrew.ItemData(lstCrew.ListIndex) Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenDynamic, adLockOptimistic ' adOpenKeyset , adLockOptimistic If moRSCREW.EOF Then FormFindCrew = False Else FormFindCrew = True End If Exit Function Error_EH: gstrMODULE = "FormCrews - Module FormFindCrew" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub FormShowCrew() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH With moRSCREW If Left$(cboType, 1) = "L" Then lblPrimRate.Caption = "Lath:" If gbytSECURITY = 1 Or gbytSECURITY = 10 Then txtPrimRate.Visible = True lblPrimRate.Visible = True txtMetal.Visible = True lblMetal.Visible = True txtDA.Visible = False lblDA.Visible = False txtQU.Visible = False lblQU.Visible = False txtSM.Visible = False lblSmooth.Visible = False txtSA.Visible = False lblSand.Visible = False txtSB.Visible = False lblSB.Visible = False txtMN.Visible = False lblMN.Visible = False End If ElseIf Left$(cboType, 1) = "S" Then lblPrimRate.Caption = "Skip:" If gbytSECURITY = 1 Or gbytSECURITY = 10 Then txtPrimRate.Visible = True lblPrimRate.Visible = True txtMetal.Visible = False lblMetal.Visible = False txtDA.Visible = True lblDA.Visible = True txtQU.Visible = True lblQU.Visible = True txtSM.Visible = True lblSmooth.Visible = True txtSA.Visible = True lblSand.Visible = True txtSB.Visible = True lblSB.Visible = True txtMN.Visible = True lblMN.Visible = True End If End If lblCrewId.Caption = Field2Str(!crew_id) txtCrewBoss = Field2Str(!crew_boss) txtPhone = Field2Str(!phone) txtEmpNo = Field2Str(!empno) txtPrimRate = Format(Field2Str2(!lath_skip), "#0.00") txtMetal = Format(Field2Str2(!METAL), "#0.00#") txtSA = Format(Field2Str2(!sand), "#0.00") txtSM = Format(Field2Str2(!smooth), "#0.00") txtQU = Format(Field2Str2(!qu), "#0.00") txtDA = Format(Field2Str2(!dash), "#0.00") txtMN = Format(Field2Str2(!mn), "#0.00") txtSB = Format(Field2Str2(!syn), "#0.00") End With Exit Sub Error_EH: gstrMODULE = "FormCrews - Module FormShowCrew" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormClear() lblCrewId.Caption = "" txtCrewBoss = "" txtPhone = "" txtEmpNo = "" txtPrimRate = 0 txtMetal = 0 txtSA = 0 txtSM = 0 txtQU = 0 txtDA = 0 txtMN = 0 txtSB = 0 End Sub Private Sub FieldsSave() Dim strLOT As String, test As String On Error GoTo 0 On Error GoTo Error_EH With moRSCREW !U_USER = gstrLOGIN !Update = Date !crew_boss = Str2Field(txtCrewBoss) !phone = Str2Field(txtPhone) !Type = Left$(Str2Field(cboType), 1) !METAL = Str2Field(txtMetal) !lath_skip = Str2Field(txtPrimRate) !sand = Str2Field(txtSA) !qu = Str2Field(txtQU) !dash = Str2Field(txtDA) !smooth = Str2Field(txtSM) !syn = Str2Field(txtSB) !mn = Str2Field(txtMN) !empno = Format(Field2Str2(txtEmpNo), "0000000") End With test = moRSCREW.EditMode moRSCREW.Update Call CrewLoad If mboolAdding Then Call CrewLoad If FormFindCrew() Then Call FormShowCrew End If End If Exit Sub Error_EH: If Err.Number = -2147467259 Then MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record" Resume Next End If gstrMODULE = "FormCrews - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormSave() Dim strName As String On Error GoTo Error_EH If mboolAdding Then moRSCREW.AddNew moRSCREW!C_USER = gstrLOGIN End If ' Store the controls to the recordset Call FieldsSave If mboolAdding Then mboolAdding = False End If Exit Sub Error_EH: Call ErrorHandler(moRSCREW.ActiveConnection) Exit Sub 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 = "Crew 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 moRSCREW.State = adStateOpen Then moRSCREW.Close End If Exit Sub Error_EH: If Err = 3219 Then Resume Next End If End Sub Private Sub lstCrew_Click() On Error GoTo Error_EH If lstCrew.ListIndex <> -1 Then If FormFindCrew() Then Call FormShowCrew Else lstCrew.Clear Call FormClear End If End If Exit Sub Error_EH: gstrMODULE = "Form Crews - Module lstCrew_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstCrew_DblClick() cmdAdd.Enabled = False cmdSave.Enabled = True txtCrewBoss.SetFocus End Sub Private Sub txtCrewBoss_GotFocus() Call FieldSelect(txtCrewBoss) End Sub Private Sub txtCrewBoss_LostFocus() txtCrewBoss = UCase(txtCrewBoss) End Sub Private Sub txtDA_GotFocus() Call FieldSelect(txtDA) End Sub Private Sub txtEmpNo_GotFocus() Call FieldSelect(txtEmpNo) End Sub Private Sub txtMetal_GotFocus() Call FieldSelect(txtMetal) End Sub Private Sub txtMN_GotFocus() Call FieldSelect(txtMN) End Sub Private Sub txtPhone_GotFocus() Call FieldSelect(txtPhone) End Sub Private Sub txtPrimRate_GotFocus() Call FieldSelect(txtPrimRate) End Sub Private Sub txtQU_GotFocus() Call FieldSelect(txtQU) End Sub Private Sub txtSA_GotFocus() Call FieldSelect(txtSA) End Sub Private Sub txtSB_GotFocus() Call FieldSelect(txtSB) End Sub Private Sub txtSM_GotFocus() Call FieldSelect(txtSM) End Sub