📄 design.frm
字号:
End
Begin VB.PictureBox Picture1
Height = 495
Index = 8
Left = 120
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 28
Top = 2160
Width = 495
End
Begin VB.PictureBox Picture1
Height = 495
Index = 9
Left = 600
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 27
Top = 2160
Width = 495
End
Begin VB.PictureBox Picture1
Height = 495
Index = 10
Left = 120
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 26
Top = 2640
Width = 495
End
Begin VB.PictureBox Picture1
Height = 495
Index = 11
Left = 600
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 25
Top = 2640
Width = 495
End
Begin VB.PictureBox Picture1
Height = 495
Index = 12
Left = 120
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 24
Top = 3120
Width = 495
End
Begin VB.PictureBox Picture1
Height = 495
Index = 15
Left = 600
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 5
Top = 3600
Width = 495
End
Begin VB.PictureBox Picture1
Height = 495
Index = 14
Left = 120
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 4
Top = 3600
Width = 495
End
Begin VB.PictureBox Picture1
Height = 495
Index = 13
Left = 600
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 3
Top = 3120
Width = 495
End
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "对比区域："
Height = 180
Left = 6840
TabIndex = 38
Top = 120
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "操作区域："
Height = 180
Left = 1560
TabIndex = 37
Top = 120
Width = 900
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private bybits(1 To 16) As Byte
Private hBitmap As Long, hBrush As Long
Private hDesktopWnd As Long
Private tmpPic As Picture
Const pi = 3.141592653589
Dim color As Long, border As Integer, pen As Boolean
Private blf As Integer
Private yk, yg As Long
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
pen = True
Case 1
pen = False
Case 2
Cls
pen = True
border = 1
color = vbBlack
End Select
End Sub
Private Sub Form_Load()
border = 1
pen = True
For i = 0 To 15
Picture1(i).BackColor = QBColor(i)
Next i
blf = 100
Picture3.AutoSize = True
yk = Picture3.Width
yg = Picture3.Height
Call initwin
Picture3.ScaleMode = 3 '设为Pixel
Picture3.AutoRedraw = True '设定所有Pixel的改变不立即在pictureBox上显示
Set tmpPic = Picture3.Picture
End Sub
Private Sub picture3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Picture3.CurrentX = x
Picture3.CurrentY = y
If Not pen Then MousePointer = 12 Else MousePointer = 0
End If
End Sub
Private Sub picture3_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If pen And Button = 1 Then
DrawWidth = border
Picture3.Line -(x, y), color
End If
If Not pen And Button = 1 Then
DrawWidth = 10
Picture3.Line -(x, y), BackColor
End If
End Sub
Private Sub picture3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
MousePointer = 0
End Sub
Private Sub Picture1_Click(Index As Integer)
color = QBColor(Index)
pen = True
End Sub
Private Sub Picture2_Click(Index As Integer)
Select Case Index
Case 0
Picture3.DrawWidth = 1
Case 1
Picture3.DrawWidth = 2
Case 2
Picture3.DrawWidth = 4
Case 3
Picture3.DrawWidth = 8
End Select
border = Picture3.DrawWidth
pen = True
End Sub
Sub initwin() '画面和滚动条重新设置
Picture3.Move 0, 0
VScroll1.Height = Picture4.Height '设置滚动条最大值
HScroll1.Visible = (Picture4.Width < Picture3.Width)
HScroll1.Max = (Picture3.Width - Picture4.Width)
VScroll1.Visible = (Picture4.Height < Picture3.Height)
VScroll1.Max = (Picture3.Height - Picture4.Height)
End Sub
Sub turnsize(bl1 As Variant) '画出缩放
Dim bl As Variant
bl = bl1 / 100
Form1.MousePointer = vbHourglass
Picture3.Width = yk * bl '设置图片缩放、放大尺寸
Picture3.Height = yg * bl
Picture3.Refresh
'利用PaintPicture重绘图片
Picture3.PaintPicture Picture3.Picture, 0, 0, yk * bl, yg * bl, 0, 0, yk, yg
Call initwin
If VScroll1.Visible Then
VScroll1.Value = IIf(VScroll1.Value * bl > VScroll1.Max, VScroll1.Max, VScroll1.Value * bl)
End If
If HScroll1.Visible Then
VScroll1.Value = IIf(HScroll1.Value * bl > HScroll1.Max, HScroll1.Max, HScroll1.Value * bl)
End If
Form1.MousePointer = vbDefault
End Sub
Private Sub Command2_Click(Index As Integer)
Select Case Index
Case 0
CommonDialog1.FileName = ""
CommonDialog1.Filter = "Picture File(*.BMP;*.GIF;*.JPG)|*.BMP;*.GIF;*.JPG"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
Picture3.Picture = LoadPicture(CommonDialog1.FileName)
Picture5.Picture = LoadPicture(CommonDialog1.FileName)
End If
HScroll1.Visible = (Picture4.Width < Picture3.Width)
HScroll1.Max = (Picture3.Width - Picture4.Width)
VScroll1.Visible = (Picture4.Height < Picture3.Height)
VScroll1.Max = (Picture3.Height - Picture4.Height)
Case 1 '刷新图片
Picture3.Cls
Case 2 '放大图片
If blf < 150 Then
blf = blf + 25
Call turnsize(blf)
End If
Case 3 '缩小图片
If blf > 30 Then
blf = blf - 25
Call turnsize(blf)
End If
Case 4 '向右旋转图片
Dim x As Double, y As Double
Dim X0 As Double, Y0 As Double
Dim Xc As Double, Yc As Double
Dim Xn As Double, Yn As Double
Dim K As Single, pcolor As Long
Static du As Integer
du = du - 90
Picture3.Picture = LoadPicture("")
T = W: W = H: H = T
Picture3.Width = Picture4.Width
Picture3.Height = Picture4.Height
K = du * pi / 180
Picture5.ScaleMode = vbPixels
Picture3.ScaleMode = vbPixels
For x = 0 To Picture5.ScaleWidth - 1
Xc = x - Picture5.ScaleWidth \ 2
For y = 0 To Picture5.ScaleHeight - 1
Yc = y - Picture5.ScaleHeight \ 2
X0 = Xc * Cos(-K) + Yc * Sin(-K)
Y0 = Yc * Cos(-K) - Xc * Sin(-K)
Xn = X0 + Picture3.ScaleWidth \ 2
Yn = Y0 + Picture5.ScaleHeight \ 2
pcolor = Picture5.Point(x, y)
Picture3.PSet (Xn, Yn), pcolor
Next y
Next x
Case 5 '向右旋转图片
du = du + 90
Picture3.Picture = LoadPicture("")
T = W: W = H: H = T
Picture3.Width = Picture4.Width
Picture3.Height = Picture4.Height
K = du * pi / 180
Picture5.ScaleMode = vbPixels
Picture3.ScaleMode = vbPixels
For x = 0 To Picture5.ScaleWidth - 1
Xc = x - Picture5.ScaleWidth \ 2
For y = 0 To Picture5.ScaleHeight - 1
Yc = y - Picture5.ScaleHeight \ 2
X0 = Xc * Cos(-K) + Yc * Sin(-K)
Y0 = Yc * Cos(-K) - Xc * Sin(-K)
Xn = X0 + Picture3.ScaleWidth \ 2
Yn = Y0 + Picture5.ScaleHeight \ 2
pcolor = Picture5.Point(x, y)
Picture3.PSet (Xn, Yn), pcolor
Next y
Next x
Case 6 '使图片变暗
Dim ary
Dim i As Long
ary = Array(&H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, _
&H0, &HAA, &H0, &H55, &H0, &HAA, &H0)
For i = 1 To 16
bybits(i) = ary(i - 1)
Next i
hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
hBrush = CreatePatternBrush(hBitmap)
Picture3.ForeColor = RGB(0, 0, 0)
Picture3.BackColor = RGB(255, 255, 255)
Picture3.ScaleMode = 3
Dim rop As Long, res As Long
Dim hdc5 As Long, width5 As Long, height5 As Long
hdc5 = Picture3.hdc
width5 = Picture3.ScaleWidth
height5 = Picture3.ScaleHeight
rop = &HA000C9 '注释：与原图做and运算
Call SelectObject(hdc5, hBrush)
res = PatBlt(hdc5, 0, 0, width5, height5, rop)
Call DeleteObject(hBrush)
Case 7 '退出程序
End
End Select
End Sub
Private Sub HScroll1_Change() ' 滚动图片
Picture3.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change() '根据滚动条的值，滚动图片
Picture3.Top = -VScroll1.Value
End Sub
Private Sub HScroll1_Scroll() '滚动时调用Change事件
HScroll1_Change
End Sub
Private Sub VScroll1_Scroll()
VScroll1_Change
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -