📄 frmimageview.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmImageView
Caption = "图象察看"
ClientHeight = 6360
ClientLeft = 60
ClientTop = 345
ClientWidth = 7875
Icon = "frmImageView.frx":0000
LinkTopic = "Form2"
LockControls = -1 'True
ScaleHeight = 6360
ScaleWidth = 7875
StartUpPosition = 3 '窗口缺省
Begin VB.PictureBox picContainer
Align = 2 'Align Bottom
Height = 1860
Left = 0
ScaleHeight = 1800
ScaleWidth = 7815
TabIndex = 4
Top = 4170
Width = 7875
Begin VB.HScrollBar hscImage
Height = 255
Left = 0
Max = 0
TabIndex = 7
TabStop = 0 'False
Top = 1545
Width = 7125
End
Begin VB.PictureBox picImage
BackColor = &H8000000A&
BorderStyle = 0 'None
FillColor = &H8000000A&
Height = 1545
Left = 15
ScaleHeight = 1545
ScaleWidth = 7395
TabIndex = 5
Top = 0
Width = 7395
Begin VB.Image img
Height = 1200
Index = 0
Left = 15
Stretch = -1 'True
Top = 15
Visible = 0 'False
Width = 1605
End
Begin VB.Label lblID
BackStyle = 0 'Transparent
Caption = "1"
Height = 225
Index = 0
Left = 900
TabIndex = 6
Top = 1290
Visible = 0 'False
Width = 690
End
Begin VB.Image imgSound
Height = 240
Index = 0
Left = 60
Picture = "frmImageView.frx":000C
Tag = "NoSound"
Top = 1260
Visible = 0 'False
Width = 240
End
Begin VB.Image imgPrint
Height = 240
Index = 0
Left = 330
Picture = "frmImageView.frx":010E
Top = 1260
Visible = 0 'False
Width = 240
End
End
End
Begin VB.PictureBox picCmd
Align = 4 'Align Right
BorderStyle = 0 'None
Height = 4170
Left = 6405
ScaleHeight = 4170
ScaleWidth = 1470
TabIndex = 0
Top = 0
Width = 1470
Begin VB.CommandButton cmdEdit
Cancel = -1 'True
Caption = "编辑 [F2]"
Height = 390
Left = 120
TabIndex = 8
Top = 1320
Width = 1260
End
Begin VB.CommandButton cmdCancel
Caption = "取消 [ESC]"
Height = 390
Left = 120
TabIndex = 2
Top = 600
Width = 1260
End
Begin VB.CommandButton cmdOK
Caption = "确认 [ENTER]"
Default = -1 'True
Height = 390
Left = 120
TabIndex = 1
Top = 120
Width = 1260
End
End
Begin MSComctlLib.StatusBar sbrPicView
Align = 2 'Align Bottom
Height = 330
Left = 0
TabIndex = 3
Top = 6030
Width = 7875
_ExtentX = 13891
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 8070
Key = "Info"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 5292
MinWidth = 5292
Key = "Pic"
EndProperty
EndProperty
End
Begin VB.Image imgHasSound
Height = 240
Left = 0
Picture = "frmImageView.frx":0258
Top = 0
Visible = 0 'False
Width = 240
End
Begin VB.Image imgHasPrint
Height = 240
Left = 0
Picture = "frmImageView.frx":035A
Top = 285
Visible = 0 'False
Width = 240
End
Begin VB.Image imgPic
Height = 1695
Left = -30
Top = 30
Width = 2055
End
End
Attribute VB_Name = "frmImageView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private CurrentID As Integer
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdEdit_Click()
'----------------
'编辑当前显示的图片
'----------------
On Error Resume Next
If CurrentID = 0 Then Exit Sub
With frmImageEdit
.FileName = img(CurrentID).Tag
.Show
End With
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'-----------------
'处理击键事件
'-----------------
Select Case KeyCode
Case US_KEY_CANCEL
cmdCancel_Click
Case vbKeyReturn
cmdOK_Click
Case Else
End Select
End Sub
Private Sub Form_Load()
MaxForm Me
ShowImage
'根据图形的版本决定是否允许编辑等
If USVersion < USFull Then Me.cmdEdit.Visible = False
'IniUS.LoadFormPlace Me
End Sub
Public Sub ShowImage()
'-----------------
'显示对应的图片
'-----------------
Dim strFile As String
Dim ID As Integer
Dim rsTemp As ADODB.Recordset
'如果报告窗体未加载,则退出
If frmReport.Loaded = False Then Exit Sub
If frmReport.WorkType = "Browse" Or (frmReport.WorkType = "Add" And frmReport.Saved) Then
'如果已经将记录存方到数据库中,则浏览数据库中的记录
Set rsTemp = OpenRS("SELECT * FROM MEDIA WHERE US_NO = '" & frmReport.txtUSNo.Text & "' AND FILE_TYPE = 'IMAGE'", "Data")
ID = 0
If rsTemp.RecordCount > 0 Then
Do While Not rsTemp.EOF
ID = ID + 1
Load img(ID)
With img(ID)
strFile = gstrImageDir & "\" & rsTemp!FILE_NAME
.Tag = strFile
.Picture = LoadPicture(strFile)
.Visible = True
.Left = img(0).Left + (img(0).Width + 30) * (ID - 1)
If picImage.Width < .Width + .Left Then picImage.Width = .Width + .Left
hscImage.Max = ID
hscImage.Min = 1
End With
'显示声音图片
Load imgSound(ID)
With imgSound(ID)
.Left = imgSound(0).Left + (img(0).Width + 30) * (ID - 1)
If Not IsNull(rsTemp!SOUND_FILE_NAME) Then
If rsTemp!SOUND_FILE_NAME <> vbNullString Then
.Visible = True
.Tag = gstrImageDir & rsTemp!SOUND_FILE_NAME
End If
End If
End With
'显示打印图片
Load imgPrint(ID)
With imgPrint(ID)
.Left = imgPrint(0).Left + (img(0).Width + 30) * (ID - 1)
If rsTemp!Print Then
.Visible = True
End If
End With
'显示编号
Load lblID(ID)
With lblID(ID)
.Visible = True
.Caption = Mid(rsTemp!FILE_NAME, 13)
'.Caption = Left(.Caption, Len(.Caption) - 4)
.Left = lblID(0).Left + (img(0).Width + 30) * (ID - 1)
End With
rsTemp.MoveNext
Loop
'自动调入第一幅图片
img_Click (1)
End If
Else
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
IniUS.SaveFormPlace Me
End Sub
Private Sub hscImage_Change()
picImage.Left = -img(hscImage.Value).Left
End Sub
Private Sub hscImage_Scroll()
hscImage_Change
End Sub
Private Sub img_Click(Index As Integer)
Dim i As Integer
'----------------
'设置当前的图片
'----------------
CurrentID = Index
imgPic.Picture = LoadPicture(img(Index).Tag)
'设置imgPic的位置
imgPic.Move (picCmd.Left - imgPic.Width) / 2, (picContainer.Top - imgPic.Height) / 2
For i = 1 To img.UBound: img(i).BorderStyle = 0: Next i
img(Index).BorderStyle = 1
End Sub
Private Sub imgSound_Click(Index As Integer)
'播放该声音
sndPlaySound imgSound(Index).Tag, SND_SYNC
End Sub
Private Sub picContainer_Resize()
hscImage.Width = picContainer.ScaleWidth
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -