Drawing on an Image

Find TImage under the Additional component tab. You will notice that we needed to change very little code from that used in Drawing on a Canvas. We call the paint procedure when the form is created and when it is resized. Unlike the PaintBox demonstration on the previous page, the graphic displays if you minimise then restore the form and it scales appropriately when you resize the form. (For fast rendering to a TImage and for the transformations usually necessary for motion graphics you can use a TGLCanvas as demonstrated in our Box2D examples).

The Pascal and code of the form follow the screenshot.

Output after resizing the form

Pascal Code of Unit

unit uImageDemo;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Image1Paint(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1Paint(Sender);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Image1Paint(Sender);
end;

procedure TForm1.Image1Paint(Sender: TObject);
const
  HB = 10;     // Horizontal border
  VB = 10;     // Vertical border
var
  MaxWidth, MaxHeight, MaxX, MaxY, Col1, Col2, Col3, Row1, Row2, Row3,
  X, Y, CellWidth, CellHeight, CentreX, CentreY, Radius: integer;
  PentagonPoints: array[1 .. 6] of TPoint;
  TrianglePoints: array[1 .. 4] of TPoint;

  procedure RenderRow1;
  begin
    with Image1.Canvas do
      begin
        //  Red rectangle
        pen.Color := clRed;
        rectangle(HB , VB, Col1 - HB, Row1 - VB);
        //  Yellow filled rectangle
        brush.Color := clYellow;
        rectangle(Col1 + HB, VB, Col2 - HB, Row1 - VB);
        //  Green circle needs bounding square
        pen.Color := clGreen;
        brush.Color := clBtnFace;
        CentreX := (Col2 + Col3) div 2;
        CentreY := Row1 div 2;
        CellWidth := Col1 - 2 * HB;
        CellHeight := Row1 - 2 * VB;
        if CellWidth < CellHeight then
          Radius := CellWidth div 2
        else
          Radius := CellHeight div 2;
        ellipse(CentreX - Radius, CentreY - Radius,  CentreX + Radius, CentreY + Radius);
        //  Blue filled ellipse needs bounding rectangle
        pen.Color := clBlue;
        brush.Color := clBlue;
        ellipse(Col3 + 2 * HB, VB, MaxX - 2 * HB, Row1 - VB);
      end;
  end;

  procedure RenderRow2;
  begin
    with Image1.Canvas do
      begin
        //  Aqua line (solid)
        pen.Color := clAqua;
        pen.width := 4;
        moveTo(HB, Row1 + VB);
        lineTo (Col1 - HB, Row2 - VB);
        //  Teal dashed line
        moveTo( Col1 + HB, Row2 - VB);
        pen.Width := 1;
        pen.Style := psDash;
        pen.Color:= clTeal;
        lineTo(Col2 - HB, Row1 + VB);
        //  BtnFace ellipse with light grey outline
        pen.Color := clLtGray;
        pen.Style := psSolid;
        brush.Color := clBtnFace;
        Ellipse(Col2 + 2 * HB, Row1 + VB, Col3 - 2 * HB, Row2 - VB);
        //Purple filled circle
        pen.Color := clPurple;
        brush.Color := clPurple;
        CentreX := (Col3 + MaxX) div 2;
        CentreY := (Row1 + Row2) div 2;
        ellipse(CentreX - Radius, CentreY - Radius,  CentreX + Radius, CentreY + Radius);
      end;
  end;

  procedure RenderRow3;
  begin
    with Image1.Canvas do
      begin
        //  Three quarters of lime ellipse
        pen.Color := clLime;
        brush.Color := clLime;
        pie(HB, Row2 + VB, Col1-HB, Row3 - VB, HB + Row1 div 2, Row2 + VB,
           Row2 + VB + Row1 div 2, Row2 + VB + Row1 div 2);
        //  Dark grey rounded rectangle
        pen.Color := clDkGray;
        brush.Color := clDkGray;
        roundRect(Col1 + 2 * HB, Row2 + VB, Col2 - 2 * HB, Row3 - VB, 20, 20);
        //Fuchsia  pentagon
        pen.color := clFuchsia;
        PentagonPoints[1] := Point((Col3 + Col2) DIV 2,Row2 + VB);
        PentagonPoints[2] := Point(Col3 - HB,(Row2 + Row3) DIV 2);
        PentagonPoints[3] := Point(Col3 - (Col1 DIV 3), Row3 - VB);
        PentagonPoints[4] := Point(Col2 + (Col1 DIV 3), Row3 - VB);
        PentagonPoints[5] := Point(Col2 +  HB,(Row2 + Row3) DIV 2);
        PentagonPoints[6] := PentagonPoints[1];
        polyline(PentagonPoints);
        //  Red filled triangle
        pen.Color := clRed;
        brush.Color := clRed;
        TrianglePoints[1] := Point((Col3 + MaxX) DIV 2, Row2 + VB);
        TrianglePoints[2] := Point(MaxX - HB, Row3 - VB);
        TrianglePoints[3] := Point(Col3 + HB, Row3 - VB);
        TrianglePoints[4] := TrianglePoints[1];
        polygon(TrianglePoints);
      end;
  end;

  procedure RenderRow4;
  var
    Count: integer;
  begin
    with Image1.Canvas do
      begin
        //  Navy arc of ellipse
        pen.Color := clNavy;
        arc(HB, Row3 + VB, Col1 - HB, MaxY - VB,
            HB + Row1 div 2, Row3 + VB, HB, Row3 + VB + Row1 div 2);
        //Blue text
        font.Color := clBlue;
        font.Size := 10;
        TextOut(col1 + HB, (Row3 + MaxY) DIV 2, 'pp4s.co.uk');
        //  Maroon curve
        pen.Color := clMaroon;
        brush.Color := clMaroon;
        Count := 0;
        X := Col2 + HB;
        Y := Row3 + VB;
        while (X <= Col3) and (Y <= MaxY) do
          begin
            Rectangle(X - 1, Y - 1, X + 1, Y + 1);
            inc(Count);
            X := Col2 + HB + (Count * MaxX ) DIV 40;
            Y := Row3 + VB + (Count * Count * MaxY) DIV 150;
          end;
        pen.Color := clNavy;
        brush.Color := clSilver;
        Chord(HB + Col3, VB + Row3, MaxX - HB, MaxY - VB,
              HB + Col3, VB + Row3, MaxX - HB, MaxY - VB);
      end;
  end;

begin
  Image1.Width := Form1.ClientWidth;
  Image1.Height := Form1.ClientHeight;
  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
  MaxWidth := Image1.ClientWidth;
  MaxHeight := Image1.ClientHeight;
  Col1 := MaxWidth DIV 4;  //  End of column
  Col2 := MaxWidth DIV 2;
  Col3 := Col1 + Col2;
  Row1 := MaxHeight DIV 4;   //  End of row
  Row2 := MaxHeight DIV 2;
  Row3 := Row1 + Row2;
  MaxX := MaxWidth;
  MaxY := MaxHeight;
  RenderRow1;
  RenderRow2;
  RenderRow3;
  RenderRow4;
end;

end.

Code of Form

object Form1: TForm1
  Left = 522
  Height = 450
  Top = 94
  Width = 450
  Caption = 'Image Demo'
  ClientHeight = 450
  ClientWidth = 450
  OnCreate = FormCreate
  OnResize = FormResize
  LCLVersion = '1.2.4.0'
  object Image1: TImage
    Left = 0
    Height = 450
    Top = 0
    Width = 450
    OnPaint = Image1Paint
  end
end    

Gradient Fill

Replace the rectangle code at the start of procedure RenderRow1 with the following to output rectangles with horizontal and vertical gradient painting.

  procedure RenderRow1;
  var
    Rect: TRect;
  begin
    Rect.Left := HB;
    Rect.Top := VB;
    Rect.Right := Col1 - HB;
    Rect.Bottom := Row1 - VB;

    with Image1.Canvas do
      begin
        // rectangle with horizontal gradient fill
        GradientFill(Rect, clRed, clGreen, gdHorizontal);
        // rectangle with vertical gradient fill
        Rect.Left:= Rect.Left + Col1;
        Rect.Right:= Rect.Right + Col1;
        GradientFill(Rect, clWhite, clGreen, gdVertical);