📄 ddwordpad.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"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6C20C089-0689-11D5-B2F8-000102D87123}#2.0#0"; "MO21ScaleBar.ocx"
Begin VB.Form frmMain
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "(Power by ProMap)"
ClientHeight = 8835
ClientLeft = 2355
ClientTop = 1140
ClientWidth = 11400
Icon = "DDwordPad.frx":0000
LinkTopic = "Form1"
ScaleHeight = 8835
ScaleWidth = 11400
StartUpPosition = 2 '屏幕中心
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin ActiveBar2LibraryCtl.ActiveBar2 abProMap
Align = 1 'Align Top
Height = 8835
Left = 0
TabIndex = 0
Top = 0
Width = 11400
_LayoutVersion = 1
_ExtentX = 20108
_ExtentY = 15584
_DataPath = ""
Bands = "DDwordPad.frx":08A6
Begin VB.PictureBox PicTip
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
ForeColor = &H80000008&
Height = 255
Left = 3240
ScaleHeight = 225
ScaleWidth = 1305
TabIndex = 1
Top = 5280
Width = 1335
Begin VB.Label lblTip
BackStyle = 0 'Transparent
Caption = "Label1"
Height = 375
Left = 0
TabIndex = 2
Top = 0
Width = 1095
End
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access 2000;"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 3240
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 4800
Visible = 0 'False
Width = 2655
End
Begin VB.PictureBox FraZoom
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 495
Left = 2760
ScaleHeight = 465
ScaleWidth = 2865
TabIndex = 5
Top = 840
Width = 2895
Begin VB.TextBox Text1
Appearance = 0 'Flat
BorderStyle = 0 'None
Height = 180
Left = 0
Locked = -1 'True
TabIndex = 6
Text = "比例尺"
Top = 0
Width = 615
End
Begin MO21ScaleBar.ScaleBar PicZoom
Height = 495
Left = 0
TabIndex = 7
Top = 0
Width = 2895
_ExtentX = 5106
_ExtentY = 873
BackColor = 16777215
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 8.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BarColor1 = 255
BarColor2 = 16711680
ScaleText = 0
ScaleBarUnits = 2
ScreenUnits = 1
End
End
Begin MSComDlg.CommonDialog FileDialog
Left = 6000
Top = 4680
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MapObjects2.Map Map1
Height = 3255
Left = 2760
TabIndex = 4
Top = 1440
Width = 5295
_Version = 131072
_ExtentX = 9340
_ExtentY = 5741
_StockProps = 225
BackColor = 16777215
BorderStyle = 1
Appearance = 1
FullRedrawOnPan = -1 'True
Contents = "DDwordPad.frx":1C87C
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H80000004&
Height = 300
Left = 2760
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 16
TabIndex = 3
Top = 4800
Visible = 0 'False
Width = 300
End
Begin VB.Timer tmrTip
Left = 2760
Top = 5160
End
End
Begin VB.Menu mnuPopUp
Caption = "功能"
Visible = 0 'False
Begin VB.Menu mnuZoomIn
Caption = "开窗放大"
End
Begin VB.Menu mnuZoomOut
Caption = "缩小显示"
End
Begin VB.Menu mnuGlobe
Caption = "全图显示"
End
Begin VB.Menu mnuMove
Caption = "平移漫游"
End
Begin VB.Menu mnuline1
Caption = "-"
End
Begin VB.Menu mnuOpenRuler
Caption = "关闭比例尺"
End
Begin VB.Menu mnuline2
Caption = "-"
End
Begin VB.Menu mnuLocator
Caption = "定位..."
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public g_feedback As DragFeedback
Private Sub abProMap_BandUndock(ByVal Band As ActiveBar2LibraryCtl.Band)
frmLayer.Resize
End Sub
Private Sub abProMap_TextChange(ByVal Tool As ActiveBar2LibraryCtl.Tool)
'工具栏文字被改变
Select Case Tool.Name
Case "cmbWork"
'工作层改变
If abProMap.Bands("barMapTip").Visible Then
'若动态提示功能开启,则显示当前层的所有字段供选择
abProMap.Bands("barMapTip").Tools("cmbTipField").CBClear
Dim RecTip As MapObjects2.Recordset
Set RecTip = frmMain.Map1.Layers(GetActiveLayer).Records
Dim lpField As Long
For lpField = 0 To RecTip.TableDesc.FieldCount - 1
If Not bIsExcept(RecTip.TableDesc.FieldName(lpField), _
GetActiveLayer) Then
abProMap.Bands("barMapTip").Tools("cmbTipField").CBAddItem RecTip.TableDesc.FieldName(lpField)
End If
Next lpField
abProMap.Bands("barMapTip").Tools("cmbTipField").CBListIndex = 0
Call abProMap_TextChange(abProMap.Bands("barMapTip").Tools("cmbTipField"))
End If
Case "cmbTipField"
'动态提示的字段改变
Dim LayerX As MapLayer
Set LayerX = frmMain.Map1.Layers(GetActiveLayer)
m_mapTip.SetLayer LayerX, abProMap.Bands("barMapTip").Tools("cmbTipField").text
End Select
End Sub
Private Sub abProMap_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
If bLocked Then Exit Sub
'处理activebar中按钮按下的响应问题
Dim lpointer As Long
Call AssertButton_barStandard
strFunName = Tool.Name
Map1.MousePointer = moArrow
SetTipText "完毕"
'对activebar中的按钮click事件进行相应处理。
Select Case Tool.Name
Case "mLastEx"
If Not LastExtent Is Nothing Then
Set NextExtent = Map1.Extent
Set Map1.Extent = LastExtent
Set LastExtent = Nothing
End If
Case "mNextEx"
If Not NextExtent Is Nothing Then
Set LastExtent = Map1.Extent
Set Map1.Extent = NextExtent
Set NextExtent = Nothing
End If
Case "miExit"
Unload Me
Case "mpPointer"
Tool.Checked = True
Case "mpMove"
'平移漫游
Tool.Checked = True
Map1.MousePointer = moPan
SetTipText "平移漫游中..."
Case "mnumpMove"
abProMap_ToolClick (abProMap.Bands("barStandard").Tools("mpMove"))
'------------------------------------------------------------------------
'放大缩小显示
'------------------------------------------------------------------------
Case "mpZoomin"
'放大
Tool.Checked = True
Map1.MousePointer = moZoomIn
SetTipText "拖动鼠标选择需要放大的区域..."
Case "mnumpZoomin"
Call abProMap_ToolClick(abProMap.Bands("barStandard").Tools("mpZoomin"))
Case "mpZoomout"
'缩小
Tool.Checked = True
Map1.MousePointer = moZoomOut
SetTipText "拖动鼠标选择需要缩小的程度..."
Case "mnumpZoomout"
Call abProMap_ToolClick(abProMap.Bands("barStandard").Tools("mpZoomout"))
Case "mGlobe"
'显示全图
Set LastExtent = Map1.Extent
Map1.Extent = Map1.FullExtent
Case "mZoomLayer"
Set LastExtent = Map1.Extent
Map1.Extent = Map1.Layers(GetActiveLayer).Extent
Case "mpInfo"
'查询当前点的信息
Tool.Checked = True
Map1.MousePointer = moIdentify
SetTipText "请点击图中点查询上面的信息..."
Case "mnumpInfo"
Call abProMap_ToolClick(abProMap.Bands("barStandard").Tools("mpInfo"))
Case "mpSQL"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -