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.