📄 画图.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "模拟Windows画图"
ClientHeight = 5445
ClientLeft = 165
ClientTop = 735
ClientWidth = 7815
LinkTopic = "Form1"
ScaleHeight = 5445
ScaleWidth = 7815
StartUpPosition = 3 '窗口缺省
Begin VB.PictureBox Picture2
Height = 4692
Left = 0
ScaleHeight = 4635
ScaleWidth = 810
TabIndex = 10
Top = 0
Width = 876
Begin VB.PictureBox Picture7
Height = 912
Left = 72
ScaleHeight = 855
ScaleWidth = 600
TabIndex = 16
Top = 2124
Width = 660
Begin VB.OptionButton Option8
Height = 444
Left = 0
Picture = "画图.frx":0000
Style = 1 'Graphical
TabIndex = 22
ToolTipText = "实心"
Top = 432
Width = 624
End
Begin VB.OptionButton Option7
Height = 444
Left = 0
Picture = "画图.frx":15A2
Style = 1 'Graphical
TabIndex = 21
ToolTipText = "空心"
Top = 0
Width = 624
End
End
Begin VB.PictureBox Picture6
Height = 1056
Left = 72
ScaleHeight = 990
ScaleWidth = 600
TabIndex = 15
Top = 972
Width = 660
Begin VB.OptionButton Option6
Height = 264
Index = 3
Left = 0
Picture = "画图.frx":2B44
Style = 1 'Graphical
TabIndex = 20
Top = 756
Width = 624
End
Begin VB.OptionButton Option6
Height = 264
Index = 2
Left = 0
Picture = "画图.frx":3A86
Style = 1 'Graphical
TabIndex = 19
Top = 504
Width = 624
End
Begin VB.OptionButton Option6
Height = 264
Index = 1
Left = 0
Picture = "画图.frx":4B48
Style = 1 'Graphical
TabIndex = 18
Top = 252
Width = 624
End
Begin VB.OptionButton Option6
Height = 264
Index = 0
Left = 0
Picture = "画图.frx":59E2
Style = 1 'Graphical
TabIndex = 17
Top = 0
Width = 624
End
End
Begin VB.OptionButton Option1
Height = 408
Left = 0
Picture = "画图.frx":6528
Style = 1 'Graphical
TabIndex = 14
ToolTipText = "刷子"
Top = 0
Width = 408
End
Begin VB.OptionButton Option2
Height = 408
Left = 396
Picture = "画图.frx":6E52
Style = 1 'Graphical
TabIndex = 13
ToolTipText = "直线"
Top = 0
Width = 408
End
Begin VB.OptionButton Option3
Height = 408
Left = 0
Picture = "画图.frx":768C
Style = 1 'Graphical
TabIndex = 12
ToolTipText = "椭圆"
Top = 396
Width = 408
End
Begin VB.OptionButton Option4
Height = 408
Left = 396
Picture = "画图.frx":827E
Style = 1 'Graphical
TabIndex = 11
ToolTipText = "方框"
Top = 396
Width = 408
End
End
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
Height = 4692
Left = 900
ScaleHeight = 4635
ScaleWidth = 7725
TabIndex = 3
Top = 0
Width = 7788
End
Begin VB.PictureBox Picture3
Height = 732
Left = 0
ScaleHeight = 675
ScaleWidth = 7755
TabIndex = 0
Top = 4716
Width = 7812
Begin VB.OptionButton Option5
BackColor = &H00FF00FF&
Height = 336
Index = 5
Left = 1584
Style = 1 'Graphical
TabIndex = 9
Top = 324
Width = 336
End
Begin VB.OptionButton Option5
BackColor = &H0000FFFF&
Height = 336
Index = 4
Left = 1260
Style = 1 'Graphical
TabIndex = 8
Top = 324
Width = 336
End
Begin VB.OptionButton Option5
BackColor = &H00000000&
Height = 336
Index = 3
Left = 936
Style = 1 'Graphical
TabIndex = 7
Top = 324
Width = 336
End
Begin VB.OptionButton Option5
BackColor = &H00FF0000&
Height = 336
Index = 2
Left = 1584
Style = 1 'Graphical
TabIndex = 6
Top = 0
Width = 336
End
Begin VB.OptionButton Option5
BackColor = &H0000C000&
Height = 336
Index = 1
Left = 1260
Style = 1 'Graphical
TabIndex = 5
Top = 0
Width = 336
End
Begin VB.OptionButton Option5
BackColor = &H000000FF&
ForeColor = &H00000000&
Height = 336
Index = 0
Left = 936
Style = 1 'Graphical
TabIndex = 4
Top = 0
Width = 336
End
Begin VB.PictureBox Picture4
BackColor = &H00FFFFFF&
Height = 732
Left = 0
ScaleHeight = 675
ScaleWidth = 870
TabIndex = 1
Top = 0
Width = 936
Begin VB.PictureBox Picture5
BackColor = &H00000000&
Height = 372
Left = 144
ScaleHeight = 315
ScaleWidth = 555
TabIndex = 2
Top = 144
Width = 612
End
End
End
Begin VB.Menu MnuPicture
Caption = "图像"
Begin VB.Menu MnuClear
Caption = "清除"
End
End
Begin VB.Menu MnuView
Caption = "查看"
Begin VB.Menu MnuBox
Caption = "工具箱"
Checked = -1 'True
End
Begin VB.Menu MnuColor
Caption = "调色版"
Checked = -1 'True
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 xStart As Single, yStart As Single, flag As Integer
Dim xOld As Single, yOld As Single
Dim r As Single, r1 As Single, r2 As Single, rOld As Single, rate As Single
Dim xx As Single, yy As Single
Private Sub Form_Load()
Option2.Value = True
Option5(3).Value = True
Option6(0).Value = True
Option7.Value = True
End Sub
Private Sub MnuBox_Click()
MnuBox.Checked = Not MnuBox.Checked
Picture2.Visible = MnuBox.Checked
End Sub
Private Sub MnuColor_Click()
MnuColor.Checked = Not MnuColor.Checked
Picture3.Visible = MnuColor.Checked
End Sub
Private Sub MnuClear_Click()
Picture1.Cls
End Sub
Private Sub Option1_Click()
flag = 1
End Sub
Private Sub Option2_Click()
flag = 2
End Sub
Private Sub Option3_Click()
flag = 3
End Sub
Private Sub Option4_Click()
flag = 4
End Sub
Private Sub Option5_Click(Index As Integer)
Picture5.BackColor = Option5(Index).BackColor
Picture1.ForeColor = Picture5.BackColor
Picture1.FillColor = Picture5.BackColor
End Sub
Private Sub Option6_Click(Index As Integer)
Select Case Index
Case 0
Picture1.DrawWidth = 1
Case 1
Picture1.DrawWidth = 2
Case 3
Picture1.DrawWidth = 3
Case 4
Picture1.DrawWidth = 4
End Select
End Sub
Private Sub Option7_Click()
Picture1.FillColor = Picture5.BackColor
Picture1.FillStyle = 1
End Sub
Private Sub Option8_Click()
Picture1.FillColor = Picture5.BackColor
Picture1.FillStyle = 0
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
xStart = X
yStart = Y
xOld = xStart
yOld = yStart
rOld = 0
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Select Case flag
Case 1
Picture1.DrawMode = 13
Picture1.Line (xOld, yOld)-(X, Y)
xOld = X
yOld = Y
Case 2
Picture1.DrawMode = 7
Picture1.Line (xStart, yStart)-(xOld, yOld), Picture1.BackColor
Picture1.Line (xStart, yStart)-(X, Y), Picture1.BackColor
Picture1.Line (xStart, yStart)-(xOld, yOld)
Picture1.Line (xStart, yStart)-(X, Y)
xOld = X
yOld = Y
Case 3
Picture1.DrawMode = 7
If rOld <> 0 Then
Picture1.Circle (xx, yy), rOld, Picture1.BackColor, , , rate
Picture1.Circle (xx, yy), rOld, , , , rate
End If
xx = (X - xStart) / 2 + xStart
yy = (Y - yStart) / 2 + yStart
r1 = Abs(X - xStart) / 2
r2 = Abs(Y - yStart) / 2
r = IIf(r1 > r2, r1, r2)
If X - xStart = 0 Then
rate = 1
Else
rate = Abs((Y - yStart) / (X - xStart))
End If
Picture1.Circle (xx, yy), r, Picture1.BackColor, , , rate
Picture1.Circle (xx, yy), r, , , , rate
rOld = r
Case 4
Picture1.DrawMode = 7
Picture1.Line (xStart, yStart)-(xOld, yOld), Picture1.BackColor, B
Picture1.Line (xStart, yStart)-(X, Y), Picture1.BackColor, B
Picture1.Line (xStart, yStart)-(xOld, yOld), , B
Picture1.Line (xStart, yStart)-(X, Y), , B
xOld = X
yOld = Y
End Select
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
DrawMode = 13
Select Case flag
Case 2
Picture1.DrawMode = 13
Picture1.Line (xStart, yStart)-(X, Y)
Case 3
Picture1.DrawMode = 13
If rOld <> 0 Then
Picture1.Circle (xx, yy), r, , , , rate
End If
Case 4
Picture1.DrawMode = 13
Picture1.Line (xStart, yStart)-(X, Y), , B
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -