📄 testcom.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Object = "{5A187E03-1FE4-11D3-9C2F-000021DF30C1}#1.0#0"; "EditView.ocx"
Object = "{B8C8CCF1-A700-47E0-A6B0-153C7ED98871}#1.0#0"; "MapTree.ocx"
Begin VB.Form TestForm
Caption = "Map测试系统"
ClientHeight = 5850
ClientLeft = 135
ClientTop = 420
ClientWidth = 8085
LinkTopic = "Form1"
ScaleHeight = 5850
ScaleWidth = 8085
StartUpPosition = 2 'CenterScreen
WindowState = 2 'Maximized
Begin MapTree.MapTreeCtrl layerTreeView
Height = 1215
Left = 600
TabIndex = 3
Top = 1560
Width = 2295
_ExtentX = 4048
_ExtentY = 2143
End
Begin EDITVIEWLib.EditView EditView
Height = 4455
Left = 4080
TabIndex = 2
Top = 360
Width = 3855
_Version = 65536
_ExtentX = 6800
_ExtentY = 7858
_StockProps = 0
End
Begin VB.PictureBox Spliter
BackColor = &H8000000C&
BorderStyle = 0 'None
FillColor = &H00808080&
Height = 5448
Left = 3288
MousePointer = 9 'Size W E
ScaleHeight = 5445
ScaleWidth = 105
TabIndex = 1
Top = -12
Width = 108
End
Begin MSComctlLib.StatusBar StatusBar
Align = 2 'Align Bottom
Height = 408
Left = 0
TabIndex = 0
Top = 5448
Width = 8088
_ExtentX = 14261
_ExtentY = 714
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 2469
MinWidth = 2469
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 5292
MinWidth = 5292
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 4233
MinWidth = 4233
Text = "武汉中地软件"
TextSave = "武汉中地软件"
EndProperty
EndProperty
End
Begin ComctlLib.ImageList mnuImageList
Left = 1884
Top = 4560
_ExtentX = 794
_ExtentY = 794
BackColor = 12632256
ImageWidth = 16
ImageHeight = 15
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 7
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "TestCom.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "TestCom.frx":005E
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "TestCom.frx":00BC
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "TestCom.frx":011A
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "TestCom.frx":0178
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "TestCom.frx":01D6
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "TestCom.frx":0234
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mnuPOPMap
Caption = "工程"
Begin VB.Menu mnuNewMap
Caption = "新建工程"
End
Begin VB.Menu mnuOpenMap
Caption = "打开工程"
End
Begin VB.Menu mnuSaveMap
Caption = "保存工程"
End
Begin VB.Menu mnuCloseMap
Caption = "关闭工程"
End
End
Begin VB.Menu mnuPOPMapFun
Caption = "Map函数"
Begin VB.Menu mnuFindFirstNext
Caption = "循环取每个Layer"
End
Begin VB.Menu mnuFindLayer
Caption = "查找特定Layer"
End
End
Begin VB.Menu mnuPOPPrint
Caption = "输出"
Begin VB.Menu mnuPrintFitToPage
Caption = "按照纸张大小设置"
End
Begin VB.Menu mnuPrintAutoCheckPage
Caption = "系统自动检测"
End
Begin VB.Menu mnuPrintSetParam
Caption = "设置输出参数"
End
Begin VB.Menu mnuSep4
Caption = "-"
End
Begin VB.Menu mnuRastTreat
Caption = "光栅化处理"
End
Begin VB.Menu mnuWindowsOut
Caption = "Windows输出"
End
Begin VB.Menu mnuSep5
Caption = "-"
End
Begin VB.Menu mnuCreateGif
Caption = "生成Gif图象"
End
Begin VB.Menu mnuCreateTif
Caption = "生成Tif图象"
End
End
Begin VB.Menu mnuEdit
Caption = "编辑"
Begin VB.Menu mnuAppendlin
Caption = "添加线"
End
End
End
Attribute VB_Name = "TestForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'============================================================================================================
'主要功能:
' 本例主要演示了MapTree控件的使用方法,其中包括工程的建立,读取,存储,同时也包括对工程的文件(Layer)的一些基本操作
' EditView控件进行显示,此外,还包括工程的打印功能.
'============================================================================================================
Public PubComPrj As Map
Public PubMapPrintParam As MapPrintParam
Dim bSpliterPressed As Boolean
Const SPLITWID = 30
Private Sub EditView_MousePosition(ByVal x_Pos As Double, ByVal y_Pos As Double)
On Error Resume Next
Dim str As String
Dim layername As String * 512
Dim layer As Integer
Dim ailin As Integer
Dim fname As String * 256
Dim res As Integer
str = "X坐标:" & Format(x_Pos, "0.000") & " Y坐标:" & Format(y_Pos, "0.000") ' & " 当前图层:" & layer & " (" & layername & ")"
Me.StatusBar.Panels(2).Text = str
End Sub
'自己绘制
Private Sub EditView_MyDraw(ByVal MpDC As Object)
On Error Resume Next
Dim mdc As MapGisDC
Dim mrc As D_Rect
Dim mrcDev As New D_Rect
Dim dot1 As New D_Dot
Dim dot2 As New D_Dot
If PubComPrj Is Nothing Then
Exit Sub
End If
Set mdc = MpDC
Set mrc = PubComPrj.MapRect
dot1.x = 100
dot1.y = 100
dot2.x = 300
dot2.y = 400
'
mdc.LpToDpXY dot1
mdc.LpToDpXY dot2
'
mrcDev.xmin = dot1.x
mrcDev.ymin = dot1.y
mrcDev.xmax = dot2.x
mrcDev.ymax = dot2.y
'
'mdc.RectDev mrcDev.xmin, mrcDev.ymin, mrcDev.xmax, mrcDev.ymax, 6
Set mrcDev = Nothing
Set mrc = Nothing
Set mdc = Nothing
End Sub
Private Sub Form_Load()
On Error Resume Next
'设置图形菜单
SetMenuBitMap
End Sub
Private Sub Form_Resize()
On Error Resume Next
EditView.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
Dim offsetHei
offsetHei = 20
If Me.ScaleHeight - StatusBar.Height - offsetHei <= 0 Then
Exit Sub
End If
layerTreeView.Move 0, 0, Me.ScaleWidth / 4, Me.ScaleHeight - StatusBar.Height - offsetHei
EditView.Move Me.ScaleWidth / 4, 0, Me.ScaleWidth * 3 / 4, Me.ScaleHeight - StatusBar.Height - offsetHei
Spliter.Move Me.ScaleWidth / 4, 0, SPLITWID, Me.ScaleHeight - StatusBar.Height - offsetHei
Print Me.StatusBar.Panels(1).Width = Me.ScaleWidth / 5
Me.StatusBar.Panels(2).Width = Me.ScaleWidth * 3 / 5
Me.StatusBar.Panels(3).Width = Me.ScaleWidth / 5
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim layer As MapLayer
Dim layertype
Dim no As Long
Dim str
If PubComPrj Is Nothing Then
Exit Sub
End If
no = 0
Set layer = PubComPrj.FindFirst(gisFINDTYPE_NOGROUP)
While Not (layer Is Nothing)
no = no + 1
layertype = layer.layertype
If layer.WorkArea.Changed Then
layer.WorkArea.Save
End If
Wend
Set layer = Nothing
Unload Me
End Sub
Private Sub layerTreeView_MouseDblClick(clicklayer As MAPGISLAYERCOMLib.MapLayer)
If Not (clicklayer Is Nothing) Then
MsgBox "layerTreeView_MouseDblClick!" & vbCrLf & "Name=" & clicklayer.WorkArea.Name
End If
End Sub
Private Sub layerTreeView_UpdateMapTree()
'更新显示内容
EditView.UpdateWindow
End Sub
'设置图形菜单
Private Sub SetMenuBitMap()
On Error Resume Next
Dim i%
Dim hMenu, hSubMenu, menuID, x
hMenu = GetMenu(hwnd)
'Map菜单
hSubMenu = GetSubMenu(hMenu, 0)
For i = 1 To 4
menuID = GetMenuItemID(hSubMenu, i - 1)
x = SetMenuItemBitmaps(hMenu, menuID, &H4, mnuImageList.ListImages(i).Picture, mnuImageList.ListImages(i).Picture)
Next
'Draw菜单
hSubMenu = GetSubMenu(hMenu, 1)
menuID = GetMenuItemID(hSubMenu, 0)
x = SetMenuItemBitmaps(hMenu, menuID, 0, mnuImageList.ListImages(6).Picture, 0&)
'Draw菜单
hSubMenu = GetSubMenu(hMenu, 2)
menuID = GetMenuItemID(hSubMenu, 0)
x = SetMenuItemBitmaps(hMenu, menuID, 0, mnuImageList.ListImages(5).Picture, mnuImageList.ListImages(5).Picture)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -