Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
Solved

Rotate Bitmap

Posted on 2000-04-18
Medium Priority
1,004 Views
Hi guys,

How to rotate bitmap to any angle (e.g.
30 or 159.97)?

Best Regards,
Pete.
0
Question by:fregal
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points

LVL 7

Expert Comment

ID: 2726331
Let's say you hav a bitmap heigth=width=101
so the middle will be (50,50)

sin and cos is working with rad 360 degrees is pi*2

rotation := ((2*pi)/(360))*degrees of rotation.

for radius := 1 to 50 do
for step := 1 to radius*8 do
begin
:=

end;

i didn't test it
0

LVL 7

Expert Comment

ID: 2726401
almost forgot you have to rounddown

1/2 pi
|
|
pi ----+---- 0 pi   &   2 pi
|
|
1 1/2 pi

0

Author Comment

ID: 2726402
Dear God_Ares,

This didn't work.

I need a procedure like
Rotate(Bitmap: TBitmap, Angle: Extended);

Regards, Pete.
0

LVL 7

Expert Comment

ID: 2726486
I'll write a nice procedure 4 u at home..  hang on
0

LVL 5

Expert Comment

ID: 2726501
You could try this. It's nasty and totally UNoptimised but it does work

This routine takes an image from a source TImage called Source and outputs the results on a second TImage called Dest. The angle to rotate by is obtained from a TEdit control called TAngle.

PROCEDURE Rotate_Image;
VAR
xp             : INTEGER;
yp             : INTEGER;
cos_angle      : REAL;
sin_angle      : REAL;
n, m           : INTEGER;
x, y           : ARRAY [2..4] OF INTEGER;
tyc, tys       : REAL;
lx, ly, ux, uy : INTEGER;
y_offset       : REAL;
x_offset       : REAL;
angle          : INTEGER;
done_something : BOOLEAN;
temp           : TBitmap;
source2        : TBitmap;
begin
angle := StrToInt(TAngle.Text) MOD 360; {Get the angle into the range 0-360}
IF angle < 0                            {We can't be bothered to handle -ve}
THEN                                    {rotations, so turn it into a +ve}
angle := 360 + angle;

sin_angle := SIN(angle * (PI / 180));   {These don't change so don't bother}
cos_angle := COS(angle * (PI / 180));   {calculating them 15000 times later}

x[2] := ROUND(Source.Width * cos_angle);  {We need to know how big the final}
y[2] := ROUND(Source.Width * sin_angle);  {image will be. Rotate the corners}
x[3] := ROUND(-Source.Height * sin_angle);
y[3] := ROUND(Source.Height * cos_angle);
x[4] := ROUND((Source.Width * cos_angle) - (Source.Height * sin_angle));
y[4] := ROUND((Source.Width * sin_angle) + (Source.Height * cos_angle));

lx := 0;
ux := 0;
ly := 0;
uy := 0;
FOR n := 2 TO 4                {Find out the maximum and minimum x's and y's}
DO
BEGIN
IF x[n] < lx THEN lx := x[n];
IF x[n] > ux THEN ux := x[n];
IF y[n] < ly THEN ly := y[n];
IF y[n] > uy THEN uy := y[n];
END;

Dest.Width := ux - lx;              {Make the destination big enough to hold}
Dest.Height := uy - ly;             {the final image}

x_offset := 0;                      {As we are rotating around 0,0 we need}
y_offset := Source.Width * Sin_Angle - 1; {to add offset values on, to get}
{the image centred on the screen. The}
IF Angle > 90                       {offsets vary depending upon the size of}
THEN                                {the rotation}
BEGIN
IF Angle <= 180
THEN
BEGIN
x_offset := Source.Width * Cos((180 - angle) * (PI/ 180)) - 1;
y_offset := Dest.Height - 1;
END
ELSE
BEGIN
IF Angle <= 270
THEN
BEGIN
x_offset := Dest.Width - 1;
y_offset := Source.Height * Cos((180 - Angle) * (PI / 180));
END
ELSE
BEGIN
x_offset := Source.Height * Cos((angle - 270) * (PI / 180));
y_offset := 0;
END;
END;
END;

Source2 := TBitmap.Create;         {Save time by working in memory rather}
Source2.Width := Source.Width;     {than directly on the screen}
Source2.Height := Source.Height;
Source2.Canvas.Draw(0, 0, Source.Picture.Bitmap);

Temp := TBitmap.Create;
Temp.Width := Dest.Width;
Temp.Height := Dest.Height;
Temp.Canvas.Brush.Color := clRed;
Temp.Canvas.Pen.Color := clRed;
Temp.Canvas.FillRect(RECT(0, 0, Temp.Width, Temp.Height));

IF angle = 0            {Rotate by 0 is nothing so just copy the image across}
THEN
Temp.Canvas.Draw(0, 0, Source2)
ELSE
FOR m := 0 TO Temp.Height   {We go around each pixel in the DESTINATION}
DO                          {image rather than the source, as integer maths}
BEGIN                       {results in 'holes' if we go the other way}
tyc := (m - y_offset) * cos_angle;
tys := (m - y_offset) * sin_angle;
done_something := FALSE;
FOR n := 0 TO Temp.Width
DO
BEGIN
xp := ROUND(((n - x_offset) * cos_angle) - tys);
yp := ROUND(((n - x_offset) * sin_angle) + tyc);
IF (xp >= Source2.Width) OR (yp >= Source2.Height) OR (xp<0) OR (yp<0)
THEN
BEGIN
IF done_something  {We've started to go off the edge of the source}
THEN               {image so there isn't anything else of any}
n := Dest.Width; { importance. May as well stop (and save time)}
END
ELSE
BEGIN
Temp.Canvas.Pixels[n, m] := Source2.Canvas.Pixels[xp, yp];
done_something := TRUE;
END;
END;
END;

Dest.Canvas.Draw(0, 0, Temp);    {Slap the resultant image up on the screen}
Temp.Free;                       {and free that memory up}
Source2.Free;
end;

The Neil
0

LVL 1

Expert Comment

ID: 2726606
neil suggested averylog procedure toa  simple operation--> I don't know if  you have ever heared of   Vectors and
lineral transformations (from math--analitical geometry///or lineral algebra)

and then apply it just as niel said(but shorter)

each pixel should move to:

the loop iterates through the pixels,and put's them in  a new bitmap

pay attention(or takeoutyour math book) that the rotation-transformation is around (0,0,0)--or e1,e2,e3 -->so you have to move      your results back .

if you'd like  i can write a full procedure...
0

Author Comment

ID: 2726792
Adjusted points from 38 to 88
0

Author Comment

ID: 2726793
To TheNeil,

1)Your example doesn't work correctly :(
2)Angle in your example - Integer, but I need to rotate bitmap to extended angle.

To tomer_engel,

>if you'd like  i can write a full >procedure...

I like.
0

LVL 4

Expert Comment

ID: 2727224
hello,
I suggest you look here :
http://www.efg2.com/Lab/ImageProcessing/RotateScanline.htm

-------------------
CONST
MaxPixelCount = 32768;

TYPE
TRGBTripleArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray;
....

// "Simple" approach. For pixel (i,j), use "reverse" rotation to find
// where the rotated pixel must have been before the rotation.
// Don't bother with center of pixel adjustment.
// Assumes input BitmapOriginal has PixelFormat = pf24bit.
FUNCTION RotateBitmapMethod1 (CONST BitmapOriginal: TBitmap;
CONST iRotationAxis, jRotationAxis: INTEGER;
CONST AngleOfRotation: DOUBLE  {radians} ): TBitmap;

VAR
cosTheta   : EXTENDED;
i          : INTEGER;
iOriginal  : INTEGER;
iPrime     : INTEGER;
j          : INTEGER;
jOriginal  : INTEGER;
jPrime     : INTEGER;
RowOriginal: pRGBTripleArray;
RowRotated : pRGBTRipleArray;
sinTheta   : EXTENDED;
BEGIN
// The size of BitmapRotated is the same as BitmapOriginal. PixelFormat
// must also match since 24-bit GBR triplets are assumed in ScanLine.
RESULT := TBitmap.Create;
RESULT.Width  := BitmapOriginal.Width;
RESULT.Height := BitmapOriginal.Height;
RESULT.PixelFormat := pf24bit; // Force this

// Get SIN and COS in single call from math library
sincos(AngleOfRotation, sinTheta, cosTheta);

// If no math library, then use this:
// sinTheta := SIN(AngleOfRotation);
// cosTheta := COS(AngleOfRotation);

// Step through each row of rotated image.
FOR j := RESULT.Height-1 DOWNTO 0 DO
BEGIN
RowRotated := RESULT.Scanline[j];
jPrime := j - jRotationAxis;

FOR i := RESULT.Width-1 DOWNTO 0 DO
BEGIN
iPrime := i - iRotationAxis;
iOriginal := iRotationAxis + ROUND(iPrime * CosTheta - jPrime * sinTheta);
jOriginal := jRotationAxis + ROUND(iPrime * sinTheta + jPrime * cosTheta);

// Make sure (iOriginal, jOriginal) is in BitmapOriginal. If not,
// assign blue color to corner points.
IF (iOriginal >= 0) AND (iOriginal <= BitmapOriginal.Width-1) AND
(jOriginal >= 0) AND (jOriginal <= BitmapOriginal.Height-1)
THEN BEGIN
// Assign pixel from rotated space to current pixel in BitmapRotated
RowOriginal := BitmapOriginal.Scanline[jOriginal];
RowRotated[i] := RowOriginal[iOriginal]
END
ELSE BEGIN
RowRotated[i].rgbtBlue := 255; // assign "corner" color
RowRotated[i].rgbtGreen := 0;
RowRotated[i].rgbtRed := 0
END

END
END
END {RotateBitmapMethod1};

But maybe you are using NT or 2000 ?
then you could use the api function PlgBlt.
here is how to use it : http://www.undu.com/Articles/000103a.html

PlgBlt. The parameters it expects are as follows (partially excerpted from the Win32 API Help):

hdcDest - Identifies the destination device context. This is the handle to the destination canvas (BkBmp.Canvas.Handle)
lpPoint â€“ This is our array of points used to identify the first three corners of the destination parallelogram. The upper-left corner of the source rectangle is mapped to the first point in this array, the upper-right corner to the second point in this array, and the lower-left corner to the third point. As I mentioned earlier, the lower-right corner is calculated for you. It doesnâ€™t hurt that we are actually passing in all four points, the PlgBlt function is ignoring the last one.
hdcSrc - Identifies the source device context.  This is the handle to the Images canvas (Img.Canvas.Handle).
nXSrc - Specifies the x-coordinate, of the upper-left corner of the source rectangle.
nYSrc - Specifies the y-coordinate, of the upper-left corner of the source rectangle.
nWidth - Specifies the width, of the source rectangle.
nHeight - Specifies the height, of the source rectangle.

Example : ========================

unit PlgBltU;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, Math;

type
TForm1 = class(TForm)
Img: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
private
P          : Array[0..3] of TPoint;
OAng       : Array[0..3] of Double;
OverHandle : Integer;
BkBmp      : TBitmap;
MidPt      : TPoint;
Ang,R      : Double;
end;

var
Form1: TForm1;

implementation

{\$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
Pt : Integer;
begin
BkBmp := TBitmap.Create;
BkBmp.Width := Width;
BkBmp.Height := Height;
P[0] := Img.BoundsRect.TopLeft;
P[3] := Img.BoundsRect.BottomRight;
P[1] := P[0]; Inc(P[1].X,Img.Width);
P[2] := P[3]; Dec(P[2].X,Img.Width);
with Img do MidPt := Point(Left+Width div 2,Top + Height div 2);
with Img do R := SqRt(Sqr(Width div 2)+Sqr(Height div 2));
for Pt := 0 to 3 do with P[Pt] do
OAng[Pt]:= ArcTan2(Y-MidPt.Y,X-MidPt.X)+Pi;
OverHandle := -1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
BkBmp.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
Pt : Integer;
begin
with BkBmp.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(ClipRect);
if PlgBlt(Handle,P,Img.Canvas.Handle,0,0,Img.Width,Img.Height,0,0,0) then
begin
Brush.Color := clBlack;
for Pt := 0 to 3 do with P[Pt] do
FillRect(Rect(X-3,Y-3,X+3,Y+3));
end
else
TextOut(0,0,'PlgBlt currently supported only on WinNT');
end;
Canvas.Draw(0,0,BkBmp);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
Pt      : Integer;
TmpRect : TRect;
begin
if ssLeft in Shift then
begin
if OverHandle = -1 then exit;
Ang := ArcTan2(Y-MidPt.Y,X-MidPt.X)-OAng[OverHandle]+Pi;
for Pt := 0 to 3 do
P[Pt] := Point(MidPt.X-Round(R*Cos(Ang+OAng[Pt])),
MidPt.Y-Round(R*Sin(Ang+OAng[Pt])));
Paint;
end
else
begin
OverHandle := -1;
for Pt := 0 to 3 do
begin
with P[Pt] do TmpRect := Rect(X-3,Y-3,X+3,Y+3);
if PtInRect(TmpRect,Point(X,Y)) then
begin
Cursor := crHandPoint;
OverHandle := Pt;
end;
end;
if OverHandle = -1 then Cursor := crDefault;
end;
end;

end.

CU

0

LVL 7

Expert Comment

ID: 2727792
manny manny lines of code but mine is best..

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Math, Spin;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Image2: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure Rotate(const org: timage; var rot:timage;x,y:integer;angle:real);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.DFM}
procedure Tform1.Rotate(const org: timage; var rot:timage;x,y:integer;angle:real);
var i,j,t1,t2:integer;
col:tcolor;
Begin

For i:=0 to org.Width-1 do
For j:=0 to org.Height-1 do
Begin
col:=org.Canvas.Pixels[i,j];
t1 := i - x;
t2 := j - y;

{set new rotated coordinates}
tx := t1 * cos(angle * pi / 180) - t2 * sin(angle * pi / 180);
ty := t1 * sin(angle * pi / 180) + t2 * cos(angle * pi / 180);

{setting pixels and preventing gaps}
rot.Canvas.Pixels[trunc(tx+x),trunc(ty+y)]:=col;
rot.Canvas.Pixels[round(tx+x),round(ty+y)]:=col;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Rotate(image1,image2,100,100,192.3);

end;

end.

enjoy
0

LVL 7

Expert Comment

ID: 2728154
it is better to modify the procedure
form

procedure Tform1.Rotate(const org: timage; var rot:timage;x,y:integer;angle:real);

to

procedure Tform1.Rotate(const org: tcanvas; var rot:tcanvas;x,y:integer;angle:real);

and

col:=org.Pixels[i,j];

[code]
rot.Pixels[trunc(tx+x),trunc(ty+y)]:=col;
rot.Pixels[round(tx+x),round(ty+y)]:=col;

0

Author Comment

ID: 2728341
Guys,

I look into all examples. Your variants of Rotate procedure works well, but it's not exactly what I need, because I can see only part of output Bitmap with your code. I need to fully rotate bitmap like Paint Shop Pro or other apps.

WBR, Pete.
0

LVL 7

Accepted Solution

God_Ares earned 352 total points
ID: 2728460
I guezz you want the canvas to get larger, right?? well here it is..
Danm dank tooooo much koffie ate to little... I think i deserve those points BIG time...

http://www.angelfire.com/ok/GODARES/downl.html

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Math, Spin;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Image2: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure Rotate(const org: timage; var rot:timage;x,y:integer;angle:real);
procedure dimensions(const org: timage; x,y:integer;var h,w:integer;angle:real);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.DFM}
procedure Tform1.dimensions(const org: timage; x,y:integer;var h,w:integer;angle:real);
var i,j,t1,t2:integer;
tx,ty:real;
xmin,xmax,ymin,ymax:integer;
Begin
xmin:=999; ymin:=999; xmax:=0; ymax:=0;  //for making the canvas larger

For i:=0 to org.Width-1 do
For j:=0 to org.Height-1 do
Begin
t1 := i - x;
t2 := j - y;

{set new rotated coordinates}
tx := t1 * cos(angle * pi / 180) - t2 * sin(angle * pi / 180);
ty := t1 * sin(angle * pi / 180) + t2 * cos(angle * pi / 180);
if xmin>round(tx+x) then xmin:=round(tx+x);
if ymin>round(ty+y) then ymin:=round(ty+y);
if xmax<round(tx+x) then xmax:=round(tx+x);
if ymax<round(ty+y) then ymax:=round(ty+y);
end;
h:=ymax-ymin;
w:=xmax-xmin;
end;

procedure Tform1.Rotate(const org: timage; var rot:timage;x,y:integer;angle:real);

var i,j,t1,t2:integer;
col:tcolor;
tx,ty:real;
h,w,dh,dw:integer;
Begin
dimensions(org,100,100,h,w,192.3);
dw:=w-rot.Width; dh:=h-rot.Height;
rot.Width:=w+1;  rot.Height:=h+1;
dw := (dw div 2);
dh := (dh div 2);
For i:=0 to org.Width-1 do
For j:=0 to org.Height-1 do
Begin
col:=org.Canvas.Pixels[i,j];
t1 := i - x;
t2 := j - y;

{set new rotated coordinates}
tx := t1 * cos(angle * pi / 180) - t2 * sin(angle * pi / 180);
ty := t1 * sin(angle * pi / 180) + t2 * cos(angle * pi / 180);

{setting pixels and preventing gaps}
rot.Canvas.Pixels[trunc(tx+x+dw),trunc(ty+y+dh)]:=col;
rot.Canvas.Pixels[round(tx+x+dw),round(ty+y+dh)]:=col;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

Rotate(image1,image2,100,100,192.3);

end;

end.

0

LVL 7

Expert Comment

ID: 2728469
tired...  need to...  stay.. awake..... have to... help fregal....  more koffie !!
0

Author Comment

ID: 2728589
Thanks, God_Ares. It works fine.
0

LVL 7

Expert Comment

ID: 2728612
thank you for accepting my answer

you can optimize the dimensions procedure you only have to test cooordinates

0,0   width,0   0,height width,heigth

will save some time...
0

Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy reâ€¦
Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing howâ€¦
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custoâ€¦
If youâ€™ve ever visited a web page and noticed a cool font that you really liked the look of, but couldnâ€™t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yoâ€¦
Suggested Courses
Course of the Month10 days, 4 hours left to enroll