' '下面是窗体代码，在 VB6 调试通过
'需在窗体放置以下 6 个控件，所有控件不必设置任何属性(包括位置和大小)，全部采用默认设置：
'Command1、Command2、Label1、Picture1、Text1、Combo1
'本人原创，转载请注明文章来源：/100bd/blog/item/400ce7c90c6cc7057e3e6fa0.html
Private Type BitMap
bmType As Long'图像类型：0 表示是位图
bmWidth As Long'图像宽度(像素)
bmHeight As Long'图像高度(像素)
bmWidthBytes As Long'每一行图像的字节数
bmPlanes As Integer'图像的图层数
bmBitsPixel As Integer '图像的位数
bmBits As Long'位图的内存指针
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
Private Sub Form_Load()
Me.Caption = "图片旋转-快速"
Text1.Text = App.Path & "\Tu1.jpg"
Command1.Caption = "打开": Command2.Caption = "旋转"
Label1.Caption = "旋转角度": Label1.BackStyle = 0
Me.ScaleMode = 3: Picture1.ScaleMode = 3
Picture1.AutoSize = True: Picture1.AutoRedraw = True
Picture1.ToolTipText = "双击恢复原图形"
ctP180 = 4 * Atn(1) '圆周率
For I = -18 To 18
If I < 0 Then
Combo1.AddItem I * 10 & " 度"
Else
Combo1.AddItem " " & I * 10 & " 度"
End If
Next
Combo1.Text = " 30 度"
'设置控件位置，实际可以在设计窗体时完成
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
Call RndImg(Picture1) '随机画一些图像
End Sub
Private Sub RndImg(Kj As Object)
'随机画一些图像
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 '还原为默认设置
Picture1.Font.Size = 9: Picture1.Font.Bold = False
Kj.Picture = Kj.Image
End Sub
Private Sub Command1_Click()
'打开图片文件
Dim F As String
On Error GoTo Err1
F = Trim(Text1.Text)
Picture1.Picture = LoadPicture(F)
Exit Sub
Err1:
MsgBox "无法读取文件：" & vbCrLf & F, vbInformation
End Sub
Private Sub Combo1_Click()
Call Command2_Click
End Sub
Private Sub Command2_Click()
'旋转图片
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 '旋转角度转弧度
Set KjFocus = Me.ActiveControl '记忆具有焦点的控件
Command1.Enabled = False: Command2.Enabled = False: Combo1.Enabled = False
'下面一条语句看似可有可无，实际有两个作用：恢复旋转前控件的原图像和大小
Picture1.Picture = Picture1.Picture
'旋转前图像数据：宽度，高度，颜色数组，总字节数，每行字节数，每像素字节数
GetBmpDat Picture1, W1, H1, B1, Bs1, BytesW1, Ps1
CenX1 = Int(W1 * 0.5): CenY1 = Int(H1 * 0.5)'旋转前的图像中心点
'计算旋转后控件的高度和宽度，要预先设置窗体和图片的 ScaleMode 为 3(像素)
W2 = Abs(W1 * Cos(ToJ)) + Abs(H1 * Sin(ToJ))'旋转后：图像宽度
H2 = Abs(H1 * Cos(ToJ)) + Abs(W1 * Sin(ToJ))'旋转后：图像高度
X = Picture1.Width - Picture1.ScaleWidth'图片框边框：宽度
Y = Picture1.Height - Picture1.ScaleHeight'图片框边框：高度
Picture1.Move Picture1.Left, Picture1.Top, X + W2, Y + H2
'下面的 Picture1.Cls 语句此处的作用主要不是清除图像，而是更新控件
'的 Image 属性，使调用 GetBmpDat 时能正确取得图像数据
Picture1.Cls
Picture1.Line (0, 0)-(W2, H2), &HFFFFFF, BF
'旋转后图像数据：宽度，高度，颜色数组，总字节数，每行字节数，每像素字节数
GetBmpDat Picture1, W2, H2, B2, Bs2, BytesW2, Ps2
CenX2 = Int(W2 * 0.5): CenY2 = Int(H2 * 0.5)'旋转后：图像中心点
'显示信息
Picture1.CurrentX = 5: Picture1.CurrentY = 5
Picture1.Print "处理中，请稍候..."
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'用 x1,y1 获得旋转坐标
x1 = x1 - CenX2 + CenX1: y1 = y1 - CenY2 + CenY1 '转变为旋转前的坐标
S2 = XYtoIndex(X, Y, BytesW2, Ps2)'旋转后：像素点在数组 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 '超出原图像区域，设为白色
Else
S1 = XYtoIndex(x1, y1, BytesW1, Ps1)'旋转前：像素点在数组 B1 中的索引
B2(S2 + 2) = B1(S1 + 2): B2(S2 + 1) = B1(S1 + 1): B2(S2) = B1(S1) '红绿蓝
End If
Next
Next
SetBitmapBits Picture1.Image, Bs2, B2(0) '将 Picture1 的图像设置为旋转后的二进数组 B2()
Command1.Enabled = True: Command2.Enabled = True: Combo1.Enabled = True
On Error Resume Next
KjFocus.SetFocus'还原具有焦点的控件
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)
'获取控件 Kj 的图像数据
Dim MapInf As BitMap
GetObject Kj.Image, Len(MapInf), MapInf '用 MapInf 得到 Kj 的图像信息
W = MapInf.bmWidth: H = MapInf.bmHeight '图像宽度、高度(像素)
BytesW = MapInf.bmWidthBytes'每行占用字节数
Ps = BytesW \ W'每个像素字节数(一般为4)
Bs = W * H * Ps'总字节数=宽度*高度*每个像素字节
ReDim B(0 To Bs - 1)
GetBitmapBits Kj.Image, Bs, B(0)'将 Kj 图像所有像素点的颜色值读入二进数组 B()
End Sub
Private Function XYtoIndex(X As Long, Y As Long, BytesW As Long, Ps As Long) As Long
'返回图像坐标 x,y 在颜色数组中的序号位置。
'BytesW：每行图像占用字节数，Ps：每个像素点占用字节数(一般为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)
'将点 x,y 围绕 x0,y0 顺时针旋转 ToJ 弧度，用 x1,y1 返回旋转后的位置
'注意：要预先设置圆周率 ctP180 = 4 * Atn(1)
Dim S As Single, J As Single
X = X - x0: Y = Y - y0
S = Sqr(X ^ 2 + Y ^ 2)'X,Y 与 x0,y0 的距离
If S = 0 Then J = 0 Else J = Y / S'与水平线的夹角的正弦值
If Abs(J) >= 1 Then
If J > 0 Then J = ctP180 * 0.5 Else J = -ctP180 * 0.5 '90 度时的特殊情况
Else
J = Atn(J / Sqr(-J * J + 1)) '与水平线的夹角
End If
If X < 0 Then J = -ctP180 - J
x1 = x0 + S * Cos(J + ToJ): y1 = y0 + S * Sin(J + ToJ) '返回旋转后的位置
End Sub
Private Sub Picture1_DblClick()
'下面语句看似可有可无，实际有两个作用：恢复旋转前控件的原图像和大小
Picture1.Picture = Picture1.Picture
End Sub
'后记：用 PlgBlt 旋转图像比本文的方法还快，几乎可以说是瞬间就完成了图像的旋转和变形。玩过祖玛游戏的朋友一定会对那个随鼠标转圈的蛤蟆印象深刻，PlgBlt 就能达到相同的效果。PlgBlt 的功能是：将源对象指定矩形区域的图像复制到目标对象的一个平行四边形区域内，通过设置放置区的平行四边形的四个点，可实现图像的扭曲、翻转、放大、缩小、任意角度旋转等功能。
html图片旋转任意角度 将图像快速旋转任意角度 - jixu的日志 - VB爱好者乐园(VBGood) - Powered by Discuz!...
