frmresult.frm

地理信息系统工程案例精选程序,本书所有案例均需要单独配置

VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form frmPicture 
   AutoRedraw      =   -1  'True
   Caption         =   "成果图"
   ClientHeight    =   5880
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8565
   Icon            =   "frmResult.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5880
   ScaleWidth      =   8565
   StartUpPosition =   1  '所有者中心
   Begin ActiveBar2LibraryCtl.ActiveBar2 abTool 
      Height          =   5880
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   8565
      _LayoutVersion  =   1
      _ExtentX        =   15108
      _ExtentY        =   10372
      _DataPath       =   ""
      Bands           =   "frmResult.frx":08A6
      Begin MapObjects2.Map Map1 
         Height          =   1575
         Left            =   120
         TabIndex        =   1
         Top             =   480
         Width           =   3255
         _Version        =   131072
         _ExtentX        =   5741
         _ExtentY        =   2778
         _StockProps     =   225
         BackColor       =   16777215
         BorderStyle     =   1
         Contents        =   "frmResult.frx":3694
      End
   End
End
Attribute VB_Name = "frmPicture"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strTool As String
Dim strPicPath() As String
Dim PicCount As Long
Dim PicNow As Long
Private Sub abTool_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)

abTool.Bands("barStandard").Tools("Pan").Checked = False
abTool.Bands("barStandard").Tools("Zoom").Checked = False
abTool.Bands("barStandard").Tools("Pointer").Checked = False

strTool = Tool.Name
Map1.MousePointer = moArrow
Select Case Tool.Name
    Case "Pan"
        Map1.MousePointer = moPan
        Tool.Checked = True
    Case "Globe"
        Map1.Extent = Map1.FullExtent
    Case "Zoom"
        Tool.Checked = True
        Map1.MousePointer = moZoomIn
    Case "Pointer"
        Tool.Checked = True
    Case "NextPic"
        PicNow = PicNow + 1
        AssertLastNext
        LoadPic (PicNow)
    Case "LastPic"
        PicNow = PicNow - 1
        AssertLastNext
        LoadPic (PicNow)
    Case "Exit"
        Me.Hide
    Case "Print"
End Select

End Sub

Private Sub Form_Load()
abTool.ClientAreaControl = Map1
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim RectangleX As MapObjects2.Rectangle
Dim ow As Long
Select Case strTool
    Case "Zoom"
    
            Set RectangleX = Map1.TrackRectangle
            If Not RectangleX Is Nothing Then Map1.Extent = RectangleX
    Case "Pan"
        Map1.Pan
    Case "Pointer"
End Select

End Sub
Public Sub InitForm(strFileName As String, Optional strTitle As String = "")
If strTitle <> "" Then
    frmPicture.Caption = "图片查看--" & strTitle
Else
    frmPicture.Caption = "图片查看"
End If

Dim CharNow As Long
CharNow = 0
PicCount = 0
Do
    CharNow = InStr(CharNow + 1, strFileName, ";")
    If CharNow <= 0 Then Exit Do
    PicCount = PicCount + 1
Loop
PicCount = PicCount + 1
ReDim strPicPath(PicCount)
Dim CharLast As Long
CharNow = 0
PicCount = 0
Do
    CharLast = CharNow
    CharNow = InStr(CharNow + 1, strFileName, ";")
    If CharNow <= 0 Then
        strPicPath(PicCount) = Mid(strFileName, CharLast + 1)
        PicCount = PicCount + 1
        Exit Do
    Else
        strPicPath(PicCount) = Mid(strFileName, CharLast + 1, CharNow - CharLast - 1)
        PicCount = PicCount + 1
    
    End If
Loop

PicNow = 0
Call AssertLastNext
If PicCount > 0 Then
    LoadPic (PicNow)
End If

End Sub
Private Sub AssertLastNext()

If PicNow <= 0 Then
    PicNow = 0
    abTool.Bands("barStandard").Tools("LastPic").Enabled = False
Else
    abTool.Bands("barStandard").Tools("LastPic").Enabled = True
End If

If PicNow + 1 >= PicCount Then
    PicNow = PicCount - 1
    abTool.Bands("barStandard").Tools("NextPic").Enabled = False
Else
    abTool.Bands("barStandard").Tools("NextPic").Enabled = True
End If

abTool.RecalcLayout

    

End Sub

Private Sub LoadPic(PicIndex As Long)

If PicIndex < 0 Or PicIndex > PicCount - 1 Then Exit Sub

Dim ImageX As New MapObjects2.ImageLayer
If Me.Caption = "图片查看" Then
    ImageX.File = fnCompletePath("data\宗地图\" & strPicPath(PicIndex))
Else
    ImageX.File = strPicPath(PicIndex)
End If
ImageX.Visible = True
Map1.Layers.Clear
Map1.Layers.Add ImageX
Map1.Refresh

End Sub