Draw Tricolor

Unit UTriangleTricolor.pas

unit UTriangleTricolor;

interface

uses math,Types,windows,Graphics,SysUtils;

type
 TIntegerArray=array[word] of integer;
 PIntegerArray=^TIntegerArray;
 tMyPoint=record x,y,c:integer; end;
 TListeMyPoint=array[0..1] of tMyPoint;
 TByte=array[0..3] of byte;

type
 TTriangleTricolor=class(Tobject)
  private
    FSommet:array[0..4]of TMYPoint;
    bord:array of TListeMyPoint;
    fcanvas:tcanvas;
    fbitmap:tbitmap;
    FMin,FMax:integer;
    function GetSommet(n: Integer): TMyPoint;
    procedure SetSommet(n: Integer; Value: TMyPoint);
    procedure drawHlineC(p1,p2:tmypoint);
    procedure drawHlineB(p1,p2:tmypoint);
    procedure PrepareBords;
    procedure CreateBord(a,b:tmypoint;drawfirst:boolean);
  public
    property Sommet[n:integer]:TMyPoint read GetSommet write SetSommet;    property canvas:tcanvas read fcanvas write fcanvas;
    procedure DrawInCanvas(canvas:tcanvas);
    procedure DrawInBitMap(bitmap:Tbitmap);
  end;

function MyPoint(x,y,c:integer):tmypoint;

implementation

function convertcolor(c:integer):integer;
begin
 result:=rgb(tbyte(c)[2],tbyte(c)[1],tbyte(c)[0]);
end;

function calculcouleur(pos,mx,c1,c2:integer):integer;
var
 a,b:TByte;
 i:integer;
begin
 if mx=0 then mx:=1;
 a:=tbyte(c1);
 b:=tbyte(c2);
 for i:=0 to 3 do a[i]:=a[i]+pos*(b[i]-a[i]) div mx;
 result:=integer(a);
end;

function MyPoint(x,y,c:integer):tmypoint;
begin
 result.x:=x;
 result.y:=y;
 result.c:=c;
end;

procedure SwapAB(var a,b:tmypoint);
var t:tmypoint;
begin
 t:=a; a:=b; b:=t;
end;

function TTriangleTricolor.GetSommet(n: Integer): TMyPoint;
begin
 result:=Mypoint(0,0,0);
 if (n<1) or (n>3) then exit;
 result:=Fsommet[n];
end;

procedure TTriangleTricolor.SetSommet(n: Integer; Value: TMyPoint);
begin
 if (n<1) or (n>3) then exit;
 Fsommet[n]:=value;
end;

procedure TTriangleTricolor.CreateBord(a,b:tmypoint;drawfirst:boolean);
var
 dx,dy,i:integer;
 drawlast:boolean;
 x,y,c:integer;
begin
 if (a.x=b.x) and (a.y=b.y) then exit;
 if (a.y=b.y) then exit;
 drawlast:=true;
 if b.y<a.y then
  begin
   swapab(a,b);
   drawlast:=drawfirst;  
   drawfirst:=true;      
  end;
 dx:=b.x-a.x;
 dy:=b.y-a.y;
 for i:=byte(not drawfirst) to dy-byte(not drawlast) do
  begin
   x:=(a.x*dy+i*dx) div dy;     
   y:=a.y+i;                    
   c:=calculcouleur(i,dy,a.c,b.c); 
   if (y-fmin>=0) and (y<=fmax) then
    begin                       
     bord[y-fmin][1]:=bord[y-fmin][0]; 
     bord[y-fmin][0]:=mypoint(x,y,c); 
    end;
  end;
end;

function MemeCote(a,b,c:tmypoint):boolean;
begin
 result:=(sign(b.y-a.y)*sign(c.y-b.y))<=0;
end;

procedure TTriangleTricolor.drawHlineC(p1,p2:tmypoint);
var
 i,dx:integer;
begin
 if p1.x>p2.x then swapab(p1,p2);
 dx:=p2.x-p1.x;
 for i:=0 to dx do canvas.pixels[p1.x+i,p1.y]:=calculcouleur(i,dx,p1.c,p2.c);
end;

procedure TTriangleTricolor.drawHlineB(p1,p2:tmypoint);
var
 i,dx:integer;
 p:pintegerarray;
begin
 if (p1.y<0) or (p1.y>=fbitmap.Height) then exit;
 fbitmap.PixelFormat:=pf32bit;
 if p1.x>p2.x then swapab(p1,p2);
 dx:=p2.x-p1.x;
 p:=fbitmap.ScanLine[p1.y];
 for i:=0 to dx do
  if (p1.x+i>=0) and (p1.x+i<fbitmap.Width) then
   p[p1.x+i]:=convertcolor(calculcouleur(i,dx,p1.c,p2.c));
end;

procedure TTriangleTricolor.PrepareBords;
var
 i:integer;
begin
 FMax:=max(max(Fsommet[1].y,Fsommet[2].y),Fsommet[3].y);
 if FMax<0 then exit;
 FMin:=min(min(Fsommet[1].y,Fsommet[2].y),Fsommet[3].y);
 if FMin<0 then FMin:=0;
 setlength(bord,fmax-fmin+1);
 Fsommet[0]:=fsommet[3];
 Fsommet[4]:=fsommet[1];
 for i:=1 to 3 do
   CreateBord(Fsommet[i],Fsommet[i+1],MemeCote(Fsommet[i-1],Fsommet[i],Fsommet[i+1]));
end;

procedure TTriangleTricolor.DrawInCanvas(canvas:tcanvas);
var
 i:integer;
begin
 PrepareBords;
 fcanvas:=canvas;
 for i:=0 to high(bord) do drawHlineC(bord[i][0],bord[i][1]);
end;

procedure TTriangleTricolor.DrawInBitMap(bitmap:Tbitmap);
var
 i:integer;
begin
 PrepareBords;
 fbitmap:=bitmap;
 for i:=0 to high(bord) do drawHlineB(bord[i][0],bord[i][1]);
end;
end.

Unit1 :

uses UTriangleTricolor

//

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
 tri:ttriangletricolor;
 bit:tbitmap;
begin
 bit:=tbitmap.Create;
 bit.Width:=width;
 bit.Height:=height;
 tri:= ttriangletricolor.create;
 tri.Sommet[1]:=MyPoint(clientwidth div 2,0,clred);
 tri.Sommet[2]:=MyPoint(0,clientheight div 2,clyellow);
 tri.Sommet[3]:=MyPoint(x,y,clwhite);
 tri.DrawInBitMap(bit);
 tri.Sommet[1]:=MyPoint(0,clientheight div 2,clyellow);
 tri.Sommet[2]:=MyPoint(clientwidth div 2,clientheight,clgreen);
 tri.Sommet[3]:=MyPoint(x,y,clwhite);
 tri.DrawInBitMap(bit);
 tri.Sommet[1]:=MyPoint(clientwidth div 2,clientheight,clgreen);
 tri.Sommet[2]:=MyPoint(clientwidth,clientheight div 2,clblue);
 tri.Sommet[3]:=MyPoint(x,y,clwhite);
 tri.DrawInBitMap(bit);
 tri.Sommet[1]:=MyPoint(clientwidth,clientheight div 2,clblue);
 tri.Sommet[2]:=MyPoint(clientwidth div 2,0,clred);
 tri.Sommet[3]:=MyPoint(x,y,clwhite);
 tri.DrawInBitMap(bit);
 tri.Free;
 canvaS.Draw(0,0,bit);
end;