pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

spkToolbar: spkGraphTools: Patch by haword (issue #0024081) for alternative gradient painting. Avoid unnecessary calculations. Cosmetic changes. Google-translate the polish comments.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3663 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-16 11:57:50 +00:00
parent b839d15d7b
commit 3159cf88d5
1 changed files with 389 additions and 313 deletions
Download Patch File Download Diff File Expand all files Collapse all files

702
components/spktoolbar/SpkGraphTools/SpkGraphTools.pas
View File

@@ -12,307 +12,360 @@ uses
const const
NUM_ZERO = 0.00000001; NUM_ZERO = 0.00000001;
(******************************************************************************* (*******************************************************************************
* * * *
* Proste struktury * * Simple structure *
* * * *
*******************************************************************************) *******************************************************************************)
type type
// WskaŸnik do tablicy TRGBTriple // Pointer to an array of TRGBTriple
PRGBTripleArray = ^TRGBTripleArray; PRGBTripleArray = ^TRGBTripleArray;
// Tablica TRGBTriple (u¿ywana podczas operacji ze ScanLine) // Array of TRGBTriple records
TRGBTripleArray = array[word] of TRGBTriple; TRGBTripleArray = array[word] of TRGBTriple;
THSLTriple = record THSLTriple = record
H, S, L : extended; H, S, L: extended;
end; end;
// Rodzaj gradientu // Gradient types
TGradientType = (gtVertical, gtHorizontal); TGradientType = (gtVertical, gtHorizontal);
// Rodzaj linii gradientowej (miejsce rozmycia) // Line gradient types
TGradientLineShade = (lsShadeStart, lsShadeEnds, lsShadeCenter, lsShadeEnd); TGradientLineShade = (lsShadeStart, lsShadeEnds, lsShadeCenter, lsShadeEnd);
// Rodzaj linii gradientowej (wypuk³oœæ) // Line gradient types (3D)
TGradient3dLine = (glRaised, glLowered); TGradient3dLine = (glRaised, glLowered);
(******************************************************************************* (*******************************************************************************
* * * *
* Klasy narzêdziowe * * Utility classes *
* * * *
*******************************************************************************) *******************************************************************************)
TColorTools = class TColorTools = class
public public
class function Darken(kolor : TColor; percentage : byte) : TColor; class function Darken(AColor: TColor; APercentage: byte): TColor;
class function Brighten(kolor : TColor; percentage : byte) : TColor; class function Brighten(AColor: TColor; APercentage: byte): TColor;
class function Shade(kol1,kol2 : TColor; percentage : byte) : TColor; overload; class function Shade(AColor1, AColor2: TColor; APercentage: byte): TColor; overload;
class function Shade(kol1,kol2 : TColor; Step : extended) : TColor; overload; class function Shade(AColor1, AColor2: TColor; AStep: extended): TColor; overload;
class function AddColors(c1, c2 : TColor) : TColor; class function AddColors(AColor1, AColor2: TColor): TColor;
class function MultiplyColors(c1, c2 : TColor) : TColor; class function MultiplyColors(AColor1, AColor2: TColor): TColor;
class function MultiplyColor(color : TColor; scalar : integer) : TColor; overload; class function MultiplyColor(AColor: TColor; AScalar: integer): TColor; overload;
class function MultiplyColor(color : TColor; scalar : extended) : TColor; overload; class function MultiplyColor(AColor: TColor; AScalar: extended): TColor; overload;
class function percent(min, pos, max : integer) : byte; class function percent(AMin, APos, AMax: integer): byte;
class function RGB2HSL(ARGB : TRGBTriple) : THSLTriple; class function RGB2HSL(ARGB: TRGBTriple): THSLTriple;
class function HSL2RGB(AHSL : THSLTriple) : TRGBTriple; class function HSL2RGB(AHSL: THSLTriple): TRGBTriple;
class function RgbTripleToColor(ARgbTriple : TRGBTriple) : TColor; class function RgbTripleToColor(ARgbTriple: TRGBTriple): TColor;
class function ColorToRgbTriple(AColor : TColor) : TRGBTriple; class function ColorToRgbTriple(AColor: TColor): TRGBTriple;
class function ColorToGrayscale(AColor : TColor) : TColor; class function ColorToGrayscale(AColor: TColor): TColor;
end; end;
TGradientTools = class TGradientTools = class
public public
class procedure HGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); overload; class procedure HGradient(ACanvas: TCanvas; cStart,cEnd: TColor; ARect: T2DIntRect); overload;
class procedure HGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint); overload; class procedure HGradient(ACanvas: TCanvas; cStart,cEnd: TColor; p1, p2: TPoint); overload;
class procedure HGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); overload; class procedure HGradient(ACanvas: TCanvas; cStart,cEnd: TColor; x1,y1,x2,y2: integer); overload;
class procedure VGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); overload; class procedure VGradient(ACanvas: TCanvas; cStart,cEnd: TColor; ARect: T2DIntRect); overload;
class procedure VGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint); overload; class procedure VGradient(ACanvas: TCanvas; cStart,cEnd: TColor; p1, p2: TPoint); overload;
class procedure VGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); overload; class procedure VGradient(ACanvas: TCanvas; cStart,cEnd: TColor; x1,y1,x2,y2: integer); overload;
class procedure Gradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect; GradientType : TGradientType); overload; class procedure Gradient(ACanvas: TCanvas; cStart,cEnd: TColor; ARect: T2DIntRect; AGradientType : TGradientType); overload;
class procedure Gradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint; GradientType : TGradientType); overload; class procedure Gradient(ACanvas: TCanvas; cStart,cEnd: TColor; p1, p2: TPoint; AGradientType : TGradientType); overload;
class procedure Gradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer; GradientType : TGradientType); overload; class procedure Gradient(ACanvas: TCanvas; cStart,cEnd: TColor; x1,y1,x2,y2: integer; AGradientType : TGradientType); overload;
class procedure HGradientLine(canvas : TCanvas; cBase, cShade : TColor; x1, x2 , y : integer; ShadeMode : TGradientLineShade); class procedure HGradientLine(ACanvas: TCanvas; cBase, cShade: TColor; x1, x2, y: integer; ShadeMode: TGradientLineShade);
class procedure VGradientLine(canvas : TCanvas; cBase, cShade : TColor; x, y1 , y2 : integer; ShadeMode : TGradientLineShade); class procedure VGradientLine(ACanvas: TCanvas; cBase, cShade: TColor; x, y1, y2: integer; ShadeMode: TGradientLineShade);
class procedure HGradient3dLine(canvas : TCanvas; x1,x2,y : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); class procedure HGradient3dLine(ACanvas: TCanvas; x1,x2,y: integer; ShadeMode: TGradientLineShade; A3dKind: TGradient3dLine = glLowered);
class procedure VGradient3dLine(canvas : TCanvas; x,y1,y2 : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); class procedure VGradient3dLine(ACanvas: TCanvas; x,y1,y2: integer; ShadeMode: TGradientLineShade; A3dKind: TGradient3dLine = glLowered);
end; end;
TTextTools = class TTextTools = class
public public
class procedure OutlinedText(Canvas : TCanvas; x, y : integer; const text : string); class procedure OutlinedText(ACanvas: TCanvas; x, y: integer; const AText: string);
end; end;
implementation implementation
type
TRgbColor = packed record
R,G,B,A: Byte;
end;
{ TColorTools } { TColorTools }
class function TColorTools.Darken(kolor : TColor; percentage : byte) : TColor; class function TColorTools.Darken(AColor: TColor; APercentage: byte): TColor;
var
var r,g,b : byte; c: TRGBColor;
f: extended;
begin begin
r:=round(GetRValue(ColorToRGB(kolor))*(100-percentage)/100); c := TRGBColor(ColorToRGB(AColor));
g:=round(GetGValue(ColorToRGB(kolor))*(100-percentage)/100); f := (100 - APercentage) / 100;
b:=round(GetBValue(ColorToRGB(kolor))*(100-percentage)/100); result := rgb(
result:=rgb(r,g,b); round(c.R * f),
round(c.G * f),
round(c.B * f)
);
end; end;
class function TColorTools.Brighten(kolor : TColor; percentage : byte) : TColor; class function TColorTools.Brighten(AColor: TColor; APercentage: byte): TColor;
var
var r,g,b : byte; c: TRgbColor;
p: Extended;
begin begin
r:=round(GetRValue(ColorToRGB(kolor))+( (255-GetRValue(ColorToRGB(kolor)))*(percentage/100) )); c := TRgbColor(ColorToRGB(AColor));
g:=round(GetGValue(ColorToRGB(kolor))+( (255-GetGValue(ColorToRGB(kolor)))*(percentage/100) )); p := APercentage/100;
b:=round(GetBValue(ColorToRGB(kolor))+( (255-GetBValue(ColorToRGB(kolor)))*(percentage/100) )); result := rgb(
result:=rgb(r,g,b); round(c.R + (255-c.R)*p),
round(c.G + (255-c.G)*p),
round(c.B + (255-c.B)*p)
);
end; end;
class function TColorTools.Shade(kol1,kol2 : TColor; percentage : byte) : TColor; class function TColorTools.Shade(AColor1, AColor2: TColor;
APercentage: byte): TColor;
var r,g,b : byte; var
c1, c2: TRgbColor;
Step: Extended; // percentage as floating point number
begin begin
r:=round(GetRValue(ColorToRGB(kol1))+( (GetRValue(ColorToRGB(kol2))-GetRValue(ColorToRGB(kol1)))*(percentage/100) )); c1 := TRGBColor(ColorToRGB(AColor1));
g:=round(GetGValue(ColorToRGB(kol1))+( (GetGValue(ColorToRGB(kol2))-GetGValue(ColorToRGB(kol1)))*(percentage/100) )); c2 := TRGBColor(ColorToRGB(AColor2));
b:=round(GetBValue(ColorToRGB(kol1))+( (GetBValue(ColorToRGB(kol2))-GetBValue(ColorToRGB(kol1)))*(percentage/100) )); Step := APercentage / 100;
result:=rgb(r,g,b); result := rgb(
round(c1.R + (c2.R - c1.R) * Step),
round(c1.G + (c2.G - c1.G) * Step),
round(c1.B + (c2.B - c1.B) * Step)
);
end; end;
class function TColorTools.Shade(kol1,kol2 : TColor; Step : extended) : TColor; class function TColorTools.Shade(AColor1, AColor2: TColor; AStep: extended): TColor;
var
var r,g,b : byte; c1, c2: TRgbColor;
begin begin
r:=round(GetRValue(ColorToRGB(kol1))+( (GetRValue(ColorToRGB(kol2))-GetRValue(ColorToRGB(kol1)))*(Step) )); c1 := TRgbColor(ColorToRGB(AColor1));
g:=round(GetGValue(ColorToRGB(kol1))+( (GetGValue(ColorToRGB(kol2))-GetGValue(ColorToRGB(kol1)))*(Step) )); c2 := TRgbColor(ColorToRGB(AColor2));
b:=round(GetBValue(ColorToRGB(kol1))+( (GetBValue(ColorToRGB(kol2))-GetBValue(ColorToRGB(kol1)))*(Step) )); result := rgb(
result:=rgb(r,g,b); round(c1.R + (c2.R - c1.R) * AStep),
round(c1.G + (c2.G - c1.G) * AStep),
round(c1.B + (c2.B - c1.B) * AStep)
);
end; end;
class function TColorTools.AddColors(c1, c2 : TColor) : TColor; class function TColorTools.AddColors(AColor1, AColor2: TColor): TColor;
var
c1, c2: TRgbColor;
begin begin
result:=rgb(max( 0,min( 255,GetRValue(c1)+GetRValue(c2) ) ), c1 := TRgbColor(ColorToRGB(AColor1));
max( 0,min( 255,GetGValue(c1)+GetGValue(c2) ) ), c2 := TRgbColor(ColorToRGB(AColor2));
max( 0,min( 255,GetBValue(c1)+GetBValue(c2) ) )); result := rgb(
max(0, min(255, c1.R + c2.R)),
max(0, min(255, c1.G + c2.G)),
max(0, min(255, c1.B + c2.B))
);
end; end;
class function TColorTools.MultiplyColors(c1, c2 : TColor) : TColor; class function TColorTools.MultiplyColors(AColor1, AColor2: TColor): TColor;
var
c1, c2: TRgbColor;
begin begin
result:=rgb(max( 0,min( 255,GetRValue(c1)*GetRValue(c2) ) ), c1 := TRgbColor(ColorToRGB(AColor1));
max( 0,min( 255,GetGValue(c1)*GetGValue(c2) ) ), c2 := TRgbColor(ColorToRGB(AColor2));
max( 0,min( 255,GetBValue(c1)*GetBValue(c2) ) )); result := rgb(
max(0, min(255, c1.R * c2.R)),
max(0, min(255, c1.G * c2.G)),
max(0, min(255, c1.B * c2.B))
);
end; end;
class function TColorTools.MultiplyColor(color : TColor; scalar : integer) : TColor; class function TColorTools.MultiplyColor(AColor: TColor; AScalar: integer): TColor;
var
c: TRgbColor;
begin begin
result:=rgb(max( 0,min( 255,GetRValue(color)*scalar ) ), c := TRgbColor(ColorToRGB(AColor));
max( 0,min( 255,GetGValue(color)*scalar ) ), result := rgb(
max( 0,min( 255,GetBValue(color)*scalar ) )); max(0, min(255, c.R * AScalar)),
max(0, min(255, c.G * AScalar)),
max(0, min(255, c.B * AScalar))
);
end; end;
class function TColorTools.MultiplyColor(color : TColor; scalar : extended) : TColor; class function TColorTools.MultiplyColor(AColor: TColor; AScalar: extended): TColor;
var
c: TRgbColor;
begin begin
result:=rgb(max( 0,min( 255,round(GetRValue(color)*scalar) ) ), c := TRgbColor(ColorToRGB(AColor));
max( 0,min( 255,round(GetGValue(color)*scalar) ) ), result := rgb(
max( 0,min( 255,round(GetBValue(color)*scalar) ) )); max(0, min(255, round(c.R * AScalar))),
max(0, min(255, round(c.G * AScalar))),
max(0, min(255, round(c.B * AScalar)))
);
end; end;
class function TColorTools.Percent(min, pos, max : integer) : byte; class function TColorTools.Percent(AMin, APos, AMax: integer): byte;
begin begin
if max=min then result:=max else if AMax = AMin then
result:=round((pos-min)*100/(max-min)); result := AMax // wp: is this correct? Shouldn't this be a value between a and 100?
else
result := round((APos - AMin) * 100 / (AMax - AMin));
end; end;
{.$MESSAGE WARN 'Porównywanie liczb rzeczywistych? Trzeba poprawiæ'} {.$MESSAGE WARN 'Comparing real numbers? This has to be corrected.'}
class function TColorTools.RGB2HSL(ARGB : TRGBTriple) : THSLTriple; class function TColorTools.RGB2HSL(ARGB: TRGBTriple): THSLTriple;
var
var RGBmin, RGBmax : extended; RGBmin, RGBmax, RGBrange: extended;
R, G, B : extended; R, G, B: extended;
H, S, L : extended; H, S, L: extended;
begin begin
R:=ARGB.rgbtRed/255; R := ARGB.rgbtRed/255;
G:=ARGB.rgbtGreen/255; G := ARGB.rgbtGreen/255;
B:=ARGB.rgbtBlue/255; B := ARGB.rgbtBlue/255;
RGBmin:=min(R,min(G,B)); RGBmin := min(R, min(G, B));
RGBmax:=max(R,min(G,B)); RGBmax := max(R, min(G, B));
RGBrange := RGBmax - RGBmin;
H:=0; H := 0;
if RGBmax=RGBmin then if RGBmax = RGBmin then
begin H := 0
// H jest nieoznaczone, ale przyjmijmy zero dla sensownoœci obliczeñ else
H:=0; if (R = RGBmax) and (G >= B) then
end else H := pi/3 * (G-B) / RGBrange + 0
if (R=RGBmax) and (G>=B) then else
begin if (R = RGBmax) and (G < B) then
H:=(pi/3)*((G-B)/(RGBmax-RGBmin))+0; H := pi/3 * (G-B) / RGBrange + 2*pi
end else else
if (R=RGBmax) and (G<B) then if (G = RGBmax) then
begin H := pi/3 * (B-R) / RGBrange + 2*pi/3
H:=(pi/3)*((G-B)/(RGBmax-RGBmin))+(2*pi); else
end else if (B = RGBmax) then
if (G=RGBmax) then H := pi/3 * (R-G) / RGBrange + 4*pi/3;
begin
H:=(pi/3)*((B-R)/(RGBmax-RGBmin))+(2*pi/3);
end else
if (B=RGBmax) then
begin
H:=(pi/3)*((R-G)/(RGBmax-RGBmin))+(4*pi/3);
end;
L:=(RGBmax+RGBmin)/2; L := RGBrange / 2;
S:=0; S:=0;
if (L<NUM_ZERO) or (rgbMin=rgbMax) then if (L < NUM_ZERO) or (rgbMin = rgbMax) then
begin S := 0
S:=0; else
end else if (L <= 0.5) then
if (L<=0.5) then S := RGBrange / (2*L)
begin else
S:=((RGBmax-RGBmin)/(2*L)); if (L > 0.5) then
end else S := RGBrange / (2-2*L);
if (L>0.5) then
begin
S:=((RGBmax-RGBmin)/(2-2*L));
end;
result.H:=H/(2*pi); result.H := H / (2*pi);
result.S:=S; result.S := S;
result.L:=L; result.L := L;
end; end;
class function TColorTools.HSL2RGB(AHSL : THSLTriple) : TRGBTriple; class function TColorTools.HSL2RGB(AHSL: THSLTriple): TRGBTriple;
var
var R, G, B : extended; R, G, B: extended;
TR, TG, TB : extended; TR, TG, TB: extended;
Q, P : extended; Q, P: extended;
function ProcessColor(Tc : extended) : extended;
function ProcessColor(c: extended): extended;
begin begin
if (Tc<(1/6)) then if (c < 1/6) then
result:=P+((Q-P)*6.0*Tc) else result := P + (Q - P) * 6.0 * c
if (Tc<(1/2)) then else
result:=Q else if (c < 1/2) then
if (Tc<(2/3)) then result := Q
result:=P+((Q-P)*((2/3)-Tc)*6.0) else else
result:=P; if (c < 2/3) then
result := P + (Q - P) * (2/3 - c) * 6.0
else
result := P;
end; end;
begin begin
if AHSL.S<NUM_ZERO then if AHSL.S < NUM_ZERO then
begin begin
R:=AHSL.L; R := AHSL.L;
G:=AHSL.L; G := AHSL.L;
B:=AHSL.L; B := AHSL.L;
end else end else
begin begin
if (AHSL.L<0.5) then if (AHSL.L < 0.5) then
Q:=AHSL.L*(AHSL.S+1.0) else Q := AHSL.L * (AHSL.S + 1.0)
Q:=AHSL.L+AHSL.S-(AHSL.L*AHSL.S); else
Q := AHSL.L + AHSL.S - AHSL.L*AHSL.S;
P:=2.0*AHSL.L-Q; P := 2.0*AHSL.L - Q;
TR:=AHSL.H+(1/3); TR := AHSL.H + 1/3;
TG:=AHSL.H; TG := AHSL.H;
TB:=AHSL.H-(1/3); TB := AHSL.H - 1/3;
if (TR<0) then TR:=TR+1 else if (TR < 0) then
if (TR>1) then TR:=TR-1; TR := TR + 1
else
if (TR > 1) then
TR := TR - 1;
if (TG<0) then TG:=TG+1 else if (TG < 0) then
if (TG>1) then TG:=TG-1; TG := TG + 1
else
if (TG > 1) then
TG := TG - 1;
if (TB<0) then TB:=TB+1 else if (TB < 0) then
if (TB>1) then TB:=TB-1; TB := TB + 1
else
if (TB > 1) then
TB := TB - 1;
R:=ProcessColor(TR); R := ProcessColor(TR);
G:=ProcessColor(TG); G := ProcessColor(TG);
B:=ProcessColor(TB); B := ProcessColor(TB);
end; end;
result.rgbtRed:=round(255*R); result.rgbtRed := round(255*R);
result.rgbtGreen:=round(255*G); result.rgbtGreen := round(255*G);
result.rgbtBlue:=round(255*B); result.rgbtBlue := round(255*B);
end; end;
class function TColorTools.RgbTripleToColor(ARgbTriple : TRGBTriple) : TColor; class function TColorTools.RgbTripleToColor(ARgbTriple: TRGBTriple) : TColor;
begin begin
result:=rgb(ARgbTriple.rgbtRed,ARgbTriple.rgbtGreen,ARgbTriple.rgbtBlue); result := rgb(
ARgbTriple.rgbtRed,
ARgbTriple.rgbtGreen,
ARgbTriple.rgbtBlue
);
end; end;
class function TColorTools.ColorToGrayscale(AColor: TColor): TColor; class function TColorTools.ColorToGrayscale(AColor: TColor): TColor;
var
var avg : byte; c: TRgbColor;
avg : byte;
begin begin
avg:=(GetRValue(Acolor) + GetGValue(AColor) + GetBValue(AColor)) div 3; c := TRgbColor(ColorToRGB(AColor));
result:=rgb(avg,avg,avg); avg := (c.R + c.G + c.B) div 3;
result := rgb(avg, avg, avg);
end; end;
class function TColorTools.ColorToRgbTriple(AColor : TColor) : TRGBTriple; class function TColorTools.ColorToRgbTriple(AColor: TColor): TRGBTriple;
var
c: TRgbColor;
begin begin
result.rgbtRed:=GetRValue(AColor); c := TRgbColor(ColorToRGB(AColor));
result.rgbtGreen:=GetGValue(AColor); result.rgbtRed := c.R;
result.rgbtBlue:=GetBValue(AColor); result.rgbtGreen := c.G;
result.rgbtBlue := c.B;
end; end;
{ TGradientTools } { TGradientTools }
class procedure TGradientTools.HGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); class procedure TGradientTools.HGradient(ACanvas: TCanvas; cStart, cEnd: TColor;
ARect: T2DIntRect);
begin
ACanvas.GradientFill(ARect.ForWinAPI,cStart, cEnd, gdHorizontal);
end;
{ -- old version ...
var vert : array[0..1] of TRIVERTEX; var vert : array[0..1] of TRIVERTEX;
gRect : GRADIENTRECT; gRect : GRADIENTRECT;
Col1,Col2 : TColor; Col1,Col2 : TColor;
@@ -343,20 +396,27 @@ with vert[1] do
gRect.UpperLeft:=0; gRect.UpperLeft:=0;
gRect.LowerRight:=1; gRect.LowerRight:=1;
GradientFill(canvas.Handle,@vert,2,@gRect,1,GRADIENT_FILL_RECT_H); GradientFill(canvas.Handle,@vert,2,@gRect,1,GRADIENT_FILL_RECT_H);
end; end; }
class procedure TGradientTools.HGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint);
class procedure TGradientTools.HGradient(ACanvas: TCanvas; cStart, cEnd: TColor;
p1, p2: TPoint);
begin begin
HGradient(canvas,cstart,cend,rect(p1.x,p1.y,p2.x,p2.y)); HGradient(ACanvas, cStart, cEnd, rect(p1.x,p1.y,p2.x,p2.y));
end; end;
class procedure TGradientTools.HGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); class procedure TGradientTools.HGradient(ACanvas: TCanvas; cStart, cEnd: TColor;
x1,y1,x2,y2: integer);
begin begin
HGradient(canvas,cstart,cend,rect(x1,y1,x2,y2)); HGradient(ACanvas, cStart, cEnd, rect(x1,y1,x2,y2));
end; end;
class procedure TGradientTools.VGradient(ACanvas: TCanvas; cStart, cEnd: TColor;
ARect: T2DIntRect);
begin
ACanvas.GradientFill(ARect.ForWinAPI, cStart, cEnd, gdVertical);
end;
{ --- old version...
class procedure TGradientTools.VGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect); class procedure TGradientTools.VGradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect);
var vert : array[0..1] of TRIVERTEX; var vert : array[0..1] of TRIVERTEX;
@@ -389,148 +449,164 @@ with vert[1] do
gRect.UpperLeft:=0; gRect.UpperLeft:=0;
gRect.LowerRight:=1; gRect.LowerRight:=1;
GradientFill(canvas.Handle,@vert,2,@gRect,1,GRADIENT_FILL_RECT_V); GradientFill(canvas.Handle,@vert,2,@gRect,1,GRADIENT_FILL_RECT_V);
end; end; }
class procedure TGradientTools.VGradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint);
class procedure TGradientTools.VGradient(ACanvas: TCanvas; cStart, cEnd: TColor;
p1, p2: TPoint);
begin begin
VGradient(canvas,cstart,cend,rect(p1.x,p1.y,p2.x,p2.y)); VGradient(ACanvas, cStart, cEnd, rect(p1.x,p1.y,p2.x,p2.y));
end; end;
class procedure TGradientTools.VGradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer); class procedure TGradientTools.VGradient(ACanvas: TCanvas; cStart, cEnd: TColor;
x1,y1,x2,y2: integer);
begin begin
VGradient(canvas,cstart,cend,rect(x1,y1,x2,y2)); VGradient(ACanvas, cStart, cEnd, rect(x1,y1,x2,y2));
end; end;
class procedure TGradientTools.Gradient(canvas : TCanvas; cStart,cEnd : TColor; rect : T2DIntRect; GradientType : TGradientType); class procedure TGradientTools.Gradient(ACanvas: TCanvas; cStart, cEnd: TColor;
ARect: T2DIntRect; AGradientType: TGradientType);
begin begin
if GradientType=gtVertical then VGradient(canvas, cStart, cEnd, rect) else if AGradientType = gtVertical then
HGradient(canvas, cStart, cEnd, rect); VGradient(ACanvas, cStart, cEnd, ARect)
else
HGradient(ACanvas, cStart, cEnd, ARect);
end; end;
class procedure TGradientTools.Gradient(canvas : TCanvas; cStart,cEnd : TColor; p1, p2 : TPoint; GradientType : TGradientType); class procedure TGradientTools.Gradient(ACanvas: TCanvas; cStart, cEnd: TColor;
p1, p2: TPoint; AGradientType: TGradientType);
begin begin
if GradientType=gtVertical then VGradient(canvas, cStart, cEnd, p1, p2) else if AGradientType = gtVertical then
HGradient(canvas, cStart, cEnd, p1, p2); VGradient(ACanvas, cStart, cEnd, p1, p2)
else
HGradient(ACanvas, cStart, cEnd, p1, p2);
end; end;
class procedure TGradientTools.Gradient(canvas : TCanvas; cStart,cEnd : TColor; x1,y1,x2,y2 : integer; GradientType : TGradientType); class procedure TGradientTools.Gradient(ACanvas: TCanvas; cStart, cEnd: TColor;
x1,y1,x2,y2: integer; AGradientType: TGradientType);
begin begin
if GradientType=gtVertical then VGradient(canvas, cStart, cEnd, x1, y1, x2, y2) else if AGradientType = gtVertical then
HGradient(canvas, cStart, cEnd, x1, y1, x2, y2); VGradient(ACanvas, cStart, cEnd, x1, y1, x2, y2)
else
HGradient(ACanvas, cStart, cEnd, x1, y1, x2, y2);
end; end;
class procedure TGradientTools.HGradientLine(canvas : TCanvas; cBase, cShade : TColor; x1, x2 , y : integer; ShadeMode : TGradientLineShade); class procedure TGradientTools.HGradientLine(ACanvas: TCanvas;
cBase, cShade: TColor; x1, x2, y: integer; ShadeMode: TGradientLineShade);
var i : integer; var
i: integer;
begin begin
if x1=x2 then exit; if x1 = x2 then
if x1>x2 then exit;
begin if x1 > x2 then
i:=x1; begin
x1:=x2; i := x1;
x2:=i; x1 := x2;
end; x2 := i;
case ShadeMode of end;
lsShadeStart : HGradient(canvas,cShade,cBase,rect(x1,y,x2,y+1)); case ShadeMode of
lsShadeEnds : begin lsShadeStart:
i:=(x1+x2) div 2; HGradient(ACanvas, cShade, cBase, rect(x1,y,x2,y+1));
HGradient(canvas,cShade,cBase,rect(x1,y,i,y+1)); lsShadeEnds:
HGradient(canvas,cBase,cShade,rect(i,y,x2,y+1)); begin
end; i := (x1 + x2) div 2;
lsShadeCenter : begin HGradient(ACanvas, cShade, cBase, rect(x1,y,i,y+1));
i:=(x1+x2) div 2; HGradient(ACanvas, cBase, cShade, rect(i,y,x2,y+1));
HGradient(canvas,cBase,cShade,rect(x1,y,i,y+1)); end;
HGradient(canvas,cShade,cBase,rect(i,y,x2,y+1)); lsShadeCenter:
end; begin
lsShadeEnd : HGradient(canvas,cBase,cShade,rect(x1,y,x2,y+1)); i := (x1 + x2) div 2;
end; HGradient(ACanvas, cBase, cShade, rect(x1,y,i,y+1));
HGradient(ACanvas, cShade, cBase, rect(i,y,x2,y+1));
end;
lsShadeEnd:
HGradient(ACanvas,cBase,cShade,rect(x1,y,x2,y+1));
end;
end; end;
class procedure TGradientTools.VGradientLine(canvas : TCanvas; cBase, cShade : TColor; x, y1 , y2 : integer; ShadeMode : TGradientLineShade); class procedure TGradientTools.VGradientLine(ACanvas: TCanvas;
cBase, cShade: TColor; x, y1, y2: integer; ShadeMode: TGradientLineShade);
var i : integer; var
i : integer;
begin begin
if y1=y2 then exit; if y1 = y2 then
if y1>y2 then exit;
begin if y1 > y2 then
i:=y1; begin
y1:=y2; i := y1;
y2:=i; y1 := y2;
end; y2 := i;
case ShadeMode of end;
lsShadeStart : VGradient(canvas,cShade,cBase,rect(x,y1,x+1,y2)); case ShadeMode of
lsShadeEnds : begin lsShadeStart:
i:=(y1+y2) div 2; VGradient(ACanvas, cShade, cBase, rect(x,y1,x+1,y2));
VGradient(canvas,cShade,cBase,rect(x,y1,x+1,i)); lsShadeEnds:
VGradient(canvas,cBase,cShade,rect(x,i,x+1,y2)); begin
end; i := (y1 + y2) div 2;
lsShadeCenter : begin VGradient(ACanvas, cShade, cBase, rect(x,y1,x+1,i));
i:=(y1+y2) div 2; VGradient(ACanvas, cBase, cShade, rect(x,i,x+1,y2));
VGradient(canvas,cBase,cShade,rect(x,y1,x+1,i)); end;
VGradient(canvas,cShade,cBase,rect(x,i,x+1,y2)); lsShadeCenter:
end; begin
lsShadeEnd : VGradient(canvas,cBase,cShade,rect(x,y1,x+1,y2)); i := (y1 + y2) div 2;
end; VGradient(ACanvas, cBase, cShade, rect(x,y1,x+1,i));
VGradient(ACanvas, cShade, cBase, rect(x,i,x+1,y2));
end;
lsShadeEnd:
VGradient(ACanvas, cBase, cShade, rect(x,y1,x+1,y2));
end;
end; end;
class procedure TGradientTools.HGradient3dLine(canvas : TCanvas; x1,x2,y : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); class procedure TGradientTools.HGradient3dLine(ACanvas: TCanvas; x1,x2,y: integer;
ShadeMode: TGradientLineShade; A3dKind: TGradient3dLine = glLowered);
begin begin
if A3dKind = glRaised then if A3dKind = glRaised then
begin begin
HGradientLine(canvas,clBtnHighlight,clBtnFace,x1,x2,y,ShadeMode); HGradientLine(ACanvas, clBtnHighlight, clBtnFace, x1,x2,y, ShadeMode);
HGradientLine(canvas,clBtnShadow,clBtnFace,x1,x2,y+1,ShadeMode); HGradientLine(ACanvas, clBtnShadow, clBtnFace, x1,x2,y+1, ShadeMode);
end else end else
begin begin
HGradientLine(canvas,clBtnShadow,clBtnFace,x1,x2,y,ShadeMode); HGradientLine(ACanvas, clBtnShadow, clBtnFace, x1,x2,y, ShadeMode);
HGradientLine(canvas,clBtnHighlight,clBtnFace,x1,x2,y+1,ShadeMode); HGradientLine(ACanvas, clBtnHighlight, clBtnFace, x1,x2,y+1, ShadeMode);
end; end;
end; end;
class procedure TGradientTools.VGradient3dLine(canvas : TCanvas; x,y1,y2 : integer; ShadeMode : TGradientLineShade; A3dKind : TGradient3dLine = glLowered); class procedure TGradientTools.VGradient3dLine(ACanvas: TCanvas; x,y1,y2: integer;
ShadeMode: TGradientLineShade; A3dKind: TGradient3dLine = glLowered);
begin begin
if A3dKind = glLowered then if A3dKind = glLowered then
begin begin
VGradientLine(canvas,clBtnFace,clBtnHighlight,x,y1,y2,ShadeMode); VGradientLine(ACanvas, clBtnFace, clBtnHighlight, x,y1,y2, ShadeMode);
VGradientLine(canvas,clBtnFace,clBtnShadow,x+1,y1,y2,ShadeMode); VGradientLine(ACanvas, clBtnFace, clBtnShadow, x+1,y1,y2, ShadeMode);
end else end else
begin begin
VGradientLine(canvas,clBtnFace,clBtnShadow,x,y1,y2,ShadeMode); VGradientLine(ACanvas, clBtnFace, clBtnShadow, x,y1,y2, ShadeMode);
VGradientLine(canvas,clBtnFace,clBtnHighlight,x+1,y1,y2,ShadeMode); VGradientLine(ACanvas, clBtnFace, clBtnHighlight, x+1,y1,y2, ShadeMode);
end; end;
end; end;
{ TTextTools } { TTextTools }
class procedure TTextTools.OutlinedText(Canvas : TCanvas; x, y : integer; const text : string); class procedure TTextTools.OutlinedText(ACanvas: TCanvas; x, y: integer; const AText: string);
var
var TmpColor : TColor; TmpColor: TColor;
TmpBrushStyle : TBrushStyle; TmpBrushStyle: TBrushStyle;
begin begin
TmpColor:=Canvas.Font.color; TmpColor := ACanvas.Font.Color;
TmpBrushStyle:=Canvas.Brush.style; TmpBrushStyle := ACanvas.Brush.Style;
Canvas.brush.style:=bsClear; ACanvas.Brush.Style := bsClear;
Canvas.font.color:=clBlack; ACanvas.Font.Color := clBlack;
Canvas.TextOut(x-1,y,text); ACanvas.TextOut(x-1, y, AText);
Canvas.TextOut(x+1,y,text); ACanvas.TextOut(x+1, y, AText);
Canvas.TextOut(x,y-1,text); ACanvas.TextOut(x, y-1, AText);
Canvas.TextOut(x,y+1,text); ACanvas.TextOut(x, y+1, AText);
Canvas.font.color:=TmpColor; ACanvas.Font.Color := TmpColor;
Canvas.TextOut(x,y,text); ACanvas.TextOut(x, y, AText);
Canvas.Brush.Style:=TmpBrushStyle; ACanvas.Brush.Style := TmpBrushStyle;
end; end;
end. end.