Rotate Bitmap

Author: admin | Category: Graphic

//This is how we can rotate bitmap
//for this example we need to use components below:
//OpenDialog1 (TopenDialog)
//Button1 (TBUtton)
//Button2 (TBUtton)
//Image1 (TImage)
//Put them to the form painter and try this script
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
  Math, StrUtils;
 
{$R *.dfm}
 
function Vektor(FromP, Top: TPoint): TPoint;
begin
  Result.x := Top.x - FromP.x;
  Result.y := Top.y - FromP.y;
end;
 
function xComp(Vektor: TPoint; Angle: Extended): Integer;
begin
  Result := Round(Vektor.x * cos(Angle) - (Vektor.y) * sin(Angle));
end;
 
function yComp(Vektor: TPoint; Angle: Extended): Integer;
begin
  Result := Round((Vektor.x) * (sin(Angle)) + (vektor.y) * cos(Angle));
end;
 
function RotImage(srcbit: TBitmap; Angle: Extended; FPoint: TPoint;
  Background: TColor): TBitmap;
var
  highest, lowest, mostleft, mostright: TPoint;
  topoverh, leftoverh: integer;
  x, y, newx, newy: integer;
begin
  Result := TBitmap.Create;
 
  while Angle >= (2 * pi) do
  begin
    angle := Angle - (2 * pi);
  end;
 
  if (angle <= (pi / 2)) then
  begin
    highest := Point(0,0);                        //OL
    Lowest := Point(Srcbit.Width, Srcbit.Height); //UR
    mostleft := Point(0,Srcbit.Height);            //UL
    mostright := Point(Srcbit.Width, 0);             //OR
  end
  else if (angle <= pi) then
  begin
    highest := Point(0,Srcbit.Height);
    Lowest := Point(Srcbit.Width, 0);
    mostleft := Point(Srcbit.Width, Srcbit.Height);
    mostright := Point(0,0);
  end
  else if (Angle <= (pi * 3 / 2)) then
  begin
    highest := Point(Srcbit.Width, Srcbit.Height);
    Lowest := Point(0,0);
    mostleft := Point(Srcbit.Width, 0);
    mostright := Point(0,Srcbit.Height);
  end
  else
  begin
    highest := Point(Srcbit.Width, 0);
    Lowest := Point(0,Srcbit.Height);
    mostleft := Point(0,0);
    mostright := Point(Srcbit.Width, Srcbit.Height);
  end;
 
  topoverh := yComp(Vektor(FPoint, highest), Angle);
  leftoverh := xComp(Vektor(FPoint, mostleft), Angle);
  Result.Height := Abs(yComp(Vektor(FPoint, lowest), Angle)) + Abs(topOverh);
  Result.Width  := Abs(xComp(Vektor(FPoint, mostright), Angle)) + Abs(leftoverh);
 
  Topoverh := TopOverh + FPoint.y;
  Leftoverh := LeftOverh + FPoint.x;
 
  Result.Canvas.Brush.Color := Background;
  Result.Canvas.pen.Color   := background;
  Result.Canvas.Fillrect(Rect(0,0,Result.Width, Result.Height));
 
  for y := 0 to srcbit.Height - 1 do
  begin
    for x := 0 to srcbit.Width - 1 do
    begin
      newX := xComp(Vektor(FPoint, Point(x, y)), Angle);
      newY := yComp(Vektor(FPoint, Point(x, y)), Angle);
      newX := FPoint.x + newx - leftoverh;
      newy := FPoint.y + newy - topoverh;
      // Move beacause of new size
      Result.Canvas.Pixels[newx, newy] := srcbit.Canvas.Pixels[x, y];
      // also fil lthe pixel beside to prevent empty pixels
      if ((angle < (pi / 2)) or
        ((angle > pi) and
        (angle < (pi * 3 / 2)))) then
      begin
        Result.Canvas.Pixels[newx, newy + 1] := srcbit.Canvas.Pixels[x, y];
      end
      else
      begin
        Result.Canvas.Pixels[newx + 1,newy] := srcbit.Canvas.Pixels[x, y];
      end;
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    if RightStr(OpenDialog1.FileName,3) = 'bmp' then
    begin
      Image1.Picture.LoadFromFile(OpenDialog1.FileName);
    end
    else
    showmessage('Please open bitmap file (bmp)');
  end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  BitRot : TBitmap;
begin
  BitRot := TBitmap.Create;
  try
    if assigned(image1.Picture.Bitmap) then
    begin
      BitRot := RotImage(image1.Picture.Bitmap,                         {Source}
                         DegToRad(90),                                           {90 degree to rotate}
                         Point(image1.Picture.Bitmap.Width div 2,        {x point for center rotate}
                         image1.Picture.Bitmap.Height div 2),              {y point for center rotate}
                         clBlack);                                                   {background Color for rotated image}
      Image1.Picture.Assign(BitRot);
    end;
  finally
    BitRot.Free;
  end;
end;
 
end.
 

Tags: Bitmap, Image