📄 round.frm
字号:
VERSION 5.00
Begin VB.Form Form7
BorderStyle = 4 'Fixed ToolWindow
Caption = "翻转和旋转"
ClientHeight = 2865
ClientLeft = 45
ClientTop = 270
ClientWidth = 3945
LinkTopic = "Form7"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2865
ScaleWidth = 3945
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
Height = 1455
Left = 5400
ScaleHeight = 1395
ScaleWidth = 1755
TabIndex = 9
Top = 120
Width = 1815
End
Begin VB.PictureBox Picture2
AutoRedraw = -1 'True
AutoSize = -1 'True
Height = 1455
Left = 5400
ScaleHeight = 1395
ScaleWidth = 1755
TabIndex = 8
Top = 1680
Width = 1815
End
Begin VB.CommandButton Command2
Caption = "取消"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3000
TabIndex = 7
Top = 840
Width = 855
End
Begin VB.CommandButton Command1
Caption = "确定"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3000
TabIndex = 6
Top = 360
Width = 855
End
Begin VB.Frame Frame1
Caption = "翻转和旋转"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2655
Left = 120
TabIndex = 0
Top = 120
Width = 2655
Begin VB.HScrollBar HScroll1
Height = 255
Left = 360
Max = 360
TabIndex = 12
Top = 2280
Width = 2175
End
Begin VB.OptionButton Option10
Caption = "按任意角度"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 10
Top = 1980
Width = 1335
End
Begin VB.OptionButton Option9
Caption = "270度 (&2)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 5
Top = 1680
Width = 1335
End
Begin VB.OptionButton Option8
Caption = "180度 (&1)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 4
Top = 1440
Width = 1335
End
Begin VB.OptionButton Option7
Caption = "90度 (&9)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 3
Top = 1200
Width = 1335
End
Begin VB.OptionButton Option2
Caption = "垂直翻转(&V)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 2
Top = 580
Width = 1455
End
Begin VB.OptionButton Option1
Caption = "水平翻转(&F)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 1
Top = 280
Value = -1 'True
Width = 1455
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00808080&
Caption = "360"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080C0FF&
Height = 240
Left = 1680
TabIndex = 13
Top = 1965
Width = 315
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "按一定角度旋转"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 240
TabIndex = 11
Top = 975
Width = 1365
End
End
End
Attribute VB_Name = "Form7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const SRCCOPY = &HCC0020
Const Pi = 3.14159265359
Private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
Private Declare Function StretchBlt% Lib "GDI32" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)
Private Sub Command1_Click()
Command1.Enabled = False
Command2.Enabled = False
'水平翻转
If Form7.Option1.Value = True Then
Picture2.Cls
px% = Picture1.ScaleWidth
py% = Picture1.ScaleHeight
'调用函数
retval% = StretchBlt(Picture2.hDC, px%, 0, -px%, py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End If
'竖直翻转
If Form7.Option2.Value = True Then
Picture2.Cls
px% = Picture1.ScaleWidth
py% = Picture1.ScaleHeight
'调用函数
retval% = StretchBlt(Picture2.hDC, 0, py%, px%, -py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End If
'90度旋转
If Form7.Option7.Value = True Then
Picture2.Cls
Call bmp_rotate(Picture1, Picture2, 3.14 / 2)
End If
'180度旋转
If Form7.Option8.Value = True Then
Picture2.Cls
Call bmp_rotate(Picture1, Picture2, 3.14)
End If
'270度旋转
If Form7.Option9.Value = True Then
Picture2.Cls
Call bmp_rotate(Picture1, Picture2, 3.14 / 2 * 3)
End If
'任意角度旋转
If Form7.Option10.Value = True Then
Picture2.Cls
Call bmp_rotate(Picture1, Picture2, Label2.Caption * 3.14 / 180)
End If
'改变原图
Form1.Picture1.Cls
SavePicture Picture2.Image, "backup.bmp"
Form1.Picture1.Picture = LoadPicture("backup.bmp")
Unload Form7
MDIForm1.Enabled = True
End Sub
Private Sub Command2_Click()
Unload Form7
MDIForm1.Enabled = True
End Sub
'窗体初值
Private Sub Form_Load()
Command1.Enabled = True
Command2.Enabled = True
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
Form1.Picture1.Picture = LoadPicture("backup.bmp")
Picture1.Picture = Form1.Picture1.Picture
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Form7
MDIForm1.Enabled = True
End Sub
'bmp_rotate函数的操作
Sub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
Dim c1x As Integer, c1y As Integer
Dim c2x As Integer, c2y As Integer
Dim a As Single
Dim p1x As Integer, p1y As Integer
Dim p2x As Integer, p2y As Integer
Dim n As Integer, r As Integer
c1x = pic1.ScaleWidth \ 2
c1y = pic1.ScaleHeight \ 2
c2x = pic2.ScaleWidth \ 2
c2y = pic2.ScaleHeight \ 2
If c2x < c2y Then n = c2y Else n = c2x
n = n - 1
pic1hDC% = pic1.hDC
pic2hDC% = pic2.hDC
'对点象素的操作
For p2x = 0 To n
For p2y = 0 To n
If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
p1x = r * Cos(a + theta!)
p1y = r * Sin(a + theta!)
c0& = GetPixel(pic1hDC%, c1x + p1x, c1y + p1y)
c1& = GetPixel(pic1hDC%, c1x - p1x, c1y - p1y)
c2& = GetPixel(pic1hDC%, c1x + p1y, c1y - p1x)
c3& = GetPixel(pic1hDC%, c1x - p1y, c1y + p1x)
If c0& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2x, c2y + p2y, c0&)
If c1& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2x, c2y - p2y, c1&)
If c2& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2y, c2y - p2x, c2&)
If c3& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2y, c2y + p2x, c3&)
Next
t% = DoEvents()
Next
End Sub
Private Sub HScroll1_Change()
Label2.Caption = HScroll1.Value
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -