This is the first method, which is slower and has no extra white edges. The second method is faster
Code:
Private Type Bitmap
bmType As Long 'Image type: 0 means bitmap
bmWidth As Long 'Image width (pixels)
bmHeight As Long 'image height (pixels)
bmWidthBytes As Long 'The number of bytes per line of image
bmPlanes As Integer 'The number of layers of the image
bmBitsPixel As Integer 'The number of bits of the image
bmBits As Long 'Bitmap memory pointer
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim ctP180 As Double
'Need to place the following 6 controls on the form, all controls do not need to set any properties (including position and size), all adopt the default settings:
'Command1, Command2, Label1, Picture1, Text1, Combo1
Private Sub Form_Load()
Me.Caption = "Picture Rotation-Fast"
Text1.Text = App.Path & "\cat.jpg"
Command1.Caption = "Open": Command2.Caption = "Rotate"
Label1.Caption = "Rotation Angle": Label1.BackStyle = 0
Me.ScaleMode = 3: Picture1.ScaleMode = 3
Picture1.AutoSize = True: Picture1.AutoRedraw = True
Picture1.ToolTipText = "Double-click to restore the original graphic"
ctP180 = 4 * Atn(1) 'Pi
For i = -18 To 18
If i < 0 Then
Combo1.AddItem i * 10 & "degree"
Else
Combo1.AddItem "" & i * 10 & "degree"
End If
Next
Combo1.Text = "30 degrees"
'Set the control position, which can actually be done when designing the form
Dim W1 As Long
W1 = Me.TextWidth("A")
Command1.Move W1, W1, W1 * 6, W1 * 3: Text1.Move W1 * 8, W1, W1 * 80, W1 * 3
Command2.Move W1, W1 * 5, W1 * 6, W1 * 3: Label1.Move W1 * 8, W1 * 5.5, W1 * 11, W1 * 3
Combo1.Move W1 * 16, W1 * 5, W1 * 12
Picture1.Move W1, W1 * 9, W1 * 40, W1 * 40
Picture1.Picture = LoadPicture(Text1.Text)
'Call RndImg(Picture1)'Draw some images randomly
End Sub
Private Sub RndImg(Kj As Object)
'Draw some images randomly
Dim i As Long
Randomize
Kj.DrawWidth = 3
For i = 1 To 100
Kj.Line (Kj.ScaleWidth * Rnd, Kj.ScaleHeight * Rnd)-Step(50, 50), &HFFFFFF * Rnd, BF
Kj.Circle (Kj.ScaleWidth * Rnd, Kj.ScaleHeight * Rnd), 30 * Rnd, &HFFFFFF * Rnd
Next
Kj.Font.size = 24: Kj.Font.Bold = True
Kj.CurrentX = 10: Kj.CurrentY = 10: Kj.ForeColor = &H777777
Kj.Print Me.Caption
Kj.CurrentX = 11: Kj.CurrentY = 11: Kj.ForeColor = RGB(0, 110, 110)
Kj.Print Me.Caption
Kj.Line (0, 0)-(Kj.ScaleWidth - 1, Kj.ScaleHeight - 1), 255, B
Kj.DrawWidth = 1: Picture1.ForeColor = 0 'Restore to default settings
Picture1.Font.size = 9: Picture1.Font.Bold = False
Kj.Picture = Kj.Image
End Sub
Private Sub Command1_Click()
'Open picture file
Dim F As String
On Error GoTo Err1
F = Trim(Text1.Text)
Picture1.Picture = LoadPicture(F)
Exit Sub
Err1:
MsgBox "Unable to read file:" & vbCrLf & F, vbInformation
End Sub
Private Sub Combo1_Click()
Call Command2_Click
End Sub
Private Sub Command2_Click()
'Rotate the picture
Dim W1 As Long, H1 As Long, B1() As Byte, Bs1 As Long, BytesW1 As Long, Ps1 As Long
Dim W2 As Long, H2 As Long, B2() As Byte, Bs2 As Long, BytesW2 As Long, Ps2 As Long
Dim S1 As Long, S2 As Long, x As Long, y As Long, x1 As Long, y1 As Long
Dim CenX1 As Long, CenY1 As Long, CenX2 As Long, CenY2 As Long
Dim KjFocus As Control, ToJ As Single
ToJ = Val(Combo1.Text) / 180 * ctP180 'Rotation angle to radians
Set KjFocus = Me.ActiveControl 'memory the control with focus
Command1.Enabled = False: Command2.Enabled = False: Combo1.Enabled = False
'The following statement seems dispensable, but actually has two functions: restore the original image and size of the control before rotating
Picture1.Picture = Picture1.Picture
'Image data before rotation: width, height, color array, total bytes, bytes per row, bytes per pixel
GetBmpDat Picture1, W1, H1, B1, Bs1, BytesW1, Ps1
CenX1 = Int(W1 * 0.5): CenY1 = Int(H1 * 0.5) 'Image center point before rotation
'Calculate the height and width of the control after rotation, and set the ScaleMode of the form and picture to 3 (pixels) in advance
W2 = Abs(W1 * Cos(ToJ)) + Abs(H1 * Sin(ToJ)) 'After rotating: image width
H2 = Abs(H1 * Cos(ToJ)) + Abs(W1 * Sin(ToJ)) 'After rotating: image height
x = Picture1.Width - Picture1.ScaleWidth 'Picture frame border: width
y = Picture1.Height - Picture1.ScaleHeight 'Picture frame border: height
Picture1.Move Picture1.Left, Picture1.Top, x + W2, y + H2
'The function of the Picture1.Cls statement below is not to clear the image, but to update the control
'Image property, so that the image data can be obtained correctly when calling GetBmpDat
Picture1.Cls
Picture1.Line (0, 0)-(W2, H2), &HFFFFFF, BF
'Image data after rotation: width, height, color array, total bytes, bytes per row, bytes per pixel
GetBmpDat Picture1, W2, H2, B2, Bs2, BytesW2, Ps2
CenX2 = Int(W2 * 0.5): CenY2 = Int(H2 * 0.5) 'After rotation: image center point
'Display information
Picture1.CurrentX = 5: Picture1.CurrentY = 5
Picture1.Print "Processing, please wait..."
Me.Refresh
W1 = W1 - 1: H1 = H1 - 1
For x = 0 To W2 - 1
For y = 0 To H2 - 1
Zhuan -ToJ, CenX2, CenY2, x, y, x1, y1 'Use x1, y1 to get the rotated coordinates
x1 = x1 - CenX2 + CenX1: y1 = y1 - CenY2 + CenY1 'converted to the coordinates before rotation
S2 = XYtoIndex(x, y, BytesW2, Ps2) 'After rotation: the index of the pixel in the array B2
If x1 < 0 Or x1 > W1 Or y1 < 0 Or y1 > H1 Then
B2(S2 + 2) = 255: B2(S2 + 1) = 255: B2(S2) = 255 'Exceed the original image area, set to white
Else
S1 = XYtoIndex(x1, y1, BytesW1, Ps1) 'Before rotation: the index of the pixel in the array B1
B2(S2 + 2) = B1(S1 + 2): B2(S2 + 1) = B1(S1 + 1): B2(S2) = B1(S1) 'Red, Green and Blue
End If
Next
Next
SetBitmapBits Picture1.Image, Bs2, B2(0) 'Set the image of Picture1 to the rotated binary array B2()
Command1.Enabled = True: Command2.Enabled = True: Combo1.Enabled = True
On Error Resume Next
KjFocus.SetFocus 'Restore the control with focus
End Sub
Private Sub GetBmpDat(Kj As Control, W As Long, H As Long, B() As Byte, Bs As Long, BytesW As Long, Ps As Long)
'Get the image data of the control Kj
Dim MapInf As Bitmap
GetObject Kj.Image, Len(MapInf), MapInf 'Use MapInf to get the image information of Kj
W = MapInf.bmWidth: H = MapInf.bmHeight 'Image width, height (pixels)
BytesW = MapInf.bmWidthBytes 'The number of bytes occupied by each line
Ps = BytesW \ W 'The number of bytes per pixel (usually 4)
Bs = W * H * Ps 'Total number of bytes = width * height * bytes per pixel
ReDim B(0 To Bs - 1)
GetBitmapBits Kj.Image, Bs, B(0) 'Read the color values ??of all pixels of the Kj image into the binary array B()
End Sub
Private Function XYtoIndex(x As Long, y As Long, BytesW As Long, Ps As Long) As Long
'Return the number position of the image coordinates x,y in the color array.
'BytesW: the number of bytes occupied by each line of image, Ps: the number of bytes occupied by each pixel (usually 4)
XYtoIndex = y * BytesW + x * Ps
End Function
Private Sub Zhuan(ToJ As Single, x0 As Long, y0 As Long, ByVal x As Long, ByVal y As Long, x1 As Long, y1 As Long)
'Rotate the point x, y clockwise around x0, y0 by ToJ radians, and use x1, y1 to return the rotated position
'Note: To set the pi ratio in advance ctP180 = 4 * Atn(1)
Dim S As Single, J As Single
x = x - x0: y = y - y0
S = Sqr(x ^ 2 + y ^ 2) 'The distance between X,Y and x0,y0
If S = 0 Then J = 0 Else J = y / S 'Sine of the angle between the horizontal line
If Abs(J) >= 1 Then
If J > 0 Then J = ctP180 * 0.5 Else J = -ctP180 * 0.5
'Special case at 90 degrees
Else
J = Atn(J / Sqr(-J * J + 1)) 'The angle between the horizontal line
End If
If x < 0 Then J = -ctP180 - J
x1 = x0 + S * Cos(J + ToJ): y1 = y0 + S * Sin(J + ToJ) 'Return to the rotated position
End Sub
Private Sub Picture1_DblClick()
'The following statement seems dispensable, but actually has two functions: restore the original image and size of the control before rotating
Picture1.Picture = Picture1.Picture
End Sub