flatbtns.pas

相信大家已经找很长时间了

begin
  inherited MouseUp (Button, Shift, X, Y);
  if FRepeatTimer <> nil then
    FRepeatTimer.Enabled  := False;
end;

procedure TTimerSpeedBtn.TimerExpired (Sender: TObject);
begin
  FRepeatTimer.Interval := RepeatPause;
  if (FState = bsDown) and MouseCapture then
  begin
    try
      Click;
    except
      FRepeatTimer.Enabled := False;
      raise;
    end;
  end;
end;

{ TFlatButton }

constructor TFlatButton.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 := $00FF80FF;
  FDownColor := $00C5D6D9;
  FBorderColor := $004080FF;
  FColorHighlight := clWhite;
  FColorShadow := clBlack;
  FSpacing := 4;
  FMargin := -1;
  FLayout := blGlyphTop;
  FUseAdvColors := false;
  FAdvColorFocused := 10;
  FAdvColorDown := 10;
  FAdvColorBorder := 50;
  FModalResult := mrNone;
  FTransparent := tmNone;
  Inc(ControlCounter);
  TabStop := true;
end;

destructor TFlatButton.Destroy;
begin
  RemoveMouseTimer;
  FGlyph.Free;
  Dec(ControlCounter);
  if ControlCounter = 0 then
  begin
    MouseTimer.Free;
    MouseTimer := nil;
  end;
  inherited Destroy;
end;

procedure TFlatButton.Paint;
var
  FTransColor: TColor;
  FImageList: TImageList;
  sourceRect, destRect, FocusRect: TRect;
  tempGlyph, memoryBitmap: TBitmap;
  Offset: TPoint;
begin
  // get the transparent color
  FTransColor  := FGlyph.Canvas.Pixels[0, FGlyph.Height - 1];

  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;

    // DrawBackground
    case FTransparent of
      tmAlways:
        DrawParentImage(Self, memoryBitmap.Canvas);
      tmNone:
        begin
          case FState of
            bsUp:
              if FMouseInButtonControl then
                 memoryBitmap.Canvas.Brush.Color := FFocusedColor
              else
                 memoryBitmap.Canvas.Brush.Color := Self.Color;
            bsDown:
                 memoryBitmap.Canvas.Brush.Color := FDownColor;
            bsExclusive:
              if FMouseInButtonControl then
                 memoryBitmap.Canvas.Brush.Color := FFocusedColor
              else
                 memoryBitmap.Canvas.Brush.Color := FDownColor;
            bsDisabled:
                 memoryBitmap.Canvas.Brush.Color := Self.Color;
          end;
          memoryBitmap.Canvas.FillRect(ClientRect);
        end;
      tmNotFocused:
        if FMouseInButtonControl then
        begin
          case FState of
            bsUp:
              if FMouseInButtonControl then
                memoryBitmap.Canvas.Brush.Color := FFocusedColor
              else
                memoryBitmap.Canvas.Brush.Color := Self.Color;
            bsDown:
              memoryBitmap.Canvas.Brush.Color := FDownColor;
            bsExclusive:
              if FMouseInButtonControl then
                memoryBitmap.Canvas.Brush.Color := FFocusedColor
              else
                memoryBitmap.Canvas.Brush.Color := FDownColor;
            bsDisabled:
              memoryBitmap.Canvas.Brush.Color := Self.Color;
          end;
          memoryBitmap.Canvas.FillRect(ClientRect);
        end
        else
          DrawParentImage(Self, memoryBitmap.Canvas);
    end;

    // DrawBorder
    case FState of
      bsUp:
        if FMouseInButtonControl then
          Frame3DBorder(memoryBitmap.canvas, ClientRect, FColorHighlight, FColorShadow, 1)
        else
          if FDefault then
            Frame3DBorder(memoryBitmap.canvas, ClientRect, FBorderColor, FBorderColor, 2)
          else
            Frame3DBorder(memoryBitmap.canvas, ClientRect, FBorderColor, FBorderColor, 1);
      bsDown, bsExclusive:
        Frame3DBorder(memoryBitmap.canvas, ClientRect, FColorShadow, FColorHighlight, 1);
      bsDisabled:
        Frame3DBorder(memoryBitmap.canvas, ClientRect, FBorderColor, FBorderColor, 1);
    end;
    FocusRect.Top    := ClientRect.Top + 3;
    FocusRect.Left   := ClientRect.Left + 3;
    FocusRect.Right  := ClientRect.Right - 3;
    FocusRect.Bottom := ClientRect.Bottom - 3;
    if FMouseInButtonControl then begin
       memoryBitmap.Canvas.DrawFocusRect(FocusRect);
    end;
    // 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 TFlatButton.UpdateTracking;
var
  P: TPoint;
begin
  if Enabled then
  begin
    GetCursorPos(P);
    FMouseInButtonControl := not (FindDragTarget(P, True) = Self);
    if FMouseInButtonControl then
      MouseLeave
    else
      MouseEnter;
  end;
end;

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

procedure TFlatButton.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;
    SetFocus;
  end;
end;

procedure TFlatButton.MouseMove (Shift: TShiftState; X, Y: Integer);
var
  NewState: TButtonState;
  P: TPoint;
begin
  inherited;

  // mouse is in control ?
  P := ClientToScreen(Point(X, Y));
  if (MouseInButtonControl <> Self) and (FindDragTarget(P, True) = Self) then
  begin
    if Assigned(MouseInButtonControl) then
      MouseInButtonControl.MouseLeave;
    // the application is active ?
    if (GetActiveWindow <> 0) then
    begin
      if MouseTimer.Enabled then
        MouseTimer.Enabled := False;
      MouseInButtonControl := 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 TFlatButton.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;
      FMouseInButtonControl := 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 TFlatButton.Click;
begin
  if Parent <> nil then begin
     GetParentForm(self).ModalResult := FModalResult;
     SetDown(False);
  end;
  if Assigned(PopupMenu) then
     PopupMenu.PopUp(ClientToScreen(Point(0, Height)).X,
                     ClientToScreen(Point(0, Height)).Y);
  inherited Click;
end;   

function TFlatButton.GetPalette: HPALETTE;
begin
  Result := FGlyph.Palette;
end;

procedure TFlatButton.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 TFlatButton.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 TFlatButton.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
  case Index of
    0: FAdvColorFocused := Value;
    1: FAdvColorDown := Value;
    2: FAdvColorBorder := Value;
  end;
  CalcAdvColors;
  Invalidate;
end;

procedure TFlatButton.SetUseAdvColors (Value: Boolean);
begin
  if Value <> FUseAdvColors then
  begin
    FUseAdvColors := Value;
    ParentColor := Value;
    CalcAdvColors;
    Invalidate;
  end;
end;

procedure TFlatButton.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;