Comment remplir un polygone sans utiliser le gdi de windows

Télécharger le projet
Commenter

Description

Un exemple qui permet de tracer des vecteurs , cercles sur une surface mémoire (tableau de mémoire) sans utiliser les API de windows.
L'exemple intégre la fonction intégrale permettant de remplir une surface polygone sans utiliser les API de Windows

Source / Exemple : 


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TFprincipe = class(TForm)
    PaintBox1: TPaintBox;
    Label1: TLabel;
    Label2: TLabel;
    ex: TEdit;
    ey: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1Click(Sender: TObject);
    procedure PaintBox1DblClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { DÚclarations privÚes }
  public
    { DÚclarations publiques }
    bmp : Tbitmap;
    xm,ym : word;
    xde,yde,xa,ya : word;
    fonction,modeclick : byte;
    procedure rafraichir;
  end;

var
  Fprincipe: TFprincipe;

implementation

{$R *.DFM}

uses gpoly,math;

procedure TFprincipe.Button1Click(Sender: TObject);
var x,y : word;
begin
     x := strtoint(ex.text);
     y := strtoint(ey.text);
     bmp.width := x;
     bmp.height := y;
     bmp.canvas.pixels[x-1,y-1] := clred;
     bmp.pixelformat := pf8bit;
     paintbox1.width := x;
     paintbox1.height := y;
     width := max(x + 64,512);
     height := y + 128;
     fcs_alloc(x,y);
     rafraichir;
     button1.enabled := true;
     button2.enabled := true;
     button3.enabled := true;
     button4.enabled := true;
     button5.enabled := true;
end;

procedure tfprincipe.rafraichir;
var xf,yf : word;
    cc : byte;
    p : longword;
    deja : boolean;
begin
     for yf := 0 to bmp.height-1 do begin
       p := longword(bmp.scanline[yf]);
       for xf := 0 to bmp.width-1 do begin
           cc := 0;
           if fcs_getb(xf,yf) then begin
              cc := 2;
              deja := true;
           end;
           byte(ptr(p+xf)^) := cc;
       end;
     end;
//     if not
     PaintBox1Paint(nil);
end;

procedure TFprincipe.FormDestroy(Sender: TObject);
begin

    fcs_done;
    bmp.destroy;
end;

procedure TFprincipe.FormCreate(Sender: TObject);
begin
    fcs_init;
    bmp := tbitmap.create;
    fonction := 0;
    modeclick := 0;
end;

procedure TFprincipe.PaintBox1Paint(Sender: TObject);
begin
     paintbox1.canvas.draw(0,0,bmp);
end;

procedure TFprincipe.Button2Click(Sender: TObject);
begin
     Application.Messagebox('Selectionner le point de dÚpart','fill poly',0);
     fonction := 1;
     modeclick := 1;
end;

procedure TFprincipe.Button3Click(Sender: TObject);
begin
     Application.Messagebox('Selectionner le point de centre','fill poly',0);
     fonction := 2;
     modeclick := 1;
end;

procedure TFprincipe.Button5Click(Sender: TObject);
begin
     Application.Messagebox('Selectionner le point de centre','fill poly',0);
     fonction := 3;
     modeclick := 1;
end;

procedure TFprincipe.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
     xm := x;
     ym := y;
end;

procedure TFprincipe.PaintBox1Click(Sender: TObject);
var rayon : word;
begin
    if fonction = 1 then begin
       if modeclick = 2 then begin
          fcs_line(xa,ya,xm,ym,true);
          xa :=xm;
          ya :=ym;
          rafraichir;
       end;
       if modeclick = 1 then begin
          xa := xm;
          ya := ym;
          xde := xm;
          yde := ym;
          modeclick := 2;
          Application.Messagebox('Double cliquer pour finir','fill poly',0);
       end;
    end;
    if fonction = 2 then begin
       if modeclick = 2 then begin
          rayon := round(sqrt(sqr(xde-xm)+sqr(yde-ya)));
          fcs_ellipse(xa,ya,rayon,rayon,100,true);
          rafraichir;
          modeclick := 0;
       end;
       if modeclick = 1 then begin

          xa := xm;
          ya := ym;
          xde := xm;
          yde := ym;
          modeclick := 2;
       end;
    end;
    if fonction = 3 then begin
       fcs_fillpoly(xm,ym,true);
       rafraichir;
    end;
end;

procedure TFprincipe.PaintBox1DblClick(Sender: TObject);
begin
    if fonction = 1 then begin
       if modeclick = 2 then begin
          fcs_line(xm,ym,xde,yde,true);
          rafraichir;
          fonction := 0;
       end;
    end;
end;

procedure TFprincipe.Button4Click(Sender: TObject);
begin
     fcs_fill(false);
     rafraichir;
end;

procedure TFprincipe.Button6Click(Sender: TObject);
begin
    Application.MessageBox('Fill Poly Copyright Sivaller','A Propos de ...',0);
end;

end.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_sivaller)