Utilisation de la Dll Vic-Pilot avec Free Lazarus Pascal.

Il n'est jamais simple d'utiliser un nouveau compilateur, alors afin de tester la compatibilité du compilateur Free Lazarus Pascal (même si son interface ressemble fortement a celle de Delphi) avec la dll Vic-Pilot. J'ai écrit un module de test qui décrit une boucle pour afficher dans un cercle toutes les couleurs de l'arc-en-ciel.

Seul les fonctions nécessaires à son utilisation sont importées dans l'en-tête, et une autre qui permet de convertir une valeur avec une teinte variant entre 0 et 360° , en couleur RRVVBB.

Une petite précision quand même, pour utilser la dll, Vic-Pilot elle doit être situé dans le même répertoire que celui dans lequel vous développer. 

unit linecircle;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

type TColorRef = longint;

function Lance_Vic:boolean; cdecl; external 'Vic_Pilot.dll' name 'Lance_Vic';
procedure Vic_Set_Width_Path(width:integer); cdecl; external 'Vic_Pilot.dll' name 'Vic_Set_Width_Path';
procedure Vic_Stroke_Color(color:TColorRef); cdecl; external 'Vic_Pilot.dll' name 'Vic_Stroke_Color';
procedure Vic_Line(x,y,xx,yy:integer); cdecl; external 'Vic_Pilot.dll' name 'Vic_Line';


{ TForm1 }

procedure HLS_to_RGB(h,l,s:real; var r,g,b:real);
	var v,m,sv,fract,vsf,mid1,mid2:real;
		 sextant:integer;
	begin
	if h=360 then h:=0 else	h:=h/360;
	if l<=0.5 then
		v:=l*(1.0+s)
	else
		v:=l+s-l*s;
	if v<=0.0 then
		begin
		r:=0.0; g:=0.0; b:=0.0;
		end
	else
		begin
		m:=l+l-v; sv:=(v-m)/v;
		h:=h*6.0;
		sextant:=trunc(h);
		fract:=h-sextant;
		vsf:=v*sv*fract;
		mid1:=m+vsf;
		mid2:=v-vsf;
		case sextant of
			0:begin r:=v;		g:=mid1;	b:=m		end;
			1:begin r:=mid2;	g:=v;		b:=m		end;
			2:begin r:=m;		g:=v;		b:=mid1	end;
			3:begin r:=m;		g:=mid2;	b:=v		end;
			4:begin r:=mid1;	g:=m;		b:=v		end;
			5:begin r:=v;		g:=m;		b:=mid2	end;
			end; {case sextant}
      end;
end; {HLS_to_RGB}

function RGB(R,G,B : Byte): TColor;
begin
  Result:=(R or (G shl 8) or (B shl 16));
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
const maxi=360;
var r,g,b:real;
begin
if Lance_Vic then
    begin
    Vic_Set_Width_Path(20);
    for i:=0 to maxi do
        begin
        HLS_to_RGB((i/maxi)*360,0.5,1,r,g,b);
        Vic_Stroke_Color(RGB(round(r*255),round(g*255),round(b*255)));
        Vic_Line(2000,2000,round(cos((i/maxi)*2*pi)*2000),round(sin((i/maxi)*2*pi)*2000));
        end;
    end;
end;

initialization
  {$I linecircle.lrs}

end.