lazarus/examples/lazintfimage/mainunit1.pas

unit MainUnit1;

{$mode objfpc}{$H+}

interface

{.$DEFINE DEBUG} //Show draw for rotate
uses
  Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs,
  Buttons, FPImage, IntfGraphics,Math, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Form1Create(Sender: TObject);
    procedure Form1Destroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FKind: Byte; // 1 = FadeIn 2 = Rotate
    procedure FadeIn(ABitmap: TBitmap; x, y: integer);
    procedure Rotate(ABitmap: TBitmap; aCanvas : TCanvas; x, y, Angle : integer);

  public
    SampleBitmapABitmap: TBitmap;
  end;

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  FKind := 1;
  Invalidate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FKind := 2;
  Invalidate;
end;

procedure TForm1.Form1Create(Sender: TObject);
begin
  FKind := 0;
  SampleBitmapABitmap:=TBitmap.Create;
  //SampleBitmapABitmap.LoadFromFile(SetDirSeparators('../../images/LazarusForm.bmp'));
  SampleBitmapABitmap.LoadFromFile(SetDirSeparators('LazarusForm.bmp'));
end;

procedure TForm1.Form1Destroy(Sender: TObject);
begin
  SampleBitmapABitmap.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if FKind = 1 then
    FadeIn(SampleBitmapABitmap,120,120)
  else
  if FKind = 2 then
    Rotate(SampleBitmapABitmap,Canvas,120,120,StrToIntDef(Edit1.Text,90));
  FKind := 0;
end;

procedure TForm1.FadeIn(ABitmap: TBitmap; x, y: integer);
var
  SrcIntfImg, TempIntfImg: TLazIntfImage;
  ImgHandle,ImgMaskHandle: HBitmap;
  FadeStep: Integer;
  px, py: Integer;
  CurColor: TFPColor;
  TempBitmap: TBitmap;
begin
  SrcIntfImg:=TLazIntfImage.Create(0,0);
  SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
  TempIntfImg:=TLazIntfImage.Create(0,0);
  TempIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
  TempBitmap:=TBitmap.Create;
  for FadeStep:=1 to 32 do
  begin
    for py:=0 to SrcIntfImg.Height-1 do
    begin
      for px:=0 to SrcIntfImg.Width-1 do
      begin
        CurColor:=SrcIntfImg.Colors[px,py];
        CurColor.Red:=(CurColor.Red*FadeStep) shr 5;
        CurColor.Green:=(CurColor.Green*FadeStep) shr 5;
        CurColor.Blue:=(CurColor.Blue*FadeStep) shr 5;
        TempIntfImg.Colors[px,py]:=CurColor;
      end;
    end;
    TempIntfImg.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
    TempBitmap.Handle:=ImgHandle;
    TempBitmap.MaskHandle:=ImgMaskHandle;
    Canvas.Draw(x,y,TempBitmap);
  end;
  SrcIntfImg.Free;
  TempIntfImg.Free;
  TempBitmap.Free;
end;

procedure TForm1.Rotate(ABitmap: TBitmap; aCanvas : TCanvas; x, y, Angle: integer);
var
  SrcIntfImg, TempIntfImg: TLazIntfImage;
  ImgHandle,ImgMaskHandle: HBitmap;
  px, py    : Integer;
  CurColor  : TFPColor;
  TempBitmap: TBitmap;
  
  ToX,ToY   : Integer;
  Xo,Yo     : Integer;
  beta      : Single;
  MinX,MaxX : Integer;
  MinY,MaxY : Integer;
  Dx,Dy     : Integer;
  
  procedure RotatePts(Var aX,aY : Integer);
  Var Xr,Yr : Integer;
  begin
    //Change new axe
    xr:=aX-Xo;
    yr:=aY-Yo;

    //Rotation
    aX:=Xo+Round(Xr*Cos(Beta)+Yr*Sin(Beta));
    aY:=Yo+Round(Xr*Sin(Beta)*-1+Cos(Beta)*Yr);
  end;
  
  {$IFDEF DEBUG}
  procedure Croix(aX,aY : integer; cl : TColor=clBlack);
  begin
    aCanvas.pen.Color:=cl;
    aCanvas.MoveTo(ax-10,ay);
    aCanvas.LineTo(ax+10,ay);
    aCanvas.MoveTo(ax,ay-10);
    aCanvas.LineTo(ax,ay+10);
  end;
  {$ENDIF}
  
begin
  SrcIntfImg:=TLazIntfImage.Create(0,0);
  SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
  TempIntfImg:=TLazIntfImage.Create(0,0);
  
  //Calculate the Sin and Cos of beta for later.
  Beta:=(Angle)*Pi/180;

  try
    {$IFDEF DEBUG}
    aCanvas.Brush.Style:=bsSolid;
    aCanvas.Brush.Color:=Color;
    aCanvas.FillRect(Rect(0,0,Width,Height-100));
    aCanvas.Brush.Color:=clWhite;
    {$ENDIF}
    
    TempIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
    TempBitmap:=TBitmap.Create;
    
    Xo:= SrcIntfImg.Width  div 2; //Center of rotation for x
    Yo:= SrcIntfImg.Height div 2; //Center of rotation for y
    px:=xo;
    py:=yo;

    //Calc new size after rotation
    px:=0;
    py:=0;
    RotatePts(px,py);
    toX:=0;
    toY:=SrcIntfImg.Height;
    RotatePts(ToX,ToY);
    
    MinX:=Min(px+x,Tox+x);
    MaxX:=Max(px+x,Tox+x);
    MinY:=Min(py+y,Toy+y);
    MaxY:=Max(py+y,Toy+y);
    
    px:=SrcIntfImg.Width;
    py:=0;
    RotatePts(px,py);
    toX:=SrcIntfImg.Width;
    toY:=SrcIntfImg.Height;
    RotatePts(ToX,ToY);

    MaxX:=MaxIntValue([px+x,Tox+x,MaxX]);
    MaxY:=MaxIntValue([py+y,Toy+y,MaxY]);
    MinX:=MinIntValue([px+x,Tox+x,MinX]);
    MinY:=MinIntValue([py+y,Toy+y,MinY]);

    {$IFDEF DEBUG}
    aCanvas.Rectangle(0+x,0+y,SrcIntfImg.Width+x,SrcIntfImg.Height+y);
    aCanvas.TextOut(xo+x-20,yo+y-20,Format('(%dx%d)',[MaxX-MinX,MaxY-MinY]));
    {$ENDIF}

    TempIntfImg.Width :=(MaxX-MinX)+1;
    TempIntfImg.Height:=(MaxY-MinY)+1;
    TempIntfImg.FillPixels(FPColor(0, 0, 0, 0));
    
    Dx:=(TempIntfImg.Width div 2)-Xo;
    Dy:=(TempIntfImg.Height div 2)-Yo;

    for py:=0 to SrcIntfImg.Height-1 do
    begin
      for px:=0 to SrcIntfImg.Width-1 do
      begin
        CurColor:=SrcIntfImg.Colors[px,py];

        ToX:=Px; ToY:=py;
        RotatePts(ToX,ToY);

        try
         TempIntfImg.Colors[ToX+Dx,ToY+Dy]:=CurColor;
        except
        end;
      end;
    end;

    {$IFDEF DEBUG}
    Croix(xo+x,yo+y,clblue);
    px:=SrcIntfImg.Width;
    py:=SrcIntfImg.Height;
    RotatePts(px,py);
    croix(px+x,py+y);

    px:=SrcIntfImg.Width;
    py:=0;
    RotatePts(px,py);
    croix(px+x,py+y);

    px:=0;
    py:=SrcIntfImg.Height;
    RotatePts(px,py);
    croix(px+x,py+y);

    px:=0;
    py:=0;
    RotatePts(px,py);
    croix(px+x,py+y);
    {$ENDIF}
    
    TempIntfImg.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
    TempBitmap.Handle:=ImgHandle;
    TempBitmap.MaskHandle:=ImgMaskHandle;
    aCanvas.Draw(x-dx,y-dy,TempBitmap);

    {$IFDEF DEBUG}
    aCanvas.Brush.Style:=bsClear;
    aCanvas.Rectangle(x-dx,y-dy,TempBitmap.Width+x-dx,TempBitmap.Height+y-dy);
    {$ENDIF}
  finally
    SrcIntfImg.Free;
    TempIntfImg.Free;
    TempBitmap.Free;
  end;
end;

end.