Solved

Rotate Bitmap

Posted on 2000-04-18
16
992 Views
Last Modified: 2013-12-03
Hi guys,

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

Best Regards,
Pete.
0
Comment
Question by:fregal
16 Comments
 
LVL 7

Expert Comment

by:God_Ares
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
  realval := (2*pi) / (radius*8);
canvas1.point(50+sin(realval*step)*radius,50+cos(realval*step)*radius)
:=
canvas2.point(50+sin(realval*step+rotation)*radius,50+cos(realval*step+rotation)*radius)

end;

i didn't test it
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 2726401
almost forgot you have to rounddown

canvas1.point(50+round(sin(realval*step)*radius),50+round(cos(realval*step)*radius))

How rad woks
         
       1/2 pi  
        |
        |    
 pi ----+---- 0 pi   &   2 pi
        |
        |
       1 1/2 pi


0
 

Author Comment

by:fregal
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

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

Expert Comment

by:TheNeil
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

by:tomer_engel
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

by:fregal
ID: 2726792
Adjusted points from 38 to 88
0
 

Author Comment

by:fregal
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 4

Expert Comment

by:jeurk
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

by:God_Ares
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;
    add,tx,ty:real;
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

by:God_Ares
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

by:fregal
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

by:
God_Ares earned 88 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...

also made an test progg...

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

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

Author Comment

by:fregal
ID: 2728589
Thanks, God_Ares. It works fine.
0
 
LVL 7

Expert Comment

by:God_Ares
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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
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…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now