rxlabel.pas

实现多变标签的控制,用得很方便 ,我一直在用

{****************************
 *                          *
 * Autor: Adrian M. Hanslik *
 * Date 13. June 1999       *
 * Version: 1.0             *
 *                          *
 ****************************}

unit Rxlabel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TRxlabel = class(TLabel)
  private
    { Private-Deklarationen }
    fMouseDown: boolean;
    fMouseMove: boolean;
    fMouseDownFont: TFont;
    fMouseMoveFont: TFont;
    procedure SetMouseDown(Value: boolean);
    procedure SetMouseMove(Value: boolean);
    procedure SetMouseDownFont(Value: TFont);
    procedure SetMouseMoveFont(Value: TFont);
  protected
    { Protected-Deklarationen }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }
    property ActiveMouseDown: boolean read fMouseDown write SetMouseDown;
    property ActiveMouseMove: boolean read fMouseMove write SetMouseMove;
    property FontMouseDown: TFont read fMouseDownFont write SetMouseDownFont;
    property FontMouseMove: TFont read fMouseMoveFont write SetMouseMoveFont;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyVcl', [TRxLabel]);
end;

var
  OldColor: TColor;
  OldName: String;
  OldSize: integer;
  OldStyle: TFontStyles;

constructor TRxlabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fMouseDown := true;
  fMouseMove := false;
  fMouseDownFont := TFont.Create;
  fMouseMoveFont := TFont.Create;
  fMouseDownFont.Color := clRed;
  OldColor := Font.Color;
  OldName := Font.Name;
  OldSize := Font.Size;
  OldStyle := Font.Style;
end;

destructor TRxlabel.Destroy;
begin
  fMouseDownFont.Free;
  fMouseMoveFont.Free;
  inherited Destroy;
end;

procedure TRxlabel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if fMouseDown = true then
     if (Button = mbLeft) or (Button = mbRight) then begin
        Font.Color := fMouseDownFont.Color;
        Font.Name := fMouseDownFont.Name;
        Font.Size := fMouseDownFont.Size;
        Font.Style := fMouseDownFont.Style;
     end;
end;

procedure TRxlabel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  Font.Color := OldColor;
  Font.Name := OldName;
  Font.Size := OldSize;
  Font.Style := OldStyle;
end;

procedure TRxlabel.CMMouseEnter(var Message: TMessage);
begin
  Font.Color := fMouseMoveFont.Color;
  Font.Name := fMouseMoveFont.Name;
  Font.Size := fMouseMoveFont.Size;
  Font.Style := fMouseMoveFont.Style;
end;

procedure TRxlabel.CMMouseLeave(var Message: TMessage);
begin
  Font.Color := OldColor;
  Font.Name := OldName;
  Font.Size := OldSize;
  Font.Style := OldStyle;
end;

procedure TRxlabel.SetMouseDown(Value: boolean);
begin
  if Value <> fMouseDown then begin
     fMouseDown := Value;
     Invalidate;
  end;
end;

procedure TRxlabel.SetMouseMove(Value: boolean);
begin
  if Value <> fMouseMove then begin
     fMouseMove := Value;
     Invalidate;
  end;
end;

procedure TRxlabel.SetMouseDownFont(Value: TFont);
begin
  if Value <> fMouseDownFont then begin
     fMouseDownFont.Assign(Value);
     Invalidate;
  end;
end;

procedure TRxlabel.SetMouseMoveFont(Value: TFont);
begin
  if Value <> fMouseMoveFont then begin
     fMouseMoveFont.Assign(Value);
     Invalidate;
  end;
end;

end.