Rotacionar/Girar imagem bitmap

Esta semana estava fazendo uma pesquisa para desenvolver uma aplicação e acabei esbarrando com uma solução para um dos problemas que vou enfrentar: rotação de imagens. Prontamente adaptei a solução, originalmente criada para o Delphi, para funcionar no Lazarus. Praticamente não mudei uma linha sequer das funções criadas para o Delphi. Aproveitei e deu uma pequena incrementada no exemplo.

Exemplo feito para o Lazarus: http://tinyurl.com/LazRotacionaImagem-7z

Programa original: http://exampledelphi.com/delphi.php/graphic/rotate-bitmap/

{
20 de dezembro de 2009
Testado com sucesso no Lazarus 0.9.29
Adaptado por Ericson Benjamim - ericsonbenjamim arroba yahoo ponto com ponto br
a partir de:
http://exampledelphi.com/delphi.php/graphic/rotate-bitmap/
}
unit LazRotacionaImagem_FormPrincipal;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ExtDlgs, Spin;

type

{ TFormPrincipal }

TFormPrincipal = class(TForm)
Button1: TButton;
Button2: TButton;
FloatSpinEditAngulo: TFloatSpinEdit;
Image1: TImage;
Label1: TLabel;
OpenPictureDialog1: TOpenPictureDialog;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
FormPrincipal: TFormPrincipal;

implementation

uses
Math, StrUtils;

{ TFormPrincipal }

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 angle := Angle - (2 * pi);

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 por causa do novo tamanho
 Result.Canvas.Pixels[newx, newy] := srcbit.Canvas.Pixels[x, y];
 // Preenche o pixel ao lado para prevenir pixels vazios
 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 TFormPrincipal.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
if RightStr(OpenPictureDialog1.FileName, 3) = 'bmp' then
begin
 Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end
else
ShowMessage('Por favor abra um arquivo de imagem BMP.');
end;
end;

procedure TFormPrincipal.Button2Click(Sender: TObject);
var
BitRot : TBitmap;
begin
BitRot := TBitmap.Create;
try
if assigned(image1.Picture.Bitmap) then
begin
 BitRot := RotImage(image1.Picture.Bitmap,                   {Origem}
                    DegToRad(FloatSpinEditAngulo.Value),
                    Point(image1.Picture.Bitmap.Width div 2, {ponto x para centralizar rotacao}
                    image1.Picture.Bitmap.Height div 2),     {ponto y para centralizar rotacao}
                    clBlack);                                {Cor de fundo para imagem rotacionada}
 Image1.Picture.Assign(BitRot);
end;
finally
BitRot.Free;
end;
end;

initialization
{$I LazRotacionaImagem_FormPrincipal.lrs}

end.