VB6.0有没有像window画图板那样的高速90度旋转的方法

Question

壁纸级别的图片都转起来的速度，唉。
请指点小弟一条明路吧

Answer 1

Private Type POINTAPI
    X As Long
    Y As Long
End Type Private Type BITMAP
  bmType As Long
  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 GetTickCount Lib "kernel32" () As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function PlgBlt Lib "gdi32" (ByVal hdcDest As Long, lpPoint As POINTAPI, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As LongPublic Sub Rotate90(Pic As PictureBox)
    Dim DefPoints(3) As POINTAPI
    Dim MemDC As Long
    Dim BHandle As Long
    Dim OldObject As Long
    Dim PicInfo As BITMAP
    Dim Width As Long, Height As Long, Temp As Long
    Pic.AutoSize = True: Pic.AutoRedraw = True
    GetObject Pic.Image, Len(PicInfo), PicInfo
    Width = PicInfo.bmWidth
    Height = PicInfo.bmHeight
    MemDC = CreateCompatibleDC(Pic.hdc)
    BHandle = CreateCompatibleBitmap(Pic.hdc, Width, Height)
    OldObject = SelectObject(MemDC, BHandle)
    BitBlt MemDC, 0, 0, Width, Height, Pic.hdc, 0, 0, vbSrcCopy
    DefPoints(0).X = 0
    DefPoints(0).Y = Width
    DefPoints(1).X = 0
    DefPoints(1).Y = 0
    DefPoints(2).X = Height
    DefPoints(2).Y = Width
    Pic.Move Pic.Left, Pic.Top, Pic.Height, Pic.Width
    Set Pic.Picture = Nothing
    PlgBlt Pic.hdc, DefPoints(0), MemDC, 0, 0, Width, Height, 0, 0, 0
    SelectObject MemDC, OldObject
    DeleteDC MemDC
    DeleteObject BHandle
 End SubPrivate Sub Command1_Click()
    Dim t As Long
    t = GetTickCount
    Rotate90 Picture1
    MsgBox GetTickCount - t
End Sub