I have note that some useful functions available graphics for Windows
are not present in Lazarus (ok ok are devoted API). I have tried to
rewrite them not using the devoted API.
// ----------------------------------------------
// Decrease the color working on RGB field
// ----------------------------------------------
Function DecColor(Colore : TColor; Quantita : Integer) : TColor;
Var
R, G, B : Byte;
(* ******************************************** *)
(* ******************************************** *)
Function _Dec(V : Byte) : Byte;
Var
V1 : Integer;
Begin
V1 := V;
V1 := V1 - Quantita;
If V1 < 0 Then V1 := 0;
If V1 > 255 Then V1 := 255;
Result := Byte(V1);
End;
(* ******************************************** *)
(* ******************************************** *)
Begin
Colore := ColorToRGB(Colore);
R := _Dec(GetRValue(Colore));
G := _Dec(GetGValue(Colore));
B := _Dec(GetBValue(Colore));
Result := RGB(R, G, B);
End;
// Write a 3D frame exactly how Windows Frame3DFunction but using two
additional params
//
// Clicked : if true invert the frame
// Flat : paint a flat frame
Procedure Frame3D(FCanvas : TCanvas;
Rect : TRect;
FColor : TColor;
Clicked : Boolean;
Flat : Boolean);
Var
C1, C2 : TColor;
begin
If Clicked Then
Begin
C1 := FColor;
C2 := DecColor(FColor, -255);
End
Else
If Flat Then
Begin
C1 := FColor;
C2 := FColor;
End
Else
Begin
C1 := DecColor(FColor, -255);
C2 := FColor;
End;
FCanvas.Pen.Color := C1;
FCanvas.MoveTo(Rect.Left, Rect.Bottom-1);
FCanvas.LineTo(Rect.Left, Rect.Top);
FCanvas.LineTo(Rect.Right-1, Rect.Top);
FCanvas.Pen.Color := C2;
FCanvas.LineTo(Rect.Right-1, Rect.Bottom-1);
FCanvas.LineTo(Rect.Left, Rect.Bottom-1);
end;
type
TGradientDirection = (gdVertical, gdHorizontal); // used in function
GradientFillCanvas
// Fill a rectangle with gradient color how the Delphi function
GradientFillCanvas
Procedure GradientFillCanvas(ACanvas : TCanvas;
ACStart : TColor;
ACStop : TColor;
ARec : TRect;
ADirection :
TGradientDirection);
Var
RStart, RStop, RStep : Extended;
GStart, GStop, GStep : Extended;
BStart, BStop, BStep : Extended;
Pixel, I : Integer;
Colore : TColor;
(* ************************************************* *)
(* ************************************************* *)
Function _Calcola(Inizio : Extended;
Fine : Extended;
NPixel : Extended) : Extended;
Begin
If (Inizio = Fine) Or (NPixel < 1) Then
Begin
Result := 0;
Exit;
End;
Result := (Fine-Inizio)/NPixel;
End;
(* ************************************************* *)
(* ************************************************* *)
Begin
ACStart := ColorToRGB(ACStart);
ACStop := ColorToRGB(ACStop);
RStart := GetRValue(ACStart);
GStart := GetGValue(ACStart);
BStart := GetBValue(ACStart);
RStop := GetRValue(ACStop);
GStop := GetGValue(ACStop);
BStop := GetBValue(ACStop);
If ADirection = gdVertical Then Pixel := ARec.Bottom-ARec.Top+1
Else Pixel := ARec.Right-ARec.Left+1;
RStep := _Calcola(RStart, RStop, Pixel);
GStep := _Calcola(GStart, GStop, Pixel);
BStep := _Calcola(BStart, BStop, Pixel);
For I := 0 To Pixel-1 Do
Begin
Colore := RGB(Trunc(RStart), Trunc(GStart),
Trunc(BStart));
ACanvas.Pen.Color := Colore;
If ADirection = gdHorizontal Then
Begin
ACanvas.MoveTo(ARec.Left+I, ARec.Top);
ACanvas.Lineto(ARec.Left+I, ARec.Bottom);
End
Else
Begin
ACanvas.MoveTo(ARec.Left, ARec.Top+I);
ACanvas.Lineto(ARec.Right, ARec.Top+I);
End;
RStart := RStart+RStep;
GStart := GStart+GStep;
BStart := BStart+BStep;
End;
End;
Bye,
David
begin:vcard
fn:David Guadagnini
n:Guadagnini;David
email;internet:[EMAIL PROTECTED]
x-mozilla-html:FALSE
version:2.1
end:vcard
