The Canvas on a form or on a picturebox

Onderstaande code is een verbetering van het Pixels tekenen uit andere threads. De code zijn alleen de stukken die je nodig hebt in je Lazarus project.

Eerst zijn de constanten en de variabelen die je nodig hebt.

const
 pxCount = 800;
 canvasWidth = 688;
 canvasHeight = 600;
var
 frmMain: TfrmMain; // deze wordt al aangemaakt
 pixels: array[0..canvasWidth - 1, 0..canvasHeight - 1] of Integer;
 Fproc: int64;
 EscapePressed: Boolean = False;

De frmMain is de naam van het venster.
Variabele Fproc wordt gebruikt om tijdens het tekenen een Delay uit te kunnen voeren. Plaats de Delay procedure body onder de implementation. Vergeet niet om de procedure declaratie in de form klasse te plaatsen.

procedure TfrmMain.Delay(msecs:double);
var T1 : int64 = 0;
   T2 : int64 = 0;
begin
 QueryPerformanceCounter(T1);
 QueryPerformanceCounter(T2);
 while 1000*(T2-T1)/Fproc<=msecs do
   begin
     Application.ProcessMessages;  // reageert op key en mouse en andere controls,
                                   // maar niet op het sluiten van het venster
     QueryPerformanceCounter(T2);
   end;
end;

Gebruik voor de zekerheid ook een CanvasClear om telkens bij de volgende tekening de paintbox schoon te maken. Plaats ook deze procedure in de form klasse. De body kan onder de Delay procedure.

procedure CanvasClear;
begin
 frmMain.pbMain.Color := clBlack;
 with frmMain.pbMain.Canvas do
 begin
   Brush.Color := clBlack;
   FillRect(0, 0, canvasWidth - 1, canvasHeight - 1);
 end;
 Application.ProcessMessages;
end;

De pixels moeten ook gegenereerd worden. Deze wordt in de FormCreate aangeroepen.

procedure TfrmMain.GenereerPixels;
var
 x, y, p: Integer;
begin
 for y := 0 to canvasHeight - 1 do
   for x := 0 to canvasWidth - 1 do
     pixels[x, y] := 0;
 p := 1;
 while p <= pxCount do
 begin
   x := Random(canvasWidth);
   y := Random(canvasHeight);
   if pixels[x, y] = 0 then
   begin
     pixels[x, y] := 1;
     Inc(p, 1);
   end;
 end;
end;

In de FormCreate moet de QueryPerformanceFrequency worden ingesteld en worden de pixels gegenereerd.

procedure TfrmMain.FormCreate(Sender: TObject);
begin
 QueryPerformanceFrequency(Fproc);
 Randomize();
 CanvasClear;
 GenereerPixels;
end;

De procedure om het diagonaal effect te tekenen, staat hier in een menu item. Je kunt de code ook in een andere procedure plaatsen.
procedure TfrmMain.TekenVanLBnaarRO;
var
  x, y, dx, dy: Integer;
begin
 pbMain.Canvas.Pen.Color := clWhite;
 pbMain.Canvas.Brush.Color := clWhite;
 x := 0;
 y := 0; // start linksboven, NB startwaarde y blijft 0
 while x < canvasWidth - 1 do
 begin
   //zolang startwaarde x kleiner dan rechterkant paintbox,
   dx := 0; // reset hulpvars voor schuine lijn
   dy := 0;
   while (x + dx >= 0) and (y + dy <= canvasHeight - 1) do
   begin
     //zolang de linkerkant niet overschreden wordt EN de onderkant niet overschreden wordt
     if EscapePressed then exit;
     if pixels[x + dx, y + dy] = 1 then
     begin
       // als de waarde in het pixels-array 1 is dan een pixel plaatsen
       pbMain.Canvas.EllipseC(x + dx, y + dy, 2, 2);
       Delay(50);
     end;
     Dec(dx, 1); // ga 1 pixel verder naar links
     Inc(dy, 1); // ga 1 pixel verder naar beneden
   end;
   Inc(x, 1); // volgende schuine lijn start 1 pixel verder naar rechts, startwaarde y = 0
 end;

 x := canvasWidth - 1;
 y := 0; // start rechtsboven, NB startwaarde x blijft canvasWidth - 1
 // zolang startwaarde y kleiner of gelijk aan onderkant paintbox
 while y <= canvasHeight - 1 do
 begin
       dx := 0;  // reset hulpvars voor schuine lijn
       dy := 0;
       // zolang de linkerkant niet overschreden wordt EN de onderkant niet overschreden wordt
       while (x + dx >= 0) and (y + dy <= canvasHeight - 1) do
       begin
         if EscapePressed then exit;
         // als de waarde in het pixels-array 1 is dan een pixel plaatsen
         if pixels[x + dx, y + dy] = 1 then
         begin
           pbMain.Canvas.EllipseC(x + dx, y + dy, 2, 2);
           Delay(50);
         end;
         Dec(dx, 1);              // ga 1 pixel verder naar links
         Inc(dy, 1);              // ga 1 pixel verder naar beneden
       end;
       Inc(y, 1); // volgende schuine lijn start 1 pixel verder naar beneden, startwaarde x = WindowWidth - 1
   end;
end;


Mocht het niet werken of heb je een andere vraag of suggestie dan kun je dat melden.
Voor het volledige programma kan deze gedownload worden op mijn Tronica Software website.