lbleffct.pas

功能强大和形态多样的TLabel控件

unit LblEffct;

{
  This unit implements a label component with 3D effects.
  Written by Keith Wood - 27 May 1995.

  This version of the component (3.0) is shareware. Previous version were
  freeware. If you like the component and use it then please send USD$15
  to the address below. Any correspondence or improvements can be sent to :

     Keith Wood                                 [e-mail]
     4 Watterson Place
     Gilmore  A.C.T.  2905
     Australia

  The label has a highlight and a shadow.  The colours of these
  can be controlled through properties as can their distance
  from the label and their direction.  There are also preset
  combinations of direction/distance and colours.

  The label can be set to operate as a button, ie. initially
  raised it will depress when clicked.

  The label can be rotated to any angle.

  Version 2.0 - 1 Feb 1996
      Added extrusion, keep letters vertical, graduated face and version.
  Version 2.1 - 14 Jun 1996
      Update to work with Delphi 2.0, fix bug with Transparent property,
      fix bug with Alignment property, prepare label offscreen and then display.
  Version 3.0 - 3 Jan 1997
      Added separate graduation colours for highlight and shadow.
      Added extra face graduation options.
      Added resize of highlight/shadow.
      Added bitmap background for text.

  Thanks to Paradox Informant and their starter article on 3D labels.
  Thanks to Bill Murto and his RotateLabel.
  Thanks to Curtis Keisler and his TxtRotat example.
}

interface

uses
  SysUtils, WinTypes, WinProcs, Classes, Graphics, Controls, StdCtrls, Dialogs;

type
  { Range of offsets for the shadows }
  TEffectDepth = 0..10;

  { Directions in which the offsets can be positioned }
  TEffectDirection = (edNone, edUp, edUpRight, edRight, edDownRight, edDown,
      edDownLeft, edLeft, edUpLeft);

  { Constants for specifying direction component }
  TDirXY = (drX, drY);

  { The preset styles of label effects available }
  TEffectStyle = (esNone, esCustom, esRaised, esSunken, esShadow, esFlying);

  { The preset colour schemes available }
  TColourScheme = (csCustom, csText, csWindows, csEmbossed, csGold, csSteel);

  { Constants for specifying positions of colours }
  TColourPosition = (cpHighlight, cpShadow, cpFace);

  { Range for rotation }
  TAngleRange = 0..360;

  { Options for varying the shadow/highlight for the label }
  TEffectOption = (eoNormal, eoReal, eoExtrude, eoGraduated);

  { Options for varying the face of the label }
  TGraduateOption = (goNone, goVertical, goHorizontal, goFDiagonal,
    goBDiagonal, goBoxed, goRIndented, goLIndented);

  { Options for varying the text size of the label }
  TResizeOption = (rsNone, rsExpand, rsReduce);

  { The label itsef }
  TLabelEffect = class(TCustomLabel)
  private
    { Private declarations }
    FDepthHighlight,
    FDepthShadow: TEffectDepth;
    FDirectionHighlight,
    FDirectionShadow: TEffectDirection;
    FColourHighlight,
    FColourShadow,
    FGraduateHighlight,
    FGraduateShadow,
    FColourFace: TColor;
    FGraduateFace: TGraduateOption;
    FGraduateFrom: TColor;
    FStyleHighlight,
    FStyleShadow: TEffectOption;
    FResizeHighlight,
    FResizeShadow: TResizeOption;
    FEffectStyle: TEffectStyle;
    FColourScheme: TColourScheme;
    FBitmap: TBitmap;
    FAsButton: Boolean;
    FAngle: TAngleRange;
    FKeepLettersVertical: Boolean;
    FVersion: String;
    bChangingStyle,                { Is preset style being invoked ? }
    bChangingScheme: Boolean;      { Is preset colour scheme being invoked ? }
    clrSchemes: array [TColourScheme,TColourPosition] of TColor;
    dDegToRad, dCosAngle, dSinAngle, dCosSquared, dSinSquared: Double;
    procedure SetDepthHighlight(iDepth: TEffectDepth);
    procedure SetDepthShadow(iDepth: TEffectDepth);
    procedure SetDirectionHighlight(edDirection: TEffectDirection);
    procedure SetDirectionShadow(edDirection: TEffectDirection);
    procedure SetColourHighlight(clrHighlight: TColor);
    procedure SetColourShadow(clrShadow: TColor);
    procedure SetGraduateHighlight(clrHighlight: TColor);
    procedure SetGraduateShadow(clrShadow: TColor);
    procedure SetColourFace(clrFace: TColor);
    procedure SetGraduateFace(goGrad: TGraduateOption);
    procedure SetGraduateFrom(clrGrad: TColor);
    procedure SetStyleHighlight(eoStyle: TEffectOption);
    procedure SetStyleShadow(eoStyle: TEffectOption);
    procedure SetResizeHighlight(rsSize: TResizeOption);
    procedure SetResizeShadow(rsSize: TResizeOption);
    procedure SetEffectStyle(esStyle: TEffectStyle);
    procedure SetColourScheme(csScheme: TColourScheme);
    procedure SetBitmap(bmp: TBitmap);
    procedure SetAsButton(bBtn: Boolean);
    procedure SetAngle(aAngle: TAngleRange);
    procedure SetTextAngle(cnv: TCanvas; aAngle: TAngleRange; iHeight: Integer);
    procedure SetKeepLettersVertical(bKeep: Boolean);
    function GetColourFace: TColor;
    procedure ChangeFont(Sender: TObject);
    procedure ChangeBitmap(Sender: TObject);
    function IsCustomEffect: Boolean;
    function IsCustomScheme: Boolean;

  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MouseDown(mbBtn: TMouseButton; ssShift: TShiftState;
        x, y: Integer); override;
    procedure MouseMove(ssShift: TShiftState; x, y: Integer); override;
    procedure MouseUp(mbBtn: TMouseButton; ssShift: TShiftState;
        x, y: Integer); override;

  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Version: String read FVersion;         { Read-only }

  published
    { Publish specialised properties }
    property DepthHighlight: TEffectDepth read FDepthHighlight
        write SetDepthHighlight stored IsCustomEffect default 1;
    property DepthShadow: TEffectDepth read FDepthShadow
        write SetDepthShadow stored IsCustomEffect default 1;
    property DirectionHighlight: TEffectDirection read FDirectionHighlight
        write SetDirectionHighlight stored IsCustomEffect default edUpLeft;
    property DirectionShadow: TEffectDirection read FDirectionShadow
        write SetDirectionShadow stored IsCustomEffect default edDownRight;
    property ColourHighlight: TColor read FColourHighlight
        write SetColourHighlight stored IsCustomScheme default clWhite;
    property ColourShadow: TColor read FColourShadow
        write SetColourShadow stored IsCustomScheme default clBlack;
    property GraduateHighlight: TColor read FGraduateHighlight
        write SetGraduateHighlight default clGray;
    property GraduateShadow: TColor read FGraduateShadow
        write SetGraduateShadow default clGray;
    property ColourFace: TColor read GetColourFace write SetColourFace;
    property GraduateFace: TGraduateOption read FGraduateFace
        write SetGraduateFace default goNone;
    property GraduateFrom: TColor read FGraduateFrom
        write SetGraduateFrom default clGray;
    property StyleHighlight: TEffectOption read FStyleHighlight
        write SetStyleHighlight default eoNormal;
    property StyleShadow: TEffectOption read FStyleShadow
        write SetStyleShadow default eoNormal;
    property ResizeHighlight: TResizeOption read FResizeHighlight
        write SetResizeHighlight default rsNone;
    property ResizeShadow: TResizeOption read FResizeShadow
        write SetResizeShadow default rsNone;
    property EffectStyle: TEffectStyle read FEffectStyle
        write SetEffectStyle default esRaised;
    property ColourScheme: TColourScheme read FColourScheme
        write SetColourScheme default csWindows;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property AsButton: Boolean read FAsButton write SetAsButton default False;
    property Angle: TAngleRange read FAngle write SetAngle default 0;
    property KeepLettersVertical: Boolean read FKeepLettersVertical
        write SetKeepLettersVertical default False;

    { Publish inherited properties }
    property Align;
    property Alignment;
    property Caption;
    property Color;
    property Cursor;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowAccelChar;
    property ShowHint;
    property Transparent default True;
    property Visible;
    property WordWrap;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

const
  sLabelEffectVersion = '3.0';

procedure Register;
begin
  RegisterComponents('MyControl', [TLabelEffect]);
end;

{ Initialisation }
constructor TLabelEffect.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  { Colour schemes cannot be constant since Custom version varies }
  clrSchemes[csText, cpHighlight] := clWhite;
  clrSchemes[csText, cpFace] := clBlack;
  clrSchemes[csText, cpShadow] := clGray;

  clrSchemes[csWindows, cpHighlight] := clWhite;
  clrSchemes[csWindows, cpFace] := clGray;
  clrSchemes[csWindows, cpShadow] := clBlack;

  clrSchemes[csEmbossed, cpHighlight] := clWhite;
  clrSchemes[csEmbossed, cpFace] := clSilver;
  clrSchemes[csEmbossed, cpShadow] := clBlack;

  clrSchemes[csGold, cpHighlight] := clYellow;
  clrSchemes[csGold, cpFace] := clOlive;
  clrSchemes[csGold, cpShadow] := clBlack;

  clrSchemes[csSteel, cpHighlight] := clAqua;
  clrSchemes[csSteel, cpFace] := clTeal;
  clrSchemes[csSteel, cpShadow] := clNavy;

  clrSchemes[csCustom, cpHighlight] := clrSchemes[csWindows, cpHighlight];
  clrSchemes[csCustom, cpFace] := clrSchemes[csWindows, cpFace];
  clrSchemes[csCustom, cpShadow] := clrSchemes[csWindows, cpShadow];

  { Initialise default values for internal fields }
  FDepthHighlight := 1;
  FDepthShadow := 1;
  FDirectionHighlight := edUpLeft;
  FDirectionShadow := edDownRight;
  FStyleHighlight := eoNormal;
  FStyleShadow := eoNormal;
  FResizeHighlight := rsNone;
  FResizeShadow := rsNone;
  FEffectStyle := esRaised;
  FColourScheme := csWindows;
  FColourHighlight := clrSchemes[FColourScheme, cpHighlight];
  FColourShadow := clrSchemes[FColourScheme, cpShadow];
  FGraduateFace := goNone;
  FGraduateFrom := clrSchemes[FColourScheme, cpFace];
  FGraduateHighlight := clrSchemes[FColourScheme, cpFace];
  FGraduateShadow := clrSchemes[FColourScheme, cpFace];
  FBitmap := TBitmap.Create;
  FBitmap.OnChange := ChangeBitmap;
  FAsButton := False;
  FAngle := 0;
  FKeepLettersVertical := False;
  FVersion := sLabelEffectVersion;

  bChangingStyle := False;
  bChangingScheme := False;
  dDegToRad := PI / 180;
  dCosAngle := 1;         { Cos(FAngle * dDegToRad) }
  dCosSquared := 1;
  dSinAngle := 0;         { Sin(FAngle * dDegToRad) }
  dSinSquared := 0;

  AutoSize := False;
  Height := 33;
  Width := 142;
  Transparent := True;
  Font.Color := clrSchemes[FColourScheme, cpFace];
  Font.Name := 'Times New Roman';
  Font.Size := 20;
  Font.OnChange := ChangeFont;
end;

{ Free resources }
destructor TLabelEffect.Destroy;
begin
  FBitmap.Free;

  inherited Destroy;
end;

{ Copy to a new label }
procedure TLabelEffect.Assign(Source: TPersistent);
begin
  if Source is TLabelEffect then  { Can copy }
    with TLabelEffect(Source) do
    begin
      Self.Alignment := Alignment;
      Self.DragCursor := DragCursor;
      Self.DragMode := DragMode;
      Self.Enabled := Enabled;
      Self.FocusControl := FocusControl;
      Self.ShowAccelChar := ShowAccelChar;
      Self.Hint := Hint;
      Self.ParentShowHint := ParentShowHint;
      Self.ShowHint := ShowHint;
      Self.Tag := Tag;
      Self.Transparent := Transparent;
      Self.Visible := Visible;
      Self.WordWrap := WordWrap;

      Self.Bitmap.Assign(Bitmap);
      Self.Caption := Caption;
      Self.ParentColor := ParentColor;
      Self.Color := Color;
      Self.ColourHighlight := ColourHighlight;
      Self.ColourShadow := ColourShadow;
      Self.ParentFont := ParentFont;
      Self.Font.Assign(Font);
      Self.ColourScheme := ColourScheme;
      Self.Cursor := Cursor;
      Self.DepthHighlight := DepthHighlight;
      Self.DepthShadow := DepthShadow;
      Self.DirectionHighlight := DirectionHighlight;
      Self.DirectionShadow := DirectionShadow;
      Self.EffectStyle := EffectStyle;
      Self.GraduateFace := GraduateFace;
      Self.GraduateFrom := GraduateFrom;
      Self.GraduateHighlight := GraduateHighlight;
      Self.GraduateShadow := GraduateShadow;
      Self.ResizeHighlight := ResizeHighlight;
      Self.ResizeShadow := ResizeShadow;
      Self.StyleHighlight := StyleHighlight;
      Self.StyleShadow := StyleShadow;
      Self.Angle := Angle;
      Self.KeepLettersVertical := KeepLettersVertical;
      Self.AsButton := AsButton;
    end
  else  { Try default assign }
    inherited Assign(Source);
end;

{ Only store these properties if a custom effect style }
function TLabelEffect.IsCustomEffect: Boolean;
begin
  Result := (EffectStyle = esCustom);
end;

{ Only store these properties if a custom colour scheme }
function TLabelEffect.IsCustomScheme: Boolean;
begin
  Result := (ColourScheme = csCustom);
end;

{ Change face colour too }
procedure TLabelEffect.ChangeFont(Sender: TObject);
begin
  SetColourFace(Font.Color);
  Invalidate;
end;

{ Set highlight depth and repaint }
procedure TLabelEffect.SetDepthHighlight(iDepth: TEffectDepth);
begin
  if FDepthHighlight <> iDepth then
  begin
    FDepthHighlight := iDepth;
    if not bChangingStyle then  { Default to custom style when changed }
      SetEffectStyle(esCustom);
    Invalidate;
  end;
end;

{ Set shadow depth and repaint }
procedure TLabelEffect.SetDepthShadow(iDepth: TEffectDepth);
begin
  if FDepthShadow <> iDepth then
  begin
    FDepthShadow := iDepth;
    if not bChangingStyle then  { Default to custom style when changed }
      SetEffectStyle(esCustom);
    Invalidate;
  end;
end;

{ Set highlight direction and repaint }
procedure TLabelEffect.SetDirectionHighlight(edDirection: TEffectDirection);
begin
  if FDirectionHighlight <> edDirection then
  begin
    FDirectionHighlight := edDirection;
    if not bChangingStyle then  { Default to custom style when changed }
      SetEffectStyle(esCustom);