Drawing on a PaintBox

Find TPaintBox under the Additional component tab. We demonstrate how to use the procedure corresponding to the OnPaint event to write graphics code. You will notice that we needed to change very little code from that used in Drawing on a Canvas. By using the canvas of a PaintBox instead of the form's canvas you can easily use other components on the same form. Our demo uses one PaintBox and five buttons.

We do not include code to redraw the PaintBox if the form is resized or minimised then restored. On the following page we demonstrate drawing on an Image instead, as recommended by the DelphiLand team.

The Pascal and code of the form follow the screenshot.

Output on pressing the last button

Output on pressing the last button

Pascal Code of Form

unit uPaintBoxDemo;

{$mode objfpc}{$H+}

interface

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

type
  TForm1 = class(TForm)
    btnRow1, btnRow2, btnRow3, btnRow4, btnAllRows: TButton;
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure btnClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.PaintBox1Paint(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 PaintBox1.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;
        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 PaintBox1.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 PaintBox1.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 PaintBox1.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
  MaxWidth := PaintBox1.ClientWidth;
  MaxHeight := PaintBox1.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;
  CellWidth := Col1 - 2 * HB;
  CellHeight := Row1 - 2 * VB;
  if CellWidth < CellHeight then
    Radius := CellWidth div 2
  else
    Radius := CellHeight div 2;
  if Sender = btnRow1 then
    RenderRow1;
  if Sender = btnRow2 then
    RenderRow2;
  if Sender = btnRow3 then
    RenderRow3;
  if Sender = btnRow4 then
    RenderRow4;
  if Sender = btnAllRows then
    begin
      RenderRow1;
      RenderRow2;
      RenderRow3;
      RenderRow4;
    end;
end;

procedure TForm1.btnClick(Sender: TObject);
begin
  PaintBox1Paint(Sender);
end;

end.

Code of Form

object Form1: TForm1
  Left = 238
  Height = 210
  Top = 150
  Width = 410
  Caption = 'PaintBox Demo'
  ClientHeight = 210
  ClientWidth = 410
  LCLVersion = '1.2.4.0'
  object PaintBox1: TPaintBox
    Left = 8
    Height = 161
    Top = 40
    Width = 392
    OnPaint = PaintBox1Paint
  end
  object btnRow1: TButton
    Left = 8
    Height = 25
    Top = 8
    Width = 75
    Caption = 'Row1'
    OnClick = btnClick
    TabOrder = 0
  end
  object btnRow2: TButton
    Left = 88
    Height = 25
    Top = 8
    Width = 75
    Caption = 'Row2'
    OnClick = btnClick
    TabOrder = 1
  end
  object btnRow3: TButton
    Left = 168
    Height = 25
    Top = 8
    Width = 75
    Caption = 'Row3'
    OnClick = btnClick
    TabOrder = 2
  end
  object btnRow4: TButton
    Left = 248
    Height = 25
    Top = 8
    Width = 75
    Caption = 'Row4'
    OnClick = btnClick
    TabOrder = 3
  end
  object btnAllRows: TButton
    Left = 328
    Height = 25
    Top = 8
    Width = 75
    Caption = 'All Rows'
    OnClick = btnClick
    TabOrder = 4
  end
end

Programming - a skill for life!

Using widgets (such as list boxes, combo boxes, string grids, DBgrids, charts and maps) and drawing on the canvas