slabel.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sLabel;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, sConst, sMessages
  {$IFDEF TNTUNICODE}, TntControls, TntStdCtrls, TntGraphics, TntWindows{$ENDIF};

type
  TsShadowMode = (smNone, smCustom, smSkin1);
  TsKindType = (ktStandard, ktCustom, ktSkin);

  TsShadow = class(TPersistent)
{$IFNDEF NOTFORHELP}
  private
    FBuffered: Boolean;
    FBlurCount: Integer;
    FDistance: Integer;
    FColor: TColor;
    ParentControl : TControl;
    FMode: TsShadowMode;
    procedure SetBlurCount(const Value: Integer);
    procedure SetDistance(const Value: Integer);
    procedure SetColor(const Value: TColor);
    procedure SetMode(const Value: TsShadowMode);
  public
    sr, sg, sb : Integer;
    constructor Create(AOwner: TComponent; Control : TControl);
    destructor Destroy; override;
    property ShadowBuffered : Boolean read FBuffered write FBuffered default False;
  published
{$ENDIF} // NOTFORHELP
    property Mode : TsShadowMode read FMode write SetMode default smSkin1;
    property Color : TColor read FColor write SetColor default clBlack;
    property BlurCount : Integer read FBlurCount write SetBlurCount default 4;
    property Distance : Integer read FDistance write SetDistance default 1;
  end;

{$IFNDEF NOTFORHELP}
  TsCustomLabel = class(TCustomLabel)
  private
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    FSkinSection: string;
{$IFDEF TNTUNICODE}
    function GetCaption: TWideCaption;
    function IsCaptionStored: Boolean;
    procedure SetCaption(const Value: TWideCaption);
    function GetHint: WideString;
    function IsHintStored: Boolean;
    procedure SetHint(const Value: WideString);
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    function GetLabelText: WideString; reintroduce; virtual;
{$ENDIF}
    procedure SetSkinSection(const Value: string);
  protected
    function GetCurrentFont : TFont; virtual;
    procedure WndProc (var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
    property Font;
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property SkinSection : string read FSkinSection write SetSkinSection;
{$IFDEF TNTUNICODE}
    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
{$ELSE}
    property Caption;
{$ENDIF}
{$IFDEF D2005}
    property EllipsisPosition;
{$ENDIF}
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FocusControl;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Transparent default True;
    property Layout;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

  TsClassSkinData = record
    CustomColor : boolean;
    CustomFont : boolean;
  end;
{$ENDIF} // NOTFORHELP

  TsLabel = class(TsCustomLabel)
{$IFNDEF NOTFORHELP}
  private
    FUseSkinColor: boolean;
  protected
    function GetCurrentFont : TFont; override;
    procedure WndProc (var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Font;
    property UseSkinColor : boolean read FUseSkinColor write FUseSkinColor default True;
{$ENDIF} // NOTFORHELP
  end;

{$IFNDEF NOTFORHELP}
  TsEditLabel = class(TsLabel)
  public
    BoundLabel : TObject;
    constructor InternalCreate(AOwner: TComponent; BoundStruct : TObject);
    destructor Destroy; override;
  end;
{$ENDIF} // NOTFORHELP

  TsWebLabel = class(TsCustomLabel)
{$IFNDEF NOTFORHELP}
  private
    FNormalFont: TFont;
    procedure SetHoverFont(const Value: TFont);
    procedure SetNormalFont(const Value: TFont);
  protected
    FHoverFont : TFont;
    FURL : string;
    FShowMode: TsWindowShowMode;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMEraseBkGnd(var Message: TWMLButtonDown); message WM_ERASEBKGND; //v4.11
    function GetCurrentFont: TFont; override;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  public
    MouseAbove: boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property Font: TFont read FNormalFont write SetNormalFont; // v4.11
    property Cursor default crHandPoint;
{$ENDIF} // NOTFORHELP
    property HoverFont: TFont read FHoverFont write SetHoverFont;
    property ShowMode : TsWindowShowMode read FShowMode write FShowMode default soDefault;
    property URL : string read FURL write FURL;
  end;

  TsKind = class(TPersistent)
{$IFNDEF NOTFORHELP}
  private
    FOwner : TControl;
    FKindType: TsKindType;
    FColor: TColor;
    constructor Create(AOwner: TControl);
    procedure SetKindType(const Value: TsKindType);
    procedure SetColor(const Value: TColor);
  public
    destructor Destroy; override;
  published
{$ENDIF} // NOTFORHELP
    property KindType : TsKindType read FKindType write SetKindType default ktSkin;
    property Color : TColor read FColor write SetColor default clWhite;
  end;

//  Used shading algorithm by Gennady Ermakovets ([e-mail])
  TsLabelFX = class(TsCustomLabel)
{$IFNDEF NOTFORHELP}
  private
    FMask : TBitmap;
    FMaskBits : Pointer;
    FMaskBitsSize : Integer;
    FShadow : TsShadow;
    FNeedInvalidate : Boolean;
    OffsTopLeft, OffsRightBottom : Integer;
    FKind: TsKind;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
  published
    property Font;
{$ENDIF} // NOTFORHELP
    property Kind : TsKind read FKind write FKind;
    property Shadow : TsShadow read FShadow write FShadow;
  end;

(* ///////////////////////////////////////////////////////////////////////
TsStickyLabel component was based on the TGMSStickyLabel control code

GMSStickyLabel v1.1 July/5/97        by Glenn Shukster & Jacques Scoatarin

  GMS COMPUTING INC.                 Phone         [phone]
  53 COLVIN CRES.                    Fax                   -6819
  THORNHILL, ONT.                    Compuserve:       72734,123
  CANADA  L4J 2N7                    InternetId:[e-mail]
                                     http://members.tor.shaw.wave.ca/~gms/

  Jacques Scoatarin                  Phone [phone]
  52 Athalassis Ave, (flat 202)      InternetId:[e-mail]
  Nicosia, Cyprus
/////////////////////////////////////////////////////////////////////// *)
  TAlignTo = (altLeft, altTop, altBottom,  altRight);
  TsStickyLabel = class(TsLabel)//CustomLabel) v4.54
{$IFNDEF NOTFORHELP}
  private
    FAttachTo: TWinControl;
    FAlignTo: TAlignTo;
    FGap : Integer;
    FOldWinProc: TWndMethod;
    FRealigning: Boolean;
    Procedure SetGap(Value: Integer);
    procedure SetAttachTo(Value: TWinControl);
    Procedure SetAlignTo(Value: TAlignTo);
    procedure NewWinProc(var Message: TMessage);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Adjust(MoveLabel: boolean);
  published
    property Font;
{$ENDIF} // NOTFORHELP
    property AlignTo: TAlignTo read FAlignTo write SetAlignTo default altLeft;
    property AttachTo: TWinControl read FAttachTo write SetAttachTo;
    Property Gap : Integer Read FGap write SetGap Default 2;
  end;

{$IFNDEF NOTFORHELP}
function GetParentCache(Control : TControl) : TCacheInfo;
{$ENDIF} // NOTFORHELP

implementation

uses ShellAPI, {$IFNDEF ALITE}sPageControl, {$ENDIF}sStyleSimply, //sMessages,
  sVCLUtils, sGraphUtils, acntUtils, sCommonData, math, sMaskData, sDefaults,
  sSkinManager;

var
  FontChanging : boolean;

function GetParentCache(Control : TControl) : TCacheInfo;
begin
  Result.Ready := False;
  Result.Bmp := nil;
  Result.X := 0;
  Result.Y := 0;
  with Control do begin
    GlobalCacheInfo.Ready := False;
    SendAMessage(Parent, AC_GETCACHE);
    Result := GlobalCacheInfo;
  end;
end;

{ TsCustomLabel }

constructor TsCustomLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Transparent := True;
//  ControlStyle := ControlStyle + [csOpaque];
end;

{procedure TsCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
var
  Text: string;
begin
  if TempBmp <> nil then begin
    Text := GetLabelText;
    if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
      (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
    if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
    Flags := DrawTextBiDiModeFlags(Flags);
    TempBmp.Canvas.Font.Assign(Font);
    if not Enabled then begin
      OffsetRect(Rect, 1, 1);
      TempBmp.Canvas.Font.Color := clBtnHighlight;
      DrawText(TempBmp.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
      OffsetRect(Rect, -1, -1);
      TempBmp.Canvas.Font.Color := clBtnShadow;
      DrawText(TempBmp.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
    end
    else DrawText(TempBmp.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  end
  else
  inherited;
end;  }

{$IFDEF TNTUNICODE}
procedure TsCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
  if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then inherited;
end;
{$ELSE}
procedure TsCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
var
  Text: string;
begin
  if Enabled or not Assigned(DefaultManager) or not DefaultManager.SkinData.Active then inherited else begin
    Text := GetLabelText;
    if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
      (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
    if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
    Flags := DrawTextBiDiModeFlags(Flags);
    Canvas.Font := Font;
    InitParentColor(Parent);
    Canvas.Font.Color := MixColors(ColorToRGB(Font.Color), ParentCenterColor, DefDisabledBlend);
    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  end;
end;
{$ENDIF}

function TsCustomLabel.GetCurrentFont: TFont;
var
  c : TColor;
begin
  Result := inherited Font;
  if Assigned(DefaultManager) and DefaultManager.SkinData.Active then begin
    c := DefaultManager.GetGlobalFontColor;
    if (c <> clFuchsia) and (Result.Color <> c) then Result.Color := c;
  end;
end;

{$IFDEF TNTUNICODE}
function TsCustomLabel.GetCaption: TWideCaption;
begin
  Result := TntControl_GetText(Self);
end;

function TsCustomLabel.IsCaptionStored: Boolean;