frmsubsea.frm

来自「采用VB和MO二次开发的全国经济地理信息系统 内含开发全过程的详细文档」· FRM 代码 · 共 272 行

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form FrmSubSea 
   ClientHeight    =   7245
   ClientLeft      =   3450
   ClientTop       =   2235
   ClientWidth     =   8595
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   7245
   ScaleWidth      =   8595
   Begin VB.CommandButton Command3 
      Caption         =   "全图显示"
      Height          =   495
      Left            =   4680
      TabIndex        =   7
      Top             =   6720
      Width           =   1095
   End
   Begin VB.ComboBox Combo3 
      Height          =   300
      Left            =   4080
      TabIndex        =   4
      Text            =   "Combo3"
      Top             =   6120
      Width           =   2295
   End
   Begin VB.ComboBox Combo2 
      Height          =   300
      Left            =   2760
      TabIndex        =   3
      Text            =   "Combo2"
      Top             =   6120
      Width           =   1215
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   120
      TabIndex        =   2
      Text            =   "请选择查询字段"
      Top             =   6120
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   6600
      TabIndex        =   1
      Top             =   6000
      Width           =   1575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "选择其他数据查询.."
      Height          =   495
      Left            =   6360
      TabIndex        =   0
      Top             =   6720
      Width           =   1935
   End
   Begin MapObjects2.Map Map1 
      Height          =   5535
      Left            =   0
      TabIndex        =   5
      Top             =   0
      Width           =   8535
      _Version        =   131072
      _ExtentX        =   15055
      _ExtentY        =   9763
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "FrmSubSea.frx":0000
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   375
      Left            =   120
      TabIndex        =   6
      Top             =   5640
      Width           =   6615
   End
End
Attribute VB_Name = "FrmSubSea"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim g_symSelection As MapObjects2.Symbol
Dim recSelection As MapObjects2.Recordset
Dim ttt As Boolean


Private Sub Command2_Click()
        Load Frmsea
        Frmsea.show
        Unload FrmSubSea
End Sub

Private Sub Command3_Click()
          Map1.Extent = Map1.FullExtent
End Sub

Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hdc As stdole.OLE_HANDLE)
  If index > 0 Then Exit Sub
  If recSelection Is Nothing Then Exit Sub
  If Not recSelection.EOF Then
    Map1.DrawShape recSelection, g_symSelection
  End If
  Set recSelection = Nothing
End Sub

Private Sub Command1_Click()
  Dim strExp As String
  If Combo3.Text = "<选择字段值>" Then
    MsgBox "请选择一个合适的字段值"
  End If
  If ttt = True Then
        If Map1.Layers(0).Records.Fields(Combo1.List(Combo1.ListIndex)).Type = moString Then
            strExp = "TempField" & " " & Combo2.List(Combo2.ListIndex) & " '" & Combo3.Text & "'"
        Else
            strExp = "TempField" & " " & Combo2.List(Combo2.ListIndex) & " " & Combo3.Text
        End If
  Else
       If Map1.Layers(0).Records.Fields(Combo1.List(Combo1.ListIndex)).Type = moString Then
            strExp = Combo1.List(Combo1.ListIndex) & " " & Combo2.List(Combo2.ListIndex) & " '" & Combo3.Text & "'"
        Else
            strExp = Combo1.List(Combo1.ListIndex) & " " & Combo2.List(Combo2.ListIndex) & " " & Combo3.Text
        End If
  End If
  Set recSelection = Map1.Layers(0).SearchExpression(strExp)
  
  Map1.Refresh
End Sub

'Private Sub Form_Resize()
'  Map1.Move 60, 60, Me.ScaleWidth - 180, Me.ScaleHeight - 2000
' Label1.Move Map1.Left, Map1.Top + Map1.Height + 180, Map1.Width / 2, 400
'  Combo1.Move Label1.Left, Label1.Top + Label1.Height + 60, Map1.Width * 0.4
' Combo2.Move Combo1.Left + Combo1.Width + 60, Combo1.Top, (Map1.Width * 0.2) - 60
' Combo3.Move Combo2.Left + Combo2.Width + 60, Combo1.Top, Map1.Width * 0.4
'  Command1.Move Map1.Width * 3 / 8, Combo1.Top + Combo1.Height + 60, Map1.Width / 4, Combo1.Height * 2
'
'End Sub

Private Sub Form_Load()
  '
  ' Set up Form.
  '
  Dim dc1 As New MapObjects2.DataConnection
  Dim lyr As New MapObjects2.MapLayer
  Dim gds As MapObjects2.GeoDataset
  dc1.Database = App.Path
  dc1.Connect
  If Frmsea.ComboADO.Text <> "请选择查询数据" Then
        Set gds = dc1.FindGeoDataset("results")
        ttt = True
    Else
        Set gds = dc1.FindGeoDataset("s省界prj")
        ttt = False
  End If
  If gds Is Nothing Then
      MsgBox "You should set DataSourec Properly"
  Else
    Set lyr.GeoDataset = gds
  End If
  Map1.Layers.Add lyr
  
  With Map1
    If Not .Layers.Count = 1 Then End
    .Layers(0).Symbol.color = moDarkGreen
  End With
  Label1.Caption = "选择符合以下条件的要素:"
  Command1.Caption = "查询"
  '
  ' List MapLayer's Numeric Fields in first combo box.
  '
  With Combo1
    Dim fldLyr As MapObjects2.Field
    For Each fldLyr In Map1.Layers(0).Records.Fields
      If fldLyr.Type < 20 Then  '字段不是 点 线 或多边形类型
        .AddItem fldLyr.Name
      End If
    Next fldLyr
   ' .ListIndex = 0
  End With
  '
  ' List operators in second combo box.
  '
  With Combo2
    .AddItem "="
    .AddItem "<"
    .AddItem ">"
    .AddItem "<="
    .AddItem ">="
    .AddItem "Like"
    .ListIndex = 0
  End With
 ' Call ListValues
  
  '
  ' Set up symbol for drawing selections.
  '
  Set g_symSelection = New MapObjects2.Symbol

  With g_symSelection
    .SymbolType = Map1.Layers(0).Symbol.SymbolType
    .color = moYellow
  End With
  Dim ly As MapObjects2.MapLayer
  Set ly = Map1.Layers(0)
  Set ly.Renderer = New LabelRenderer
  With ly.Renderer
   .Field = "NAME"
   .Symbol(0).color = moBlack
   .Symbol(0).Font.Size = 4
  End With
End Sub

Private Sub Combo1_Click()
  Call ListValues
End Sub

Private Sub ListValues()
  If Len(Combo1.List(Combo1.ListIndex)) > 0 Then
    '
    ' Iterate through recordset of MapLayer.
    '
    Dim recLyr As MapObjects2.Recordset
    
    Dim layer As MapObjects2.MapLayer
    Dim Recs As MapObjects2.Recordset
    Set layer = Map1.Layers(0)
    Set Recs = layer.Records
    Dim str As Double
    Set recLyr = Map1.Layers(0).Records
    Dim strName As String
    strName = Combo1.List(Combo1.ListIndex)
    Combo3.Clear

    Do While Not recLyr.EOF
      Combo3.AddItem recLyr.Fields(strName).ValueAsString
     If ttt = True Then
         str = recLyr.Fields(strName).Value 'AsString
         Recs.Edit
         Recs!TempField = str
         Recs.Update
         Recs.MoveNext
     End If
      recLyr.MoveNext
    Loop
  End If
Combo3.Text = "<选择字段值>"
End Sub


Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
        Dim rect As New MapObjects2.rectangle

  If Button = 1 Then
    ' Zoom in
    Set rect = Map1.TrackRectangle
    If Not rect Is Nothing Then Map1.Extent = rect
  Else
    ' Zoom out
    Set rect = Map1.Extent
    rect.ScaleRectangle 1.5
    Map1.Extent = rect
  End If
End Sub