Comment remplir un polygone sans utiliser le gdi de windows

Soyez le premier à donner votre avis sur cette source.

Vue 7 757 fois - Téléchargée 499 fois

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.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_jfs59
Messages postés
184
Date d'inscription
mardi 29 avril 2003
Statut
Membre
Dernière intervention
2 février 2010
-
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 ... ????
f0xi
Messages postés
4200
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
2 janvier 2019
26 -
Je rejoins jfs, et j'ajouterais meme que ça sert a rien de le poster sans.

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.