neng

WkIGeF6Y.rar (93.44 KB) [求助]VB能否让某个图片旋转一定角度显示？

[此贴子已经被作者于2007-6-14 14:17:17编辑过]

模块里
Declare Function PlgBlt Lib "gdi32" (ByVal hdcDest As Long, _
lpPoint As POINTS2D, _
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 Long

Global Const NotPI = 3.14159265238 / 180

'--------------------------------------------------------------------------------
Public Type POINTS2D
x As Long
y As Long
End Type

窗体里面
Option Explicit

Dim FRAME As Integer

Private Sub DanRotate(ByRef picDestHdc As Long, xPos As Long, yPos As Long, _
ByVal Angle As Long, _
ByRef picSrcHdc As Long, srcXoffset As Long, srcYoffset As Long, _
ByVal srcWidth As Long, ByVal srcHeight As Long)

Dim Points(3) As POINTS2D
Dim DefPoints(3) As POINTS2D
Dim ThetS As Single, ThetC As Single
Dim ret As Long

'SET LOCAL AXIS / ALIGNMENT
Points(0).x = -srcWidth * 0.5
Points(0).y = -srcHeight * 0.5

Points(1).x = Points(0).x + srcWidth
Points(1).y = Points(0).y

Points(2).x = Points(0).x
Points(2).y = Points(0).y + srcHeight

'ROTATE AROUND Z-AXIS
ThetS = Sin(Angle * NotPI)
ThetC = Cos(Angle * NotPI)
DefPoints(0).x = (Points(0).x * ThetC - Points(0).y * ThetS) + xPos
DefPoints(0).y = (Points(0).x * ThetS + Points(0).y * ThetC) + yPos

DefPoints(1).x = (Points(1).x * ThetC - Points(1).y * ThetS) + xPos
DefPoints(1).y = (Points(1).x * ThetS + Points(1).y * ThetC) + yPos

DefPoints(2).x = (Points(2).x * ThetC - Points(2).y * ThetS) + xPos
DefPoints(2).y = (Points(2).x * ThetS + Points(2).y * ThetC) + yPos

PlgBlt picDestHdc, DefPoints(0), picSrcHdc, srcXoffset, srcYoffset, srcWidth, srcHeight, 0, 0, 0

End Sub

Private Sub Command1_Click()

Unload Me
End

End Sub

Private Sub Command2_Click()
Dim tel As Integer

'Reset & start FPS counter
FRAME = 0
Timer1.Enabled = True

For tel = 0 To 360 Step 1
picBck.Cls
DanRotate picBck.hDC, 128, 128, tel, picCol.hDC, 0, 0, 128, 128
picBck.Refresh
FRAME = FRAME + 1
DoEvents
Next tel

'Stop FPS timer
Timer1.Enabled = False

End Sub

Private Sub Timer1_Timer()

Label1.Caption = FRAME & " fps"
FRAME = 0

End Sub