Rotate Bitmap

Hi guys,

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

Best Regards,
Pete.
fregalAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
God_AresConnect With a Mentor Commented:
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
 
God_AresCommented:
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
 
God_AresCommented:
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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
fregalAuthor Commented:
Dear God_Ares,

This didn't work.

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

Regards, Pete.
0
 
God_AresCommented:
I'll write a nice procedure 4 u at home..  hang on
0
 
TheNeilCommented:
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
 
tomer_engelCommented:
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
 
fregalAuthor Commented:
Adjusted points from 38 to 88
0
 
fregalAuthor Commented:
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
 
jeurkCommented:
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
 
God_AresCommented:
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
 
God_AresCommented:
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
 
fregalAuthor Commented:
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
 
God_AresCommented:
tired...  need to...  stay.. awake..... have to... help fregal....  more koffie !!
0
 
fregalAuthor Commented:
Thanks, God_Ares. It works fine.
0
 
God_AresCommented:
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
All Courses

From novice to tech pro — start learning today.