rotate bitmap 5

[ADoozer]

ok, another simple one for someone,

im trying to rotate an image (selected with bitblt from a larger image) through 90° and 270° (and eventually 45°,135°,225°,315°)

can i do it with one of the raster ops (bitblt) or do i need a seperate API?

any input appreciated!

ps: i hate bitmaps!!!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[ADoozer]

someone want to fill me in, or should i keep bashing my head against my monitor a bit longer.

using my above code, ive tried using cos and sin functions, changing values to radians, changed just about every possible property of the picture box, rewrote the code, made it crash and made the second api call fail!!!!!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

Here's a clue: check the declaration of XFORM...

 

[Hypetia]

Members of XFORM UDT should be declared Single not Double.
Is this was the hidden key?

 

[strongm]

Yes.

Odd, isn't it. For about two years nobody has been able to provide a working VB SetWorldTransform solution in here (nor does there seem to be one available on the Web - or at least Google can't find one), and now all of a sudden everyone can do it...

(Even more oddly, the tek-tips search engine can't seem to find any mention of the earlier threads on the subject)

 

[ADoozer]

i must have messed it up beyond repair then, ive changed the type to single but still it does nothing apart from shift it a few pixels or twips or whatever!!!

am i missing something in my picture box properties???

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

Um...yes. You need to muck about with the MapMode as well...

 

[ADoozer]

ah flip!!!!

its beat me, i think i broke my head on the monitor!!!

this is what i have now, ive tried all the MM_ constants,
if your feeling genorous and want to post some working code id be grateful, but ive had enough of it now!!

Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM) As Long

Private Type XFORM
eM11 As Single
eM12 As Single
eM21 As Single
eM22 As Single
eDx As Single
eDy As Single
End Type

Private Const GM_ADVANCED = 2

Private Const MM_ADLIB = 9 ' Ad Lib-compatible synthesizer
Private Const MM_ANISOTROPIC = 8
Private Const MM_HIENGLISH = 5
Private Const MM_HIMETRIC = 3
Private Const MM_ISOTROPIC = 7
Private Const MM_LOENGLISH = 4
Private Const MM_LOMETRIC = 2
Private Const MM_TEXT = 1
Private Const MM_TWIPS = 6

Dim myXFORM As XFORM

Private Sub Command1_Click()

OldGFXMode = SetGraphicsMode(Picture1.hdc, GM_ADVANCED)
OldMapMode = SetMapMode(Picture1.hdc, MM_TWIPS)

myXFORM.eM11 = 0.866
myXFORM.eM12 = 0.5
myXFORM.eM21 = -0.5
myXFORM.eM22 = 0.866
myXFORM.eDx = 0
myXFORM.eDy = 0

Returned = SetWorldTransform(Picture1.hdc, myXFORM)
Picture1.Refresh

End Sub

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

Anyway, enough beating about the bush. Here's my working proof of concept. You'll need a form with two picture boxes and a command button. Picturebox2 needs to have a picture loaded into it.
[tt]
Option Explicit

Private Type XFORM
eM11 As Single
eM12 As Single
eM21 As Single
eM22 As Single
eDx As Single
eDy As Single
End Type

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long

Private Type POINTAPI
x As Long
y As Long
End Type


Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long
Private Declare Function GetGraphicsMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Const MM_TEXT = 1
Private Const MM_LOENGLISH = 4

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 ModifyWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM, ByVal iMode As Long) As Long
Private Declare Function GetWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM) As Long
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM) As Long

Private Const GM_ADVANCED = 2
Private Const GM_COMPATIBLE = 1

Private gOldWorld As XFORM

Private Sub Command1_Click()
Picture1.ForeColor = RGB(255, 0, 0) ' Just makes our demo lines more visible
TransformAndDraw Picture1.hdc, Picture2.hdc, 0, 0, 45
End Sub

' This particular XForm is a rotation only
Private Function buildXForm(ByVal x0 As Long, ByVal y0 As Long, ByVal q As Single) As XFORM
q = RadDeg(q)
buildXForm.eM11 = Round(Cos(q), 4)
buildXForm.eM12 = Round(Sin(q), 4) ' sign swapped with eM21 becuase y axis is downwards
buildXForm.eM21 = Round(-Sin(q), 4)
buildXForm.eM22 = Round(Cos(q), 4)
buildXForm.eDx = x0 'x0 - Cos(q) * x0 + Sin(q) * y0
buildXForm.eDy = y0 'y0 - Cos(q) * y0 - Sin(q) * x0
End Function

Private Sub TransformAndDraw(ByVal hdcTarget As Long, ByVal hdcSource As Long, ByVal aboutX As Long, ByVal aboutY As Long, ByVal rotate As Single)
Dim myXForm As XFORM
Dim mypoint As POINTAPI

' grab original settings so we can restore
GetWorldTransform hdcTarget, gOldWorld

SetGraphicsMode hdcTarget, GM_ADVANCED

' Change MapMode so that SetWorldTransform works properly
Debug.Print "Map mode: "; SetMapMode(hdcTarget, MM_TEXT)
'Debug.Print "Current graphics mode:"; GetGraphicsMode(hdcTarget)

' Build rotation transformation matrix
' In this case rotating 'rotate' degrees clockwise about point aboutX, aboutY
myXForm = buildXForm(aboutX, aboutY, rotate)

' Apply the transform
SetWorldTransform hdcTarget, myXForm

' Show that GDI drawing functions are affected
MoveToEx hdcTarget, 0, 0, mypoint
LineTo hdcTarget, 1000, 0

' Piece de resistance: bitmap gets rotated even though all we do is a normal BitBlt
BitBlt hdcTarget, 0, 0, 500, 500, hdcSource, 0, 0, vbSrcCopy

SetWorldTransform hdcTarget, gOldWorld
SetGraphicsMode hdcTarget, GM_COMPATIBLE

' Everything now back to normal, transform removed
' Draw a line to prove it
MoveToEx hdcTarget, 0, 100, mypoint
LineTo hdcTarget, 1000, 100
End Sub

Private Function RadDeg(ByVal angle As Double) As Double
RadDeg = angle * Atn(1) / 45
End Function

 

[strongm]

Pah! You give in too easy...

 

[strongm]

All that remains now is the DirectDraw solution...

 

[ADoozer]

im 23, i give up early, its in my nature (plus the simpsons is on) LOL

will give your code a go, i obviously was nowhere near the mark though!!!

anyway another star for your efforts!

as for direct draw NOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO!!!!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

I'll try to remember to post the DirectDraw solution this evening when I get home...you may be surprised...

 

[ADoozer]

hmmmmm... it seems to be doing random stuff!!

copying parts of the desktop to picture1 etc etc

gunna have a play around with it, but i figured id put it out there!!

thanks again though for the code!!

 

[ADoozer]

der!!! its bin a long day, the bitblt width and height were set to 500 hence copying the desktop as well as the image!!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[RichieSimonetti]

This is an example:

Rotating a Picture through any angle
By: John Percival
URL:

http://www.vbworld.com/tips/tip137.html

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
Then call it as follows:

Dim theta As Double

If Not IsNumeric(txtangle.Text) Then txtangle.Text = 0
txtangle.Text = txtangle.Text - 360 * (txtangle.Text \ 360)
theta = PI * CDbl(txtangle.Text) / 180

topict.Cls
topict.Visible = False

RotatePicture frompict.hdc, topict.hdc, _
theta, 0, 0, frompict.ScaleWidth - 1, _
frompict.ScaleHeight - 1, frompict.ScaleWidth / 2, _
frompict.ScaleHeight / 2, topict.ScaleWidth / 2, _
topict.ScaleHeight / 2

topict.Visible = True
This will rotate the contents of frompict through the number of degrees in txtAngle and place the result in topict. The middle of the original picture will map onto the middle of the new picture.

Unfortunatelly, the site isn't available anymore.

 

[BiggerBrother]

Very handy post Strongm - a star for you.

However, and know its been a while since the last post in this thread, but everytime I run this code, and my form looses focus, when I go back to the form, the image in picture1 has disappeared. How can I resolve this issue?

Thanks

BB

 

[RichieSimonetti]

Try using Autoredraw property to true.

 

[DrJavaJoe]

Set autoredraw property to true and refresh the picturebox.

&quot;Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'.&quot;

 

[DrJavaJoe]

Richie beat me to the draw.

&quot;Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'.&quot;

 

[strongm]

That's just standard VB behaviour - picture boxes don't by default know anything about anything that has been drawn to them. There are a number of solutions to this, but the simplest is just to set the target picture boxes autoredraw property to true, and do a Refresh after the tansform.