graphicstest_mainform.pas

source code for the Marco Cantu s book Delphi 2009 Handbook

unit GraphicsTest_MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ExtCtrls, ExtDlgs;

type
  TFormGraphicsTest = class(TForm)
    Image1: TImage;
    ImageList1: TImageList;
    btnLoadImage: TButton;
    btnCreateAndSave: TButton;
    btnImageFromList: TButton;
    Image2: TImage;
    procedure btnLoadImageClick(Sender: TObject);
    procedure btnCreateAndSaveClick(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1Click(Sender: TObject);
    procedure btnImageFromListClick(Sender: TObject);
  private
    fPainting: Boolean;
    fImgNo: Integer;
  public
    { Public declarations }
  end;

var
  FormGraphicsTest: TFormGraphicsTest;

implementation

{$R *.dfm}

uses
  jpeg, pngimage, GIFImg;

procedure TFormGraphicsTest.btnCreateAndSaveClick(Sender: TObject);
var
  bmp: TBitmap;
begin
  if Assigned (Image1.Picture) and
    Assigned (Image1.Picture.Graphic) then
  begin
    Image1.Picture.Graphic.Empty;
  end;
  bmp := TBitmap.Create;
  bmp.Width := Image1.Width;
  bmp.Height := Image1.Height;
  Image1.Picture.Bitmap := bmp;

  fPainting := True;
end;

procedure TFormGraphicsTest.btnImageFromListClick(Sender: TObject);
begin
  ImageList1.Draw(Image2.Canvas, 10, 10, 0);
  ImageList1.Draw(Image2.Canvas, 10, 30, 1);
  ImageList1.Draw(Image2.Canvas, 10, 50, 2);
  ImageList1.Draw(Image2.Canvas, 10, 70, 3);

  ImageList1.Draw(Image2.Canvas, 30, 10, 4, dsSelected, itImage);
  ImageList1.Draw(Image2.Canvas, 30, 30, 4, dsTransparent, itImage);
  ImageList1.Draw(Image2.Canvas, 30, 50, 4, dsFocus, itImage);
  ImageList1.Draw(Image2.Canvas, 30, 70, 4, TDrawingStyle.dsNormal, itImage);
end;

procedure TFormGraphicsTest.btnLoadImageClick(Sender: TObject);
var
  strFilename: string;
begin
  case fImgNo of
    0: strFilename := 'adog.jpg';
    1: strFilename := 'Athene.png';
    2: strFilename := 'CodeGear.gif';
  end;
  Image1.Picture.LoadFromFile(strFileName);
  fImgNo := (fImgNo + 1) mod 3
end;

procedure SaveWithClass (graph: TGraphic; graphClass: TGraphicClass;
  const strFilename: string);
var
  grapImg: TGraphic;
begin
  grapImg := graphClass.Create;
  try
    grapImg.Assign(graph);
    grapImg.SaveToFile(strFilename);
  finally
    grapImg.Free;
  end;
end;

procedure TFormGraphicsTest.Image1Click(Sender: TObject);
var
  jpgImg: TJPEGImage;
begin
  if fPainting then
  begin
    jpgImg := TJPEGImage.Create;
    try
      jpgImg.Assign(Image1.Picture.Graphic);
      jpgImg.SaveToFile('test.jpg');
    finally
      jpgImg.Free;
    end;

    SaveWithClass (Image1.Picture.Graphic,
      TPngImage, 'test.png');
    SaveWithClass (Image1.Picture.Graphic,
      TGIFImage, 'test.gif');
    // done with painting
    fPainting := False;
  end;
end;

procedure TFormGraphicsTest.Image1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  aCanvas: TCanvas;
begin
  if fPainting then
  begin
    aCanvas := Image1.Picture.Bitmap.Canvas;
    aCanvas.Pixels [X, Y] := clBlue;
    aCanvas.Pixels [X+1, Y] := clBlue;
    aCanvas.Pixels [X, Y+1] := clBlue;
    aCanvas.Pixels [X+1, Y+1] := clRed;
  end;

end;

end.