unit JDCtrls;
////////////////////////////////////////////////////////////////////////////////
// JDCtrls
// Components:
// TJDLabel - Custom 3D label
////////////////////////////////////////////////////////////////////////////////
interface
uses
Classes, Controls, SysUtils, Windows, StdCtrls, ExtCtrls, Graphics, StrUtils;
type
TJDLabel = class;
//Customized bevels for the 3D text, not for the control's border
TIOBevel = (ioRaised, ioLowered, ioNone);
TIOBevelStyle = (isUpper, isLower, isBoth);
TJDLabel = class(TCustomLabel)
private
fLst: TStringList;
fBmp: TBitmap;
fStrength: Integer;
fDistance: Integer;
fIndentLeft: Integer;
fIndentTop: Integer;
fBevel: TIOBevel;
fBevelStyle: TIOBevelStyle;
fCaption: String;
procedure SetStrength(Value: Integer);
procedure SetDistance(Value: Integer);
procedure SetIndentLeft(Value: Integer);
procedure SetIndentTop(Value: Integer);
procedure SetBevel(Value: TIOBevel);
procedure SetBevelStyle(Value: TIOBevelStyle);
procedure SetCaption(Value: String);
protected
property AutoSize;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure Refresh;
published
//Custom properties
property Distance: Integer read fDistance write SetDistance;
property Strength: Integer read fStrength write SetStrength;
property IndentLeft: Integer read fIndentLeft write SetIndentLeft;
property IndentTop: Integer read fIndentTop write SetIndentTop;
property Bevel: TIOBevel read fBevel write SetBevel; //Text, not border
property BevelStyle: TIOBevelStyle read fBevelStyle write SetBevelStyle;
property Caption: String read fCaption write SetCaption; //Override of original
//These properties need special attention to mimic their functionality
property Alignment;
property Font;
property Layout;
property ShowAccelChar;
property Transparent;
property WordWrap;
//Remaining inherited properties
property Align;
property Anchors;
property BiDiMode;
property Color nodefault;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;
function IntRange(const Value, Min, Max: Integer): Integer;
procedure Register;
////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////
procedure Register;
begin
RegisterComponents('JD Custom', [TJDLabel]);
end;
////////////////////////////////////////////////////////////////////////////////
// Misc. Methods
////////////////////////////////////////////////////////////////////////////////
//Keeps an integer within a given range of possible values
function IntRange(const Value, Min, Max: Integer): Integer;
begin
Result:= Value;
if Value < Min then Result:= Min;
if Value > Max then Result:= Max;
end;
////////////////////////////////////////////////////////////////////////////////
// TJDLabel
////////////////////////////////////////////////////////////////////////////////
constructor TJDLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fLst:= TStringList.Create;
fCaption:= inherited Caption;
inherited Caption:= '';
Self.Parent:= TWinControl(AOwner);
fBmp:= TBitmap.Create;
fBevel:= ioLowered;
fBevelStyle:= isBoth;
fIndentLeft:= 8;
fIndentTop:= 8;
Distance:= 3;
Strength:= 100;
Font.Style:= Font.Style + [fsBold];
Font.Size:= 20;
Font.Color:= clNavy;
Color:= $00A40000;
AutoSize:= False;
Height:= 49;
Width:= 209;
end;
destructor TJDLabel.Destroy;
begin
if assigned(fBmp) then fBmp.Free;
if assigned(fLst) then fLst.Free;
inherited Destroy;
end;
procedure TJDLabel.Paint;
begin
inherited Paint;
Self.Refresh;
end;
procedure TJDLabel.Refresh;
var
R,G,B : Integer;
TR, TG, TB: Integer;
X, Y, S, D: Integer;
TW, TH, TT: Integer;
Tmp, TS: String;
TTop, TLeft: Integer;
begin
if (assigned(fBmp)) and (assigned(fLst)) then begin
if inherited Caption <> '' then
inherited Caption:= '';
fBmp.Canvas.Font.Assign(Font);
if fBmp.Width <> Width then
fBmp.Width:= Width;
if fBmp.Height <> Height then
fBmp.Height:= Height;
fBmp.Transparent:= Transparent;
Self.Canvas.Brush.Color:= Color;
fBmp.Canvas.Brush.Color:= Color;
fBmp.Canvas.FillRect(Rect(0, 0, Width, Height));
if Transparent then begin
fBmp.TransparentMode:= tmFixed;
fBmp.TransparentColor:= Color;
end;
fBmp.Canvas.Brush.Style:= bsClear;
TW:= Canvas.TextWidth(Caption) + (fDistance div 2);
TH:= Canvas.TextHeight(Caption) + (fDistance div 2);
TT:= 0;
if Self.Layout = tlTop then begin
TT:= fIndentTop;
end else if Self.Layout = tlBottom then begin
TT:= Height - TH - fIndentTop;
end else begin
TT:= (Height div 2) - (TH div 2) + fIndentTop;
end;
R:= (Color and $ff);
G:= ((Color and $ff00) shr 8);
B:= ((Color and $ff0000) shr 16);
fLst.Clear;
Tmp:= Caption + ' ';
TS:= '';
TTop:= 0;
fLst.Delimiter:= Char(' ');
fLst.DelimitedText:= Tmp;
for Y:= 0 to fLst.Count-1 do begin
if Y = fLst.Count-1 then
TS:= TS + fLst[Y]+' ';
if (fBmp.Canvas.TextWidth(TS+fLst[Y]) >= fBmp.Width-(fIndentLeft*2))
or (Y = fLst.Count) then
begin
if Alignment = taLeftJustify then
TLeft:= fIndentLeft
else if Alignment = taRightJustify then
TLeft:= Width - fBmp.Canvas.TextWidth(TS) - fIndentLeft
else
TLeft:= (Width div 2) - (Canvas.TextWidth(TS) div 2);
if fBevel <> ioNone then begin
for X:= 1 to fDistance do begin
S:= Trunc((X / fDistance) * fStrength);
if (fBevel = ioRaised) then
S:= S * -1;
D:= fDistance - X;
if (fBevelStyle in [isLower, isBoth]) then begin
TR:= IntRange(R + S, 0, 255);
TG:= IntRange(G + S, 0, 255);
TB:= IntRange(B + S, 0, 255);
fBmp.Canvas.Font.Color:= RGB(TR, TG, TB);
fBmp.Canvas.TextOut(TLeft + D, (TTop) + D, TS);
end;
if (fBevelStyle in [isUpper, isBoth]) then begin
TR:= IntRange(R - S, 0, 255);
TG:= IntRange(G - S, 0, 255);
TB:= IntRange(B - S, 0, 255);
fBmp.Canvas.Font.Color:= RGB(TR, TG, TB);
fBmp.Canvas.TextOut(TLeft - D, (TTop) - D, TS);
end;
end;
end;
fBmp.Canvas.Font.Color:= Font.Color;
fBmp.Canvas.TextOut(TLeft, (TTop), TS);
TTop:= TTop + fBmp.Canvas.TextHeight(TS) + 5;
TS:= '';
end;
TS:= TS + fLst[Y] + ' ';
end;
Canvas.Draw(0, 0, fBmp);
end;
end;
procedure TJDLabel.SetStrength(Value: Integer);
begin
fStrength:= IntRange(Value, 0, 255);
Refresh;
end;
procedure TJDLabel.SetDistance(Value: Integer);
begin
fDistance:= IntRange(Value, 0, 255);
Refresh;
end;
procedure TJDLabel.SetIndentLeft(Value: Integer);
begin
fIndentLeft:= IntRange(Value, 0, 500);
Refresh;
end;
procedure TJDLabel.SetIndentTop(Value: Integer);
begin
fIndentTop:= IntRange(Value, 0, 500);
Refresh;
end;
procedure TJDLabel.SetBevel(Value: TIOBevel);
begin
fBevel:= Value;
Refresh;
end;
procedure TJDLabel.SetBevelStyle(Value: TIOBevelStyle);
begin
fBevelStyle:= Value;
Refresh;
end;
procedure TJDLabel.SetCaption(Value: String);
begin
fCaption:= Value;
Refresh;
end;
end.