frmselectloc.frm

房产测绘用的软件源代码

VERSION 5.00
Begin VB.Form frmSelectLoc 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择座落"
   ClientHeight    =   3255
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   5370
   Icon            =   "frmSelectLoc.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3255
   ScaleWidth      =   5370
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.ListBox List2 
      Height          =   1500
      Left            =   3885
      Sorted          =   -1  'True
      TabIndex        =   3
      Top             =   1365
      Visible         =   0   'False
      Width           =   1320
   End
   Begin VB.ListBox List1 
      Height          =   2940
      Left            =   135
      Sorted          =   -1  'True
      TabIndex        =   2
      Top             =   135
      Width           =   3525
   End
   Begin VB.CommandButton CancelButton 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   390
      Left            =   3900
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   390
      Left            =   3900
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "frmSelectLoc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mWidth As Double
Dim mHeight As Double
Dim mLyrName As String
Dim mCanceled As Boolean
Private Sub CancelButton_Click()
    mCanceled = True
    Unload Me
End Sub

Private Sub Form_Load()
    Dim rs As ADODB.Recordset
    
    On Error Resume Next
    Screen.MousePointer = 11
    Set rs = New ADODB.Recordset
    rs.Open "SELECT * FROM tbTable", MAP_CONN, adOpenKeyset, adLockPessimistic, adCmdText
    Do While Not rs.EOF
        List2.AddItem "" & rs("LyrName")
        List1.AddItem "" & rs("zl")
        List1.ItemData(List1.NewIndex) = List2.NewIndex
        
        rs.MoveNext
    Loop
    '--------------------------
    mCanceled = True
    If List1.ListCount <= 0 Then
        OKButton.Enabled = False
    Else
        List1.ListIndex = 0 '选中第一项
    End If
    '--------------------
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then
            rs.Close
        End If
        Set rs = Nothing
    End If
    Screen.MousePointer = 0
End Sub
Private Sub List1_DblClick()
    Call OKButton_Click
End Sub

Private Sub OKButton_Click()
    Dim rs As ADODB.Recordset
    Dim szSQL As String
    
    On Error GoTo ErrHandler
    'get the Region Layer Name
    mLyrName = List2.List(List1.ItemData(List1.ListIndex))
    
    szSQL = "SELECT width,height FROM tbTable WHERE LyrName='" & mLyrName & "'"
    Set rs = New ADODB.Recordset
    rs.Open szSQL, MAP_CONN, adOpenKeyset, adLockPessimistic, adCmdText
    rs.MoveFirst
    If Not rs.EOF Then
        mWidth = rs("width")
        mHeight = rs("height")
    End If
    '----------------------
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then
            rs.Close
        End If
        Set rs = Nothing
    End If
    '--------------------------
    mCanceled = False
    Unload Me
    Exit Sub
ErrHandler:
    mCanceled = True
    ErrMessageBox "frmSelectLoc::OK()", Me.Caption
End Sub
Public Property Get IsCanceled() As Boolean
    IsCanceled = mCanceled
End Property
Public Property Get MapWidth() As Double
    MapWidth = mWidth
End Property
Public Property Get MapHeight() As Double
    MapHeight = mHeight
End Property
Public Property Get RegionLayerName() As String
    RegionLayerName = mLyrName
End Property