Как можно повернуть изображение на 'n' градусов?

Как можно повернуть изображение на 'n' градусов?

0

Точно не помню, где я это взял. Кажется, на VBNet.
Use this function to rotate a bitmap through a certain angle. This function is unfortunately quite slow due to the amount of calculations that it must do. Put this in a code module:
Declarations
Public Declare Function GetPixel Lib 'gdi32' _
(ByVal hdc As Long, ByVal x As Long, ByVal y _
As Long) As Long

Public Declare Function SetPixelV Lib 'gdi32' _
(ByVal hdc As Long, ByVal x As Long, ByVal y As _
Long, ByVal crColor As Long) As Long

Public Const Pi = 3.14159265358979
Procedure
' **************************************** ********
'Rotate the picture in Source and place it
'in Dest. Rotate the area Left <= x <= right,
'top <= y <= bottom through Angle radians
'around the point (origx, origy). Place the result so
'(origx, origy) maps to (newx, newy).
'*************************************** *********
Public Sub RotatePicture(ByVal SourcehDC As Long, _
ByVal DesthDC As Long, ByVal AngleInRadians As _
Double, ByVal Left As Integer, ByVal Top As _
Integer, ByVal Right As Integer, ByVal Bottom _
As Integer, ByVal OrigX As Integer, ByVal OrigY _
As Integer, ByVal NewX As Integer, ByVal NewY As Integer)
' Parameters:
'SourcehDC, DesthDC: hDC for source and destinations
'picture boxes or forms
'AngleInRadians: The angle to rotate the picture by
'Left, Top, Right, Bottom: The bounds of the source picture
'OrigX, OrigY, NewX, NewY: OrigX maps to NewX and
'OrigY maps to NewY

Dim sin_theta As Double
Dim cos_theta As Double
Dim MinX As Integer
Dim MaxX As Integer
Dim MinY As Integer
Dim MaxY As Integer
Dim tx As Integer
Dim ty As Integer
Dim fx As Double
Dim fy As Double
Dim ifx As Integer
Dim ify As Integer

'Compute the sine and cosine of theta.
sin_theta = Sin(AngleInRadians)
cos_theta = Cos(AngleInRadians)

'Make some bounds for new picture
MinX = (Left - OrigX) * cos_theta + _
(Top - OrigY) * sin_theta + NewX
MinY = -(Left - OrigX) * sin_theta + _
(Top - OrigY) * cos_theta + NewY
MaxX = MinX
MaxY = MinY

tx = (Left - OrigX) * cos_theta + _
(Bottom - OrigY) * sin_theta + NewX
ty = -(Left - OrigX) * sin_theta + _
(Bottom - OrigY) * cos_theta + NewY
If MinX > tx Then MinX = tx
If MinY > ty Then MinY = ty
If MaxX < tx Then MaxX = tx
If MaxY < ty Then MaxY = ty

tx = (Right - OrigX) * cos_theta + _
(Top - OrigY) * sin_theta + NewX
ty = -(Right - OrigX) * sin_theta + _
(Top - OrigY) * cos_theta + NewY
If MinX > tx Then MinX = tx
If MinY > ty Then MinY = ty
If MaxX < tx Then MaxX = tx
If MaxY < ty Then MaxY = ty

tx = (Right - OrigX) * cos_theta + _
(Bottom - OrigY) * sin_theta + NewX
ty = -(Right - OrigX) * sin_theta + _
(Bottom - OrigY) * cos_theta + NewY
If MinX > tx Then MinX = tx
If MinY > ty Then MinY = ty
If MaxX < tx Then MaxX = tx
If MaxY < ty Then MaxY = ty

If MinX < 1 Then MinX = 1
If MaxX < 1 Then MaxX = 1

If MinY < 1 Then MinY = 1
If MaxY < 1 Then MaxY = 1

'Perform the rotation.
For ty = MinY To MaxY
For tx = MinX To MaxX

'Find the location (fx, fy) that maps to the pixel (tx, ty).
fx = (tx - NewX) * cos_theta - (ty - NewY) * sin_theta + OrigX
fy = (tx - NewX) * sin_theta + (ty - NewY) * cos_theta + OrigY

'Skip it if the nearest source pixel
'lies outside the allowed source area.
ify = Fix(fy)
ifx = Fix(fx)
If ifx >= Left And ifx < Right And ify >= Top And ify < Bottom Then
Call SetPixelV(DesthDC, tx, ty, GetPixel(SourcehDC, ifx, ify))
End If
Next tx
Next ty

End Sub
T

0

Спасибо, только она у меня не работает.
Ошибка:
Public Const Pi = 3.14159265358979

0

Это, видимо, код модуля. Для формы пиши
Private Const ...
или просто - Const ...

0

Спасибо, я попробую.

0

Доработай мой пример - вставь это в FORM1.FRM и поизменяй:

VERSION 5.00
Begin VB.Form frmRotate
Caption = 'Rotating a bitmap'
ClientHeight = 3795
ClientLeft = 60
ClientTop = 345
ClientWidth = 6735
LinkTopic = 'Form1'
ScaleHeight = 3795
ScaleWidth = 6735
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdRotate
Caption = '&Rotate'
Height = 375
Left = 960
TabIndex = 2
Top = 2760
Width = 1215
End
Begin VB.PictureBox picTwo
Height = 3375
Left = 3120
ScaleHeight = 3315
ScaleWidth = 3315
TabIndex = 1
Top = 240
Width = 3375
End
Begin VB.PictureBox picOne
AutoSize = -1 'True
Height = 1860
Left = 240
Picture = 'Rotate.frx':0000
ScaleHeight = 1800
ScaleWidth = 2580
TabIndex = 0
Top = 240
Width = 2640
End
End
Attribute VB_Name = 'frmRotate'
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const PI = 3.14159265358979
Const ANGLE = 45

Private Sub cmdRotate_Click()
Dim intX As Integer
Dim intY As Integer
Dim intX1 As Integer
Dim intY1 As Integer
Dim dblX2 As Double
Dim dblY2 As Double
Dim dblX3 As Double
Dim dblY3 As Double
Dim dblThetaDeg As Double
Dim dblThetaRad As Double
'Initialize rotation angle
dblThetaDeg = ANGLE
'Compute angle in radians
dblThetaRad = dblThetaDeg * PI / 180
'Set scale modes to pixels
picOne.ScaleMode = vbPixels
picTwo.ScaleMode = vbPixels
For intX = 0 To picTwo.ScaleWidth
intX1 = intX - picTwo.ScaleWidth 2
For intY = 0 To picTwo.ScaleHeight
intY1 = intY - picTwo.ScaleHeight 2
'Rotate picture by dblThetaRad
dblX2 = intX1 * Cos(-dblThetaRad) + _
intY1 * Sin(-dblThetaRad)
dblY2 = intY1 * Cos(-dblThetaRad) - _
intX1 * Sin(-dblThetaRad)
'Translate to center of picture box
dblX3 = dblX2 + picOne.ScaleWidth 2
dblY3 = dblY2 + picOne.ScaleHeight 2
'If data point is in picOne, set its color in picTwo
If dblX3 > 0 And dblX3 < picOne.ScaleWidth - 1 _
And dblY3 > 0 And dblY3 < picOne.ScaleHeight - 1 Then
picTwo.PSet (intX, intY), picOne.Point(dblX3, dblY3)
End If
Next intY
Next intX
End Sub

Спасибо, только я имел ввиду повернуть PictureBox.

0