lazarus/examples/canvas_test/imagetest.pas

unit imagetest;

{$mode objfpc}

interface

uses
  Classes, Math, Forms, Graphics, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, LCLIntf, LCLType, IntfGraphics, FPImage;

type

  { TfrmImage }

  TfrmImage = class(TForm)
    btnSaveJPEG: TButton;
    btnResize: TButton;
    btnRotate: TButton;
    imageDepths: TImage;
    MyImage: TImage;
    Label1: TLabel;
    trackJPEG: TTrackBar;
    procedure btnResizeClick(Sender: TObject);
    procedure btnRotateClick(Sender: TObject);
    procedure btnSaveJPEGClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private

  public
    procedure RotateBitmap(ASource: TBitmap; ADest: TCanvas; x, y, Angle: integer);
  end; 

var
  frmImage: TfrmImage;

implementation

{$R *.lfm}

{ TfrmImage }

procedure TfrmImage.FormCreate(Sender: TObject);
var
  MyBitmap: TBitmap;
begin
  // Create a 100x100 bitmap and draw to it
  MyBitmap := TBitmap.Create;
  MyBitmap.PixelFormat := pf4bit;
  MyBitmap.Width  := 80;
  MyBitmap.Height := 80;
//  MyBitmap.
//  MyBitmap.Canvas.Brush.Color := RGBA(0,0,0,0);
  MyBitmap.Canvas.Pen.Color := clBlue;
  MyBitmap.Canvas.Rectangle(20, 20, 60, 60);
  imageDepths.Canvas.Draw(0, 0, MyBitmap);
  //
  MyBitmap.PixelFormat := pf32bit;
  MyBitmap.Width  := 80;
  MyBitmap.Height := 80;
  MyBitmap.Canvas.Brush.Color := TColor($F2F2F2);
  MyBitmap.Canvas.Pen.Color := clBlue;
  MyBitmap.Canvas.Rectangle(20, 20, 60, 60);
  imageDepths.Canvas.Draw(100, 0, MyBitmap);
  MyBitmap.Free;
end;

procedure TfrmImage.RotateBitmap(ASource: TBitmap; ADest: 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;

begin
  SrcIntfImg:=TLazIntfImage.Create(0,0);
  SrcIntfImg.LoadFromBitmap(ASource.Handle,ASource.MaskHandle);
  TempIntfImg:=TLazIntfImage.Create(0,0);

  //Calculate the Sin and Cos of beta for later.
  Beta:=(Angle)*Pi/180;

  try
    TempIntfImg.LoadFromBitmap(ASource.Handle,ASource.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]);

    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;

    TempIntfImg.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
    TempBitmap.Handle:=ImgHandle;
    TempBitmap.MaskHandle:=ImgMaskHandle;
    ADest.Draw(x-dx,y-dy,TempBitmap);
  finally
    SrcIntfImg.Free;
    TempIntfImg.Free;
    TempBitmap.Free;
  end;
end;

procedure TfrmImage.btnSaveJPEGClick(Sender: TObject);
var
  jpeg: TJPEGImage;
  Points: array[0..2] of TPoint;
  SaveDialog: TSaveDialog;
begin
  jpeg := TJPEGImage.Create;
  SaveDialog := TSaveDialog.Create(nil);
  try
    // Create a blue triangle image
    // on a black background
    jpeg.Width := 100;
    jpeg.Height := 100;
    jpeg.Canvas.Brush.Color := clBlue;
    Points[0] := Point(50, 25);
    Points[1] := Point(25, 75);
    Points[2] := Point(75, 75);
    jpeg.Canvas.Polygon(Points);

    // Prepares the save dialog and the
    // compression configurations
    SaveDialog.DefaultExt := 'jpg';
    jpeg.CompressionQuality := trackJPEG.Position;

    // Saves the file
    if SaveDialog.Execute then
      jpeg.SaveToFile(SaveDialog.FileName);
  finally
    // Releases the objects
    jpeg.Free;
    SaveDialog.Free;
  end;
end;

procedure TfrmImage.btnResizeClick(Sender: TObject);
var
  MyBitmap: TBitmap;
begin
  // Create a 100x100 bitmap and draw to it
  MyBitmap := TBitmap.Create;
  MyBitmap.Width  := 100;
  MyBitmap.Height := 100;
  MyBitmap.Canvas.Brush.Color := clBlue;
  MyBitmap.Canvas.Pen.Color := clBlue;
  MyBitmap.Canvas.Rectangle(20, 20, 80, 80);
  // Now resize it to 200x100
  MyBitmap.Width := 200;
  MyBitmap.Canvas.CopyRect(
      Bounds(0, 0, 200, 100),
      MyBitmap.Canvas,
      Bounds(0, 0, 100, 100));
  MyImage.Canvas.Draw(0, 0, MyBitmap);
  MyBitmap.Free;

  {  LCLIntf.StretchBlt(
      MyBitmap.Canvas.Handle, 0, 0, 200, 100,
      MyBitmap.Canvas.Handle, 0, 0, 100, 100, SRCCOPY);}
end;

procedure TfrmImage.btnRotateClick(Sender: TObject);
var
  MyBitmap: TBitmap;
begin
  // Create a 100x100 bitmap and draw to it
  MyBitmap := TBitmap.Create;
  MyBitmap.Width  := 100;
  MyBitmap.Height := 100;
  MyBitmap.Canvas.Brush.Color := clBlue;
  MyBitmap.Canvas.Pen.Color := clBlue;
  MyBitmap.Canvas.Rectangle(20, 20, 80, 80);
  RotateBitmap(MyBitmap, MyImage.Canvas, 0, 0, 40);
  MyBitmap.Free;
end;

end.