Comment remplir un polygone sans utiliser le gdi de windows

0/5 (2 avis)

Vue 8 170 fois - Téléchargée 585 fois

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

Ajouter un commentaire Commentaires
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 37
13 août 2006 à 16:57
Je rejoins jfs, et j'ajouterais meme que ça sert a rien de le poster sans.
cs_jfs59 Messages postés 178 Date d'inscription mardi 29 avril 2003 Statut Membre Dernière intervention 2 février 2010
11 août 2006 à 19:11
Vi vi .. mais on sait pas ce qu'il y a dans fcs.dll
hpoly := LoadLibrary('fcs.dll');

a moins que ce soit donné ailleur ... donc ... ????
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)