📄 picturebox.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
AutoRedraw = -1 'True
Caption = "PictureBox"
ClientHeight = 4755
ClientLeft = 165
ClientTop = 735
ClientWidth = 6360
Icon = "PictureBox.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4755
ScaleWidth = 6360
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CommonDialog1
Left = 360
Top = 3480
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.PictureBox Picture3
AutoRedraw = -1 'True
AutoSize = -1 'True
Height = 735
Left = 240
ScaleHeight = 675
ScaleWidth = 675
TabIndex = 12
Top = 2160
Visible = 0 'False
Width = 735
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Height = 3975
Left = 1080
ScaleHeight = 3915
ScaleWidth = 5115
TabIndex = 0
Top = 0
Width = 5175
End
Begin VB.PictureBox Picture2
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 660
Left = 1440
Picture = "PictureBox.frx":030A
ScaleHeight = 630
ScaleWidth = 3900
TabIndex = 1
Top = 4080
Width = 3930
Begin VB.Label Label1
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Height = 375
Left = 90
TabIndex = 2
Top = 120
Width = 300
End
End
Begin VB.Label Label3
Height = 375
Left = 120
TabIndex = 11
Top = 3600
Width = 975
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 380
Index = 7
Left = 505
TabIndex = 10
Top = 1170
Width = 380
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 380
Index = 6
Left = 120
TabIndex = 9
Top = 1170
Width = 380
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 380
Index = 5
Left = 505
TabIndex = 8
Top = 780
Width = 375
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 380
Index = 4
Left = 120
TabIndex = 7
Top = 789
Width = 380
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 375
Index = 3
Left = 505
TabIndex = 6
Top = 390
Width = 380
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 380
Index = 2
Left = 120
TabIndex = 5
Top = 390
Width = 380
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 380
Index = 1
Left = 505
TabIndex = 4
Top = 0
Width = 380
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 380
Index = 0
Left = 120
TabIndex = 3
Top = 0
Width = 380
End
Begin VB.Image Image1
Height = 1545
Left = 120
Picture = "PictureBox.frx":8344
Top = 0
Width = 765
End
Begin VB.Menu MFile
Caption = "文件(&F)"
Index = 1
Begin VB.Menu MNew
Caption = "新建(&N)"
Index = 1
Shortcut = ^N
End
Begin VB.Menu MSave
Caption = "保存(&S)"
Shortcut = ^S
End
Begin VB.Menu fmenusp
Caption = "-"
End
Begin VB.Menu MExit
Caption = "退出(&X)"
Index = 2
Shortcut = ^X
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim i, drawact As Integer
Dim canline, canpen, canrubber, canenlarge, canellipse, canrectangle, canflood, canget, canbrush As Boolean
Dim x0, y0, xnow, ynow, radius0, radius As Single
Dim Filename As String
Private Sub Form_Load()
' 初始化图片框的大小和AutoRedraw属性和窗体的标题
Picture3.Width = Picture1.Width
Picture3.Height = Picture1.Height
Picture1.AutoRedraw = True
Picture3.AutoRedraw = True
Picture1.Picture = LoadPicture()
Filename = "Untitled"
Form1.Caption = Filename
End Sub
Private Sub Label2_Click(Index As Integer)
' 选择某项操作时，将其下凹看上去像是被按下去的
For i = 0 To Label2.Count - 1
Label2(i).BorderStyle = 0
Next
Label2(Index).BorderStyle = 1
drawact = Index
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' 当鼠标按下时，对于选择不同的工具执行不同的操作
Select Case drawact
' 橡皮
Case 0
canrubber = True
Picture1.CurrentX = X: Picture1.CurrentY = Y
Picture1.DrawMode = 13
Picture1.DrawWidth = 7
' 直线
Case 1
canline = True
x0 = X: y0 = Y
xnow = X: ynow = Y
Picture1.DrawMode = 7
Picture1.DrawWidth = 1
' 矩形
Case 2
canrectangle = True
x0 = X: y0 = Y
xnow = X: ynow = Y
Picture1.DrawMode = 7
Picture1.DrawWidth = 2
' 椭圆
Case 3
canellipse = True
x0 = X: y0 = Y
xnow = X: ynow = Y
Picture1.DrawMode = 7
Picture1.DrawWidth = 1
' 铅笔
Case 4
canpen = True
Picture1.CurrentX = X: Picture1.CurrentY = Y
Picture1.DrawMode = 13
' 刷子
Case 5
canbrush = True
Picture1.CurrentX = X: Picture1.CurrentY = Y
Picture1.DrawMode = 13
Picture1.DrawWidth = 5
' 油漆桶
Case 6
Picture1.BackColor = Label1.BackColor
' 放大镜
Case 7
canenlarge = True
x0 = X: y0 = Y
xnow = X: ynow = Y
Picture1.DrawMode = 7
Picture1.DrawWidth = 1
End Select
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' 在标签中显示当前鼠标在画板中的位置
Label3.Caption = "X: " + CStr(X) + Chr(13) + Chr(10) + "Y: " + CStr(Y)
' 当鼠标移动时，对于选择不同的工具执行不同的操作
Select Case drawact
' 橡皮
Case 0
If canrubber Then
Picture1.Line -(X, Y), vbWhite
End If
' 直线
Case 1
If canline Then
Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor)
Picture1.Line (x0, y0)-(X, Y), Not (Picture1.ForeColor)
xnow = X: ynow = Y
End If
' 矩形
Case 2
If canrectangle Then
Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
Picture1.Line (x0, y0)-(X, Y), Not (Picture1.ForeColor), B
xnow = X: ynow = Y
End If
' 椭圆
Case 3
radius0 = Sqr((xnow - x0) ^ 2 + (ynow - y0) ^ 2)
radius = Sqr((X - x0) ^ 2 + (Y - y0) ^ 2)
If canellipse Then
Picture1.Circle (x0, y0), radius0, Not (Picture1.ForeColor)
Picture1.Circle (x0, y0), radius, Not (Picture1.ForeColor)
xnow = X: ynow = Y
End If
' 铅笔
Case 4
If canpen Then
Picture1.Line -(X, Y), Picture1.ForeColor
End If
' 刷子
Case 5
If canbrush Then
Picture1.Line -(X, Y), Picture1.ForeColor
End If
' 油漆桶
Case 6
' do nothing
' 放大镜
Case 7
If canenlarge Then
Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
Picture1.Line (x0, y0)-(X, Y), Not (Picture1.ForeColor), B
xnow = X: ynow = Y
End If
End Select
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' 当鼠标放开时，对于选择不同的工具执行不同的操作
Select Case drawact
Case 1
canline = False
Picture1.Line (x0, y0)-(xnow, ynow)
Picture1.DrawMode = 13
Picture1.Line (x0, y0)-(xnow, ynow), Picture1.ForeColor
Case 2
canrectangle = False
Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
Picture1.DrawMode = 13
Picture1.Line (x0, y0)-(xnow, ynow), Picture1.ForeColor, B
Case 3
canellipse = False
Picture1.Circle (x0, y0), radius, Not (Picture1.ForeColor)
Picture1.DrawMode = 13
Picture1.Circle (x0, y0), radius, Picture1.ForeColor
Case 4
canpen = False
Case 5
canbrush = False
Case 7
canenlarge = False
Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
If (xnow - x0) * (ynow - y0) <> 0 Then
Picture3.PaintPicture Picture1.Image, 0, 0, Picture3.Width, Picture3.Height, x0, y0, (xnow - x0), (ynow - y0)
Picture1.PaintPicture Picture3.Image, 0, 0
End If
End Select
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' 通过point方法拾取颜色，并设定为前景色
Picture1.ForeColor = Picture2.Point(X, Y)
Label1.BackColor = Picture2.Point(X, Y)
End Sub
Private Sub MNew_Click(Index As Integer)
' 新建一个图画
Picture1.Picture = LoadPicture()
Filename = "Untitled"
Form1.Caption = Filename
End Sub
Private Sub MSave_Click()
' 设置过滤器
CommonDialog1.Filter = "bmp文件|*.bmp|所有文件|*.*"
' 设置缺省过滤器
CommonDialog1.FilterIndex = 2
If Filename = "Untitled" Then
'如果文件尚未命名，则显示保存对话框
CommonDialog1.ShowSave
Filename = CommonDialog1.Filename
If Filename <> "" Then
SavePicture Picture1.Image, Filename
End If
Else
'否则直接保存
SavePicture Picture1.Image, Filename
End If
Form1.Caption = Filename
End Sub
Private Sub MExit_Click(Index As Integer)
' 退出程序
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -