📄 frmmain.frm
字号:
TabIndex = 0
Top = 315
Width = 1215
End
Begin VB.TextBox txtAngle
Height = 315
Left = 720
TabIndex = 1
Top = 645
Width = 1215
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "距离:"
Height = 180
Left = 165
TabIndex = 17
Top = 390
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "角度:"
Height = 180
Left = 165
TabIndex = 16
Top = 720
Width = 540
End
End
Begin VB.Frame frame1
Caption = "起点"
Height = 1200
Left = 225
TabIndex = 12
Top = 165
Width = 2085
Begin VB.TextBox txtBeginX
BackColor = &H00C0E0FF&
Height = 315
Left = 405
TabIndex = 2
Top = 330
Width = 1530
End
Begin VB.TextBox txtBeginY
BackColor = &H00C0E0FF&
Height = 315
Left = 405
TabIndex = 3
Top = 660
Width = 1530
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "X:"
Height = 180
Left = 165
TabIndex = 14
Top = 405
Width = 270
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Y:"
Height = 180
Left = 165
TabIndex = 13
Top = 720
Width = 270
End
End
End
Begin VB.Line lnFirWhite
BorderColor = &H00FFFFFF&
X1 = 75
X2 = 1890
Y1 = 585
Y2 = 585
End
Begin VB.Line lnFirBlack
BorderColor = &H00808080&
X1 = 75
X2 = 1890
Y1 = 705
Y2 = 705
End
Begin VB.Line lnSecWhite
BorderColor = &H00FFFFFF&
X1 = 75
X2 = 1890
Y1 = 675
Y2 = 675
End
Begin VB.Image imgSplitter
Height = 4725
Left = 2715
MouseIcon = "frmMain.frx":BC12
MousePointer = 99 'Custom
Top = 525
Width = 60
End
Begin VB.Line lnLeft
BorderColor = &H00FFFFFF&
X1 = 2880
X2 = 2880
Y1 = 525
Y2 = 5250
End
Begin VB.Line lnSecBlack
BorderColor = &H00808080&
X1 = 75
X2 = 1890
Y1 = 615
Y2 = 615
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuNew
Caption = "新建(&N)"
Shortcut = ^N
End
Begin VB.Menu mnuOpen
Caption = "打开(&O)..."
End
Begin VB.Menu mnuClose
Caption = "关闭(&C)"
End
Begin VB.Menu mnu1
Caption = "-"
End
Begin VB.Menu mnuTidyup
Caption = "数据库整理(&T)"
End
Begin VB.Menu mnuBackup
Caption = "数据库备份(&B)..."
End
Begin VB.Menu mnuRestore
Caption = "数据库恢复(&R)..."
End
Begin VB.Menu mnu7
Caption = "-"
End
Begin VB.Menu mnuSyslog
Caption = "系统日志(&S)..."
End
Begin VB.Menu mnuOption
Caption = "选项(&P)..."
End
Begin VB.Menu mnu2
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "退出(&E)"
Shortcut = ^Q
End
End
Begin VB.Menu mnuEdit
Caption = "编辑(&E)"
Begin VB.Menu mnuFeatureStyle
Caption = "风格(&F)..."
Enabled = 0 'False
End
Begin VB.Menu mnuEditOptions
Caption = "编辑选项(&E)..."
Enabled = 0 'False
End
Begin VB.Menu mnuLayerControl
Caption = "图层控制(&L)..."
End
Begin VB.Menu mnu3
Caption = "-"
End
Begin VB.Menu mnuSelectAll
Caption = "全选(&A)"
Shortcut = ^A
End
Begin VB.Menu mnuDelete
Caption = "删除(&D)"
Shortcut = {DEL}
End
End
Begin VB.Menu mnuView
Caption = "视图(&V)"
Begin VB.Menu mnuShowToolbar
Caption = "显示工具条(&S)"
Checked = -1 'True
End
Begin VB.Menu mnuShowText
Caption = "显示文本标签(&T)"
Checked = -1 'True
End
Begin VB.Menu mnu4
Caption = "-"
End
Begin VB.Menu mnuFullMap
Caption = "全视图(&F)"
Shortcut = {F4}
End
Begin VB.Menu mnuFlush
Caption = "刷新(&R)"
Shortcut = {F5}
End
Begin VB.Menu mnuShowNodes
Caption = "显示端点(&N)"
Checked = -1 'True
Shortcut = {F6}
End
Begin VB.Menu mnuShowLabel
Caption = "显示标签(&L)"
Shortcut = {F7}
End
Begin VB.Menu mnuTX
Caption = "房屋套型标注(&B)"
End
End
Begin VB.Menu mnuTools
Caption = "工具(&T)"
Begin VB.Menu mnuConvertToRegion
Caption = "转成区域(&R)"
End
Begin VB.Menu mnuCombine
Caption = "区域合并(&B)"
End
Begin VB.Menu mnuWall
Caption = "生成墙体(&Q)"
End
Begin VB.Menu mnu5
Caption = "-"
End
Begin VB.Menu mnuMaxRing
Caption = "生成墙体(&M)"
End
Begin VB.Menu mnuTriangle
Caption = "三角形角度计算(&T)..."
End
End
Begin VB.Menu mnuProp
Caption = "属性(&P)"
Begin VB.Menu mnuLayerSet
Caption = "层数设置(&L)..."
End
Begin VB.Menu mnuProperties
Caption = "类型设置(&P)..."
End
Begin VB.Menu mnuProporte
Caption = "分摊(&D)..."
End
Begin VB.Menu mnuWallFT
Caption = "墙体分摊(&W)"
Enabled = 0 'False
End
Begin VB.Menu mnuAttach
Caption = "阳台、阁楼归属(&G)"
End
Begin VB.Menu mnu6
Caption = "-"
End
Begin VB.Menu mnuCalcArea
Caption = "面积计算(&C)"
End
Begin VB.Menu mnuAreaDisp
Caption = "面积计算报表(&A)"
End
Begin VB.Menu mnuPrintMap
Caption = "打印图纸(&E)"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuCalc
Caption = "计算器(&C)..."
End
Begin VB.Menu mnuAbout
Caption = "关于(&A)..."
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
Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const SW_SHOW = 5
'用于记录窗体大小和位置
Dim WorkHeight As Double
Dim WorkWidth As Double
Dim WorkLeft As Double
Dim WorkTop As Double
Dim sglSplitLimit As Double
'Custom Tools
Const ctLineTool = 500 '直线
Const ctPointTool = 501
Const ctPolyLineTool = 502 '折线
Const ctPolygonTool = 503 '区域
Const ctArcTool = 504 '画圆弧
Const ctPointSelectTool = 505 '点选构面
Const ctGenWallTool = 506 '生成墙体
'SHORTEST_DISTANCE是Pixel为Unit的
Dim SHORTEST_DISTANCE As Single
Const SHORTEST_TIME As Long = 150
Const BLOCK_SIZE As Long = 102400
Dim MAP_WIDTH As Long
Dim MAP_HEIGHT As Long
'以下是用来记录PolyLine、Polygon的Points
Dim NewPts As
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -