737 lines
22 KiB
Plaintext
737 lines
22 KiB
Plaintext
|
'//+----------------------------------------------------------------------------
|
||
|
|
'//
|
||
|
|
'// File: loadreg.frm
|
||
|
|
'//
|
||
|
|
'// Module: pbadmin.exe
|
||
|
|
'//
|
||
|
|
'// Synopsis: The regions dialog.
|
||
|
|
'//
|
||
|
|
'// Copyright (c) 1997-1999 Microsoft Corporation
|
||
|
|
'//
|
||
|
|
'// Author: quintinb Created Header 09/02/99
|
||
|
|
'//
|
||
|
|
'//+----------------------------------------------------------------------------
|
||
|
|
|
||
|
|
VERSION 5.00
|
||
|
|
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
|
||
|
|
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
|
||
|
|
Begin VB.Form frmLoadRegion
|
||
|
|
BorderStyle = 3 'Fixed Dialog
|
||
|
|
ClientHeight = 4665
|
||
|
|
ClientLeft = 135
|
||
|
|
ClientTop = 1545
|
||
|
|
ClientWidth = 4485
|
||
|
|
Icon = "LoadReg.frx":0000
|
||
|
|
LinkTopic = "Form1"
|
||
|
|
LockControls = -1 'True
|
||
|
|
MaxButton = 0 'False
|
||
|
|
MinButton = 0 'False
|
||
|
|
PaletteMode = 1 'UseZOrder
|
||
|
|
ScaleHeight = 4665
|
||
|
|
ScaleWidth = 4485
|
||
|
|
ShowInTaskbar = 0 'False
|
||
|
|
WhatsThisButton = -1 'True
|
||
|
|
WhatsThisHelp = -1 'True
|
||
|
|
Begin VB.CommandButton cmbEdit
|
||
|
|
Caption = "edit"
|
||
|
|
Height = 345
|
||
|
|
Left = 3120
|
||
|
|
TabIndex = 2
|
||
|
|
Top = 630
|
||
|
|
WhatsThisHelpID = 90010
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cmbDelete
|
||
|
|
Caption = "del"
|
||
|
|
Height = 345
|
||
|
|
Left = 3120
|
||
|
|
TabIndex = 3
|
||
|
|
Top = 1125
|
||
|
|
WhatsThisHelpID = 90020
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cmbregsave
|
||
|
|
Caption = "add"
|
||
|
|
Height = 330
|
||
|
|
Left = 3120
|
||
|
|
TabIndex = 1
|
||
|
|
Top = 120
|
||
|
|
WhatsThisHelpID = 90000
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin VB.Frame Frame1
|
||
|
|
Height = 60
|
||
|
|
Left = 3120
|
||
|
|
TabIndex = 7
|
||
|
|
Top = 1680
|
||
|
|
Width = 1245
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cmbOK
|
||
|
|
Caption = "ok"
|
||
|
|
Height = 345
|
||
|
|
Left = 3120
|
||
|
|
TabIndex = 5
|
||
|
|
Top = 3720
|
||
|
|
WhatsThisHelpID = 10030
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cmbCancel
|
||
|
|
Cancel = -1 'True
|
||
|
|
Caption = "cancel"
|
||
|
|
Height = 345
|
||
|
|
Left = 3120
|
||
|
|
TabIndex = 6
|
||
|
|
Top = 4200
|
||
|
|
WhatsThisHelpID = 10040
|
||
|
|
Width = 1230
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton loadReg
|
||
|
|
Caption = "import"
|
||
|
|
Height = 375
|
||
|
|
Left = 3120
|
||
|
|
TabIndex = 4
|
||
|
|
Top = 1920
|
||
|
|
WhatsThisHelpID = 90030
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin ComctlLib.ListView RegionList
|
||
|
|
Height = 4455
|
||
|
|
Left = 120
|
||
|
|
TabIndex = 0
|
||
|
|
Top = 105
|
||
|
|
WhatsThisHelpID = 90040
|
||
|
|
Width = 2835
|
||
|
|
_ExtentX = 5001
|
||
|
|
_ExtentY = 7858
|
||
|
|
View = 3
|
||
|
|
LabelWrap = -1 'True
|
||
|
|
HideSelection = 0 'False
|
||
|
|
_Version = 327682
|
||
|
|
ForeColor = -2147483640
|
||
|
|
BackColor = -2147483643
|
||
|
|
Appearance = 1
|
||
|
|
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
|
||
|
|
NumItems = 1
|
||
|
|
BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
|
||
|
|
Key = ""
|
||
|
|
Object.Tag = ""
|
||
|
|
Text = "region"
|
||
|
|
Object.Width = 4022
|
||
|
|
EndProperty
|
||
|
|
End
|
||
|
|
Begin MSComDlg.CommonDialog commonregion
|
||
|
|
Left = 3480
|
||
|
|
Top = 2640
|
||
|
|
_ExtentX = 847
|
||
|
|
_ExtentY = 847
|
||
|
|
_Version = 393216
|
||
|
|
DialogTitle = "Open Region File"
|
||
|
|
Filter = "*.pbr Region file| *.pbr"
|
||
|
|
End
|
||
|
|
End
|
||
|
|
Attribute VB_Name = "frmLoadRegion"
|
||
|
|
Attribute VB_GlobalNameSpace = False
|
||
|
|
Attribute VB_Creatable = False
|
||
|
|
Attribute VB_PredeclaredId = True
|
||
|
|
Attribute VB_Exposed = False
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
Dim intMaxRegionID As Integer
|
||
|
|
|
||
|
|
Dim EditList As EditLists
|
||
|
|
|
||
|
|
Dim bEditMode As Boolean
|
||
|
|
Dim nNewOne As Integer
|
||
|
|
|
||
|
|
Dim FirstEntry As Boolean
|
||
|
|
Dim dbDataRegion As Database
|
||
|
|
Dim rsDataRegion As Recordset
|
||
|
|
|
||
|
|
Function FillRegionList()
|
||
|
|
|
||
|
|
On Error GoTo ErrTrap
|
||
|
|
|
||
|
|
Dim strTemp As String
|
||
|
|
Dim intRowID As Integer
|
||
|
|
Dim itmX As ListItem
|
||
|
|
|
||
|
|
RegionList.ListItems.Clear
|
||
|
|
RegionList.Sorted = False
|
||
|
|
intMaxRegionID = 0
|
||
|
|
If rsDataRegion.BOF = False Then
|
||
|
|
rsDataRegion.MoveFirst
|
||
|
|
Do While Not rsDataRegion.EOF
|
||
|
|
Set itmX = RegionList.ListItems.Add()
|
||
|
|
intRowID = rsDataRegion!ID
|
||
|
|
With itmX
|
||
|
|
.Text = rsDataRegion!Region
|
||
|
|
strTemp = "Key:" & intRowID
|
||
|
|
.Key = strTemp
|
||
|
|
End With
|
||
|
|
If intMaxRegionID < intRowID Then
|
||
|
|
intMaxRegionID = intRowID
|
||
|
|
End If
|
||
|
|
rsDataRegion.MoveNext
|
||
|
|
If rsDataRegion.AbsolutePosition Mod 40 = 0 Then DoEvents
|
||
|
|
Loop
|
||
|
|
End If
|
||
|
|
RegionList.Sorted = True
|
||
|
|
|
||
|
|
Exit Function
|
||
|
|
ErrTrap:
|
||
|
|
Exit Function
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Function LoadRegionRes()
|
||
|
|
|
||
|
|
On Error GoTo LoadErr
|
||
|
|
Me.Caption = LoadResString(2003) & " " & gsCurrentPB
|
||
|
|
RegionList.ColumnHeaders(1).Text = LoadResString(2005)
|
||
|
|
cmbregsave.Caption = LoadResString(1011)
|
||
|
|
cmbEdit.Caption = LoadResString(1012)
|
||
|
|
cmbDelete.Caption = LoadResString(1013)
|
||
|
|
loadReg.Caption = LoadResString(2004)
|
||
|
|
cmbOK.Caption = LoadResString(1002)
|
||
|
|
cmbCancel.Caption = LoadResString(1003)
|
||
|
|
' set fonts
|
||
|
|
SetFonts Me
|
||
|
|
RegionList.Font.Charset = gfnt.Charset
|
||
|
|
RegionList.Font.Name = gfnt.Name
|
||
|
|
RegionList.Font.Size = gfnt.Size
|
||
|
|
|
||
|
|
On Error GoTo 0
|
||
|
|
|
||
|
|
Exit Function
|
||
|
|
|
||
|
|
LoadErr:
|
||
|
|
Exit Function
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Function SaveEdit(ByVal Action As String, ByVal ID As Integer, ByVal NewRegion As String, Optional ByVal OldRegion As String) As Integer
|
||
|
|
|
||
|
|
' populate the array - for performance reasons
|
||
|
|
|
||
|
|
Dim intX As Integer
|
||
|
|
Dim bFound As Boolean
|
||
|
|
|
||
|
|
On Error GoTo SaveErr
|
||
|
|
bFound = False
|
||
|
|
If Action = "U" Or Action = "D" Then
|
||
|
|
intX = 1
|
||
|
|
Do While intX <= EditList.Count
|
||
|
|
If ID = EditList.ID(intX) Then
|
||
|
|
' this handles Adds that have been Updated before being
|
||
|
|
' written to the db.
|
||
|
|
If Action = "U" And EditList.Action(intX) = "A" Then
|
||
|
|
Action = "A"
|
||
|
|
'If EditList.Region(intX) = "" And _
|
||
|
|
EditList.Action(intX) = "A" Then Action = "A"
|
||
|
|
End If
|
||
|
|
bFound = True
|
||
|
|
Exit Do
|
||
|
|
End If
|
||
|
|
intX = intX + 1
|
||
|
|
Loop
|
||
|
|
End If
|
||
|
|
If Not bFound Then
|
||
|
|
intX = EditList.Count + 1
|
||
|
|
EditList.Count = intX
|
||
|
|
ReDim Preserve EditList.Action(intX)
|
||
|
|
ReDim Preserve EditList.ID(intX)
|
||
|
|
ReDim Preserve EditList.Region(intX)
|
||
|
|
ReDim Preserve EditList.OldRegion(intX)
|
||
|
|
End If
|
||
|
|
|
||
|
|
EditList.Action(intX) = Action
|
||
|
|
EditList.ID(intX) = ID
|
||
|
|
EditList.Region(intX) = NewRegion
|
||
|
|
If Action = "U" Then
|
||
|
|
EditList.OldRegion(intX) = OldRegion
|
||
|
|
End If
|
||
|
|
On Error GoTo 0
|
||
|
|
|
||
|
|
Exit Function
|
||
|
|
SaveErr:
|
||
|
|
Exit Function
|
||
|
|
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Sub cmbCancel_Click()
|
||
|
|
|
||
|
|
Unload Me
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub cmbDelete_Click()
|
||
|
|
|
||
|
|
Dim intX As Integer
|
||
|
|
|
||
|
|
On Error Resume Next
|
||
|
|
intX = MsgBox(LoadResString(6024), vbQuestion + vbYesNo + vbDefaultButton2)
|
||
|
|
If intX = 6 Then
|
||
|
|
SaveEdit "D", _
|
||
|
|
Right(RegionList.SelectedItem.Key, Len(RegionList.SelectedItem.Key) - 4), _
|
||
|
|
RegionList.SelectedItem.Text
|
||
|
|
RegionList.ListItems.Remove RegionList.SelectedItem.Key
|
||
|
|
End If
|
||
|
|
RegionList.SetFocus
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub cmbEdit_Click()
|
||
|
|
|
||
|
|
On Error GoTo ErrTrap
|
||
|
|
RegionList.SetFocus
|
||
|
|
RegionList.StartLabelEdit
|
||
|
|
|
||
|
|
Exit Sub
|
||
|
|
ErrTrap:
|
||
|
|
Exit Sub
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub cmbOK_Click()
|
||
|
|
|
||
|
|
Dim rsTemp As Recordset
|
||
|
|
Dim intX, intY As Integer
|
||
|
|
Dim intRegionID As Integer
|
||
|
|
Dim itemY As ListItem
|
||
|
|
Dim bUpdates As Boolean
|
||
|
|
Dim PerformedDelete As Boolean
|
||
|
|
Dim rsTempPop As Recordset, rsTempDelta As Recordset
|
||
|
|
Dim i As Integer, deltnum As Integer
|
||
|
|
Dim deltasql As String, popsql As String
|
||
|
|
|
||
|
|
PerformedDelete = False
|
||
|
|
If bEditMode Then
|
||
|
|
RegionList.SetFocus
|
||
|
|
SendKeys "{ENTER}", True
|
||
|
|
RegionList_AfterLabelEdit 1, RegionList.SelectedItem.Text
|
||
|
|
'bEditMode = False
|
||
|
|
End If
|
||
|
|
|
||
|
|
On Error GoTo SaveErr
|
||
|
|
Me.MousePointer = 11
|
||
|
|
frmLoadRegion.Enabled = False
|
||
|
|
bUpdates = False
|
||
|
|
|
||
|
|
Set rsTemp = gsyspb.OpenRecordset("Region", dbOpenDynaset)
|
||
|
|
|
||
|
|
'Debug.Print ("editlist.count = " & EditList.Count)
|
||
|
|
For intX = 1 To EditList.Count
|
||
|
|
Select Case EditList.Action(intX)
|
||
|
|
Case "D" 'delete
|
||
|
|
gsyspb.Execute "Delete from Region Where RegionID =" & EditList.ID(intX)
|
||
|
|
popsql = "Select * from DialUpPort where RegionID = " & EditList.ID(intX)
|
||
|
|
Set rsTempPop = gsyspb.OpenRecordset(popsql, dbOpenDynaset)
|
||
|
|
If Not (rsTempPop.BOF And rsTempPop.EOF) Then
|
||
|
|
rsTempPop.MoveFirst
|
||
|
|
Do Until rsTempPop.EOF
|
||
|
|
rsTempPop.Edit
|
||
|
|
rsTempPop!RegionID = 0
|
||
|
|
rsTempPop.Update
|
||
|
|
|
||
|
|
If rsTempPop!status = 1 Then
|
||
|
|
Set rsTempDelta = gsyspb.OpenRecordset("Select * from Delta order by DeltaNum", dbOpenDynaset)
|
||
|
|
If rsTempDelta.RecordCount = 0 Then
|
||
|
|
deltnum = 1
|
||
|
|
Else
|
||
|
|
rsTempDelta.MoveLast
|
||
|
|
deltnum = rsTempDelta!deltanum
|
||
|
|
If deltnum > 6 Then
|
||
|
|
deltnum = deltnum - 1
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
For i = 1 To deltnum
|
||
|
|
deltasql = "Select * from delta where DeltaNum = " & i & _
|
||
|
|
" AND AccessNumberId = '" & rsTempPop!AccessNumberId & "' " & _
|
||
|
|
" order by DeltaNum"
|
||
|
|
Set rsTempDelta = gsyspb.OpenRecordset(deltasql, dbOpenDynaset)
|
||
|
|
If Not (rsTempDelta.BOF And rsTempDelta.EOF) Then
|
||
|
|
rsTempDelta.Edit
|
||
|
|
Else
|
||
|
|
rsTempDelta.AddNew
|
||
|
|
rsTempDelta!deltanum = i
|
||
|
|
rsTempDelta!AccessNumberId = rsTempPop!AccessNumberId
|
||
|
|
End If
|
||
|
|
If rsTempPop!status = 1 Then
|
||
|
|
rsTempDelta!CountryNumber = rsTempPop!CountryNumber
|
||
|
|
rsTempDelta!AreaCode = rsTempPop!AreaCode
|
||
|
|
rsTempDelta!AccessNumber = rsTempPop!AccessNumber
|
||
|
|
rsTempDelta!MinimumSpeed = rsTempPop!MinimumSpeed
|
||
|
|
rsTempDelta!MaximumSpeed = rsTempPop!MaximumSpeed
|
||
|
|
rsTempDelta!RegionID = rsTempPop!RegionID
|
||
|
|
rsTempDelta!CityName = rsTempPop!CityName
|
||
|
|
rsTempDelta!ScriptId = rsTempPop!ScriptId
|
||
|
|
rsTempDelta!Flags = rsTempPop!Flags
|
||
|
|
rsTempDelta.Update
|
||
|
|
End If
|
||
|
|
Next i
|
||
|
|
End If
|
||
|
|
rsTempPop.MoveNext
|
||
|
|
Loop
|
||
|
|
End If
|
||
|
|
|
||
|
|
|
||
|
|
LogRegionDelete EditList.Region(intX), EditList.Region(intX) & ";" & EditList.ID(intX)
|
||
|
|
PerformedDelete = True
|
||
|
|
bUpdates = True
|
||
|
|
Case "U" 'update
|
||
|
|
If EditList.Region(intX) <> "" Then
|
||
|
|
gsyspb.Execute "Update Region set RegionDesc='" & EditList.Region(intX) & _
|
||
|
|
"' Where RegionID =" & EditList.ID(intX)
|
||
|
|
LogRegionEdit EditList.OldRegion(intX), EditList.Region(intX) & ";" & EditList.ID(intX)
|
||
|
|
bUpdates = True
|
||
|
|
End If
|
||
|
|
Case "A" 'add
|
||
|
|
If EditList.Region(intX) <> "" Then
|
||
|
|
With rsTemp
|
||
|
|
.AddNew
|
||
|
|
!RegionID = EditList.ID(intX)
|
||
|
|
!RegionDesc = EditList.Region(intX)
|
||
|
|
.Update
|
||
|
|
End With
|
||
|
|
LogRegionAdd EditList.Region(intX), EditList.Region(intX) & ";" & EditList.ID(intX)
|
||
|
|
End If
|
||
|
|
End Select
|
||
|
|
If intX Mod 5 = 0 Then DoEvents
|
||
|
|
Next
|
||
|
|
If PerformedDelete Then
|
||
|
|
If Not ReIndexRegions(gsyspb) Then GoTo SaveErr
|
||
|
|
End If
|
||
|
|
|
||
|
|
rsTemp.Close
|
||
|
|
|
||
|
|
If bUpdates Then frmMain.FillPOPList
|
||
|
|
frmLoadRegion.Enabled = True
|
||
|
|
Me.MousePointer = 0
|
||
|
|
On Error GoTo 0
|
||
|
|
Unload Me
|
||
|
|
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
SaveErr:
|
||
|
|
frmLoadRegion.Enabled = True
|
||
|
|
Me.MousePointer = 0
|
||
|
|
MsgBox LoadResString(6056) & Chr(13) & Chr(13) & Err.Description, vbExclamation
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
'GsysPb.Execute "Delete from Region", dbFailOnError
|
||
|
|
'Set rsTemp = GsysPb.OpenRecordset("Region", dbOpenDynaset)
|
||
|
|
'For intX = 1 To RegionList.ListItems.Count
|
||
|
|
' Set itemY = RegionList.ListItems(intX)
|
||
|
|
' With rsTemp
|
||
|
|
' .AddNew
|
||
|
|
' !regionID = Right(itemY.Key, Len(itemY.Key) - 4)
|
||
|
|
' !regiondesc = Left$(itemY.Text, 30)
|
||
|
|
' .Update
|
||
|
|
' End With
|
||
|
|
' If intX Mod 25 = 0 Then DoEvents
|
||
|
|
'Next
|
||
|
|
'rsTemp.Close
|
||
|
|
'Set rsTemp = Nothing
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
'check for deletes
|
||
|
|
'Set rsTemp = GsysPb.OpenRecordset("Region", dbOpenDynaset)
|
||
|
|
'If Not (rsTemp.BOF And rsTemp.EOF) Then
|
||
|
|
' rsTemp.MoveLast
|
||
|
|
' rsTemp.MoveFirst
|
||
|
|
' For intX = 1 To rsTemp.RecordCount
|
||
|
|
' intRegionID = rsTemp!regionID
|
||
|
|
' intY = 1
|
||
|
|
' Do While intY <= RegionList.ListItems.Count
|
||
|
|
' Set itemY = RegionList.ListItems(intY)
|
||
|
|
' If Val(Right(itemY.Key, Len(itemY.Key) - 4)) = intRegionID Then
|
||
|
|
' Exit Do
|
||
|
|
' End If
|
||
|
|
' intY = intY + 1
|
||
|
|
' Loop
|
||
|
|
' If intY > RegionList.ListItems.Count Then ' no find - didn't fall out of loop early
|
||
|
|
'clear region id
|
||
|
|
' GsysPb.Execute "Update DialUpPort set RegionID = 0 WHERE RegionID =" & intRegionID
|
||
|
|
' GsysPb.Execute "Update Delta set RegionID = 0 WHERE RegionID ='" & intRegionID & "'"
|
||
|
|
' End If
|
||
|
|
' rsTemp.MoveNext
|
||
|
|
' If intX Mod 25 = 0 Then DoEvents
|
||
|
|
' Next
|
||
|
|
'End If
|
||
|
|
'rsTemp.Close
|
||
|
|
'Set itemY = Nothing
|
||
|
|
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub cmbregsave_Click()
|
||
|
|
|
||
|
|
Dim itmX As ListItem
|
||
|
|
Dim strNewKey, strOldKey, strOldText, strNewRegion As String
|
||
|
|
|
||
|
|
On Error GoTo ErrTrap
|
||
|
|
|
||
|
|
If bEditMode Then
|
||
|
|
RegionList.SetFocus
|
||
|
|
SendKeys "{ENTER}", True
|
||
|
|
bEditMode = False
|
||
|
|
End If
|
||
|
|
|
||
|
|
strNewRegion = LoadResString(2006)
|
||
|
|
|
||
|
|
Set itmX = RegionList.FindItem(strNewRegion, lvwText)
|
||
|
|
If Not itmX Is Nothing Then
|
||
|
|
itmX.Selected = True
|
||
|
|
Set RegionList.SelectedItem = RegionList.ListItems(itmX.Key)
|
||
|
|
RegionList.SetFocus
|
||
|
|
itmX.EnsureVisible
|
||
|
|
Exit Sub
|
||
|
|
Else
|
||
|
|
strNewKey = "Key:" & intMaxRegionID + 1
|
||
|
|
'If RegionList.SelectedItem Is Nothing Then
|
||
|
|
Set itmX = RegionList.ListItems.Add()
|
||
|
|
With itmX
|
||
|
|
.Text = strNewRegion
|
||
|
|
.Key = strNewKey
|
||
|
|
.Selected = True
|
||
|
|
End With
|
||
|
|
Set RegionList.SelectedItem = RegionList.ListItems(itmX.Key)
|
||
|
|
RegionList.SetFocus
|
||
|
|
itmX.EnsureVisible
|
||
|
|
'Else 'jump thru hoops to make listview work right.
|
||
|
|
' With RegionList.SelectedItem
|
||
|
|
' strOldText = .Text
|
||
|
|
' .Text = strNewRegion
|
||
|
|
' strOldKey = .Key
|
||
|
|
' .Key = strNewKey
|
||
|
|
' End With
|
||
|
|
' Set itmX = RegionList.ListItems.Add()
|
||
|
|
' With itmX
|
||
|
|
' .Text = strOldText
|
||
|
|
' .Key = strOldKey
|
||
|
|
' End With
|
||
|
|
'End If
|
||
|
|
|
||
|
|
SaveEdit "A", intMaxRegionID + 1, "" ' save an empty region to key on later
|
||
|
|
intMaxRegionID = intMaxRegionID + 1
|
||
|
|
End If
|
||
|
|
|
||
|
|
Set RegionList.SelectedItem = RegionList.ListItems(itmX.Key)
|
||
|
|
RegionList.SetFocus
|
||
|
|
RegionList.StartLabelEdit
|
||
|
|
' The second StartLabelEdit causes this to work ???
|
||
|
|
RegionList.StartLabelEdit
|
||
|
|
|
||
|
|
On Error GoTo 0
|
||
|
|
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
ErrTrap:
|
||
|
|
Me.MousePointer = 0
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub Form_Activate()
|
||
|
|
|
||
|
|
Screen.MousePointer = 11
|
||
|
|
Me.Enabled = False
|
||
|
|
FillRegionList
|
||
|
|
Me.Enabled = True
|
||
|
|
Screen.MousePointer = 0
|
||
|
|
If RegionList.ListItems.Count = 0 Then
|
||
|
|
RegionList.TabStop = False
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||
|
|
Dim ShiftDown
|
||
|
|
ShiftDown = (Shift And vbShiftMask) > 0
|
||
|
|
|
||
|
|
If KeyCode = 222 And ShiftDown Then
|
||
|
|
Beep
|
||
|
|
KeyCode = 0
|
||
|
|
End If
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_KeyPress(KeyAscii As Integer)
|
||
|
|
CheckChar KeyAscii
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub Form_Load()
|
||
|
|
|
||
|
|
On Error GoTo LoadErr
|
||
|
|
bEditMode = False
|
||
|
|
|
||
|
|
CenterForm Me, Screen
|
||
|
|
EditList.Count = 0
|
||
|
|
Me.Enabled = False
|
||
|
|
LoadRegionRes
|
||
|
|
'new
|
||
|
|
Set dbDataRegion = OpenDatabase(gsCurrentPBPath)
|
||
|
|
Set rsDataRegion = dbDataRegion.OpenRecordset("Select RegionDesc as Region, RegionID as ID from Region order by RegionDesc")
|
||
|
|
|
||
|
|
Me.Enabled = True
|
||
|
|
Screen.MousePointer = 0
|
||
|
|
FirstEntry = True
|
||
|
|
|
||
|
|
Exit Sub
|
||
|
|
LoadErr:
|
||
|
|
Me.Enabled = True
|
||
|
|
Screen.MousePointer = 0
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_Unload(Cancel As Integer)
|
||
|
|
|
||
|
|
rsDataRegion.Close
|
||
|
|
dbDataRegion.Close
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub loadReg_Click()
|
||
|
|
|
||
|
|
Dim fileopen As String
|
||
|
|
Dim maxindex As Integer
|
||
|
|
Dim indexcount, intY As Integer
|
||
|
|
Dim Count As Integer
|
||
|
|
Dim itmX As ListItem
|
||
|
|
Dim strTemp As String
|
||
|
|
Dim bFlag As Boolean
|
||
|
|
|
||
|
|
On Error GoTo ErrTrap
|
||
|
|
maxindex = 200
|
||
|
|
ReDim Region(maxindex) As String
|
||
|
|
|
||
|
|
commonregion.Filter = LoadResString(2007)
|
||
|
|
commonregion.FilterIndex = 1
|
||
|
|
commonregion.Flags = cdlOFNHideReadOnly
|
||
|
|
commonregion.ShowOpen
|
||
|
|
fileopen = commonregion.FileName
|
||
|
|
If fileopen = "" Then Exit Sub
|
||
|
|
|
||
|
|
Open fileopen For Input Access Read As #1
|
||
|
|
If EOF(1) Then
|
||
|
|
Close #1
|
||
|
|
Exit Sub
|
||
|
|
End If
|
||
|
|
Input #1, Count
|
||
|
|
indexcount = 1
|
||
|
|
Do While indexcount <= Count And Not EOF(1)
|
||
|
|
Input #1, Region(indexcount)
|
||
|
|
Region(indexcount) = Left(Trim(Region(indexcount)), 30)
|
||
|
|
If Region(indexcount) <> "" Then
|
||
|
|
indexcount = indexcount + 1
|
||
|
|
End If
|
||
|
|
Loop
|
||
|
|
Close #1
|
||
|
|
Count = indexcount - 1
|
||
|
|
|
||
|
|
For indexcount = 1 To Count
|
||
|
|
' check for dups
|
||
|
|
intY = 1
|
||
|
|
bFlag = False
|
||
|
|
Do While intY <= RegionList.ListItems.Count
|
||
|
|
If LCase(RegionList.ListItems(intY)) = LCase(Region(indexcount)) Then
|
||
|
|
bFlag = True
|
||
|
|
Exit Do
|
||
|
|
End If
|
||
|
|
intY = intY + 1
|
||
|
|
Loop
|
||
|
|
' add if not a dup
|
||
|
|
If Not bFlag Then
|
||
|
|
Set itmX = RegionList.ListItems.Add()
|
||
|
|
With itmX
|
||
|
|
.Text = Left(Region(indexcount), 30)
|
||
|
|
strTemp = "Key:" & intMaxRegionID + 1
|
||
|
|
.Key = strTemp
|
||
|
|
End With
|
||
|
|
SaveEdit "A", intMaxRegionID + 1, Left(Region(indexcount), 30)
|
||
|
|
intMaxRegionID = intMaxRegionID + 1
|
||
|
|
End If
|
||
|
|
Next indexcount
|
||
|
|
RegionList.Sorted = True
|
||
|
|
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
ErrTrap:
|
||
|
|
If Err.Number = 62 Or Err.Number = 3163 Then
|
||
|
|
Exit Sub
|
||
|
|
Else
|
||
|
|
Exit Sub
|
||
|
|
End If
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub RegionList_BeforeLabelEdit(Cancel As Integer)
|
||
|
|
'Debug.Print ("BeforeLabelEdit")
|
||
|
|
bEditMode = True
|
||
|
|
|
||
|
|
'Debug.Print ("working on " & RegionList.SelectedItem.index)
|
||
|
|
nNewOne = RegionList.SelectedItem.index
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
' This doesn't get called if no changes are made to the default text
|
||
|
|
'
|
||
|
|
Private Sub RegionList_AfterLabelEdit(Cancel As Integer, NewString As String)
|
||
|
|
|
||
|
|
'Debug.Print ("AfterLabelEdit")
|
||
|
|
Dim itmX As ListItem
|
||
|
|
|
||
|
|
bEditMode = False
|
||
|
|
|
||
|
|
If Trim(NewString) = "" Then
|
||
|
|
Cancel = True
|
||
|
|
RegionList.StartLabelEdit
|
||
|
|
Exit Sub
|
||
|
|
End If
|
||
|
|
' null indicates the user canceled the edit
|
||
|
|
If Not IsNull(NewString) Then
|
||
|
|
NewString = Left(Trim(NewString), 30)
|
||
|
|
|
||
|
|
' check for dups
|
||
|
|
Set itmX = RegionList.FindItem(NewString, lvwText)
|
||
|
|
If Not itmX Is Nothing Then
|
||
|
|
If itmX.index <> nNewOne Then
|
||
|
|
MsgBox LoadResString(6025), vbExclamation
|
||
|
|
Cancel = True
|
||
|
|
RegionList.StartLabelEdit
|
||
|
|
Exit Sub
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
|
||
|
|
'Debug.Print (NewString)
|
||
|
|
Set itmX = RegionList.SelectedItem
|
||
|
|
'Debug.Print (itmX.Key)
|
||
|
|
SaveEdit "U", Right(itmX.Key, Len(itmX.Key) - 4), NewString, itmX
|
||
|
|
RegionList.SortKey = 0
|
||
|
|
RegionList.Sorted = True
|
||
|
|
End If
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub RegionList_ItemClick(ByVal Item As ComctlLib.ListItem)
|
||
|
|
If bEditMode Then
|
||
|
|
RegionList_AfterLabelEdit 1, RegionList.ListItems.Item(nNewOne).Text
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub RegionList_LostFocus()
|
||
|
|
If RegionList.ListItems.Count > 0 Then
|
||
|
|
RegionList.TabStop = True
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|