5148aebbc0
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1436 8e941d3f-bd1b-0410-a28a-d453659cc2b4
925 lines
27 KiB
ObjectPascal
925 lines
27 KiB
ObjectPascal
{ ----------------------------------------------------------------------------}
|
|
{ A Gradient Fill component for Delphi. }
|
|
{ TGradientFill, Copyright 1995, Curtis White. All Rights Reserved. }
|
|
{ TNetGradient, Copyright 1997, Heiko Webers. All Rights Reserved. }
|
|
{ This component can be freely used and distributed in commercial and private }
|
|
{ environments, provided this notice is not modified in any way. }
|
|
{ ----------------------------------------------------------------------------}
|
|
{ Feel free to contact me if you have any questions, comments or suggestions }
|
|
{ at cwhite@teleport.com }
|
|
{ Or me at heikowebers@usa.net }
|
|
{ ----------------------------------------------------------------------------}
|
|
{ Date last modified: 18/10/2009 }
|
|
{ ----------------------------------------------------------------------------}
|
|
{ ----------------------------------------------------------------------------}
|
|
{ TNetGradient v2.05 }
|
|
{ ----------------------------------------------------------------------------}
|
|
{ Description: }
|
|
{ A gradient fill like in the new Netscape Communicator Options Box. }
|
|
{ Features: }
|
|
{ The begin and end colors can be any colors. }
|
|
{ The fill direction can be set to Right-To-Left or Left-To-Right. }
|
|
{ The number of colors, between 1 and 255 can be set for the fill. }
|
|
{ The Caption can be anything and anywhere on TNetGradient. }
|
|
{ ----------------------------------------------------------------------------}
|
|
{ ----------------------------------------------------------------------------}
|
|
{ Revision History: }
|
|
{ 1.00: Initial release }
|
|
{ 1.00: Changed to TNetGradient }
|
|
{ 1.01: Border Update by Enzo Scozzaro www.scozzaro.it www.thefox.it }
|
|
{ 2.00: +Caption Alignment, +Layout, +DataSource }
|
|
{ 2.01: +SubCaption, +Font, +MarginLeft, +MarginTop, +SubCapField }
|
|
{ 2.03: -Bug TextLetf }
|
|
{ 2.04: FillDirection: +ftTopToBottom, +ftBottomToTop }
|
|
{ 2.05: +Begin/EndUpdate, Fix crash in frames, Fix memory leaks, Cleanup }
|
|
{ ----------------------------------------------------------------------------}
|
|
|
|
unit SMNetGradient;
|
|
|
|
{$MODE Delphi}
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, GraphType, Db, DBCtrls, LMessages;
|
|
|
|
Const
|
|
DefaultStyle = DT_SINGLELINE or DT_END_ELLIPSIS or DT_EXPANDTABS;
|
|
|
|
type
|
|
{ Direction of fill }
|
|
TFillDirection = (fdLeftToRight, fdRightToLeft, ftTopToBottom, ftBottomToTop);
|
|
{ Range of valid colors }
|
|
TNumberOfColors = 1..255;
|
|
TLabelBevel = TBevelCut;
|
|
|
|
TMargin = 0..MaxInt;
|
|
|
|
TPointArray = array of TPoint;
|
|
|
|
TCustomNetGradient = class;
|
|
|
|
{ TSubCaption }
|
|
|
|
TSubCaption = class(TPersistent)
|
|
private
|
|
{ Private-Deklarationen }
|
|
Parent: TCustomNetGradient;
|
|
FCaption: TCaption;
|
|
FFont: TFont;
|
|
FHotTrack: Boolean;
|
|
FMarginLeft: Integer;
|
|
FMarginTop: Integer;
|
|
FVisible: Boolean;
|
|
procedure OnFontChanged(Sender: TObject);
|
|
protected
|
|
{ Protected declarations }
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure SetCaption(const Value: TCaption); virtual;
|
|
procedure SetFont(Value: TFont); virtual;
|
|
procedure SetMarginLeft(Value: Integer); virtual;
|
|
procedure SetMarginTop(Value: Integer); virtual;
|
|
procedure SetVisible(Value: Boolean); virtual;
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(AOwner: TCustomNetGradient); overload;
|
|
destructor Destroy; override;
|
|
published
|
|
{ Published-Deklarationen }
|
|
property Caption: TCaption read FCaption write SetCaption;
|
|
property HotTrack: Boolean read FHotTrack write FHotTrack default False;
|
|
property MarginLeft: Integer read FMarginLeft write SetMarginLeft default 5;
|
|
property MarginTop: Integer read FMarginTop write SetMarginTop default 0;
|
|
property Font: TFont read FFont write SetFont;
|
|
property Visible: Boolean read FVisible write SetVisible default True;
|
|
end;
|
|
|
|
{ TCustomNetGradient }
|
|
|
|
TCustomNetGradient = class(TCustomControl)
|
|
private
|
|
//*** Enzo *** Bordi
|
|
FBevelInner: TLabelBevel;
|
|
FBevelOuter: TLabelBevel;
|
|
|
|
//*** Emzp *** Allineamento Caption
|
|
FAlignment : TAlignment;
|
|
FBorderColor: TColor;
|
|
FFlatBorder: Boolean;
|
|
FLayout : TTextLayout;
|
|
|
|
//FMargin: TMargin;
|
|
{ Variables for properties }
|
|
FDirection: TFillDirection;
|
|
FBeginColor: TColor;
|
|
FEndColor: TColor;
|
|
// FCenter: Boolean;
|
|
FNumberOfColors: TNumberOfColors;
|
|
FFont : TFont;
|
|
FCaption : TCaption;
|
|
FTextTop : Integer;
|
|
FTextLeft: Integer;
|
|
FSubCaption: TSubCaption;
|
|
FUpdateCount: Integer;
|
|
procedure OnFontChanged(Sender: TObject);
|
|
procedure Changed;
|
|
function GetBorderPoints(const R: TRect): TPointArray;
|
|
procedure SetBorderColor(const Value: TColor);
|
|
{ Procedures for setting property values }
|
|
procedure SetFillDirection(Value: TFillDirection);
|
|
procedure SetBeginColor(Value: TColor);
|
|
procedure SetEndColor(Value: TColor);
|
|
procedure SetFlatBorder(const Value: Boolean);
|
|
procedure SetNumberOfColors(Value: TNumberOfColors);
|
|
procedure SetFont(AFont: TFont);
|
|
procedure SetCaption(const Value: String);
|
|
procedure SetSubCaption(const Value: TSubCaption);
|
|
procedure SetTextTop(Value: Integer);
|
|
procedure SetTextLeft(Value: Integer);
|
|
{ Fill procedure }
|
|
procedure GradientFill;
|
|
protected
|
|
procedure Paint; override;
|
|
procedure SetAlignment(Value: TAlignment);
|
|
procedure SetLayout(Value: TTextLayout); virtual;
|
|
procedure SetBevelInner(Value: TLabelBevel);
|
|
procedure SetBevelOuter(Value: TLabelBevel);
|
|
procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
|
|
property CaptionAlignment: TAlignment read FAlignment write SetAlignment;
|
|
property CaptionLayout: TTextLayout read FLayout write SetLayout default tlCenter;
|
|
property BevelInner: TLabelBevel read FBevelInner write SetBevelInner default bvNone;
|
|
property BevelOuter: TLabelBevel read FBevelOuter write SetBevelOuter default bvRaised;
|
|
{ Starting color of fill }
|
|
property BeginColor: TColor read FBeginColor write SetBeginColor default clBlue;
|
|
property BorderColor: TColor read FBorderColor write SetBorderColor default clWhite;
|
|
{ Ending color of fill }
|
|
property EndColor: TColor read FEndColor write SetEndColor default clBlack;
|
|
property FlatBorder: Boolean read FFlatBorder write SetFlatBorder default False;
|
|
{ Direction of fill }
|
|
property FillDirection: TFillDirection read FDirection write SetFillDirection default fdLeftToRight;
|
|
{ Number of colors to use in the fill (1 - 256) - default is 255. If 1 }
|
|
{ then it uses the Begin Color. }
|
|
property NumberOfColors: TNumberOfColors read FNumberOfColors write SetNumberOfColors default 255;
|
|
{ Enable standard properties }
|
|
property Font: TFont read FFont write SetFont;
|
|
property Caption: String read FCaption write SetCaption;
|
|
property TextTop: Integer read FTextTop write SetTextTop;
|
|
property TextLeft: Integer read FTextLeft write SetTextLeft;
|
|
property SubCaption: TSubCaption read FSubCaption write SetSubCaption;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
end;
|
|
|
|
{ TNetGradient }
|
|
|
|
TNetGradient = class (TCustomNetGradient)
|
|
published
|
|
property Anchors;
|
|
property BevelInner;
|
|
property BevelOuter;
|
|
property BeginColor;
|
|
property BorderColor;
|
|
property CaptionAlignment;
|
|
property CaptionLayout;
|
|
property EndColor;
|
|
property FlatBorder;
|
|
property FillDirection;
|
|
property NumberOfColors;
|
|
property Font;
|
|
property Caption;
|
|
property TextTop;
|
|
property TextLeft;
|
|
property SubCaption;
|
|
//default properties
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BorderWidth;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Visible;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
end;
|
|
|
|
{ TDBNetGradient }
|
|
|
|
TDBNetGradient = class (TCustomNetGradient)
|
|
private
|
|
FDataLink : TFieldDataLink;
|
|
FSubCapField: Boolean;
|
|
procedure DataChange(Sender: TObject);
|
|
function GetDataField: String;
|
|
function GetDataSource: TDataSource;
|
|
procedure SetDataField(const Value: String);
|
|
procedure SetDataSource(Value: TDataSource);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property DataField: String read GetDataField write SetDataField;
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
property SubCapField: Boolean read FSubCapField write FSubCapField default false;
|
|
|
|
property CaptionAlignment;
|
|
property CaptionLayout;
|
|
property BevelInner;
|
|
property BevelOuter;
|
|
property BeginColor;
|
|
property BorderColor;
|
|
property EndColor;
|
|
property FlatBorder;
|
|
property FillDirection;
|
|
property NumberOfColors;
|
|
property Font;
|
|
property Caption;
|
|
property TextTop;
|
|
property TextLeft;
|
|
property SubCaption;
|
|
//default properties
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BorderWidth;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Visible;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TCustomNetGradient }
|
|
|
|
{ Override the constructor to initialize variables }
|
|
constructor TCustomNetGradient.Create(AOwner: TComponent);
|
|
begin
|
|
{ Inherit original constructor }
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csAcceptsControls, csNoFocus];
|
|
{ Add new initializations }
|
|
FLayout := tlCenter;
|
|
FBevelInner := bvNone;
|
|
FBevelOuter := bvRaised;
|
|
|
|
Height := 25;
|
|
Width := 400;
|
|
FBeginColor := clSilver;
|
|
FEndColor := $00A56D39;
|
|
FBorderColor := clWhite;
|
|
FDirection := fdLeftToRight;
|
|
FNumberOfColors:= 255;
|
|
//FTextLeft:= 0;
|
|
//FTextTop:= 0;
|
|
FFont := TFont.Create;
|
|
FFont.Style:= [fsbold];
|
|
FFont.OnChange := OnFontChanged;
|
|
|
|
FSubCaption := TSubCaption.Create(Self);
|
|
//Caption := Name;
|
|
//FCaption := AOwner.Name;
|
|
//ShowMessage((AOwner as TComponent).);
|
|
//FCaption:= 'test';
|
|
end;
|
|
|
|
destructor TCustomNetGradient.Destroy;
|
|
begin
|
|
FSubCaption.Destroy;
|
|
FFont.Destroy;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ Set begin color when property is changed }
|
|
procedure TCustomNetGradient.SetBeginColor(Value: TColor);
|
|
begin
|
|
if Value <> FBeginColor then
|
|
begin
|
|
FBeginColor := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
{ Set end color when property is changed }
|
|
procedure TCustomNetGradient.SetEndColor(Value: TColor);
|
|
begin
|
|
if Value <> FEndColor then
|
|
begin
|
|
FEndColor := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.SetFlatBorder(const Value: Boolean);
|
|
begin
|
|
if FFlatBorder <> Value then
|
|
begin
|
|
FFlatBorder := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
{ Set the number of colors to be used in the fill }
|
|
procedure TCustomNetGradient.SetNumberOfColors(Value: TNumberOfColors);
|
|
begin
|
|
if Value <> FNumberOfColors then
|
|
begin
|
|
FNumberOfColors := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
// Set the Font
|
|
procedure TCustomNetGradient.SetFont(AFont: TFont);
|
|
begin
|
|
if AFont <> FFont then
|
|
begin
|
|
FFont.Assign(AFont);
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
// Set the Caption on NG
|
|
procedure TCustomNetGradient.SetCaption(const Value: String);
|
|
begin
|
|
if Value <> FCaption then
|
|
begin
|
|
FCaption := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.SetSubCaption(const Value: TSubCaption);
|
|
begin
|
|
FSubCaption.Assign(Value);
|
|
end;
|
|
|
|
// Set the Position of the Caption (Top)
|
|
procedure TCustomNetGradient.SetTextTop(Value: Integer);
|
|
begin
|
|
if Value <> FTextTop then
|
|
begin
|
|
FTextTop := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
// Set the Position of the Caption (Left)
|
|
procedure TCustomNetGradient.SetTextLeft(Value: Integer);
|
|
begin
|
|
if Value <> FTextLeft then
|
|
begin
|
|
FTextLeft := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
{ Perform the fill when paint is called }
|
|
procedure TCustomNetGradient.Paint;
|
|
begin
|
|
GradientFill;
|
|
end;
|
|
|
|
{ Gradient fill procedure - the actual routine }
|
|
procedure TCustomNetGradient.GradientFill;
|
|
var
|
|
{ Set up working variables }
|
|
BeginRGBValue : array[0..2] of Byte; { Begin RGB values }
|
|
RGBDifference : array[0..2] of integer; { Difference between begin and end }
|
|
{ RGB values }
|
|
ColorBand , rp,cr: TRect; { Color band rectangular coordinates }
|
|
I , x : Integer; { Color band index }
|
|
R : Byte; { Color band Red value }
|
|
G : Byte; { Color band Green value }
|
|
B : Byte; { Color band Blue value }
|
|
WorkBmp : TBitmap; { Off screen working bitmap }
|
|
DrawStyle : LongInt;
|
|
TS : TTextStyle;
|
|
GlyphOffs : Integer;
|
|
//SbCapOffs : Integer;
|
|
|
|
procedure DoDrawText(const Text: string; ACanvas: TCanvas; AFont: TFont; var Rect: TRect; Flags: LongInt);
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
Font.Assign(AFont);
|
|
Rect.Left:=Rect.Left; //**
|
|
if not(Enabled) then
|
|
begin
|
|
OffsetRect(Rect, 1, 1);
|
|
Font.Color := clBtnHighlight;
|
|
DrawText(Handle, PChar(Text), Length(Text), Rect, Flags);
|
|
OffsetRect(Rect, -1, -1); //**
|
|
Font.Color := clBtnShadow;
|
|
DrawText(Handle, PChar(Text), Length(Text), Rect, Flags);
|
|
end
|
|
else
|
|
DrawText(Handle, PChar(Text), Length(Text), Rect, Flags);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
{ Create the working bitmap and set its width and height }
|
|
WorkBmp := TBitmap.Create;
|
|
WorkBmp.Width := Width;
|
|
WorkBmp.Height := Height;
|
|
|
|
{ Use working bitmap to draw the gradient }
|
|
with WorkBmp do
|
|
begin
|
|
Rp := GetClientRect;
|
|
{ Extract the begin RGB values }
|
|
case FDirection of
|
|
fdLeftToRight, ftTopToBottom: begin
|
|
{ Set the Red, Green and Blue colors }
|
|
BeginRGBValue[0] := GetRValue (ColorToRGB (FBeginColor));
|
|
BeginRGBValue[1] := GetGValue (ColorToRGB (FBeginColor));
|
|
BeginRGBValue[2] := GetBValue (ColorToRGB (FBeginColor));
|
|
{ Calculate the difference between begin and end RGB values }
|
|
RGBDifference[0] := GetRValue (ColorToRGB (FEndColor)) -
|
|
BeginRGBValue[0];
|
|
RGBDifference[1] := GetGValue (ColorToRGB (FEndColor)) -
|
|
BeginRGBValue[1];
|
|
RGBDifference[2] := GetBValue (ColorToRGB (FEndColor)) -
|
|
BeginRGBValue[2];
|
|
end;
|
|
|
|
fdRightToLeft,ftBottomToTop: begin
|
|
{ Set the Red, Green and Blue colors }
|
|
BeginRGBValue[0] := GetRValue (ColorToRGB (FEndColor));
|
|
BeginRGBValue[1] := GetGValue (ColorToRGB (FEndColor));
|
|
BeginRGBValue[2] := GetBValue (ColorToRGB (FEndColor));
|
|
{ Calculate the difference between begin and end RGB values }
|
|
RGBDifference[0] := GetRValue (ColorToRGB (FBeginColor)) -
|
|
BeginRGBValue[0];
|
|
RGBDifference[1] := GetGValue (ColorToRGB (FBeginColor)) -
|
|
BeginRGBValue[1];
|
|
RGBDifference[2] := GetBValue (ColorToRGB (FBeginColor)) -
|
|
BeginRGBValue[2];
|
|
end;
|
|
end;
|
|
|
|
{ Set the pen style and mode }
|
|
Canvas.Pen.Style := psSolid;
|
|
Canvas.Pen.Mode := pmCopy;
|
|
|
|
case FDirection of
|
|
|
|
{ Calculate the color band's left and right coordinates }
|
|
{ for LeftToRight and RightToLeft fills }
|
|
fdLeftToRight, fdRightToLeft:
|
|
begin
|
|
ColorBand.Top := 0;
|
|
ColorBand.Bottom := Height;
|
|
end;
|
|
ftTopToBottom, ftBottomToTop:
|
|
begin
|
|
ColorBand.Left := 0;
|
|
ColorBand.Right := Width;
|
|
end;
|
|
end;
|
|
|
|
{ Perform the fill }
|
|
if FNumberOfColors = 1 then
|
|
begin
|
|
Canvas.Brush.Color := FBeginColor;
|
|
Canvas.FillRect(rp);
|
|
end
|
|
else
|
|
begin
|
|
for I := 0 to FNumberOfColors do
|
|
begin
|
|
case FDirection of
|
|
{ Calculate the color band's left and right coordinates }
|
|
fdLeftToRight, fdRightToLeft:
|
|
begin
|
|
ColorBand.Left := MulDiv (I, Self.Width, FNumberOfColors);
|
|
ColorBand.Right := MulDiv (I + 1, Self.Width, FNumberOfColors);
|
|
end;
|
|
ftTopToBottom, ftBottomToTop:
|
|
begin
|
|
ColorBand.Top := MulDiv (I, Self.Height, FNumberOfColors);
|
|
ColorBand.Bottom := MulDiv (I + 1, Self.Height, FNumberOfColors);
|
|
end;
|
|
end;
|
|
{ Calculate the color band's color }
|
|
R := BeginRGBValue[0] + MulDiv (I, RGBDifference[0], FNumberOfColors - 1);
|
|
G := BeginRGBValue[1] + MulDiv (I, RGBDifference[1], FNumberOfColors - 1);
|
|
B := BeginRGBValue[2] + MulDiv (I, RGBDifference[2], FNumberOfColors - 1);
|
|
{ Select the brush and paint the color band }
|
|
Canvas.Brush.Color := RGB (R, G, B);
|
|
Canvas.FillRect (ColorBand);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Copy the working bitmap to the main canvas }
|
|
Canvas.Draw(0, 0, WorkBmp);
|
|
|
|
// <TextOut>
|
|
//Canvas.Brush.Style:= bsClear;
|
|
Canvas.Font.Assign(FFont);
|
|
|
|
//Canvas.Textout(FTextLeft, FTextTop, FCaption); *** Enzo *** Implemetation
|
|
if FFlatBorder then
|
|
begin
|
|
if BorderWidth > 0 then
|
|
begin
|
|
Canvas.Pen.Width := BorderWidth;
|
|
Canvas.Pen.EndCap := pecSquare;
|
|
Canvas.Pen.Color := FBorderColor;
|
|
//see if there's a better way of drawing a rectangle since
|
|
// in BorderWidth >= 3 glitches occurs
|
|
Canvas.Polyline(GetBorderPoints(rp));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FBevelOuter <> bvNone then
|
|
Canvas.Frame3D(rp, 1, FBevelOuter);
|
|
if FBevelInner <> bvNone then
|
|
Canvas.Frame3D(rp, 1, FBevelInner);
|
|
end;
|
|
|
|
if Caption <> '' then begin
|
|
Font.Assign(Self.Font);
|
|
Rp := GetClientRect;
|
|
Inc(Rp.Left, FTextLeft); //5=FMargin
|
|
//if FGlyph.DisplayAlign = daLeft then
|
|
// Inc(Rp.Left, GlyphOffs)
|
|
//else
|
|
// Dec(R.Right, GlyphOffs);
|
|
//Dec(R.Right, SbCapOffs);
|
|
case FAlignment of
|
|
taLeftJustify : begin
|
|
DrawStyle := DefaultStyle or DT_LEFT;
|
|
Inc(Rp.Left, FTextLeft);
|
|
end;
|
|
taRightJustify : begin
|
|
DrawStyle := DefaultStyle or DT_RIGHT;
|
|
Inc(Rp.Right, FTextLeft);
|
|
|
|
end;
|
|
taCenter : begin
|
|
DrawStyle := DefaultStyle or DT_CENTER;
|
|
Inc(Rp.Left, FTextLeft);
|
|
end;
|
|
end;
|
|
//DrawStyle := DefaultStyle or FAlignment; //Enzo DT_LEFT;
|
|
|
|
TS := Canvas.TextStyle;
|
|
TS.Alignment:= CaptionAlignment;
|
|
//TS.Layout:= tlCenter;
|
|
TS.Opaque:= false;
|
|
TS.Clipping:= false;
|
|
TS.SystemFont:=Canvas.Font.IsDefault;
|
|
|
|
CR := Rp;
|
|
//cr.left := cr.Left + FTextLeft;
|
|
//rp.left :=rp.left + FTextLeft;
|
|
rp.Top:= rp.Top + FTextTop;
|
|
if FLayout <> tlTop then begin
|
|
|
|
X := Canvas.TextHeight('W');
|
|
DoDrawText(Caption, WorkBmp.Canvas, Self.Font, CR, DrawStyle or DT_CALCRECT);
|
|
if FLayout = tlBottom then OffsetRect(Rp, 0, Height - CR.Bottom-2)
|
|
else OffsetRect(Rp, 0, (Height - CR.Bottom) div 2);
|
|
end;
|
|
// if Rp.Right - Rp.Left >= Canvas.TextWidth(Caption[1]) then
|
|
Canvas.TextRect(rp, rp.Left, rp.Top, Caption, TS);
|
|
|
|
|
|
end;
|
|
|
|
|
|
//*** Enzo **** SubCaption
|
|
|
|
if (FSubCaption.Caption <> '') then begin
|
|
GlyphOffs := 0;
|
|
//SbCapOffs := 0;
|
|
Canvas.Font.Assign(FSubCaption.Font);
|
|
Rp := GetClientRect;
|
|
|
|
//DrawStyle := DefaultStyle or DT_RIGHT;
|
|
|
|
// if FLayout <> tlTop then begin
|
|
// rp:=GetClientRect;
|
|
X := canvas.TextHeight('W');
|
|
|
|
Inc(Rp.Left, ClientWidth - canvas.TextWidth(FSubCaption.Caption) - FSubCaption.MarginLeft);
|
|
if Rp.Left < SubCaption.FMarginLeft + GlyphOffs then Rp.Left := SubCaption.FMarginLeft + GlyphOffs;
|
|
//SbCapOffs := Rp.Right - Rp.Left;
|
|
CR := Rp;
|
|
Inc(cr.Left, SubCaption.FMarginLeft);
|
|
rp.Top:= rp.Top+SubCaption.FMarginTop;
|
|
DoDrawText(FSubCaption.Caption, WorkBmp.Canvas, Self.Font, CR, DT_CALCRECT);
|
|
if FLayout = tlBottom then begin
|
|
OffsetRect(Rp, 0, Height - X - Abs(canvas.TextHeight('W') - X) div 2);
|
|
end else if FLayout = tlTop then begin
|
|
Font.Assign(Self.Font);
|
|
end else
|
|
OffsetRect(Rp, 0, (Height - CR.Bottom) div 2);
|
|
Canvas.TextRect(rp, rp.Left, rp.Top, FSubCaption.Caption);
|
|
end;
|
|
|
|
|
|
// Border Outer and Inner
|
|
|
|
|
|
// Canvas.Frame3d(rp, 1, bvRaised);
|
|
// </TextOut>
|
|
|
|
{ Release the working bitmap resources }
|
|
WorkBmp.Free;
|
|
end;
|
|
|
|
{ Set the fill direction }
|
|
procedure TCustomNetGradient.SetFillDirection(Value: TFillDirection);
|
|
begin
|
|
if Value <> FDirection then
|
|
begin
|
|
FDirection := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
//*** Enzo ***
|
|
|
|
procedure TCustomNetGradient.SetAlignment(Value: TAlignment);
|
|
begin
|
|
if FAlignment <> Value then
|
|
begin
|
|
FAlignment := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.SetLayout(Value: TTextLayout);
|
|
begin
|
|
if Value <> FLayout then
|
|
begin
|
|
FLayout := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.SetBevelInner(Value: TLabelBevel);
|
|
begin
|
|
if Value <> FBevelInner then begin
|
|
FBevelInner := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.SetBevelOuter(Value: TLabelBevel);
|
|
begin
|
|
if Value <> FBevelOuter then
|
|
begin
|
|
FBevelOuter := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.WMEraseBkgnd(var Message: TLMEraseBkgnd);
|
|
begin
|
|
// Do nothing. Just to avoid flicker.
|
|
end;
|
|
|
|
procedure TCustomNetGradient.OnFontChanged(Sender: TObject);
|
|
begin
|
|
Changed;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.BeginUpdate;
|
|
begin
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TCustomNetGradient.Changed;
|
|
begin
|
|
if (FUpdateCount = 0) and not (csLoading in ComponentState) then
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomNetGradient.GetBorderPoints(const R: TRect): TPointArray;
|
|
var
|
|
Offset, Fix: Integer;
|
|
begin
|
|
Offset := BorderWidth div 2;
|
|
Fix := BorderWidth mod 2;
|
|
SetLength(Result, 5);
|
|
Result[0].x := R.Left + BorderWidth - Offset - Fix;
|
|
Result[0].y := R.Top + BorderWidth - Offset - Fix;
|
|
|
|
Result[1].x := R.Right - BorderWidth + Offset;
|
|
Result[1].y := R.Top + BorderWidth - Offset - Fix;
|
|
|
|
Result[2].x := R.Right - BorderWidth + Offset;
|
|
Result[2].y := R.Bottom - BorderWidth + Offset;
|
|
|
|
Result[3].x := R.Left + BorderWidth - Offset - Fix;
|
|
Result[3].y := R.Bottom - BorderWidth + Offset;
|
|
|
|
Result[4].x := R.Left + BorderWidth - Offset - Fix;
|
|
Result[4].y := R.Top + BorderWidth - Offset - Fix;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.SetBorderColor(const Value: TColor);
|
|
begin
|
|
if FBorderColor <> Value then
|
|
begin
|
|
FBorderColor := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomNetGradient.EndUpdate;
|
|
begin
|
|
if FUpdateCount > 0 then
|
|
Dec(FUpdateCount);
|
|
Changed;
|
|
end;
|
|
|
|
//**********
|
|
|
|
constructor TSubCaption.Create(AOwner: TCustomNetGradient);
|
|
begin
|
|
inherited Create;
|
|
Parent := AOwner;
|
|
//FCaption := '';
|
|
FFont := TFont.Create;
|
|
FFont.OnChange := OnFontChanged;
|
|
//FHotTrack := False;
|
|
FMarginLeft := 5;
|
|
//FMarginTop := 0;
|
|
FVisible := True;
|
|
end;
|
|
|
|
destructor TSubCaption.Destroy;
|
|
begin
|
|
FFont.Destroy;
|
|
inherited Destroy;
|
|
end; // Destroy
|
|
|
|
procedure TSubCaption.SetCaption(const Value: TCaption);
|
|
begin
|
|
if Value <> FCaption then
|
|
begin
|
|
FCaption := Value;
|
|
Parent.Changed;
|
|
end
|
|
end;
|
|
|
|
procedure TSubCaption.SetFont(Value: TFont);
|
|
begin
|
|
FFont.Assign(Value);
|
|
end;
|
|
|
|
procedure TSubCaption.OnFontChanged(Sender: TObject);
|
|
begin
|
|
Parent.Changed;
|
|
end;
|
|
|
|
procedure TSubCaption.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TSubCaption then
|
|
begin
|
|
FCaption := TSubCaption(Source).Caption;
|
|
FHotTrack := TSubCaption(Source).HotTrack;
|
|
FMarginLeft := TSubCaption(Source).MarginLeft;
|
|
FMarginTop := TSubCaption(Source).MarginTop;
|
|
FVisible := TSubCaption(Source).Visible;
|
|
Font := TSubCaption(Source).Font;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TSubCaption.SetMarginLeft(Value: Integer);
|
|
begin
|
|
if Value <> FMarginLeft then
|
|
begin
|
|
FMarginLeft := Value;
|
|
Parent.Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TSubCaption.SetMarginTop(Value: Integer);
|
|
begin
|
|
if Value <> FMarginTop then
|
|
begin
|
|
FMarginTop := Value;
|
|
Parent.Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TSubCaption.SetVisible(Value: Boolean);
|
|
begin
|
|
if Value <> FVisible then
|
|
begin
|
|
FVisible := Value;
|
|
Parent.Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TDBNetGradient.DataChange(Sender: TObject);
|
|
begin
|
|
if FDataLink.DataSet.Active then
|
|
begin
|
|
if not FSubCapField then
|
|
begin
|
|
Caption := FDataLink.Field.DisplayText;
|
|
end else
|
|
begin
|
|
fSubCaption.SetCaption( FDataLink.Field.DisplayText);
|
|
//fSubCaption.SetCaption( FDataLink.Field.AsString);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDBNetGradient.GetDataField: String;
|
|
begin
|
|
Result := FDataLink.FieldName;
|
|
end;
|
|
|
|
procedure TDBNetGradient.SetDataField (const Value: string);
|
|
begin
|
|
FDataLink.FieldName := Value;
|
|
end;
|
|
|
|
function TDBNetGradient.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
procedure TDBNetGradient.SetDataSource (Value: TDataSource);
|
|
|
|
procedure ChangeDataSource(AControl: TControl; Link: TDataLink;
|
|
NewDataSource: TDataSource);
|
|
begin
|
|
if Link.DataSource=NewDataSource then exit;
|
|
if Link.DataSource<>nil then
|
|
Link.DataSource.RemoveFreeNotification(AControl);
|
|
Link.DataSource:=NewDataSource;
|
|
if Link.DataSource<>nil then
|
|
Link.DataSource.FreeNotification(AControl);
|
|
end;
|
|
|
|
begin
|
|
//* enzo
|
|
//FDataLink.DataSource := Value;
|
|
ChangeDataSource(Self, FDataLink, Value);
|
|
// useless e
|
|
{if Value <> nil then
|
|
Value.FreeNotification (Value);}
|
|
end;
|
|
|
|
constructor TDBNetGradient.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
//*** Enzo ***
|
|
FDataLink := TFieldDataLink.Create;
|
|
FDataLink.Control := Self;
|
|
FDataLink.OnDataChange := DataChange;
|
|
(*
|
|
FDataLink.OnUpdateData := @UpdateData;
|
|
FDataLink.OnActiveChange := @ActiveChange;
|
|
FDataLink.OnLayoutChange := @LayoutChange;
|
|
*)
|
|
end;
|
|
|
|
destructor TDBNetGradient.Destroy;
|
|
begin
|
|
FDataLink.Destroy;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
end.
|