Delphi Canvas Demonstration

Program CanvasDemo has the following definition of the TGraphicsForm class:

type
  TGraphicsForm = class(TForm)
  public
    procedure Paint; override;
    procedure Resize; override;
    procedure PrintEventHandler(Sender: TObject);
    procedure SaveEventHandler(Sender: TObject);
end;       

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.

We demonstrate the creation and use of objects of the inbuilt classes TBitmap (for saving a graphics file), TMainMenu and TMenuItem. The statement SaveMenuItem.OnClick := GraphicsForm.SaveEventHandler causes the code in procedure SaveEventHandler to run when the user clicks on the Print menu item.

The program created the form shown below (with its menu in action).

Graphics Form

Graphics Form

program CanvasDemo;
  //Compile in Delphi, not Lazarus
uses
  SysUtils, Forms, Menus, Controls, Graphics,
  Types, StdCtrls, Dialogs, Printers;
const
  H_BORDER = 10;     //Horizontal border
  V_BORDER = 10;     //Vertical border
  WIDTH = 600;
  HEIGHT = 600;
  PRINT_WIDTH = 4000;
  PRINT_HEIGHT = 4000;
type
  TGraphicsForm = class(TForm)
  public
    procedure Paint; override;
    procedure Resize; override;
    procedure PrintEventHandler(Sender: TObject);
    procedure SaveEventHandler(Sender: TObject);
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;
  Menu : TMainMenu;
  FileMenuItem, PrintMenuItem, SaveMenuItem : TMenuItem;

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, MaxYVB,
          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, 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 TGraphicsForm.PrintEventHandler(Sender: TObject);
begin
   Showmessage('Printing');
  //Divide the area into columns and rows
  HB := H_BORDER * 5;
  VB := V_BORDER * 5;
  Grid(PRINT_WIDTH, PRINT_HEIGHT);
  Printer.BeginDoc;
  DrawRow1(Printer.Canvas);
  DrawRow2(Printer.Canvas);
  DrawRow3(Printer.Canvas);
  DrawRow4(Printer.Canvas);
  Printer.EndDoc;
end;

procedure TGraphicsForm.SaveEventHandler(Sender: TObject);
var
  Bitmap : TBitmap;
begin
  Showmessage('Saving graphics.bmp');
  Bitmap := TBitmap.Create;
  Bitmap.Width := WIDTH;
  Bitmap.Height := HEIGHT;
  HB := H_BORDER;
  VB := V_BORDER;
  //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;
  GraphicsForm := TGraphicsForm.CreateNew(Application);
  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;
  //Create file menu containing print and save
  Menu := TMainMenu.Create(GraphicsForm);
  FileMenuItem := TMenuItem.Create(Menu);
  //The letter after & is a shortcut key (ALT-F then P should print).  
  FileMenuItem.Caption:= '&File';
  Menu.Items.Add(FileMenuItem);
  PrintMenuItem := TMenuItem.Create(FileMenuItem);
  PrintMenuItem.Caption := '&Print';
  PrintMenuItem.OnClick := GraphicsForm.PrintEventHandler;
  FileMenuItem.Add(PrintMenuItem);
  SaveMenuItem := TMenuItem.Create(FileMenuItem);
  SaveMenuItem.Caption := '&Save';
  SaveMenuItem.OnClick := GraphicsForm.SaveEventHandler;
  FileMenuItem.Add(SaveMenuItem);
  //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