📄 frmmapsave.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{033364CA-47F9-4251-98A5-C88CD8D3C808}#1.0#0"; "esriControls.olb"
Begin VB.Form frmMapSave
Caption = "图像保存"
ClientHeight = 8205
ClientLeft = 60
ClientTop = 450
ClientWidth = 9375
LinkTopic = "Form1"
ScaleHeight = 8205
ScaleWidth = 9375
StartUpPosition = 2 '屏幕中心
Begin esriControls.LicenseControl LicenseControl1
Left = 1260
OleObjectBlob = "frmMapSave.frx":0000
Top = 2640
End
Begin esriControls.MapControl MapControl1
Height = 4995
Left = 180
OleObjectBlob = "frmMapSave.frx":002D
TabIndex = 0
Top = 120
Width = 9015
End
Begin VB.Frame Frame2
Height = 2115
Left = 120
TabIndex = 5
Top = 5940
Width = 9075
Begin VB.TextBox txtScale
Height = 375
Left = 7560
TabIndex = 23
Top = 780
Width = 1275
End
Begin VB.TextBox txtUnit
Height = 375
Left = 900
TabIndex = 21
Top = 1380
Width = 2715
End
Begin VB.TextBox txtJWD
Height = 375
Left = 900
TabIndex = 19
Top = 780
Width = 2715
End
Begin VB.TextBox txtHcTime
Height = 375
Left = 5040
TabIndex = 17
Top = 780
Width = 1515
End
Begin VB.CommandButton cmd_Exit
Caption = "返回"
Height = 375
Left = 6900
TabIndex = 15
Top = 1500
Width = 915
End
Begin VB.CommandButton cmd_save
Caption = "保存"
Height = 375
Left = 4980
TabIndex = 14
Top = 1500
Width = 915
End
Begin VB.TextBox txtYear
Height = 375
Left = 7560
TabIndex = 13
Top = 180
Width = 1275
End
Begin VB.TextBox txtArea
Height = 375
Left = 5040
TabIndex = 11
Top = 180
Width = 1515
End
Begin VB.TextBox txtNum
Height = 375
Left = 2640
TabIndex = 9
Top = 180
Width = 1275
End
Begin VB.TextBox txtName
Height = 375
Left = 720
TabIndex = 8
Top = 180
Width = 1275
End
Begin VB.Label Label8
Caption = "比例尺"
Height = 375
Left = 6780
TabIndex = 22
Top = 840
Width = 855
End
Begin VB.Label Label7
Caption = "成图单位"
Height = 315
Left = 60
TabIndex = 20
Top = 1440
Width = 735
End
Begin VB.Label Label4
Caption = "图幅左下角经纬度"
Height = 435
Left = 60
TabIndex = 18
Top = 780
Width = 795
End
Begin VB.Label Label3
Caption = "航测时间"
Height = 375
Left = 4140
TabIndex = 16
Top = 840
Width = 735
End
Begin VB.Label Label6
Caption = "成图时间"
Height = 375
Left = 6720
TabIndex = 12
Top = 240
Width = 915
End
Begin VB.Label Label1
Caption = "图幅区域"
Height = 315
Left = 4140
TabIndex = 10
Top = 240
Width = 855
End
Begin VB.Label Label2
Caption = "图号"
Height = 375
Left = 2160
TabIndex = 7
Top = 240
Width = 495
End
Begin VB.Label Label5
Caption = "图名"
Height = 315
Left = 180
TabIndex = 6
Top = 240
Width = 555
End
End
Begin VB.Frame Frame1
Height = 675
Left = 120
TabIndex = 2
Top = 5160
Width = 9075
Begin VB.TextBox txtPathName
Height = 375
Left = 1860
TabIndex = 4
Top = 180
Width = 5715
End
Begin VB.CommandButton cmd_open
Caption = "打开图像"
Height = 315
Left = 480
TabIndex = 3
Top = 240
Width = 915
End
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 7440
TabIndex = 1
Top = 6480
Width = 675
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 8340
Top = 6420
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
End
Attribute VB_Name = "frmMapSave"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private MyMap As New MapIdentify
Private Sub cmd_Exit_Click()
Unload Me
End Sub
Private Sub cmd_open_Click()
Dim sfilename As String
Dim pRasterLayer As IRasterLayer
CommonDialog1.Filter = "tiff (*.tif)|*.tif" '
CommonDialog1.ShowOpen
sfilename = CommonDialog1.FileName
txtPathName.Text = sfilename
Set pRasterLayer = New RasterLayer
pRasterLayer.CreateFromFilePath sfilename
MapControl1.AddLayer pRasterLayer, MapControl1.LayerCount
End Sub
Private Sub cmd_save_Click()
Dim rs As ADODB.Recordset
Dim sql As String
Dim SqlStmt As String
Set rs = New ADODB.Recordset
SqlStmt = "Select * from research "
Set rs = QueryExt(SqlStmt)
Dim strName As String
' Dim i As Integer
' Dim n As Integer
rs.MoveFirst
rs.MoveLast
SqlStmt = "INSERT INTO research(MapName,MapNum,MapPath,MapYear,MapArea,MapHCTime,MapScale,MapUnit,MapJWD) Values('" + "" + _
"','" + "" + "','" + "" + "','" + "" + "','" + "" + "','" + "" + "','" + "" + "','" + "" + "','" + "" + "')"
SQLExt (SqlStmt)
strName = txtName.Text
' rs.MovePrevious
If MyMap.In_DB(strName) = False Then
Dim image_data() As Byte '定义图片保存的变量
Open Trim(txtPathName.Text) For Binary As #1
ReDim image_data(LOF(1) - 1)
Get #1, , image_data
rs("MapName") = txtName.Text
rs("map").AppendChunk image_data
Close #1
rs("mappath") = txtPathName
rs("mapnum") = txtNum.Text
rs("mapyear") = txtYear.Text
rs("maparea") = txtArea.Text
rs("mapJWD") = txtJWD.Text
rs("mapHCTime") = txtHcTime.Text
rs("mapScale") = txtScale.Text
rs("mapUnit") = txtUnit.Text
rs.Update '可能出现保存不成功的现象，所以要考虑可能会出现错误
rs.MoveLast
MsgBox ("保存成功!") '保存成功
txtPathName.Text = ""
txtName.Text = ""
txtNum.Text = ""
txtYear.Text = ""
txtArea.Text = ""
txtJWD.Text = ""
txtHcTime.Text = ""
txtScale.Text = ""
txtUnit.Text = ""
ElseIf MyMap.In_DB(strName) = True Then
MsgBox ("文档已经存在，不能保存，请修改！")
End If
rs.Close '关闭结果集
End Sub
Private Sub Command2_Click()
frmIdentify.Show
frmMapSave.Hide
End Sub
Private Sub Form_Load()
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
cnn.Open Conn
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -