Smoothingbutton

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 SE tGroupIndex (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_TextChange; 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 $ 00 E1Eaeb; Property Colorfocused: Tcolor Index 0 Read FfocusedColor Write Setco lors 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;

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] the 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 fstate: = BSUP

// DrawBorder case FState of bsUp: if FMouseInControl then Frame3D (memoryBitmap.canvas, buttonRect, FColorHighlight, FColorShadow, 1) else Frame3D (memoryBitmap.canvas, buttonRect, FBorderColor, FBorderColor, 1); bsDown, bsExclusive: Frame3D (memoryBitmap.canvas ButtonRect, Fcolorshadow, FcolorHighlight, 1); BSDISABED: Frame3D (Memorybitmap.canvas, ButtonRect, FborderColor, FborderColor, 1);

// DrawBackground case FState of bsUp: if FMouseInControl then memoryBitmap.Canvas.Brush.Color: = FFocusedColor else memoryBitmap.Canvas.Brush.Color: = Self.Color; bsDown: memoryBitmap.Canvas.Brush.Color: = FDownColor; bsExclusive: if FMouseInControl then memoryBitmap.Canvas.Brush.Color: = FFocusedColor else memoryBitmap.Canvas.Brush.Color: = FDownColor; bsDisabled: memoryBitmap.Canvas.Brush.Color: = Self.Color; end; memoryBitmap.Canvas.FillRect (buttonRect) ;

// DrawGlyph if not FGlyph.Empty then begin tempGlyph: = TBitmap.Create; case FNumGlyphs of 1: case FState of bsUp: sourceRect: = Rect (0, 0, FGlyph.Width, FGlyph.Height); bsDisabled: sourceRect: = RECT (0, 0, FGlyph.width, Fglyph.Height); BSDown: SourceRect: = Rect (0, 0, Fglyph.width, Fglyph.Height); bsexClusive: source: = Rect (0, 0, Fglyph.Width, FGlyph.Height); end; 2: case fState of bsUp: sourceRect: = Rect (0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height); bsDisabled: sourceRect: = Rect (FGlyph.Width div FNumGlyphs, 0, FGlyph .Width, FGlyph.Height); bsDown: sourceRect: = Rect (0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height); bsExclusive: sourceRect: = Rect (0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height ); End; 3: case fstate of bsup: SourceRect: = RECT (0, 0, FGlyph.width Div Fnumglyph s, FGlyph.Height); bsDisabled: SourceRect: = Rect (FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height); bsDown: SourceRect: = Rect ((FGlyph.Width div FNumGlyphs ) * 2, 0, fglyph.width, fglyph.height); bsexClusive: SourceRect: = Rect ((FGlyph.width Div Fnumglyph) * 2, 0, FGlyph.width, FGlyph.Height); end; 4: Case Fstate of bsUp: SourceRect: = Rect (0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height); bsDisabled: SourceRect: = Rect (FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height BSDown: SourceRect: =

Rect ((FGlyph.Width div FNumGlyphs) * 2, 0, (FGlyph.Width div FNumGlyphs) * 3, FGlyph.Height); bsExclusive: SourceRect: = Rect ((FGlyph.width div FNumGlyphs) * 3, 0, FGlyph. Width, FGlyph.Height); end; end; destRect: = Rect (0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height); tempGlyph.Width: = FGlyph.Width div FNumGlyphs; tempGlyph.Height: = FGlyph.Height Tempglyph.canvas.copyRect (DestRect, Fglyph.canvas, SourceRect);

if (FNumGlyphs = 1) and (FState = bsDisabled) then begin tempGlyph: = CreateDisabledBitmap (tempGlyph, clBlack, clBtnFace, clBtnHighlight, clBtnShadow, True); FTransColor: = tempGlyph.Canvas.Pixels [0, tempGlyph.Height - 1]; END;

FImageList: = TImageList.CreateSize (FGlyph.Width div FNumGlyphs, FGlyph.Height); try FImageList.AddMasked (tempGlyph, FTransColor); FImageList.Draw (memoryBitmap.canvas, glyphpos.x, glyphpos.y, 0); finally FImageList. ..........................

// DrawText memoryBitmap.Canvas.Brush.Style: = bsClear; if FState = bsDisabled then begin OffsetRect (TextBounds, 1, 1); memoryBitmap.Canvas.Font.Color: = clBtnHighlight; DrawText (memoryBitmap.Canvas.Handle, PChar ( Caption), Length (Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE); OffsetRect (TextBounds, -1, -1); memoryBitmap.Canvas.Font.Color: = clBtnShadow; DrawText (memoryBitmap.Canvas.Handle, PChar (Caption ), Length (Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE); end else DrawText (memoryBitmap.Canvas.Handle, PChar (Caption), Length (Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);

// Copy memoryBitmap to screen canvas.CopyRect (ClientRect, memoryBitmap.canvas, ClientRect); finally memoryBitmap.free; // delete the bitmap end; end; procedure TFlatSpeedButton.UpdateTracking; var P: TPoint; begin if Enabled then begin GetCursorPos ( P); FMouseInControl: = NOT (FinddragTarget (p, true) = self); if FmouseInControl dam, ELSE MOUSEENTER; END;

Procedure tflatspeedbutton.loaded; system;

procedure TFlatSpeedButton.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown (Button, Shift, X, Y); if (Button = mbLeft) and Enabled then begin if not FDown then begin FState: = BSDown; Invalidate; end; fdragging: = true; end;

Procedure TFLATSPEEDBUTTON.MOUSEMOVE (Shift: TshiftState; x, y: integer); var newstate: tbuttonstate; p: tpoint; begin inherited

// mouse is in control? p: = ClientToscreen (Point (x, y)); IF (MouseIntrol <> Self) and (FindragTarget (p, true) = self) THEN BEGINTROL) THEN MOUSEINTROL.MOUSELEAVE; ? // the application is active if (GetActiveWindow <> 0) then begin if MouseTimer.Enabled then MouseTimer.Enabled: = False; MouseInControl: = Self; MouseTimer.OnTimer: = MouseTimerHandler; MouseTimer.Enabled: = True; MouseEnter; end ;

IF fdragging the beginning: = bsup else newstate: = bSEXClusive; if (x> = 0) AND (Y> = 0) AND (Y <= clientHeight) Then IF fdown the newstate : = bsExclusive else NewState: = bsDown; if NewState <> fState then begin fState: = NewState; Invalidate; end; end; end; procedure TFlatSpeedButton.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Doculick: Boolean; Begin Inherited MouseUp (Button, Shift, X, Y); if fdragging the begin fdragging: = false; doclick: = (x> = 0) AND (x = 0) AND Y <= ClientHeight); if FGroupIndex = 0 then begin // Redraw face in-case mouse is captured fState: = bsUp; FMouseInControl: = False; if DoClick and not (fState in [bsExclusive, bsDown]) then Invalidate; end else IF Doclick Then Begin SetDown (Not FDown); if Fdown Ten Repaint; END EL SEGIN if fdown the fstate: = bsexclusive; repaint; end; if Doclicken click ElseLeave; UpdateTracking;

Procedure tflatspeedbutton.click; begin if parent <> nil dam (self) .ModalResult: = fmodalResult; inherited click;

Function TFLATSPEEDBUTTON.GETPALETTE: HPALETTE; Begin Result: = FGLYPH.PALETTE; END

procedure TFlatSpeedButton.SetColors (Index: Integer; Value: TColor); begin case Index of 0: FFocusedColor: = Value; 1: FDownColor: = Value; 2: FBorderColor: = Value; 3: FColorHighlight: = Value; 4: FColorShadow: = Value; end; Invalidate; end; procedure TFlatSpeedButton.CalcAdvColors; begin if FUseAdvColors then begin FFocusedColor: = CalcAdvancedColor (Color, FFocusedColor, FAdvColorFocused, lighten); FDownColor: = CalcAdvancedColor (Color, FDownColor, FAdvColorDown, darken); FBorderColor: = CalcadvancedColor (Color, Fbordercolor, FadvColorborder, Darken); end;

procedure TFlatSpeedButton.SetAdvColors (Index: Integer; Value: TAdvColors); begin case Index of 0: FAdvColorFocused: = Value; 1: FAdvColorDown: = Value; 2: FAdvColorBorder: = Value; end; CalcAdvColors; Invalidate; end;

Procedure tflatspeedbutton.SetuseAdvcolors (Value: Boolean); Begin IF Value <> FuseAdvcolors The Begin FuseAdvcolors: = Value; ParentColor: = value; Calcadvcolors;

procedure TFlatSpeedButton.SetGlyph (value: TBitmap); begin if value <> FGlyph then begin FGlyph.Assign (value); if not FGlyph.Empty then begin if FGlyph.Width mod FGlyph.Height = 0 then begin FNumGlyphs: = FGlyph.Width Div fglyph.height; if fnumglyphs> 4 the fnumglyphs: = 1; End; end;

Procedure tflatspeedbutton.setnumglyphs (value: tnumglyphs); Begin IF value <> fnumglyphs dam fnumglyphs: = value; invalidate; end;

procedure TFlatSpeedButton.UpdateExclusive; var Msg: TMessage; begin if (FGroupIndex <> 0) and (Parent <> nil) then begin Msg.Msg: = CM_BUTTONPRESSED; Msg.WParam: = FGroupIndex; Msg.LParam: = Longint (Self) ; = 0; parent.broadcast (msg); end; end; procedure tflatspeedButton.SetDown (value: boolean); begin if FgroupIndex = 0 Then value: = false; if value <> fdown kilince if fdown and (not FAllowAllUp) then Exit; FDown: = Value; if Value then begin if fState = bsUp then Invalidate; fState: = bsExclusive end else begin fState: = bsUp; Repaint; end; if Value then UpdateExclusive; end; end;

Procedure TflatspeedButton.SetGroupIndex (Value: Integer); Begin IF FGroupIndex <> value dam fgroupindex: = value; UpdateExClusive; end;

Procedure tflatspeedbutton.setLayout (Value: tbuttonlayout); Begin if Flayout <> value dam FLAYOUT: = value; invalidate; end;

Procedure tflatspeedbutton.setMargin (Value: integer); begin if (value <> fmargin) and (value> = -1) THEN BEGIN FMARGIN: = value;

Procedure tflatspeedbutton.setspacing (value: integer); begin if value <> fspacing the begin fspacing: = value; invalidate;

Procedure tflatspeedbutton.setallowallup (value: boolean); begin if Fallowallup <> value dam Fallowallup: = value; UpdateExClusive; end;

Procedure tflatspeedbutton.wmlbuttondblclk (var message: twmlbuttondown); begin inherited; if fdown then dblclick;

procedure TFlatSpeedButton.CMEnabledChanged (var Message: TMessage); begin inherited; if not Enabled then begin FMouseInControl: = False; FState: = bsDisabled; RemoveMouseTimer; end; UpdateTracking; Invalidate; end; procedure TFlatSpeedButton.CMButtonPressed (var Message: TMessage); var Sender: TFlatSpeedButton; begin if Message.WParam = FGroupIndex then begin Sender: = TFlatSpeedButton (Message.LParam); if Sender <> Self then begin if Sender.Down and FDown then begin FDown: = False; fState: = bsUp; Invalidate ; End; Fallowallup: = sender.Allowallup; end; end;

Procedure tflatspeedbutton.cmdialogchar (var message: tcmdialogchar); Begin with message DO if ISAccel (charcode, caption) and enabled dam clicks; result: = 1; end else inherited;

Procedure TFLATSPEEDBUTTON.CMFONTCHANGED (VAR MESSAGE: TMESSAGE); projectage;

Procedure TflatspeedButton.cmTextChanged (Var Message: tMessage); begin invalidate;

Procedure tFLATSPEEDBUTTON.CMSYSCOLORCHANGE (VAR message: tMESSAGE); Begin IF FuseAdvcolors The Begin ParentColor: = true; Calcadvcolors;

Procedure tflatspeedbutton.cmparentcolorchanged (var message: twmnoparams); begin inherited; if FuseAdvcolors the begin parentcolor: = true; Calcadvcolors; End; Invalidate

Procedure TFLATSPEEDBUTTON.MOUSEENTER; Begin IF Enabled and NOT FMOUSEINTROL: = true;

procedure TFlatSpeedButton.MouseLeave; begin if Enabled and FMouseInControl and not FDragging then begin FMouseInControl: = False; RemoveMouseTimer; Invalidate; end; end; procedure TFlatSpeedButton.MouseTimerHandler (Sender: TObject); var P: TPoint; begin GetCursorPos (P); if Findragtarget (p, true) <> self dam.

Procedure tflatspeedbutton.removemousetimer; begin if mouseincontrol = self dam mousetimer.enabled: = false; mouseincontrol: = nil; end;

End.