VERSION 5.00 Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX" Begin VB.UserControl ctlNWISPermit ClientHeight = 5712 ClientLeft = 0 ClientTop = 0 ClientWidth = 10536 ScaleHeight = 5712 ScaleWidth = 10536 Begin VB.Frame Frame2 BorderStyle = 0 'None Caption = "Frame2" Height = 1095 Left = 480 TabIndex = 7 Top = 2160 Width = 4215 Begin VB.CommandButton cmdLoad Caption = "Load..." BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 120 TabIndex = 9 ToolTipText = "Load a list of permit numbers from a file." Top = 240 Width = 975 End Begin VB.CommandButton cmdSave Caption = "Save..." BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 8 ToolTipText = "Save the list of permit numbers to a file." Top = 240 Width = 975 End Begin VB.Label lblPermitNumbers Caption = "Permit Numbers --->" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Index = 1 Left = 2280 TabIndex = 11 Top = 480 Width = 1935 End Begin VB.Label lblPermitNumbers Caption = "Or Enter" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Index = 0 Left = 2280 TabIndex = 10 Top = 240 Width = 1455 End End Begin TabDlg.SSTab SSTab1 Height = 3975 Left = 120 TabIndex = 0 Top = 120 Width = 7815 _ExtentX = 13780 _ExtentY = 7006 _Version = 393216 Style = 1 Tabs = 4 TabsPerRow = 4 TabHeight = 520 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty TabCaption(0) = "First Set" TabPicture(0) = "ctlNWISPermit.ctx":0000 Tab(0).ControlEnabled= -1 'True Tab(0).Control(0)= "fraFirst(0)" Tab(0).Control(0).Enabled= 0 'False Tab(0).ControlCount= 1 TabCaption(1) = "Second " TabPicture(1) = "ctlNWISPermit.ctx":001C Tab(1).ControlEnabled= 0 'False Tab(1).Control(0)= "fraFirst(1)" Tab(1).ControlCount= 1 TabCaption(2) = "Third" TabPicture(2) = "ctlNWISPermit.ctx":0038 Tab(2).ControlEnabled= 0 'False Tab(2).Control(0)= "fraFirst(2)" Tab(2).ControlCount= 1 TabCaption(3) = "Forth" TabPicture(3) = "ctlNWISPermit.ctx":0054 Tab(3).ControlEnabled= 0 'False Tab(3).Control(0)= "fraFirst(3)" Tab(3).ControlCount= 1 Begin VB.Frame fraFirst BorderStyle = 0 'None Caption = "First Set of Permits:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3495 Index = 3 Left = -74880 TabIndex = 24 Top = 360 Width = 7575 Begin VB.ComboBox cboPermitCode BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 3 ItemData = "ctlNWISPermit.ctx":0070 Left = 120 List = "ctlNWISPermit.ctx":0072 TabIndex = 27 ToolTipText = "Select a premit code. The pull down list contains only those codes that have been used." Top = 360 Width = 4215 End Begin VB.ComboBox cboAssignerName BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 3 ItemData = "ctlNWISPermit.ctx":0074 Left = 120 List = "ctlNWISPermit.ctx":0076 TabIndex = 26 ToolTipText = "Select an assigner name. The pull down list contains only those assigner names that have been entered in the database." Top = 1080 Width = 4215 End Begin VB.TextBox txtPermitNumbers CausesValidation= 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3255 Index = 3 Left = 4440 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 25 Top = 120 Width = 3015 End Begin VB.Label Label1 Caption = "Permit Code - Permit Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 3 Left = 120 TabIndex = 29 Top = 120 Width = 3135 End Begin VB.Label lblAssigner Caption = "Assigner Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 3 Left = 120 TabIndex = 28 Top = 840 Width = 4095 End End Begin VB.Frame fraFirst BorderStyle = 0 'None Caption = "First Set of Permits:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3495 Index = 2 Left = -74880 TabIndex = 18 Top = 360 Width = 7575 Begin VB.ComboBox cboPermitCode BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 2 ItemData = "ctlNWISPermit.ctx":0078 Left = 120 List = "ctlNWISPermit.ctx":007A TabIndex = 21 ToolTipText = "Select a premit code. The pull down list contains only those codes that have been used." Top = 360 Width = 4215 End Begin VB.ComboBox cboAssignerName BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 2 ItemData = "ctlNWISPermit.ctx":007C Left = 120 List = "ctlNWISPermit.ctx":007E TabIndex = 20 ToolTipText = "Select an assigner name. The pull down list contains only those assigner names that have been entered in the database." Top = 1080 Width = 4215 End Begin VB.TextBox txtPermitNumbers CausesValidation= 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3255 Index = 2 Left = 4440 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 19 Top = 120 Width = 3015 End Begin VB.Label Label1 Caption = "Permit Code - Permit Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 120 TabIndex = 23 Top = 120 Width = 3135 End Begin VB.Label lblAssigner Caption = "Assigner Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 120 TabIndex = 22 Top = 840 Width = 4095 End End Begin VB.Frame fraFirst BorderStyle = 0 'None Caption = "First Set of Permits:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3495 Index = 1 Left = -74880 TabIndex = 12 Top = 360 Width = 7575 Begin VB.ComboBox cboPermitCode BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 1 ItemData = "ctlNWISPermit.ctx":0080 Left = 120 List = "ctlNWISPermit.ctx":0082 TabIndex = 15 ToolTipText = "Select a premit code. The pull down list contains only those codes that have been used." Top = 360 Width = 4215 End Begin VB.ComboBox cboAssignerName BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 1 ItemData = "ctlNWISPermit.ctx":0084 Left = 120 List = "ctlNWISPermit.ctx":0086 TabIndex = 14 ToolTipText = "Select an assigner name. The pull down list contains only those assigner names that have been entered in the database." Top = 1080 Width = 4215 End Begin VB.TextBox txtPermitNumbers CausesValidation= 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3255 Index = 1 Left = 4440 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 13 Top = 120 Width = 3015 End Begin VB.Label Label1 Caption = "Permit Code - Permit Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 120 TabIndex = 17 Top = 120 Width = 3135 End Begin VB.Label lblAssigner Caption = "Assigner Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 120 TabIndex = 16 Top = 840 Width = 4095 End End Begin VB.Frame fraFirst BorderStyle = 0 'None Caption = "First Set of Permits:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3495 Index = 0 Left = 120 TabIndex = 1 Top = 360 Width = 7575 Begin VB.TextBox txtPermitNumbers CausesValidation= 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3255 Index = 0 Left = 4440 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 6 ToolTipText = "Enter a list of permit numbers to retrieve." Top = 120 Width = 3015 End Begin VB.ComboBox cboAssignerName BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 0 ItemData = "ctlNWISPermit.ctx":0088 Left = 120 List = "ctlNWISPermit.ctx":008A TabIndex = 3 ToolTipText = "Select an assigner name. The pull down list contains only those assigner names that have been entered in the database." Top = 1080 Width = 4215 End Begin VB.ComboBox cboPermitCode BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Index = 0 ItemData = "ctlNWISPermit.ctx":008C Left = 120 List = "ctlNWISPermit.ctx":008E TabIndex = 2 ToolTipText = "Select a premit code. The pull down list contains only those codes that have been used." Top = 360 Width = 4215 End Begin VB.Label lblAssigner Caption = "Assigner Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 120 TabIndex = 5 Top = 840 Width = 4095 End Begin VB.Label Label1 Caption = "Permit Code - Permit Name:" BeginProperty Font Name = "MS Sans Serif" Size = 9.6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 120 TabIndex = 4 Top = 120 Width = 3135 End End End End Attribute VB_Name = "ctlNWISPermit" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False ' Control ************************************************************** ' Name: ctlNWISPermit ' Purpose: Selection control for selecting permit_tx and other ' related permit information. ' ' Author: Todd Augenstein, USGS ' Date: 9/25/2001 ' 'Dependencies: 'Changes: ' ' Notes: ' ' The objective of this control is to either set the value ' property to a valid psuedo where clause containing less than ' 1750 characters of permit selection criteria. Where the user can enter ' one to four combinations of: ' ' 1. permit codes ' 2. assigner names (the system actually retrieves on party index) ' 3. permit numbers ' 4. permit codes and permit numbers ' 5. assigner names (party index) and permit numbers ' 6. permit codes and assigner names (party index) and permit numbers ' ' ctlSelectSites.UpdateCriteria actually sets the Where keys ' based on the value property set on this control. ' ' ctlSelectSites.UpdateCriteria when called should use ' ctlNWISPermit.value ' ' The psuedo where clauses has the following SQL syntax ' ViewNm.AttributeNm = "value" ' ' Where valid combinations of viewNm.AttributeNm are: ' ' SITEPERMIT.permit_cd ' SITEPERMIT.party_ix (user selects enters assigner_nm system overloads party_ix) ' SITEPERMIT.permit_tx ' SITEPERMIT.permit_cd -SITEPERMIT.permit_tx ' SITEPERMIT.party_ix -SITEPERMIT.permit_tx ' SITEPERMIT.permit_cd -SITEPERMIT.party_ix - SITEPERMIT.permit_tx ' ' FROMSITEPERMIT.permit_cd ' FROMSITEPERMIT.party_ix (user selects enters assigner_nm system overloads party_ix) ' FROMSITEPERMIT.permit_tx ' FROMSITEPERMIT.permit_cd -FROMSITEPERMIT.permit_tx ' FROMSITEPERMIT.party_ix -FROMSITEPERMIT.permit_tx ' FROMSITEPERMIT.permit_cd -FROMSITEPERMIT.party_ix - FROMSITEPERMIT.permit_tx ' ' TOSITEPERMIT.permit_cd ' TOSITEPERMIT.party_ix (user selects enters assigner_nm system overloads party_ix) ' TOSITEPERMIT.permit_tx ' TOSITEPERMIT.permit_cd -TOSITEPERMIT.permit_tx ' TOSITEPERMIT.party_ix -TOSITEPERMIT.permit_tx ' TOSITEPERMIT.permit_cd -TOSITEPERMIT.party_ix - TOSITEPERMIT.permit_tx ' ' The same sets of codes can be done with the PERMIT, FROMPERMIT, and TOPERMIT views. ' ' The property SiteType determines which sites in the database ' will be selected, ALL, FROM or TO. Each instance of the control ' can only have ONE site type. The SiteType lets you know which ' view name to use SITEPERMIT, FROMSITEPERMIT, or TOSITEPERMIT. ' ' Control ctlSelectSites also has a SiteType property that you ' use to determine which key to create. ' ' A master list of where keys are in modGlobalConstants; ' association between where key and class that handles it ' are in table where_key, see swuds data dictionary.) ' ' ' SiteType = nothing (empty string) ' ' WhereSitePermit - Just add permit selection criteria to where clause ' ' SiteType = From ' ' WhereFromSitePermit ' ' SiteType = to ' ' WhereToSitePermit ' ' The user interface can display this control twice. Once from from-sites and once for to-sites. ' In the case of from and to site selection, two where keys can be ' set. One for the from and one for the to. ' ' There should never be more than two keys of the 3 ' keys listed entered in the control ' file. And each call (instance) of this control should only ' set one and only one key via ctlSelectSites. '*********************************************************************** Option Explicit Private Const MaxCharacters = 1750 Private Const conPermitCd = "permit_cd" Private Const conPermitTx = "permit_tx" Private Const conAssignerNm = "assigner_nm" Private m_SiteType As String ' Used to define the type of site ' condition on the where clause, is it ' a from, to, or both (empty string) site. Private m_varWidthPreferred As Long Private m_varHeightPreferred As Long ' ' This control can be used for SitePermit and Permit selection ' based on the setting of ' m_varTableName = SitePermit ' m_varTableName = Permit ' Private m_varTableName As String Private m_dicAssigner As scripting.Dictionary Private m_colPermitCd As Collection Private m_colSaveHeader(3) As Collection Private m_SettingValues As Boolean Public Event change() Private Sub cboAssignerName_Change(Index As Integer) If Not m_SettingValues Then ReLoadPermitCd Index RaiseEvent change End If End Sub ' ' Purpose: Allow next tab to be enabled. ' Private Sub cboAssignerName_Click(Index As Integer) EnableTabs If Not m_SettingValues Then ReLoadPermitCd Index RaiseEvent change End If End Sub Private Sub ReLoadAssigners(Index As Integer) Dim PermitCd As String Dim n As Integer Dim num As Integer Dim oldname As String With cboAssignerName(Index) oldname = cboAssignerName(Index).text 'If m_dicAssigner Is Nothing Then LoadAssigners Index If Len(oldname) = 0 Then If cboPermitCode(Index).text <> "" Then ' ' load the assigner JUST for the selected permit code. ' PermitCd = Mid(Trim(cboPermitCode(Index).text), 1, 4) .clear num = 0 For n = 1 To m_dicAssigner.Count If PermitCd = m_dicAssigner.Items(n - 1).PermitCd Then .List(num) = m_dicAssigner.Items(n - 1).AssignerNm .ItemData(num) = num num = num + 1 End If Next Else ' Reload them all .clear num = 0 For n = 1 To m_dicAssigner.Count .List(num) = m_dicAssigner.Items(n - 1).AssignerNm .ItemData(num) = num num = num + 1 Next End If End If cboAssignerName(Index).text = oldname End With End Sub Private Sub InitAssigners() Dim num As Integer Dim cmd As String Dim Assigner As clsAssigner Dim xRS As ADODB.Recordset lblAssigner(0).caption = "Loading Assigners, please wait ..." lblAssigner(0).Refresh cmd = "SELECT distinct c1.permit_cd, c3.permit_nm, c2.party_nm, c2.party_ix " & _ "FROM " & modQuery.GetActualTableNm("permit_xx") & " c1 " & _ "LEFT JOIN party c2 ON c1.party_id = c2.party_id " & _ "LEFT JOIN permit_cd c3 ON c1.permit_cd = c3.permit_cd" modQuery.DoSql cmd, xRS If m_dicAssigner Is Nothing Then Set m_dicAssigner = New scripting.Dictionary Else m_dicAssigner.RemoveAll End If num = 0 While Not xRS.EOF Set Assigner = New clsAssigner Assigner.PermitCd = Trim(xRS!permit_cd) Assigner.PermitNm = Trim(xRS!permit_nm) Assigner.AssignerNm = Trim(xRS!party_nm) Assigner.Partyix = Trim(xRS!party_ix) If Not m_dicAssigner.Exists(Trim(xRS!permit_cd) & "+" & Trim(xRS!party_nm)) Then m_dicAssigner.Add Assigner.PermitCd & "+" & Assigner.AssignerNm, Assigner num = num + 1 End If xRS.MoveNext Wend lblAssigner(0).caption = "Assigner Name:" lblAssigner(0).Refresh End Sub Private Sub LoadAssigners(Index As Integer) Dim num As Integer Dim cmd As String Dim Assigner As clsAssigner Dim vAssigner As Variant If Not m_dicAssigner Is Nothing And Len(cboAssignerName(Index).text) = 0 Then lblAssigner(Index).caption = "Loading Assigners, please wait ..." lblAssigner(Index).Refresh With cboAssignerName(Index) .clear num = 0 For Each vAssigner In m_dicAssigner.Items Set Assigner = vAssigner .List(num) = Assigner.AssignerNm .ItemData(num) = num num = num + 1 Next If m_dicAssigner.Count = 0 Then ' .text = m_dicAssigner.Items(0).AssignerNm 'Else MsgBox "No permit assigners where found in the database." .text = "" End If End With lblAssigner(Index).caption = "Assigner Name:" lblAssigner(Index).Refresh End If End Sub Private Sub cboPermitCode_Change(Index As Integer) If Not m_SettingValues Then ReLoadAssigners Index RaiseEvent change End If End Sub Private Sub cboPermitCode_Click(Index As Integer) EnableTabs If Not m_SettingValues Then ReLoadAssigners Index RaiseEvent change End If End Sub ' ' Purpose: Load permit control based on the selected assigner name. ' Private Sub ReLoadPermitCd(Index As Integer) Dim AssignerNm As String Dim n As Integer Dim num As Integer Dim oldname As String With cboPermitCode(Index) If Len(.text) = 0 Then If cboAssignerName(Index).text <> "" Then If m_colPermitCd Is Nothing Then LoadPermitCd Index ' ' Else load the permits JUST for the selected assigner name. ' AssignerNm = cboAssignerName(Index).text .clear num = 0 If m_dicAssigner Is Nothing Then LoadAssigners Index For n = 1 To m_dicAssigner.Count If AssignerNm = m_dicAssigner.Items(n - 1).AssignerNm Then .List(num) = m_dicAssigner.Items(n - 1).PermitCd & " - " & m_dicAssigner.Items(n - 1).PermitNm .ItemData(num) = num num = num + 1 End If Next Else 'Reload them allWith cboPermitCode(Index) LoadPermitCd Index End If End If End With End Sub Private Sub InitPermitCd() Dim Ref As DataMgr.clsRefList If m_colPermitCd Is Nothing Then Set m_colPermitCd = New Collection Set Ref = New DataMgr.clsRefList Ref.GetRefList m_colPermitCd, "PERMITCD", "", "permit_nm" RemoveUnusedPermitCd m_colPermitCd If m_colPermitCd.Count = 0 Then MsgBox "There are no permits associated to site records in this database." End If End If End Sub Private Sub LoadPermitCd(Index As Integer) Dim num&, selectedListIndex& Dim Ref As DataMgr.clsRefList With cboPermitCode(Index) .clear num = 0 For Each Ref In m_colPermitCd If IsNumeric(Trim(Ref.RefCd)) Then .List(num) = Trim(Ref.RefNm) .ItemData(num) = Trim(Ref.RefCd) Else .List(num) = Trim(Ref.RefCd) & " - " & Trim(Ref.RefNm) .ItemData(num) = num End If num = num + 1 Next End With End Sub ' ' Purpose: Remove unused permit codes from the reflist. ' Private Sub RemoveUnusedPermitCd(ByVal colPermitCd As Collection) Dim cmd As String Dim n As Integer Dim num As Integer Dim xRS As ADODB.Recordset Dim colTemp As Collection Dim Ref As DataMgr.clsRefList If colPermitCd Is Nothing Then Exit Sub If colPermitCd.Count < 1 Then Exit Sub cmd = "SELECT distinct c1.permit_cd " & _ "FROM " & modQuery.GetActualTableNm("permit_xx") & " c1 " modQuery.DoSql cmd, xRS If xRS.EOF Then For n = 1 To colPermitCd.Count colPermitCd.Remove 1 Next n Set xRS = Nothing Exit Sub End If Set colTemp = New Collection While Not xRS.EOF If m_colPermitCd.Count = 0 Then GoTo FinishIt num = 1 For Each Ref In m_colPermitCd If Trim(Ref.RefCd) = Trim(xRS!permit_cd) Then colTemp.Add Ref m_colPermitCd.Remove num num = num + 1 End If Next xRS.MoveNext Wend FinishIt: Set xRS = Nothing Set m_colPermitCd = Nothing Set m_colPermitCd = colTemp End Sub ' ' Purpose: Save the contents of the active list of permit ' numbers to a file. ' Private Sub cmdSave_Click() Dim FilePathName As String Dim SaveFile As Integer Dim objParser As clsParser Dim n As Long Dim canceled As Boolean On Error GoTo errSaveSpecs If Trim(txtPermitNumbers(SSTab1.Tab).text) = "" Then MsgBox "There are no permits to save." Exit Sub End If ' m_objRetrievalEngine.SaveControlFile dicValues ' ' Get the file. ' frmSwudsMain.dlgOpenFile.InitDir = g_OutputPath frmSwudsMain.dlgOpenFile.CancelError = True canceled = False FilePathName = "" modFileIO.OpenFile SaveFile, _ FilePathName, _ "Output", _ "Text files (*.txt)|*.txt|All files (*.*)|*.*", _ "Save", _ frmSwudsMain.dlgOpenFile If canceled Then Exit Sub ' ' Reload comments: ' If Not m_colSaveHeader(SSTab1.Tab) Is Nothing Then For n = 1 To m_colSaveHeader(SSTab1.Tab).Count Print #SaveFile, m_colSaveHeader(SSTab1.Tab).item(n) Next End If Set objParser = New Parser.clsParser objParser.AssignProperties "ASCII Delimited", vbCr, "" objParser.TrimToken = True objParser.Suppress = True objParser.Parse txtPermitNumbers(SSTab1.Tab).text For n = 1 To objParser.Count Print #SaveFile, objParser.GetToken(n) Next Close SaveFile Set objParser = Nothing Exit Sub errSaveSpecs: If Err.Number = cdlCancel Then Exit Sub ' just exit, and go back to saveas form. Else MsgBox "Can not save file. " & vbCrLf & Err.description End If End Sub ' Purpose: Remove all entries from permit selection and enter permits ' found in the table specified. ' Private Sub cmdLoad_Click() Dim SaveFile As Integer, FileName$ Dim NextLine$ Dim n As Integer Dim canceled As Boolean On Error GoTo errLoadSpecs ' ' Set the default file name location: ' frmSwudsMain.dlgOpenFile.InitDir = g_OutputPath frmSwudsMain.dlgOpenFile.CancelError = True canceled = False ' ' OK, get the file. ' FileName = "" modFileIO.OpenFile SaveFile, _ FileName, _ "Input", _ "Text files (*.txt)|*.txt|All files (*.*)|*.*", _ "Open", _ frmSwudsMain.dlgOpenFile, , canceled If canceled Then Exit Sub If SaveFile >= 0 Then txtPermitNumbers(SSTab1.Tab).text = "" If m_colSaveHeader(SSTab1.Tab) Is Nothing Then Set m_colSaveHeader(SSTab1.Tab) = New Collection Else For n = 1 To m_colSaveHeader(SSTab1.Tab).Count m_colSaveHeader(SSTab1.Tab).Remove 1 Next n End If While Not EOF(SaveFile) Line Input #SaveFile, NextLine NextLine = Trim(NextLine) ' Remove extra white space, so counts are OK. If LCase(Left(NextLine, 1)) = "#" Then ' ' Ignore lines beginning with the comment character "#" ' and stop reading if we are at the end of the control file. ' m_colSaveHeader(SSTab1.Tab).Add NextLine Else If txtPermitNumbers(SSTab1.Tab).text = "" Then txtPermitNumbers(SSTab1.Tab).text = NextLine Else txtPermitNumbers(SSTab1.Tab).text = txtPermitNumbers(SSTab1.Tab).text & vbCrLf & NextLine End If End If Wend Close SaveFile RaiseEvent change End If Exit Sub errLoadSpecs: If Err.Number = cdlCancel Then Exit Sub ' just exit, and go back to saveas form. Else MsgBox "Can not read file. " & vbCrLf & Err.description End If End Sub Private Sub txtPermitNumbers_Change(Index As Integer) EnableTabs If Not m_SettingValues Then RaiseEvent change End Sub Private Sub UserControl_Initialize() SSTab1.TabEnabled(1) = False SSTab1.TabEnabled(2) = False SSTab1.TabEnabled(3) = False m_varWidthPreferred = 5900 m_varHeightPreferred = 3400 UserControl_Resize m_SettingValues = True InitAssigners InitPermitCd LoadAssigners 0 LoadPermitCd 0 m_SettingValues = False End Sub Private Sub UserControl_Resize() Dim w&, h& Dim neww& w = UserControl.ScaleWidth h = UserControl.ScaleHeight If w > 300 Then SSTab1.width = w - 150 fraFirst(0).width = w - 350 fraFirst(1).width = w - 350 fraFirst(2).width = w - 350 fraFirst(3).width = w - 350 If w > 7575 Then txtPermitNumbers(0).width = 2500 + w - 7575 txtPermitNumbers(1).width = 2500 + w - 7575 txtPermitNumbers(2).width = 2500 + w - 7575 txtPermitNumbers(3).width = 2500 + w - 7575 End If End If If h > 300 Then SSTab1.Height = h - 150 fraFirst(0).Height = h - 600 fraFirst(1).Height = h - 600 fraFirst(2).Height = h - 600 fraFirst(3).Height = h - 600 txtPermitNumbers(0).Height = h - 800 txtPermitNumbers(1).Height = h - 800 txtPermitNumbers(2).Height = h - 800 txtPermitNumbers(3).Height = h - 800 End If End Sub Public Sub clear() Dim n As Integer SSTab1.Tab = 0 For n = 0 To 3 cboAssignerName(n).text = "" cboPermitCode(n).text = "" txtPermitNumbers(n).text = "" Next SSTab1.TabEnabled(1) = False SSTab1.TabEnabled(2) = False SSTab1.TabEnabled(3) = False RaiseEvent change End Sub 'Parses a where clause and sets up the controls to match it Public Property Let value(ByVal newvalue$) Dim UcaseSQL$ Dim tableName As String Dim PermitCdField As String Dim PermitTxField As String Dim AssignerField As String Dim PermitCdPos As Long Dim PermitTxPos As Long Dim AssignerPos As Long Dim nextPermitCd As Long Dim nextPermitTx As Long Dim nextAssigner As Long Dim startSearch As Long Dim SearchString As String Dim endSearch As Long m_SettingValues = True UcaseSQL = UCase(newvalue) tableName = UCase(m_SiteType & m_varTableName & ".") startSearch = InStr(UcaseSQL, tableName) If startSearch > 0 Then endSearch = InStrRev(UcaseSQL, tableName) endSearch = InStr(endSearch, UcaseSQL, ")") If endSearch = 0 Then endSearch = Len(UcaseSQL) UcaseSQL = Mid(UcaseSQL, startSearch, endSearch - startSearch + 1) PermitCdField = tableName & UCase(conPermitCd) PermitTxField = tableName & UCase(conPermitTx) AssignerField = tableName & UCase(conAssignerNm) PermitCdPos = InStr(UcaseSQL, PermitCdField) PermitTxPos = InStr(UcaseSQL, PermitTxField) AssignerPos = InStr(UcaseSQL, AssignerField) While PermitCdPos > 0 Or PermitTxPos > 0 Or AssignerPos > 0 If PermitCdPos > 0 And (AssignerPos = 0 Or AssignerPos > PermitCdPos) _ And (PermitTxPos = 0 Or PermitTxPos > PermitCdPos) Then startSearch = PermitCdPos + Len(PermitCdField) startSearch = InStr(startSearch, UcaseSQL, "'") + 1 endSearch = InStr(startSearch, UcaseSQL, "'") cboPermitCode(nextPermitCd).text = Mid(UcaseSQL, startSearch, endSearch - startSearch) nextPermitCd = nextPermitCd + 1 PermitCdPos = InStr(endSearch, UcaseSQL, PermitCdField) ElseIf AssignerPos > 0 And (PermitTxPos = 0 Or PermitTxPos > AssignerPos) Then startSearch = AssignerPos + Len(AssignerField) startSearch = InStr(startSearch, UcaseSQL, "'") + 1 endSearch = InStr(startSearch, UcaseSQL, "'") cboAssignerName(nextAssigner).text = Mid(UcaseSQL, startSearch, endSearch - startSearch) nextAssigner = nextAssigner + 1 If nextPermitCd < nextAssigner Then nextPermitCd = nextAssigner AssignerPos = InStr(endSearch, UcaseSQL, AssignerField) ElseIf PermitTxPos > 0 Then startSearch = PermitTxPos + Len(PermitTxField) startSearch = InStr(startSearch, UcaseSQL, "(") + 1 endSearch = InStr(startSearch, UcaseSQL, ")") If endSearch > startSearch Then SearchString = Mid(UcaseSQL, startSearch, endSearch - startSearch) While Len(SearchString) > 0 txtPermitNumbers(nextPermitTx).text = txtPermitNumbers(nextPermitTx).text & StrSplit(SearchString, ",", "'") & vbCrLf Wend nextPermitTx = nextPermitTx + 1 If nextAssigner < nextPermitTx Then nextAssigner = nextPermitTx PermitTxPos = InStr(endSearch, UcaseSQL, PermitTxField) Else PermitTxPos = 0 End If End If Wend End If RaiseEvent change m_SettingValues = False End Property 'Returns a where clause that describes which criteria are selected Public Property Get value() As String Dim n As Integer Dim strText As String Dim Vals(4) As String On Error GoTo errValue For n = 0 To 3 strText = txtPermitNumbers(n).text Vals(n) = MakeWhere(SQL_AND, _ TextToSQL(Mid(cboPermitCode(n).text, 1, 4), m_SiteType & m_varTableName & "." & conPermitCd), _ TextToSQL(cboAssignerName(n).text, m_SiteType & m_varTableName & "." & conAssignerNm), _ TextListToSQL(strText, m_SiteType & m_varTableName & "." & conPermitTx, SQL_IN)) Next n value = MakeWhere(SQL_OR, Vals(0), Vals(1), Vals(2), Vals(3)) Exit Property errValue: MsgBox Err.description End Property Private Sub EnableTabs() If cboAssignerName(0).text <> "" Or _ cboPermitCode(0).text <> "" Or _ txtPermitNumbers(0).text <> "" Then SSTab1.TabEnabled(1) = True End If If cboAssignerName(1).text <> "" Or _ cboPermitCode(1).text <> "" Or _ txtPermitNumbers(1).text <> "" Then SSTab1.TabEnabled(2) = True End If If cboAssignerName(2).text <> "" Or _ cboPermitCode(2).text <> "" Or _ txtPermitNumbers(2).text <> "" Then SSTab1.TabEnabled(3) = True End If End Sub Public Property Let tableName(ByVal newvalue As String) m_varTableName = UCase(newvalue) End Property Public Property Get tableName() As String tableName = m_varTableName End Property Public Property Let SiteType(ByVal newvalue As String) m_SiteType = UCase(newvalue) End Property Public Property Get SiteType() As String SiteType = m_SiteType End Property