unit TFlatSpeedButtonUnit;
interface
{$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;
destructor TFlatSpeedButton.Destroy; begin RemoveMouseTimer; FGlyph.Free; Dec(ControlCounter); if ControlCounter = 0 then begin MouseTimer.Free; MouseTimer := nil; end; inherited Destroy; end;
procedure TFlatSpeedButton.Paint; var FTransColor: TColor; FImageList: TImageList; sourceRect, destRect: TRect; tempGlyph, memoryBitmap: TBitmap; buttonRect: TRect; Offset: TPoint; begin // get the transparent color FTransColor := FGlyph.Canvas.Pixels[0, FGlyph.Height - 1]; buttonRect := ClientRect;
memoryBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free try memoryBitmap.Height := ClientRect.Bottom; memoryBitmap.Width := ClientRect.Right; memoryBitmap.Canvas.Font := Self.Font;
if FState in [bsDown, bsExclusive] then Offset := Point(1, 1) else Offset := Point(0, 0);
CalcButtonLayout(memoryBitmap.Canvas, ClientRect, Offset, FLayout, FSpacing, FMargin, FGlyph, FNumGlyphs, Caption, TextBounds, GlyphPos);
if not Enabled then begin FState := bsDisabled; FDragging := False; end else if FState = bsDisabled then if FDown and (GroupIndex <> 0) then FState := bsExclusive else &nb [1] [2] [3] [4] 下一页 没有相关教程
|