VERSION 5.00 Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX" Begin VB.Form frmScaffold Caption = "Scaffolding Information" ClientHeight = 4260 ClientLeft = 60 ClientTop = 345 ClientWidth = 8760 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 4260 ScaleWidth = 8760 StartUpPosition = 3 'Windows Default Begin VB.CheckBox chkPaid Caption = "Paid" 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 = 315 Left = 7080 TabIndex = 36 Top = 60 Width = 855 End Begin VB.TextBox txt108 Height = 315 Left = 6180 TabIndex = 31 Top = 3000 Width = 435 End Begin VB.TextBox txt68 Height = 315 Left = 6180 TabIndex = 30 Top = 2640 Width = 435 End Begin VB.ComboBox cboArea Height = 315 ItemData = "frmScaffold.frx":0000 Left = 5820 List = "frmScaffold.frx":001C Style = 2 'Dropdown List TabIndex = 27 Top = 1380 Width = 1275 End Begin MSComCtl2.DTPicker dtpScaffold Height = 315 Left = 5820 TabIndex = 26 Top = 960 Width = 1275 _ExtentX = 2249 _ExtentY = 556 _Version = 393216 Format = 20381697 CurrentDate = 37103 End Begin VB.ComboBox cboSCrew Height = 315 Left = 5820 Style = 2 'Dropdown List TabIndex = 25 Top = 540 Width = 2535 End Begin VB.Frame fraStory Caption = "House Size" Height = 855 Left = 6900 TabIndex = 22 Top = 3360 Width = 1515 Begin VB.OptionButton optStory Caption = "Single Story" Height = 255 Index = 1 Left = 180 TabIndex = 24 Top = 480 Width = 1155 End Begin VB.OptionButton optStory Caption = "Two Story" Height = 195 Index = 0 Left = 180 TabIndex = 23 Top = 240 Width = 1095 End End Begin VB.TextBox txtMin Alignment = 1 'Right Justify Height = 315 Left = 6420 TabIndex = 18 Top = 2040 Width = 435 End Begin VB.TextBox txtHrs Alignment = 1 'Right Justify Height = 315 Left = 5820 TabIndex = 17 Top = 2040 Width = 435 End Begin VB.CommandButton cmdDelete Caption = "&Delete" 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 = 7320 TabIndex = 14 TabStop = 0 'False Top = 2100 Width = 1035 End Begin VB.TextBox txtNotes Height = 1335 Left = 180 TabIndex = 7 Top = 2820 Width = 5115 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 = 7320 TabIndex = 12 TabStop = 0 'False Top = 2700 Width = 1035 End Begin VB.CommandButton cmdSave Caption = "&Save" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 7320 TabIndex = 11 TabStop = 0 'False Top = 1500 Width = 1035 End Begin VB.CommandButton cmdAdd Caption = "&Add" 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 = 7320 TabIndex = 10 TabStop = 0 'False Top = 900 Width = 1035 End Begin VB.Frame fraUPDown Caption = "Scaffold Action" Height = 855 Left = 5460 TabIndex = 4 Top = 3360 Width = 1395 Begin VB.OptionButton optScaffold Caption = "Take Down" Height = 255 Index = 1 Left = 180 TabIndex = 6 Top = 480 Width = 1155 End Begin VB.OptionButton optScaffold Caption = "Put Up" Height = 315 Index = 0 Left = 180 TabIndex = 5 Top = 180 Width = 1095 End End Begin VB.ListBox lstScaffold Height = 2010 Left = 180 TabIndex = 0 TabStop = 0 'False Top = 480 Width = 5055 End Begin VB.Label lblL108 Alignment = 1 'Right Justify BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 195 Left = 6720 TabIndex = 35 Top = 3060 Width = 360 End Begin VB.Label lblL68 Alignment = 1 'Right Justify BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 195 Left = 6720 TabIndex = 34 Top = 2700 Width = 360 End Begin VB.Label lblFrames Caption = "Frame Count" Height = 195 Left = 5760 TabIndex = 33 Top = 2400 Width = 1035 End Begin VB.Label lbl108 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "10'8"":" Height = 195 Left = 5730 TabIndex = 32 Top = 3060 Width = 420 End Begin VB.Label lbl68 Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "6'8"":" Height = 195 Left = 5820 TabIndex = 29 Top = 2700 Width = 330 End Begin VB.Label lblArea Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Area:" Height = 195 Left = 5355 TabIndex = 28 Top = 1440 Width = 375 End Begin VB.Label lblColon Caption = ":" BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 6300 TabIndex = 21 Top = 1920 Width = 135 End Begin VB.Label lblMin Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Min" Height = 195 Left = 6540 TabIndex = 20 Top = 1800 Width = 255 End Begin VB.Label lblHrs Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Hrs" Height = 195 Left = 5940 TabIndex = 19 Top = 1800 Width = 240 End Begin VB.Label lblTime Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Time:" Height = 195 Left = 5340 TabIndex = 16 Top = 2100 Width = 390 End Begin VB.Label lblYards BorderStyle = 1 'Fixed Single Height = 315 Left = 5460 TabIndex = 15 Top = 60 Width = 1275 End Begin VB.Label lblNotes AutoSize = -1 'True Caption = "Notes" Height = 195 Left = 180 TabIndex = 13 Top = 2580 Width = 420 End Begin VB.Label lblProjCode BorderStyle = 1 'Fixed Single Height = 315 Left = 180 TabIndex = 9 Top = 60 Width = 1095 End Begin VB.Label lblCrew Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew:" Height = 195 Left = 5325 TabIndex = 8 Top = 600 Width = 405 End Begin VB.Label lblLotNo BorderStyle = 1 'Fixed Single Caption = " " Height = 315 Left = 3780 TabIndex = 3 Top = 60 Width = 1635 End Begin VB.Label lblProject BorderStyle = 1 'Fixed Single Caption = " " Height = 315 Left = 1320 TabIndex = 2 Top = 60 Width = 2415 End Begin VB.Label lblDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Date:" Height = 195 Left = 5340 TabIndex = 1 Top = 1020 Width = 390 End End Attribute VB_Name = "frmScaffold" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRS As Recordset Dim moRSProj As Recordset Dim moRSCREW As Recordset Dim mintPRCREW As Integer Dim mboolAdding As Boolean, mstrAREA As String Private Sub cmdAdd_Click() cmdAdd.Enabled = False cmdSave.Enabled = True cmdDelete.Enabled = False mboolAdding = True Call FormClear End Sub Private Sub cmdDelete_Click() Dim strSQL As String, strYN As String On Error GoTo Error_EH strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?") If strYN = vbNo Then Exit Sub End If moRSCREW.Delete Call ScaffoldLoad cmdAdd.Enabled = True cmdSave.Enabled = False cmdDelete.Enabled = False Exit Sub Error_EH: gstrMODULE = "Form Scaffold - Module cmdDelete" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdSave_Click() cmdAdd.Enabled = True cmdSave.Enabled = False cmdDelete.Enabled = False Call FormSave End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH If lstScaffold.ListCount = 0 Then intResponse = MsgBox("No Scaffolding Information, do you wish to add some?", vbYesNo + vbQuestion, "Add Records") If intResponse = vbYes Then strSQL = "SELECT * FROM tblscaffold WHERE Lot_Id = 1" Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockOptimistic Call cmdAdd_Click Else Unload Me End If End If Exit Sub Error_EH: gstrMODULE = "FormScaffold - 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 Call ScaffoldLoad Call ProjLoad If lstScaffold.ListIndex <> -1 Then If FormFindCrew() Then Call FormShowCrew End If End If Exit Sub Error_EH: gstrMODULE = "FormScaffold - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ScaffoldLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String, strCREW As String Dim strPAID As String, strAMT As String On Error GoTo Error_EH ' strSQL = "SELECT crew, scaf_date, Scaf_id, up, down from tblScaffold WHERE Lot_id = " & gintLOTID & " ORDER BY Scaf_date" strSQL = "SELECT * from tblScaffold WHERE Lot_id = " & gintLOTID & " ORDER BY Scaf_date" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstScaffold.Clear Do Until oRS.EOF With lstScaffold cboSCrew.ListIndex = oRS!crew - 1 If oRS!paid Then strPAID = "PD" Else strPAID = " " End If strAMT = Format(Field2Str2(oRS!pdamt), "#,#") If oRS!up Then strLine = Field2Str(oRS!scaf_date) & " " & "UP " & " " & cboSCrew.Text & vbTab & strPAID & vbTab & strAMT ElseIf oRS!down Then strLine = Field2Str(oRS!scaf_date) & " " & "DOWN" & " " & cboSCrew.Text & vbTab & strPAID & vbTab & strAMT Else strLine = "INVALID SCAFFOLD ENTRY - FIX" End If .AddItem strLine .ItemData(.NewIndex) = oRS!scaf_id End With oRS.MoveNext Loop If lstScaffold.ListCount Then lstScaffold.ListIndex = 0 Else lstScaffold.ListIndex = -1 Call FormClear End If Exit Sub Error_EH: gstrMODULE = "Form Scaffold - Module ScaffoldLoad" 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 tblScaffold " strSQL = strSQL & "WHERE Scaf_Id = " & lstScaffold.ItemData(lstScaffold.ListIndex) Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If moRSCREW.EOF Then FormFindCrew = False Else FormFindCrew = True End If Exit Function Error_EH: gstrMODULE = "FormScaffold - 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 cboSCrew.ListIndex = Field2Integer(!crew) - 1 dtpScaffold.Value = Field2Str(!scaf_date) txtNotes = Field2Str(!notes) txtHrs = Field2Str(!hrs) txtMin = Field2Str(!Min) txt68 = Field2Str2(!frame6) txt108 = Field2Str2(!frame10) mstrAREA = Field2Str(!Area) If !paid Then chkPaid = vbChecked chkPaid.BackColor = &HFFFF& Else chkPaid = vbUnchecked chkPaid.BackColor = &H8000000F End If If mstrAREA = "W" Then cboArea.Text = "West" ElseIf mstrAREA = "N" Then cboArea.Text = "North" ElseIf mstrAREA = "S" Then cboArea.Text = "South" ElseIf mstrAREA = "X" Then cboArea.Text = "Xtra" ElseIf mstrAREA = "2" Then cboArea.Text = "2-North" ElseIf mstrAREA = "3" Then cboArea.Text = "3-North" ElseIf mstrAREA = "4" Then cboArea.Text = "4-South" ElseIf mstrAREA = "5" Then cboArea.Text = "5-West" Else cboArea.ListIndex = -1 End If If !up Then optScaffold(0).Value = True ElseIf !down Then optScaffold(1).Value = True Else optScaffold(0).Value = False optScaffold(1).Value = False End If If !Single Then optStory(1).Value = True ElseIf !Double Then optStory(0).Value = True Else optStory(0).Value = False optStory(1).Value = False End If End With Exit Sub Error_EH: gstrMODULE = "FormScaffold - Module FormShowCrew" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormClear() dtpScaffold.Value = Date cboSCrew.ListIndex = -1 txtNotes = "" txtHrs = 0 txtMin = 0 cboArea.ListIndex = -1 optStory(0).Value = False optStory(1).Value = False optScaffold(0).Value = False optScaffold(1).Value = False End Sub Private Sub FieldsSave() Dim strLOT As String, test As String On Error GoTo Error_EH With moRSCREW !U_USER = gstrLOGIN !U_date = Date If cboSCrew.ListIndex = -1 Then !crew = 0 mintPRCREW = 0 Else !crew = cboSCrew.ItemData(cboSCrew.ListIndex) Call GetCrew End If !prcrew = mintPRCREW !scaf_date = dtpScaffold.Value !hrs = Str2Field(txtHrs) !Min = Str2Field(txtMin) !Area = Left((cboArea.Text), 1) !notes = Str2Field(txtNotes) !proj_lot = Str2Field(Trim(lblProject) & " " & lblLotNo) !up = Field2CheckBox(optScaffold(0)) !down = Field2CheckBox(optScaffold(1)) !Single = Field2CheckBox(optStory(1)) !Double = Field2CheckBox(optStory(0)) !frame6 = Str2Field(txt68) !frame10 = Str2Field(txt108) End With moRSCREW.Update Call ScaffoldLoad If mboolAdding Then Call ScaffoldLoad 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 = "FormScaffold - 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 moRSCREW!Lot_id = gintLOTID moRSCREW!proj_id = gintPROJID 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 = "Scaffold 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 lstScaffold_Click() On Error GoTo Error_EH If lstScaffold.ListIndex <> -1 Then If FormFindCrew() Then Call FormShowCrew Else lstScaffold.Clear Call FormClear End If End If Exit Sub Error_EH: gstrMODULE = "Form Crews - Module lstScaffold_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstScaffold_DblClick() cmdAdd.Enabled = False cmdSave.Enabled = True cmdDelete.Enabled = True End Sub Private Sub txtNotes_LostFocus() txtNotes = UCase(txtNotes) End Sub Private Sub ProjLoad() Dim strSQL As String strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID Set moRSProj = New Recordset moRSProj.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly strSQL = "SELECT Lot_no, Lot_id, Sq_Yd, Scaf6, Scaf10 FROM tblLotInfo WHERE lot_id = " & gintLOTID Set moRS = New Recordset moRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lblProjCode = Field2Str(moRSProj!proj_code) lblProject = Field2Str(moRSProj!proj_desc) lblLotNo = Field2Str(moRS!lot_no) lblYards = Field2Str(moRS!sq_yd) lblL68 = Field2Str2(moRS!Scaf6) lblL108 = Field2Str2(moRS!scaf10) End Sub Private Sub CrewLoad() Dim oRSRCrew As Recordset Dim strSQL As String, intRows As Integer Dim row, col As Long On Error GoTo Error_EH strSQL = "SELECT Crew_ID, Name FROM tblSC_Crew" Set oRSRCrew = New Recordset oRSRCrew.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly oRSRCrew.MoveLast oRSRCrew.MoveFirst intRows = oRSRCrew.RecordCount Do Until oRSRCrew.EOF cboSCrew.AddItem oRSRCrew("Name") cboSCrew.ItemData(cboSCrew.NewIndex) = Field2Long(oRSRCrew("CREW_ID")) oRSRCrew.MoveNext Loop oRSRCrew.Close Exit Sub Error_EH: gstrMODULE = "Form Scaffold - Module CrewLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetCrew() Dim oRS As Recordset Dim strSQL As String, intRows As Integer Dim row, col As Long On Error GoTo Error_EH strSQL = "SELECT Crew_ID, PRCREW FROM tblSC_Crew WHERE Crew_ID =" & cboSCrew.ItemData(cboSCrew.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then mintPRCREW = Field2Str2(oRS!prcrew) Else mintPRCREW = 0 End If ' Do Until oRSRCrew.EOF ' cboSCrew.AddItem oRSRCrew("Name") ' cboSCrew.ItemData(cboSCrew.NewIndex) = Field2Long(oRSRCrew("CREW_ID")) ' oRSRCrew.MoveNext ' Loop oRS.Close Exit Sub Error_EH: gstrMODULE = "Form Scaffold - Module GETCREW" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub