home *** CD-ROM | disk | FTP | other *** search
- {*******************************************************}
- { }
- { TDSoft Visual Component Library }
- { }
- { Copyright (c) 2001 Daniele Teti }
- { }
- {-------------------------------------------------------}
- { For suggest, request, bug or only for sport: }
- { Daniele_Teti@hotmail.com }
- {-------------------------------------------------------}
- { }
- { }
- {*******************************************************}
-
- unit TDSuperLabel;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, DsgnIntf;
-
- {$R *.dcr}
-
- type
- TTDSuperLabel = class(TCustomLabel)
- private
- FOnClickExecute: string;
- FParameters: string;
- FHoverFontStyle: TFontStyles;
- FHoverColor: TColor;
- procedure SetStyle(const Value: TFontStyles);
- procedure SetHoverColor(const Value: TColor);
- { Private declarations }
- protected
- { Protected declarations }
- OldFontStyle: TFontStyles;
- OldFontColor: TColor;
- IsMouseOver: Boolean;
- procedure WMLBUTTONUP(var Mes: TMessage); message WM_LBUTTONUP;
- procedure CMMOUSEENTER(var Mes: TMessage); message CM_MOUSEENTER;
- procedure CMMOUSELEAVE(var Mes: TMessage); message CM_MOUSELEAVE;
- procedure ReDraw;
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- published
- property Align;
- property Alignment;
- property Anchors;
- property AutoSize;
- property BiDiMode;
- property Caption;
- property Color;
- property Constraints;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property FocusControl;
- //property Font;
- property ParentBiDiMode;
- property ParentColor;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowAccelChar;
- property ShowHint;
- property Transparent;
- 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 OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
-
- { Published declarations }
- property OnClickExecute: string read FOnClickExecute write FOnClickExecute;
- property Parameters: string read FParameters write FParameters;
- property HoverFontStyle: TFontStyles read FHoverFontStyle write SetStyle;
- property HoverColor: TColor read FHoverColor write SetHoverColor;
- end;
-
-
- TAboutProperty = class(TStringProperty)
- public
- function GetAttributes: TPropertyAttributes; override;
- procedure Edit; override;
- end;
-
-
- procedure Register;
-
- implementation
-
- uses ShellApi;
-
- procedure Register;
- begin
- RegisterComponents('TDSoft', [TTDSuperLabel]);
- RegisterPropertyEditor(TypeInfo(string), TTDSuperLabel, 'About', TAboutProperty);
- end;
-
- { TTDSuperLabel }
-
- procedure TTDSuperLabel.CMMOUSEENTER(var Mes: TMessage);
- begin
- IsMouseOver := True;
- ReDraw;
- end;
-
- procedure TTDSuperLabel.CMMOUSELEAVE(var Mes: TMessage);
- begin
- IsMouseOver := False;
- ReDraw;
- end;
-
- constructor TTDSuperLabel.Create(AOwner: TComponent);
- begin
- inherited;
- FHoverFontStyle := Font.Style + [fsUnderLine];
- FHoverColor := clBlue;
- IsMouseOver := False;
- Redraw;
- end;
-
- procedure TTDSuperLabel.ReDraw;
- begin
- if IsMouseOver then
- begin
- OldFontStyle := Font.Style;
- OldFontColor := Font.Color;
- Font.Style := FHoverFontStyle;
- Font.Color := FHoverColor;
- end
- else
- begin
- Font.Style := OldFontStyle;
- Font.Color := OldFontColor;
- end;
- end;
-
-
- procedure TTDSuperLabel.SetHoverColor(const Value: TColor);
- begin
- FHoverColor := Value;
- ReDraw;
- end;
-
- procedure TTDSuperLabel.SetStyle(const Value: TFontStyles);
- begin
- FHoverFontStyle := Value;
- ReDraw;
- end;
-
- procedure TTDSuperLabel.WMLBUTTONUP(var Mes: TMessage);
- begin
- inherited;
- if trim(FOnClickExecute) <> '' then
- ShellExecute(0, 'open', PChar(FOnClickExecute), PChar(' ' + FParameters), nil, SW_SHOW);
- end;
-
- { TAboutProperty }
-
- procedure TAboutProperty.Edit;
- begin
- MessageDlg('TTDSuperLabel 0.9' + #13 + '(06/Apr/2001)' + #13 + #13 +
- 'written by Teti Daniele (Daniele_Teti@Hotmail.com)', mtInformation, [mbOk], 0);
- end;
-
- function TAboutProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paDialog];
- end;
-
- end.
-
-