taolanamhieu
23-09-2006, 03:19 AM
Cần thêm vào Form:
PictureBox:
picBck: Nơi chứa hình đã xoay (cần lớn gấp đôi picCol)
picCol: chứa hình cần xoay
CommandButton: Command1
'--- Add vào Form----
Option Explicit
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 Long
Const NotPI = 3.14159265238 / 180
'-------------------------------------------------------------------------------
Private Type POINTAPI
x As Long
y As Long
End Type
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)
'## DanRotate - Rotates an image.
'##
'## PicDestHdc = the hDc of the target picturebox (ie. Picture2.hdc )
'## xPos = the target coordinates (note that the image will be centered around these
'## yPos coordinates).
'## Angle = Rotate Angle (0-360)
'## PicSrcHdc = The source image To rotate (ie. Picture1.hdc )
'## srcXoffset = The offset coordinates within the Source Image To grab.
'## srcYoffset
'## srcWidth = The width/height of the source image To grab.
'## srcHeight
'##
'## Returns: Nothing.
'## Please note this Function doesn't check Or returns anything. It's up To you To make sure all parameters
'## are valid, checked, etc.
'##
'## Use this code As you like. Credits appreciated.
'##
'## Danny van der Ark (danny@slave-studios.co.uk)
'## Aug 2Oo2
Dim Points(3) As POINTAPI
Dim DefPoints(3) As POINTAPI
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()
Dim tel As Integer
For tel = 0 To 360 Step 1
picBck.Cls
DanRotate picBck.hDC, 128, 128, tel, picCol.hDC, 0, 0, 128, 128
picBck.Refresh
DoEvents
Next tel
End Sub
chúc các bác thành công
PictureBox:
picBck: Nơi chứa hình đã xoay (cần lớn gấp đôi picCol)
picCol: chứa hình cần xoay
CommandButton: Command1
'--- Add vào Form----
Option Explicit
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 Long
Const NotPI = 3.14159265238 / 180
'-------------------------------------------------------------------------------
Private Type POINTAPI
x As Long
y As Long
End Type
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)
'## DanRotate - Rotates an image.
'##
'## PicDestHdc = the hDc of the target picturebox (ie. Picture2.hdc )
'## xPos = the target coordinates (note that the image will be centered around these
'## yPos coordinates).
'## Angle = Rotate Angle (0-360)
'## PicSrcHdc = The source image To rotate (ie. Picture1.hdc )
'## srcXoffset = The offset coordinates within the Source Image To grab.
'## srcYoffset
'## srcWidth = The width/height of the source image To grab.
'## srcHeight
'##
'## Returns: Nothing.
'## Please note this Function doesn't check Or returns anything. It's up To you To make sure all parameters
'## are valid, checked, etc.
'##
'## Use this code As you like. Credits appreciated.
'##
'## Danny van der Ark (danny@slave-studios.co.uk)
'## Aug 2Oo2
Dim Points(3) As POINTAPI
Dim DefPoints(3) As POINTAPI
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()
Dim tel As Integer
For tel = 0 To 360 Step 1
picBck.Cls
DanRotate picBck.hDC, 128, 128, tel, picCol.hDC, 0, 0, 128, 128
picBck.Refresh
DoEvents
Next tel
End Sub
chúc các bác thành công