平滑SpeedButton

核心提示：unit TFlatSpeedButtonUnit;interface{$I Version.inc}uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, ExtCtrls, CommCtrl, Buttons, FlatUtili

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
　　　　  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);
　　  bsDisabled:
　　　  Frame3D(memoryBitmap.canvas, buttonRect, FBorderColor, FBorderColor, 1);
　  end;

　  // 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: sourceRect := 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 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, FGlyph.Height);
　　　　　　 bsExclusive: SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 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.Free;
　　  end;
　　  tempGlyph.free;
　  end;

　  // 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 then
　　  MouseLeave
　  else
　　  MouseEnter;
  end;
end;

procedure TFlatSpeedButton.Loaded;
begin
  inherited Loaded;
  Invalidate;
end;

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;
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 (MouseInControl <> Self) and (FindDragTarget(P, True) = Self) then
  begin
　  if Assigned(MouseInControl) then
　　  MouseInControl.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;
  end;

  if FDragging then
  begin
　  if not FDown then
　　  NewState := bsUp
　  else
　　  NewState := bsExclusive;
　  if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
　　  if FDown then
　　　  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
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
　  FDragging := False;
　  DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 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 then Repaint;
　　  end
　　  else
　　  begin
　　　  if FDown then FState := bsExclusive;
　　　  Repaint;
　　  end;
　  if DoClick then Click else MouseLeave;
　  UpdateTracking;
  end;
end;

procedure TFlatSpeedButton.Click;
begin
  if Parent <> nil then
　  GetParentForm(self).ModalResult := FModalResult;
  inherited Click;
end;

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;
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 then
  begin
　  FUseAdvColors := Value;
　  ParentColor := Value;
　  CalcAdvColors;
　  Invalidate;
  end;
end;

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 then FNumGlyphs := 1;
　　  end;
　  end;
　  Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetNumGlyphs (value: TNumGlyphs);
begin
  if value <> FNumGlyphs then
  begin
　  FNumGlyphs := value;
　  Invalidate;
  end;
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);
　  Msg.Result := 0;
　  Parent.Broadcast(Msg);
  end;
end;

procedure TFlatSpeedButton.SetDown (Value: Boolean);
begin
  if FGroupIndex = 0 then Value := False;
  if Value <> FDown then
  begin
　  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 then
  begin
　  FGroupIndex := Value;
　  UpdateExclusive;
  end;
end;

procedure TFlatSpeedButton.SetLayout (Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
　  FLayout := Value;
　  Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetMargin (Value: Integer);
begin
  if (Value <> FMargin) and (Value >= -1) then
  begin
　  FMargin := Value;
　  Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetSpacing (Value: Integer);
begin
  if Value <> FSpacing then
  begin
　  FSpacing := Value;
　  Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetAllowAllUp (Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
　  FAllowAllUp := Value;
　  UpdateExclusive;
  end;
end;

procedure TFlatSpeedButton.WMLButtonDblClk (var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;

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;
end;

procedure TFlatSpeedButton.CMDialogChar (var Message: TCMDialogChar);
begin
  with Message do
　  if IsAccel(CharCode, Caption) and Enabled then
　  begin
　　  Click;
　　  Result := 1;
　  end else
　　  inherited;
end;

procedure TFlatSpeedButton.CMFontChanged (var Message: TMessage);
begin
  Invalidate;
end;

procedure TFlatSpeedButton.CMTextChanged (var Message: TMessage);
begin
  Invalidate;
end;

procedure TFlatSpeedButton.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
  begin
　  ParentColor := True;
　  CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatSpeedButton.CMParentColorChanged (var Message: TWMNoParams);
begin
  inherited;
  if FUseAdvColors then
  begin
　  ParentColor := True;
　  CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatSpeedButton.MouseEnter;
begin
  if Enabled and not FMouseInControl  then
  begin
　  FMouseInControl := True;
　  Repaint;
  end;
end;

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 FindDragTarget(P, True) <> Self then
　  MouseLeave;
end;

procedure TFlatSpeedButton.RemoveMouseTimer;
begin
  if MouseInControl = Self then
  begin
　  MouseTimer.Enabled := False;
　  MouseInControl := nil;
  end;
end;

end.