📄 frmphoto.frm
字号:
Height = 210
Left = 120
TabIndex = 26
Top = 690
Width = 420
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "民族"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 25
Top = 1170
Width = 420
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "生日"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 24
Top = 1650
Width = 420
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "籍贯"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 23
Top = 2130
Width = 420
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "学历"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 22
Top = 2610
Width = 420
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "职业"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 21
Top = 3090
Width = 420
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "爱好"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 20
Top = 3570
Width = 420
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "配偶"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 120
TabIndex = 19
Top = 4050
Width = 420
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "民族"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 120
TabIndex = 18
Top = 4530
Width = 420
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "生日"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 120
TabIndex = 17
Top = 5010
Width = 420
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "籍贯"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 120
TabIndex = 16
Top = 5490
Width = 420
End
End
Attribute VB_Name = "FrmPhoto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParan As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Dim sJPGFile As String
Private Sub Cmd清除图片_Click()
'清除图像框中图像
Me.Picture2.Picture = LoadPicture()
Me.Image1.Picture = LoadPicture()
'删除图片文件
If Dir(sJPGFile, 16) <> "" Then Kill sJPGFile
Me.Cmd选择图片.Enabled = True
Me.Cmd清除图片.Enabled = False
End Sub
Private Sub Cmd图片关闭_Click()
Unload Me
End Sub
Private Sub Cmd选择图片_Click()
Dim ImgFileName As String
On Error GoTo wqi127
'open
With Me.CommonDialog1
.DialogTitle = "选择图片"
.InitDir = App.Path
.Filter = "Jpeg file|*.jpg"
.FileName = "*.jpg"
.DefaultExt = ".jpg"
.Flags = cdlOFNExplorer Or cdlOFNLongNames Or cdlOFNFileMustExist Or cdlOFNReadOnly Or cdlOFNHideReadOnly
.ShowOpen
ImgFileName = .FileName
End With
'拷贝文件
'有无Img文件夹
If Dir(App.Path & "\Img", vbDirectory) = "" Then MkDir App.Path & "\Img"
FileCopy ImgFileName, sJPGFile
Me.Picture2.Picture = LoadPicture(sJPGFile)
Me.Picture2.Move 0, 0
Me.Image1.Width = Me.Picture2.Width / Me.Picture2.Height * 1335
Me.Image1.Left = (Me.Picture3.Width - Me.Image1.Width) / 2
Me.Image1.Picture = LoadPicture(sJPGFile)
Me.Cmd选择图片.Enabled = False
Me.Cmd清除图片.Enabled = True
wqi127:
End Sub
Private Sub Form_Load()
Me.Move FrmInfo.Left, FrmInfo.Top, FrmInfo.Width, FrmInfo.Height
'有无Img文件夹
If Dir(App.Path & "\Img", vbDirectory) = "" Then MkDir App.Path & "\Img"
sJPGFile = App.Path & "\Img\" & FrmMain.TreeView1.SelectedItem.Key & ".jpg"
Me.Caption = "图片 - [" & FrmMain.TreeView1.SelectedItem.Text & "]"
Me.Text1 = FrmInfo.Text1
Me.Text2 = FrmInfo.Text2
Me.Text3 = FrmInfo.Text3
Me.Text4 = FrmInfo.Text4
Me.Text5 = FrmInfo.Text5
Me.Text6 = FrmInfo.Text6
Me.Text7 = FrmInfo.Text7
Me.Text8 = FrmInfo.Text8
Me.Text9 = FrmInfo.Text9
Me.Text10 = FrmInfo.Text10
Me.Text11 = FrmInfo.Text11
Me.Text12 = FrmInfo.Text12
'显示图片文件
If Dir(sJPGFile, 32) <> "" Then
Me.Picture2.Picture = LoadPicture(sJPGFile)
Me.Picture2.Move 0, 0
Me.Image1.Width = Me.Picture2.Width / Me.Picture2.Height * 1335
Me.Image1.Left = (Me.Picture3.Width - Me.Image1.Width) / 2
Me.Image1.Picture = LoadPicture(sJPGFile)
Me.Cmd清除图片.Enabled = True
Me.Cmd选择图片.Enabled = False
Else
Me.Cmd清除图片.Enabled = False
Me.Cmd选择图片.Enabled = True
End If
If FrmMain.Tag = 0 Then
Cmd选择图片.Enabled = False
Cmd清除图片.Enabled = False
End If
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
If Me.Width < 2900 Or Me.Height < 2300 Then Exit Sub
Me.Picture1.Move 2400, 120, Me.ScaleWidth - 2520, Me.ScaleHeight - 500
Me.Picture2.Move 0, 0
Me.Picture3.Top = Me.ScaleHeight - 1715
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'移动图片
Dim wqi As Long
If Button = 1 Then
Picture2.MousePointer = 15
ReleaseCapture
wqi = SendMessage(Me.Picture2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
Picture2.MousePointer = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -