Files
claudetools/clients/valleywide/app-modernization/source-code/Orders-VWP_Current-2020/frmProjList.frm
Mike Swanson fccf9f9468 sync: auto-sync from GURU-5070 at 2026-06-14 05:33:01
Author: Mike Swanson
Machine: GURU-5070
Timestamp: 2026-06-14 05:33:01
2026-06-14 05:34:46 -07:00

614 lines
17 KiB
Plaintext

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