📄 水准平差.frm
字号:
VERSION 5.00
Object = "{628CC7D5-A6CF-11D0-B997-00805F024BFD}#1.0#0"; "VertMenu.ocx"
Object = "{FCD7ED96-3275-41C9-B835-C4C80DC30069}#10.4#0"; "EditGridCtrlLib.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form all
Caption = "Form1"
ClientHeight = 9885
ClientLeft = 165
ClientTop = 855
ClientWidth = 17670
LinkTopic = "Form1"
ScaleHeight = 9885
ScaleWidth = 17670
StartUpPosition = 3 'Windows Default
WindowState = 2 'Maximized
Begin MSComDlg.CommonDialog pingcha
Left = 600
Top = 5520
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComDlg.CommonDialog shuizhunshoubo
Left = 600
Top = 4560
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame2
Height = 11055
Left = 1800
TabIndex = 2
Top = 0
Width = 13335
Begin EditGridCtrlLib.EditGridCtrl grid1
Height = 9135
Left = 0
TabIndex = 9
Top = 0
Width = 12975
_ExtentX = 22886
_ExtentY = 16113
ForeColorSel = -2147483633
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin EditGridCtrlLib.EditGridCtrl grid
Height = 9015
Left = 0
TabIndex = 8
Top = 120
Width = 12975
_ExtentX = 22886
_ExtentY = 15901
ForeColorSel = -2147483633
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Frame Frame1
Caption = "表格操作"
Height = 800
Left = 360
TabIndex = 3
Top = 9480
Width = 11775
Begin VB.CommandButton Command3
Caption = "水准手薄设置"
Height = 375
Left = 8880
TabIndex = 7
Top = 240
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "减少点"
Height = 375
Left = 2520
TabIndex = 6
Top = 240
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "增加点"
Height = 375
Left = 960
TabIndex = 5
Top = 240
Width = 1095
End
Begin VB.CommandButton todo
Caption = "生成平差报告"
Height = 375
Left = 9120
TabIndex = 4
Top = 240
Width = 1335
End
End
Begin VB.Label Label1
Caption = "提示："
Height = 255
Left = 1080
TabIndex = 11
Top = 9240
Width = 615
End
Begin VB.Label Label6
Height = 255
Left = 1920
TabIndex = 10
Top = 9240
Width = 9855
End
End
Begin VertMenu.VerticalMenu VMenu
Height = 10335
Left = 0
TabIndex = 1
Top = 0
Width = 1815
_ExtentX = 3201
_ExtentY = 18230
MenusMax = 3
MenuCaption1 = "水准测量"
MenuItemsMax1 = 3
MenuItemIcon11 = "水准平差.frx":0000
MenuItemCaption11= "新建手薄"
MenuItemIcon12 = "水准平差.frx":031A
MenuItemCaption12= "打开文件"
MenuItemIcon13 = "水准平差.frx":0634
MenuItemCaption13= "保存文件"
MenuCaption2 = "水准平差"
MenuItemsMax2 = 3
MenuItemIcon21 = "水准平差.frx":094E
MenuItemCaption21= "新建文件"
MenuItemIcon22 = "水准平差.frx":0C68
MenuItemCaption22= "导入文件"
MenuItemIcon23 = "水准平差.frx":0F82
MenuItemCaption23= "保存文件"
MenuCaption3 = "大地编程"
MenuItemsMax3 = 7
MenuItemIcon31 = "水准平差.frx":129C
MenuItemCaption31= "斜距改化"
MenuItemIcon32 = "水准平差.frx":15B6
MenuItemCaption32= "高斯平均引数正算"
MenuItemTag32 = "10"
MenuItemIcon33 = "水准平差.frx":18D0
MenuItemCaption33= "高斯平均引数反算"
MenuItemIcon34 = "水准平差.frx":1BEA
MenuItemCaption34= "白塞尔大地主题正算"
MenuItemIcon35 = "水准平差.frx":1F04
MenuItemCaption35= "白塞尔大地主题反算"
MenuItemIcon36 = "水准平差.frx":221E
MenuItemCaption36= "高斯投影正算"
MenuItemIcon37 = "水准平差.frx":2538
MenuItemCaption37= "高斯投影反算"
End
Begin VB.PictureBox picSplitter
BackColor = &H00808080&
FillColor = &H00808080&
Height = 4800
Left = 1800
ScaleHeight = 4740
ScaleMode = 0 'User
ScaleWidth = 156
TabIndex = 0
Top = 240
Visible = 0 'False
Width = 72
End
Begin VB.Image imgSplitter
Height = 7335
Left = 1800
MousePointer = 9 'Size W E
Top = 120
Width = 135
End
Begin VB.Menu file
Caption = "文件"
Begin VB.Menu open
Caption = "打开"
Shortcut = ^O
End
Begin VB.Menu save
Caption = "保存"
Shortcut = ^S
End
Begin VB.Menu saveas
Caption = "另存为"
End
End
End
Attribute VB_Name = "all"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const NAME_COLUMN = 0
Const TYPE_COLUMN = 1
Const SIZE_COLUMN = 2
Const DATE_COLUMN = 3
Public BBmat
Public ro As Integer
Dim CCmat() As Variant
Dim temp() As Variant
Dim ccc As Integer
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Dim mbMoving As Boolean
Const sglSplitLimit = 500
Const grid_rows = 96
Const grid1_rows = 10
Const grid_rows_height = 300
Private Sub Command1_Click()
If grid.Visible = True Then
Call grid.AddItem(" ", grid.RowSel)
grid.RowHeight(grid.RowSel) = 300
ElseIf grid1.Visible = True Then
Call grid1.AddItem(" ", grid1.RowSel)
grid1.RowHeight(grid1.RowSel) = 300
Else
End If
End Sub
Private Sub Command2_Click()
If grid.Visible = True Then
If grid.Rows <= 7 Then
Command2.Enabled = False
Else
Command2.Enabled = True
Call grid.RemoveItem(grid.RowSel)
End If
ElseIf grid1.Visible = True Then
If grid1.Rows <= 4 Then
Command2.Enabled = False
Else
Command2.Enabled = True
Call grid1.RemoveItem(grid1.RowSel)
End If
Else
End If
End Sub
Private Sub Form_Load()
grid.Visible = True
grid1.Visible = False
todo.Visible = False
Dim i As Long
Dim j As Integer
On Error Resume Next
With grid
.Cols = 12
.Rows = grid_rows
.AllowBigSelection = True
.AllowUserResizing = flexResizeColumns
'单元格文字
.TextMatrix(1, 1) = "水准表格"
.TextMatrix(2, 1) = "测站编号"
.TextMatrix(2, 2) = "后尺"
.TextMatrix(2, 3) = "下丝"
.TextMatrix(3, 3) = "上丝"
.TextMatrix(2, 4) = "前尺"
.TextMatrix(2, 5) = "下丝"
.TextMatrix(3, 5) = "上丝"
.TextMatrix(2, 6) = "方向及尺号"
.TextMatrix(2, 7) = "标尺读数"
.TextMatrix(4, 7) = "基本分划"
.TextMatrix(4, 8) = "辅助分划"
.TextMatrix(2, 9) = "基＋K 减辅"
.TextMatrix(2, 10) = "高差中数"
.TextMatrix(4, 2) = "后距"
.TextMatrix(4, 4) = "前距"
.TextMatrix(5, 2) = "视距差d"
.TextMatrix(5, 4) = "视距差累计差D"
.TextMatrix(2, 11) = "备注"
For i = 1 To 30
.TextMatrix(2 + 4 * i, 1) = i '序号列
Next i
' .ColLocked(1) = True
'设置行高
.RowHeight(1) = 500
For j = 2 To grid_rows
.RowHeight(j) = 300
Next j
'设置列宽
.ColWidth(0) = 300
.ColWidth(1) = 800
.ColWidth(2) = 600
.ColWidth(3) = 800
.ColWidth(4) = 600
.ColWidth(5) = 800
.ColWidth(6) = 1000
.ColWidth(7) = 1000
.ColWidth(8) = 1000
.ColWidth(9) = 1000
.ColWidth(10) = 1000
.ColWidth(11) = 3000
For i = 1 To 32
For j = 1 To 11
.row = i
.col = j
' .CellFontBold = True
.CellAlignment = 4
Next j
Next i
.RowLocked(1) = True
.RowLocked(2) = True
.RowLocked(3) = True
.RowLocked(4) = True
.RowLocked(5) = True
.ColInputType(1) = TypeString
For j = 2 To 5
.ColInputType(j) = TypeNumeric
Next j
For j = 7 To 10
.ColInputType(j) = TypeNumeric
Next j
'合并单元格
Call .Merge(1, 1, 1, 11)
Call .Merge(2, 1, 5, 1)
Call .Merge(2, 2, 3, 2)
Call .Merge(2, 4, 3, 4)
Call .Merge(4, 2, 4, 3)
Call .Merge(5, 2, 5, 3)
Call .Merge(4, 4, 4, 5)
Call .Merge(5, 4, 5, 5)
Call .Merge(2, 6, 5, 6)
Call .Merge(4, 7, 5, 7)
Call .Merge(4, 8, 5, 8)
Call .Merge(2, 7, 2, 8)
Call .Merge(2, 9, 5, 9)
Call .Merge(2, 10, 5, 10)
Call .Merge(2, 11, 5, 11)
.Editable = True
End With
With grid1
.Cols = 7
.Rows = grid1_rows
'单元格文字
.TextMatrix(1, 1) = "水准平差计算表格"
.TextMatrix(2, 1) = "测段号"
.TextMatrix(2, 2) = "起点"
.TextMatrix(2, 3) = "终点"
.TextMatrix(2, 4) = "水平距离"
.TextMatrix(2, 5) = "高差"
.TextMatrix(2, 6) = "备注"
' .ColLocked(1) = True
'设置行高
.RowHeight(1) = 500
For j = 2 To grid1_rows
.RowHeight(j) = 300
Next j
'设置列宽
.ColWidth(0) = 300
.ColWidth(1) = 1000
.ColWidth(2) = 1000
.ColWidth(3) = 1200
.ColWidth(4) = 1200
.ColWidth(5) = 3000
.ColWidth(6) = 3000
For i = 1 To 30
For j = 1 To 6
.row = i
.col = j
' .CellFontBold = True
.CellAlignment = 4
Next j
Next i
.RowLocked(1) = True
.RowLocked(2) = True
'第2/9列的输入子控件设置为数值型TextBox
.ColInputType(3) = TypeNumeric
.ColInputType(4) = TypeNumeric
'合并单元格
Call .Merge(1, 1, 1, 6)
.Editable = True
End With
shuizhunshoubo.Filter = "Text File(*.txt)|*.txt|Excel File(*.xls)|*.xls|All File(*.*)|*.*"
shuizhunshoubo.FilterIndex = 1
mDataPath = App.Path & "\示例数据库\"
mMDir mDataPath
mTempPath = App.Path & "\TEMP\"
mMDir mTempPath
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -