用API函数GetPixel来获得原图的像素点,经过对各点坐标处理后再用SetPixel拷贝到目标位置,即可实现位图的旋转显示。 在窗体放置一个图片框控件并装入一幅图片,将“AutoRedraw”和“AutoSize”属性均设置为“True”; 放置一个图片框控件用于目标显示; 放置一个滚动条控件,“Min”和“Max”属性分别设置为0和20。 将下面代码拷入窗体代码中: Option Explicit Private Sub Form_Load() Picture1.ScaleMode = 3 Picture2.ScaleMode = 3 Picture2.Width = ((Picture1.Width) ^ 2 + (Picture1.Height) ^ 2) ^ 0.5 Picture2.Height = Picture2.Width End SubPrivate Sub HScroll1_Change() abc = HScroll1.Value / 20 Picture2.Cls Call bmp_rotate(Picture1, Picture2, Pi * abc) '调用自定义函数,abc取值0-2可使位图旋转一周 End Sub由于像素处理的代码较多,这里将坐标变换部分放入一个模块中,可将其保存为一个.bas文件,也可以插入到一个现有的模块代码中。 Option Explicit 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 Global Const Pi = 3.14159265359 Global abc As DoubleSub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!) '自定义旋转位图函数 Dim c1x, c1y, c2x, c2y, p1x, p1y, p2x, p2y, n, r, pic1hDC, pic2hDC As Integer Dim a As Single Dim t, c0, c1, c2, c3, xret 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
在窗体放置一个图片框控件并装入一幅图片,将“AutoRedraw”和“AutoSize”属性均设置为“True”;
放置一个图片框控件用于目标显示;
放置一个滚动条控件,“Min”和“Max”属性分别设置为0和20。
将下面代码拷入窗体代码中:
Option Explicit
Private Sub Form_Load()
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
Picture2.Width = ((Picture1.Width) ^ 2 + (Picture1.Height) ^ 2) ^ 0.5
Picture2.Height = Picture2.Width
End SubPrivate Sub HScroll1_Change()
abc = HScroll1.Value / 20
Picture2.Cls
Call bmp_rotate(Picture1, Picture2, Pi * abc)
'调用自定义函数,abc取值0-2可使位图旋转一周
End Sub由于像素处理的代码较多,这里将坐标变换部分放入一个模块中,可将其保存为一个.bas文件,也可以插入到一个现有的模块代码中。
Option Explicit
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
Global Const Pi = 3.14159265359
Global abc As DoubleSub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!) '自定义旋转位图函数
Dim c1x, c1y, c2x, c2y, p1x, p1y, p2x, p2y, n, r, pic1hDC, pic2hDC As Integer
Dim a As Single
Dim t, c0, c1, c2, c3, xret
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