📄 frmimage.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmImage
Caption = "图像信息"
ClientHeight = 8265
ClientLeft = 60
ClientTop = 450
ClientWidth = 8055
LinkTopic = "Form1"
ScaleHeight = 8265
ScaleWidth = 8055
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog CD
Left = 555
Top = 7545
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton CancelButton
Caption = "取消"
Height = 495
Left = 5760
TabIndex = 16
Top = 7605
Width = 1815
End
Begin VB.CommandButton OkButton
Caption = "确定"
Height = 495
Left = 3225
TabIndex = 15
Top = 7635
Width = 1815
End
Begin VB.Frame fraPro
Caption = "图像信息"
Height = 7170
Left = 360
TabIndex = 0
Top = 240
Width = 7215
Begin VB.CommandButton cmdOpen
Caption = "....."
Height = 300
Left = 3330
TabIndex = 27
Top = 360
Width = 525
End
Begin VB.TextBox txtMaxY
Height = 330
Left = 4320
TabIndex = 26
Text = "Text5"
Top = 5085
Width = 1710
End
Begin VB.TextBox txtMaxX
Height = 330
Left = 4320
TabIndex = 25
Text = "Text4"
Top = 4395
Width = 1695
End
Begin VB.TextBox txtMinY
Height = 330
Left = 1470
TabIndex = 24
Text = "Text3"
Top = 5070
Width = 1740
End
Begin VB.TextBox txtMinX
Height = 300
Left = 1455
TabIndex = 23
Text = "Text2"
Top = 4440
Width = 1725
End
Begin VB.TextBox txtProj
Height = 285
Left = 4305
TabIndex = 18
Text = "Text1"
Top = 1815
Width = 1740
End
Begin VB.TextBox txtLabel
Height = 1095
Left = 1470
MaxLength = 255
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 14
Text = "frmImage.frx":0000
Top = 5700
Width = 4545
End
Begin VB.TextBox txtIntro
Height = 1290
Left = 1440
MaxLength = 255
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 13
Text = "frmImage.frx":0006
Top = 2760
Width = 4605
End
Begin VB.TextBox txtDate
Height = 285
Left = 1440
MaxLength = 18
TabIndex = 12
Text = "Text4"
Top = 2280
Width = 1695
End
Begin VB.TextBox txtFormat
Height = 285
Left = 1440
MaxLength = 255
TabIndex = 11
Text = "Text3"
Top = 1800
Width = 1695
End
Begin VB.TextBox txtRes
Height = 285
Left = 1440
MaxLength = 18
TabIndex = 10
Text = "Text2"
Top = 1320
Width = 1695
End
Begin VB.ComboBox cboType
Height = 315
Left = 1440
Style = 2 'Dropdown List
TabIndex = 7
Top = 840
Width = 1695
End
Begin VB.TextBox txtName
Height = 285
Left = 1440
MaxLength = 255
ScrollBars = 2 'Vertical
TabIndex = 6
Text = "Text1"
Top = 360
Width = 1695
End
Begin VB.Label Label13
Caption = "MaxY"
Height = 255
Left = 3480
TabIndex = 22
Top = 5100
Width = 810
End
Begin VB.Label Label12
Caption = "MaxX"
Height = 315
Left = 3450
TabIndex = 21
Top = 4470
Width = 885
End
Begin VB.Label Label11
Caption = "MinY"
Height = 285
Left = 405
TabIndex = 20
Top = 5085
Width = 690
End
Begin VB.Label Label10
Caption = "MinX"
Height = 300
Left = 405
TabIndex = 19
Top = 4440
Width = 675
End
Begin VB.Label Label9
Caption = "投 影"
Height = 300
Left = 3360
TabIndex = 17
Top = 1815
Width = 750
End
Begin VB.Label Label8
Caption = "标 签"
Height = 255
Left = 420
TabIndex = 9
Top = 6000
Width = 735
End
Begin VB.Label Label7
Caption = "图像介绍"
Height = 375
Left = 360
TabIndex = 8
Top = 3075
Width = 735
End
Begin VB.Label Label5
Caption = "日 期"
Height = 255
Left = 360
TabIndex = 5
Top = 2280
Width = 735
End
Begin VB.Label Label4
Caption = "格 式"
Height = 375
Left = 360
TabIndex = 4
Top = 1800
Width = 735
End
Begin VB.Label Label3
Caption = "分 辨 率"
Height = 375
Left = 360
TabIndex = 3
Top = 1320
Width = 735
End
Begin VB.Label Label2
Caption = "图像类型"
Height = 255
Left = 360
TabIndex = 2
Top = 840
Width = 855
End
Begin VB.Label Label1
Caption = "图 像 名"
Height = 255
Index = 0
Left = 360
TabIndex = 1
Top = 360
Width = 735
End
End
End
Attribute VB_Name = "frmImage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private OK As Boolean '确定用户按了OK还是CANCEL按钮
Private m_obj As clsImage '数据对象，用来存贮用户输入数据
Public m_ViewType As gxcViewType '显示状态，指添加还是修改
Private m_TypeID As Long '图像类型
Public path As String
Public sDir As String
Public sDirectory As String
Public sName As String
Public sIName As String
'打开对话框，并传入用户输入数据
Public Function ShowDlg(ByRef obj As Object, ByVal eViewType As gxcViewType, Optional nTypeID As Long = -1) As Boolean
'保存数据
Set m_obj = obj
m_ViewType = eViewType
If nTypeID = -1 And (Not m_obj Is Nothing) Then
m_TypeID = m_obj.TypeID
Else
m_TypeID = nTypeID
End If
'根据新增、编辑或查看设置现实内容
SetStatus
'显示对话框
OK = False
Me.Show vbModal
If OK = False Then
ShowDlg = False
Exit Function
End If
'保存数据
Set obj = m_obj
ShowDlg = True
Unload Me
End Function
'根据是 新增 还是 修改，确定显示内容
Private Sub SetStatus()
Call SetDefaultvalue
Select Case m_ViewType
Case vtadd
CancelButton.Visible = True
OKButton.Caption = "确定"
Case vtModify
CancelButton.Visible = True
OKButton.Caption = "保存"
End Select
End Sub
Private Sub SetDefaultvalue()
Dim ctl As Control
Dim i As Integer
'如果是新增，则清空所有文本框
'此处判断m_obj为空与判断m_viewtype=vtadd等效
If m_obj Is Nothing Then
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Text = ""
End If
Next
Else '用传入对象的值更新数据
With m_obj
txtName.Text = .IName
txtLabel.Text = .Label
txtDate.Text = CStr(.IDate)
txtMinX.Text = CStr(.MinX)
txtMinY.Text = CStr(.MinY)
txtMaxX.Text = CStr(.MaxX)
txtMaxY.Text = CStr(.MaxY)
txtRes.Text = .Res
txtProj.Text = .Proj
txtIntro.Text = .Introduce
txtFormat.Text = .IFormat
For i = 0 To cboType.ListCount - 1
If cboType.ItemData(i) = m_TypeID Then
cboType.ListIndex = i
Exit For
End If
Next i
End With
End If
End Sub
Private Sub cmdOpen_Click()
Dim str As String
Dim pos As Long
Dim ppath As String
Dim RSImage As Image
Dim file As String
CD.CancelError = True
On Error Resume Next
CD.DialogTitle = "选择图像"
CD.Filter = "bmp(*.bmp)|*.bmp|gif(*.gif)|*.gif|jpg(*.jpg)|*.jpg|tif(*.tif)|*.tif"
CD.FileName = ""
CD.ShowOpen
If Err.Number = 32755 Then Exit Sub
path = CD.FileName
str = StrReverse(path)
pos = InStr(str, "\")
ppath = StrReverse(Mid(str, pos))
txtName.Text = StrReverse(Left(str, pos - 1))
txtName.Enabled = False
sName = txtName.Text
Dim obj As New RSImageInfo
If obj.Open(path) = True Then
txtRes.Text = obj.ResolutionH
txtMinX.Text = obj.XMin
txtMinY.Text = obj.YMin
txtMaxX.Text = obj.XMax
txtMaxY.Text = obj.YMax
txtFormat.Text = obj.DataSize
If obj.IsProjected = True Then
txtProj.Text = obj.SensorType
End If
End If
End Sub
Private Sub Form_Load()
Dim opIType As New clsOpIType
opIType.FillCombo cboType
End Sub
'确定按钮处理事件
Private Sub OKButton_Click()
OK = True
'检测输入的有效性
If Not CheckValid Then Exit Sub
'如果是新增状态，则初始化一个数据对象
If m_ViewType = vtadd Then Set m_obj = New clsImage
cmdOpen.Visible = True
'保存用户输入
SaveValue
Me.Hide
End Sub
'检测输入有效性
Private Function CheckValid() As Boolean
If txtName.Text = "" Or txtIntro.Text = "" Then
MsgBox "请填写完毕以上各项内容"
CheckValid = False
Exit Function
End If
If cboType.Text = "" Then
MsgBox "请填写完毕以上各项内容"
CheckValid = False
Exit Function
End If
CheckValid = True
End Function
'保存数据
Private Sub SaveValue()
'给 成员变量 对象赋值
With m_obj
.IName = RealString((txtName.Text))
.Label = RealString((txtLabel.Text))
.Introduce = RealString((txtIntro.Text))
.Res = RealString((txtRes.Text))
.Proj = RealString((txtProj.Text))
.IDate = CDate(txtDate.Text)
.IFormat = txtFormat.Text
.MinX = CDbl(txtMinX.Text)
.MaxX = CDbl(txtMaxX.Text)
.MinY = CDbl(txtMinY.Text)
.MaxY = CDbl(txtMaxY.Text)
.TypeID = cboType.ItemData(cboType.ListIndex)
.TypeName = cboType.Text
sDir = .TypeName
sIName = .IName
sDirectory = App.path & "\图像\" & sDir
sDirectory = CheckPath(sDirectory)
End With
End Sub
'取消按钮处理事件
Private Sub CancelButton_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -