Lazarus Canvas Demonstration

Program CanvasDemo2 has the following definition of the TGraphicsForm class:

type
  TGraphicsForm = class(TForm)
  public
    procedure Paint; override;
    procedure Resize; override;
end;       

This Lazarus version of the canvas demonstration saves a file named graphics.bmp and displays a form on screen. You need to copy the code into the project file of an application (not a console application) so that all of the units in the uses section will be found by the compiler. The project file should have the name CanvasDemo2.lpr not CanvasDemo2.lpi.

We placed the code for drawing on the canvas of the form in new Paint and Resize methods so that the graphics are redrawn when necessary. Try dragging the edges of the form to see the shapes respond to the new size of canvas. The statement GraphicsForm.Invalidate repaints the entire form window.

program CanvasDemo2;
  {$mode objfpc}{$H+}
  {In Lazarus, Project > New project, select Application.
   View Units and select Project1.  Copy this code into Project1
   and save the unit as unit1 (although it will not be needed).
   Save the project as CanvasDemo2.}
uses
  Interfaces, Classes, SysUtils, LResources, Forms, Controls,
  Graphics, Dialogs, Menus, Types, StdCtrls;
const
  H_BORDER = 10;     //Horizontal border
  V_BORDER = 10;     //Vertical border
  WIDTH = 600;
  HEIGHT = 600;
type
  TGraphicsForm = class(TForm)
  public
    procedure Paint; override;
    procedure Resize; override;
  end;
var
  GraphicsForm : TGraphicsForm;
  MaxX, MaxY, Col1, Col2, Col3, Row1, Row2, Row3,
  X, Y, HB, VB : integer;
  PentagonPoints : array[1..6] of TPoint;
  TrianglePoints : array[1..4] of TPoint;

procedure DrawRow1(Canvas : TCanvas);
begin
  with 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;
      ellipse(Col2 + HB, VB, Col3 - HB, Row1 - VB);
      //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 DrawRow2(Canvas : TCanvas);
begin
  with 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);
      //White 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;
      Ellipse(Col3 + HB, Row1 + VB, MaxX - HB, Row2 - VB);
    end;
end;

procedure DrawRow3(Canvas : TCanvas);
begin
  with 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 DrawRow4(Canvas : TCanvas);
var
  Count : integer;
begin
  with 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
      brush.Color := clBtnFace;
      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, MaxYVB,
            HB + Col3, VB + Row3, MaxX-HB, MaxY-VB);
    end;
end;

procedure Grid(MaxWidth, MaxHeight : integer);
begin
  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;
end;

procedure TGraphicsForm.Paint;
begin
  DrawRow1(GraphicsForm.Canvas);
  DrawRow2(GraphicsForm.Canvas);
  DrawRow3(GraphicsForm.Canvas);
  DrawRow4(GraphicsForm.Canvas);
end;

procedure TGraphicsForm.Resize;
begin
  //Divide the area into columns and rows
  HB := H_BORDER;
  VB := V_BORDER;
  Grid(GraphicsForm.ClientWidth, GraphicsForm.ClientHeight);
  GraphicsForm.Invalidate;
end;

procedure Save;
var
  Bitmap : TBitmap;
begin
  ShowMessage('Saving graphics.bmp');
  Bitmap := TBitmap.Create;
  Bitmap.Width := WIDTH;
  Bitmap.Height := HEIGHT;
  HB := H_BORDER;
  VB := V_BORDER;
  //Colour the background white.
  Bitmap.Canvas.Brush.Color := clWhite;
  Bitmap.Canvas.Pen.Color := clWhite;
  Bitmap.Canvas.Rectangle(0, 0, WIDTH, HEIGHT);
  //Divide the area into columns and rows then draw and save.
  Grid(WIDTH, HEIGHT);
  DrawRow1(Bitmap.Canvas);
  DrawRow2(Bitmap.Canvas);
  DrawRow3(Bitmap.Canvas);
  DrawRow4(Bitmap.Canvas);
  Bitmap.SaveToFile('graphics.bmp');
end;

begin
  HB := H_BORDER;
  VB := V_BORDER;
  Application.Initialize;
  Application.CreateForm(TGraphicsForm, GraphicsForm);
  GraphicsForm.Caption := 'Graphics';
  GraphicsForm.Width := WIDTH;
  GraphicsForm.Height := HEIGHT;
  GraphicsForm.Constraints.MaxHeight:= HEIGHT + 100;
  GraphicsForm.Constraints.MinHeight:= HEIGHT - 100;
  GraphicsForm.Constraints.MaxWidth:= WIDTH + 100;
  GraphicsForm.Constraints.MinWidth:= WIDTH - 100;
  Save;
  //Divide the area into columns and rows
  Grid(GraphicsForm.ClientWidth, GraphicsForm.ClientHeight);
  GraphicsForm.ShowModal;
end.   
Programming - a skill for life!

Introduction to the use of a canvas in Delphi and Lazarus