Rotation

[shree]

I am using the following code to rotate a point Pt about another point P1. It works fine, but is quite imprecise and the effect is quite visible when I use it to rotate a group of points. Since rotation is a one to one mapping, there should be very little distortion. Is there a better way to achieve the rotation?


private Sub RotatePoint(P1 as POINTAPI, Pt as POINTAPI, Angle as Single)
Dim rXConstTemp as Single, rYConstTemp as Single
Dim mX as Single, mY as Single
Dim SinAngle as Single, CosAngle as Single

SinAngle = Sin(Angle * 3.141592654 / 180)
CosAngle = Cos(Angle * 3.141592654 / 180)
rXConstTemp = P1.X * (1 - CosAngle) + P1.Y * SinAngle
rYConstTemp = P1.Y * (1 - CosAngle) - P1.X * SinAngle

mX = Pt.X * CosAngle - Pt.Y * SinAngle + rXConstTemp
mY = Pt.X * SinAngle + Pt.Y * CosAngle + rYConstTemp

Pt.X = mX
Pt.Y = mY
End Sub

[Iouri]

Check this out. This code will rotate text on the form. It might help you

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
' lfFaceName(LF_FACESIZE) As Byte 'THIS WAS DEFINED IN API-CHANGES MY OWN
lfFacename As String * 33
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 Sub CheckVals()
Command1.Enabled = ((Val(txtDegree.Text) < 360) And Val(txtSize.Text) > 7)
End Sub

Private Sub FontStuff()
On Error GoTo GetOut
Dim F As LOGFONT, hPrevFont As Long, hFont As Long, FontName As String
Dim FONTSIZE As Integer
FONTSIZE = Val(txtSize.Text)

F.lfEscapement = 10 * Val(txtDegree.Text) 'rotation angle, in tenths
FontName = "Arial Black" + Chr$(0) 'null terminated
F.lfFacename = FontName
F.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
hFont = CreateFontIndirect(F)
hPrevFont = SelectObject(Me.hdc, hFont)
CurrentX = 3930
CurrentY = 3860
Print "Funny Font"

' Clean up, restore original font
hFont = SelectObject(Me.hdc, hPrevFont)
DeleteObject hFont

Exit Sub
GetOut:
Exit Sub

End Sub

Private Sub Command1_Click()
Me.Cls
FontStuff
End Sub


Private Sub txtDegree_Change()
If Not IsNumeric(txtDegree.Text) Then txtDegree.Text = "90"
CheckVals
End Sub

Private Sub txtsize_Change()
If Not IsNumeric(txtSize.Text) Then txtSize.Text = "18"
CheckVals
End Sub




Iouri Boutchkine
iouri@hotsheet.com

[shree]

Thank you Iouri, but my problem is rotating bitmaps. This does not solve it. Maybe you have other ideas...

And the code you posted applies only to TrueType fonts. It doesn't work for fonts like Courier.

[Iouri]

This code will rotate image

Const SRCCOPY = &HCC0020
Const Pi = 3.14159265359
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
Private Declare Function StretchBlt% Lib "GDI32" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)

Sub Form_Load()
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
End Sub


Sub Command1_Click()
'flip horizontal
Picture2.Cls
px% = Picture1.ScaleWidth
py% = Picture1.ScaleHeight
retval% = StretchBlt(Picture2.hDC, px%, 0, -px%, py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End Sub


Sub Command2_Click()
'flip vertical
Picture2.Cls
px% = Picture1.ScaleWidth
py% = Picture1.ScaleHeight
retval% = StretchBlt(Picture2.hDC, 0, py%, px%, -py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End Sub

Sub Command3_Click()
'rotate 45 degrees
Picture2.Cls
Call bmp_rotate(Picture1, Picture2, 3.14 / 4)
End Sub


Sub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
' bmp_rotate(pic1, pic2, theta)
' Rotate the image in a picture box.
' pic1 is the picture box with the bitmap to rotate
' pic2 is the picture box to receive the rotated bitmap
' theta is the angle of rotation
Dim c1x As Integer, c1y As Integer
Dim c2x As Integer, c2y As Integer
Dim a As Single
Dim p1x As Integer, p1y As Integer
Dim p2x As Integer, p2y As Integer
Dim n As Integer, r As Integer

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


Iouri Boutchkine
iouri@hotsheet.com

[shree]

My code uses the same logic as yours. But the error is when we compute the sin and cos. What I want is (maybe an incremental one) method that will avoid the sin and cos calculation. Or somehow reduce the imprecision.

Thanks anyway.

[EC Lim]

I have a question, can I apply this to rotate a line.

The problem that I try to solve is as follow;

Line A --> x1,y1(0,0) to x2,y2(10,10)
If I would like to rotate the line A 30 degree in anticlock direction to become Line B then;
Line B --> x1,y1(0,0) to x2,y2(?,?)

The question that I have is how to determine the x2,y2.

[shree]

Rotation about the origin is quite easy. And if its a line that you are going to rotate in one go, there is not much problem of drifts.


r = sqr((y2-y1)^2 + (x2-x1)^2) 'Compute the radius
x2 = r*cos(Angle) 'Angle should be in radians
y2 = r*sin(Angle)




This would be vector rotation, and it is good enough. But this method seems to have a flaw when used for raster rotations.

[Iouri]

Put your line on a picture box and rotate the picture.

Iouri Boutchkine
iouri@hotsheet.com

[EC Lim]

Hello Iouri,

Can I know how to rotate a picture box?

Thank you.

[EC Lim]

Hello Shree,

Thank you for your advise, I will used this code in my program.

Regards