Draw Canvas Pictures

Zeichne ein Bild :

procedure TForm1.Button1Click(Sender: TObject);
var u, v: integer;
begin
 {Strahlen}
 u := 0;
 while u <= 390 do
 begin
 Canvas.Moveto(200,0); Canvas.LineTo(u,50);
 u:=u+10;
 end;

 {zwei Parallelen und Kreise}
 Canvas.MoveTo(0,100+00); Canvas.LineTo(399,100-40);
 Canvas.MoveTo(0,100+40); Canvas.LineTo(399,100+00);
 Canvas.Brush.Style:=bsClear;

 u:=0;
 while u<=75 do
 begin
   Canvas.Ellipse(200-u,100-u, 200+u, 100+u);
   u:=u+5;
 end;

 {zwei Parallelen mit schiefen Streifen}
 Canvas.MoveTo(0,200); Canvas.LineTo(399,200);

 u:=0; while u<= 390 do
 begin
  Canvas.MoveTo(u,200-20); Canvas.LineTo(u+50,200+20);
  u:=u+10;
 end;

 Canvas.MoveTo(0,250); Canvas.LineTo(399,250);

 u:=0; while u<= 390 do
 begin
  Canvas.MoveTo(u,250-20); Canvas.LineTo(u-50,250+20);
  u:=u+10;
 end;

 {Pfeil klein}
 Canvas.MoveTo(350,100);Canvas.LineTo(350,150);
 Canvas.MoveTo(350,100);Canvas.LineTo(350-10,100+10);
 Canvas.MoveTo(350,100);Canvas.LineTo(350+10,100+10);
 Canvas.MoveTo(350,150);Canvas.LineTo(350-10,150-10);
 Canvas.MoveTo(350,150);Canvas.LineTo(350+10,150-10);

 {Pfeil groß}
 Canvas.MoveTo(380,100);Canvas.LineTo(380,150);
 Canvas.MoveTo(380,100);Canvas.LineTo(380-10,100-10);
 Canvas.MoveTo(380,100);Canvas.LineTo(380+10,100-10);
 Canvas.MoveTo(380,150);Canvas.LineTo(380-10,150+10);
 Canvas.MoveTo(380,150);Canvas.LineTo(380+10,150+10);

 {Text}
 Canvas.Textout(0,100,'Optische Täuschungen');
end;

Zeichne ein Bild mit Unterproceduren :

procedure TForm1.Button2Click(Sender: TObject);
  procedure gerade(x1, y1, x2, y2: integer);
  begin Canvas.Moveto(x1,y1); Canvas.LineTo(x2, y2);
  end; {gerade}

  procedure kreis(xm, ym, r:integer);
  begin
  Canvas.Brush.Style:=bsClear;
  Canvas.Ellipse(xm-r, ym-r, xm+r, ym+r);
  end; {kreis}

  procedure streifen(x1, y1, s: integer); {s=Schräge}
  var u:integer;
  begin gerade(x1,y1,clientwidth-1,y1);
  u:=0;
  while
  u < clientwidth do begin
  gerade(u-s,y1-20,u+s,y1+20); {Aufruf in der Prozedurvereinbarung}
  u:=u+10;
  end {while}
  end; {streifen}

  procedure dach(x, y, h: integer); {h = Höhe}
  begin
  gerade(x,y,x-h,y+h); gerade(x,y,x+h,y+h);
  end;

  var u,v:integer;
  begin {Klickprozedur}
  {Strahlen}
  u:=0;
  while u<= 390 do begin
  gerade(200, 0, u, 50);
  u:=u+10;
  end;

  {zwei Parallelen und Kreise}
  gerade(0,100, 399,100-40);
  gerade(0,100+40, 399,100);
  u:=0; while u<=75 do
  begin
   kreis(200,100,u);
   u:=u+5;
  end;

  {zwei Parallelen mit schiefen Streifen}
  streifen(0, 200, 40);
  streifen(0, 250, -40);
  {Pfeil klein}
  gerade(350, 100, 350, 150);
  dach(350, 100, 10);
  dach(350, 150, -10);
  {Pfeil groß}
  gerade(380, 100, 380, 150);
  dach(380, 100,-10);
  dach(380, 150, 10);

  {Text}
  Canvas.Textout(0,100,'Optische Täuschungen mit Prozeduren');
end;

Zeichne Quadrate in eine Image :

procedure TForm1.Button3Click(Sender: TObject);
  procedure quadrat(cv:TCanvas; x,y,a:integer);              {A}
  var a1: integer;
  begin cv.brush.style:=bsclear;
    a1:=a div 2; cv.rectangle(x-a1,y-a1,x+a1,y+a1);
  end;{quadrat}

  procedure quadrate(cv: TCanvas; x,y,anfang,ende:integer);
    var a: integer;
    begin
      a:=anfang;
      while a<=ende do
      begin
      quadrat(cv,x,y,a);
      a:=a+4;
      end; {while}
    end; {quadrate}
  begin
   quadrate(Image1.canvas, 50,50,10,50);
   quadrate(Image1.canvas, Image1.clientwidth-50,50,20,60);
   quadrate(Image1.canvas, Image1.clientwidth-50,Image1.clientheight-50,30,70);
   quadrate(Image1.canvas, 50,Image1.clientheight-50,40,80);
end;

Zeichne einen Rand und fülle die Image aus :

procedure TForm1.Button4Click(Sender: TObject);
var clpen, clbrush: TColor; bs: TBrushstyle;
begin
  with image1.Canvas do
    begin
    clpen:=Pen.Color;
    clbrush:=Brush.Color;
    bs:=Brush.Style;
      Pen.color:=clblue;
      brush.style:=bsSolid;
      brush.color:=claqua;
      rectangle(0,0,image1.clientwidth,image1.clientheight);
      Pen.color:=clpen;
      brush.style:=bs;
      brush.color:=clbrush;
    end;
end;

Animiere ein Quadrat in einer Image :

procedure TForm1.Button5Click(Sender: TObject);
var
  a: integer;
begin
    a:=1;
       while a<=100 do
       begin
         {Quadrat zeichnen}
         quadrat(Image1.canvas,60,60,a,clred);

         {warten}
         pause(50);

         {Quadrat löschen, wenn nicht fertig}
         if a < 100 then
         quadrat(Image1.canvas,60,60,a,clwhite);
         {nächstes Quadrat}
         a:=a+1;
       end;
end;