VERSION 5.00 Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx" Begin VB.Form frmProjList Caption = "Project List" ClientHeight = 5250 ClientLeft = 60 ClientTop = 345 ClientWidth = 8460 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 5250 ScaleWidth = 8460 StartUpPosition = 3 'Windows Default Begin VB.TextBox txtContains Height = 315 Left = 540 TabIndex = 7 Top = 4920 Visible = 0 'False Width = 4650 End Begin VB.CommandButton cmdSearch Caption = "Search" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 3195 TabIndex = 5 Top = 4140 Width = 900 End Begin VB.TextBox txtSearch Height = 315 Left = 15 TabIndex = 4 Top = 4920 Width = 4890 End Begin VB.ComboBox cboSearch Height = 315 ItemData = "frmProjList.frx":0000 Left = 855 List = "frmProjList.frx":000D Style = 2 'Dropdown List TabIndex = 2 Top = 4215 Width = 2325 End Begin LpLib.fpList lstProj Height = 3915 Left = 60 TabIndex = 1 Top = 180 Width = 8370 _Version = 196608 _ExtentX = 14764 _ExtentY = 6906 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 = 4 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= 285 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmProjList.frx":0033 End Begin VB.CommandButton cmdExit Caption = "&Exit" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 4230 TabIndex = 0 TabStop = 0 'False Top = 4140 Width = 900 End Begin VB.Label lblInst Caption = "High Light The Lot You Want And Then Double Click To Select It." BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 810 Left = 5280 TabIndex = 8 Top = 4200 Width = 3135 End Begin VB.Label lblLookUp Caption = "Enter The Project Code" Height = 255 Left = 30 TabIndex = 6 Top = 4590 Width = 5115 End Begin VB.Label lblSearch Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Search By: " Height = 195 Left = 45 TabIndex = 3 Top = 4230 Width = 825 End End Attribute VB_Name = "frmProjList" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRSORDER As Recordset Dim mboolAdding As Boolean, mboolPROJ As Boolean Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdSearch_Click() Call ContainLoad mboolPROJ = True End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH Exit Sub Error_EH: gstrMODULE = "formProjList - 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 ProjLoad If lstProj.ListIndex <> -1 Then ' If FormFindCrew() Then ' Call FormShowCrew ' End If cboSearch.ListIndex = 0 mboolPROJ = False End If ' Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "formProjList - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ProjLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT Proj_ID, Proj_Code, Proj_Desc, Proj_Cont from tblPROJECT WHERE Create > #01/01/2014#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstProj.Clear Do Until oRS.EOF With lstProj strLine = Field2Str(oRS!PROJ_ID) & vbTab & Field2Str(oRS!Proj_Code) & vbTab & Field2Str(oRS!Proj_Desc) & vbTab & Field2Str(oRS!Proj_Cont) .AddItem strLine ' .ItemData(.NewIndex) = oRS!order_id End With oRS.MoveNext Loop If lstProj.ListCount Then lstProj.ListIndex = 0 mboolPROJ = False Else lstProj.ListIndex = -1 ' Call FormClear End If Exit Sub Error_EH: gstrMODULE = "FormProjList - Module ProjLoad" 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 tblorders " strSQL = strSQL & "WHERE order_Id = " & lstProj.ItemData(lstProj.ListIndex) Set moRSORDER = New Recordset moRSORDER.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSORDER.EOF Then FormFindCrew = False Else FormFindCrew = True End If Exit Function Error_EH: gstrMODULE = "formProjList - Module FormFindCrew" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function 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 moRSORDER.State = adStateOpen Then moRSORDER.Close End If Exit Sub Error_EH: If Err = 3219 Then Resume Next End If End Sub Private Sub cboSearch_Click() Dim intMIN As Integer On Error Resume Next ' mintCnt2 = mintCnt2 + 1 ' lblCount2 = mintCnt2 ' mdteBegin = Now ' cboSortOrder.ListIndex = cboSort.ListIndex ' cboSortOrder.ListIndex = 4 If cboSearch.ListIndex = 0 Then If mboolPROJ Then Call ProjLoad End If ' If mbytSort <> cbolistindex Then '' If mbytSort = 6 Then ' Call InventoryLoad '' End If '' lstProj.col = 3 '' lstProj.ColSortSeq = -1 '' lstProj.ColSorted = SortedNone ' lstEmpList.col = 3 ' lstEmpList.ColSortSeq = -1 ' lstEmpList.ColSorted = SortedNone txtSearch = "" txtSearch.Visible = True txtContains.Visible = False txtSearch.SetFocus lstProj.ListIndex = 0 lstProj.col = 2 lstProj.ColSortSeq = -1 lstProj.ColSorted = SortedNone lstProj.col = 1 lstProj.ColSortSeq = 0 lstProj.ColSorted = SortedAscending lstProj.Redraw = True lstProj.ColSortDataType = ColSortDataTypeTextNoCase lstProj.SearchIgnoreCase = True lstProj.ColumnSearch = 1 txtSearch = "" txtSearch.SetFocus lblLookUp.Caption = "Enter Project Code Search Info:" ElseIf cboSearch.ListIndex = 1 Then If mboolPROJ Then Call ProjLoad End If '' If mbytSort = 6 Then ' Call InventoryLoad '' End If ' lstProj.col = 2 ' lstProj.ColSortSeq = -1 ' lstProj.ColSorted = SortedNone txtSearch = "" txtSearch.Visible = True txtContains.Visible = False txtSearch.SetFocus lstProj.ListIndex = 0 lstProj.col = 1 lstProj.ColSortSeq = -1 lstProj.ColSorted = SortedNone lstProj.col = 2 lstProj.ColSortSeq = 0 lstProj.ColSorted = SortedAscending lstProj.Redraw = True lstProj.ColSortDataType = ColSortDataTypeTextNoCase lstProj.SearchIgnoreCase = True ' lstproj.ColumnSearch = 2 lstProj.ColumnSearch = 2 ' If chkKEEP Then ' Call cmdSearch_Click ' txtSearch.SetFocus ' Else txtSearch = "" txtSearch.SetFocus ' End If ' txtSearch = "" lblLookUp.Caption = "Enter Description Search Information:" ' txtSearch.SetFocus ElseIf cboSearch.ListIndex = 2 Then '' If mbytSort = 6 Then ' Call InventoryLoad '' End If txtSearch = "" txtSearch.Visible = False txtContains.Visible = True txtContains.SetFocus lstProj.ListIndex = 0 ' lstProj.col = 2 ' lstProj.ColSortSeq = 0 ' lstProj.ColSorted = SortedAscending ' lstProj.col = 1 ' lstProj.ColSortSeq = -1 ' lstProj.ColSorted = SortedNone '' lstProj.col = 3 '' lstProj.ColSortSeq = -1 '' lstProj.ColSorted = SortedNone ' lstProj.Redraw = True lblLookUp.Caption = "Enter Search Info For Partial Description:" '' lstProj.ColSortDataType = ColSortDataTypeTextNoCase '' lstProj.SearchIgnoreCase = True '' lstProj.ColumnSearch = 2 ' If chkKEEP Then ' Call cmdSearch_Click ' txtSearch.SetFocus ' Else '' txtSearch = "" '' txtSearch.SetFocus ' End If '' lbllookup.Caption = "Enter First Name Search Information:" ' txtSearch.SetFocus ' End If '' ElseIf cboSearch.ListIndex = 3 Then '' If mbytSort = 6 Then ' Call InventoryLoad '' End If '' lstProj.col = 0 '' lstProj.ColSortSeq = -1 '' lstProj.ColSorted = SortedNone '' lstProj.col = 1 '' lstProj.ColSortSeq = -1 '' lstProj.ColSorted = SortedNone '' lstProj.col = 6 '' lstProj.ColSortSeq = 0 '' lstProj.ColSorted = SortedAscending '' lstProj.col = 2 '' lstProj.ColSortSeq = -1 '' lstProj.ColSorted = SortedNone '' lstProj.Redraw = True '' lstProj.ColSortDataType = ColSortDataTypeTextNoCase '' lstProj.SearchIgnoreCase = True ' lstEmpList.ColumnSearch = 2 '' lstProj.ColumnSearch = 6 ' If chkKEEP Then ' Call cmdSearch_Click ' txtSearch.SetFocus ' Else '' txtSearch = "" '' txtSearch.SetFocus ' End If '' lbllookup.Caption = "Enter SS Number Search Information:" ' txtSearch.SetFocus End If '' mbytSort = cboSearch.ListIndex ' mdteEnd = Now ' intMIN = DateDiff("s", mdteBegin, mdteEnd) ' lblDteBegin = Format(mdteBegin, "HH:MM:SS") ' lbldteEnd = Format(mdteEnd, "HH:MM:SS") ' lblDiff = intMIN End Sub Private Sub lstProj_DblClick() lstProj.col = 0 gintPROJID = Field2Str2(lstProj.ColText) Unload Me End Sub Private Sub txtSearch_Change() 'Multiple character search code. lstProj.SearchText = txtSearch.Text lstProj.SearchMethod = 2 lstProj.Action = ActionSearch lstProj.SearchIndex = -1 lstProj.Action = 0 If lstProj.SearchIndex <> -1 Then lstProj.TopIndex = lstProj.SearchIndex lstProj.ListIndex = lstProj.SearchIndex Else lstProj.Action = 6 ' clear End If End Sub Private Sub ContainLoad() Dim oRS As Recordset, oRSP As Recordset Dim strSQL As String, strSELECT As String, strContain As String Dim strSQLP As String, intYN As Integer, strADDRESS As String, strLine As String Dim strProj_Desc As String, strProj_Cont As String, strProj_Code As String lstProj.Clear strContain = Trim$(txtContains.Text) strSQL = "SELECT Proj_ID, Proj_Code, Proj_Desc, Proj_Cont FROM tblPROJECT WHERE Create > #01/01/2014#" Set oRS = New Recordset oRS.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF If Len(oRS!Proj_Desc) = 0 Then '1 intYN = 0 Else strADDRESS = Field2Str(oRS!Proj_Desc) intYN = InStr(1, UCase(Trim(strADDRESS)), UCase(Trim(txtContains))) ', vbTextCompare) End If If intYN > 0 Then strLine = Field2Str2(oRS!PROJ_ID) & vbTab & RTrim(Field2Str(oRS!Proj_Code)) & vbTab & RTrim(Field2Str(oRS!Proj_Desc)) & vbTab & RTrim(Field2Str(oRS!Proj_Cont)) ' & " -- " & oRS!Desc lstProj.AddItem strLine End If oRS.MoveNext ' mboolSHOW = True Loop oRS.Close If lstProj.ListCount = 0 Then MsgBox "No Project Information Found" ' Call cmdNewSearch_Click Else lstProj.ListIndex = 0 End If ' End If '1 End Sub