平滑SpeedButton
unit TFlatSpeedButtonUnit;
inte易做图ce
{$I Version.inc}
uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, ExtCtrls,
CommCtrl, Buttons, FlatUtilitys;type
TFlatSpeedButton = class(TGraphicControl)
private
FUseAdvColors: Boolean;
FAdvColorFocused: TAdvColors;
FAdvColorDown: TAdvColors;
FAdvColorBorder: TAdvColors;
TextBounds: TRect;
GlyphPos: TPoint;
FNumGlyphs: TNumGlyphs;
FDownColor: TColor;
FBorderColor: TColor;
FColorHighlight: TColor;
FColorShadow: TColor;
FFocusedColor: TColor;
FGroupIndex: Integer;
FGlyph: TBitmap;
FDown: Boolean;
FDragging: Boolean;
FAllowAllUp: Boolean;
FLayout: TButtonLayout;
FSpacing: Integer;
FMargin: Integer;
FMouseInControl: Boolean;
FModalResult: TModalResult;
procedure SetColors (Index: Integer; Value: TColor);
procedure SetAdvColors (Index: Integer; Value: TAdvColors);
procedure SetUseAdvColors (Value: Boolean);
procedure UpdateExclusive;
procedure SetGlyph (Value: TBitmap);
procedure SetNumGlyphs (Value: TNumGlyphs);
procedure SetDown (Value: Boolean);
procedure SetAllowAllUp (Value: Boolean);
procedure SetGroupIndex (Value: Integer);
procedure SetLayout (Value: TButtonLayout);
procedure SetSpacing (Value: Integer);
procedure SetMargin (Value: Integer);
procedure UpdateTracking;
procedure WMLButtonDblClk (var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMButtonPressed (var Message: TMessage); message CM_BUTTONPRESSED;
procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
procedure RemoveMouseTimer;
procedure MouseTimerHandler (Sender: TObject);
protected
FState: TButtonState;
function GetPalette: HPALETTE; override;
procedure CalcAdvColors;
procedure Loaded; override;
procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
procedure MouseEnter;
procedure MouseLeave;
published
property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
property Color default $00E1EAEB;
property ColorFocused: TColor index 0 read FFocusedColor write SetColors default $00E1EAEB;
property ColorDown: TColor index 1 read FDownColor write SetColors default $00C5D6D9;
property ColorBorder: TColor index 2 read FBorderColor write SetColors default $008396A0;
property ColorHighLight: TColor index 3 read FColorHighlight write SetColors default clWhite;
property ColorShadow: TColor index 4 read FColorShadow write SetColors default clBlack;
property AdvColorFocused: TAdvColors index 0 read FAdvColorFocused write SetAdvColors default 10;
property AdvColorDown: TAdvColors index 1 read FAdvColorDown write SetAdvColors default 10;
property AdvColorBorder: TAdvColors index 2 read FAdvColorBorder write SetAdvColors default 50;
property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default false;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
property Down: Boolean read FDown write SetDown default False;
property Caption;
property Enabled;
property Font;
property Glyph: TBitmap read FGlyph write SetGlyph;
property Layout: TButtonLayout read FLayout write SetLayout default blGlyphTop;
property Margin: Integer read FMargin write SetMargin default -1;
property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
property ParentFont;
property ParentColor;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{$IFDEF D4CB4}
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;var
MouseInControl: TFlatSpeedButton = nil;implementation
var
MouseTimer: TTimer = nil;
ControlCounter: Integer = 0;constructor TFlatSpeedButton.Create (AOwner: TComponent);
begin
inherited Create(AOwner);
if MouseTimer = nil then
begin
MouseTimer := TTimer.Create(nil);
MouseTimer.Enabled := False;
MouseTimer.Interval := 100; // 10 times a second
end;
SetBounds(0, 0, 25, 25);
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
FGlyph := TBitmap.Create;
FNumGlyphs := 1;
ParentFont := True;
ParentColor := True;
FFocusedColor := $00E1EAEB;
FDownColor := $00C5D6D9;
FBorderColor := $008396A0;
FColorHighlight := clWhite;
FColorShadow := clBlack;
FSpacing := 4;
FMargin := -1;
FLayout := blGlyphTop;
FUseAdvColors := false;
FAdvColorFocused := 10;
FAdvColorDown := 10;
FAdvColorBorder := 50;
FModalResult := mrNone;
Inc(ControlCounter);
end;
补充:软件开发 , Delphi ,