unit FlatButton; { Кнопка с полным контролем цвета на Windows и Linux. Используй вместо TButton везде где нужна тёмная тема. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, Controls, Graphics, LCLType, Types; type TFlatButton = class(TGraphicControl) private FActive: Boolean; FHot: Boolean; FClrNorm: TColor; FClrActive: TColor; FClrHot: TColor; FClrBorder: TColor; FClrText: TColor; FClrTextAct:TColor; FOnClick: TNotifyEvent; procedure SetActive(V: Boolean); protected procedure Paint; override; procedure MouseEnter; override; procedure MouseLeave; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public constructor Create(AOwner: TComponent); override; property Active: Boolean read FActive write SetActive; property ClrNorm: TColor read FClrNorm write FClrNorm; property ClrActive: TColor read FClrActive write FClrActive; property ClrHot: TColor read FClrHot write FClrHot; property ClrBorder: TColor read FClrBorder write FClrBorder; property ClrText: TColor read FClrText write FClrText; property ClrTextAct:TColor read FClrTextAct write FClrTextAct; property OnClick: TNotifyEvent read FOnClick write FOnClick; property Caption; property Font; property Enabled; property Visible; end; // Фабрика — аналог MakeBtn, возвращает TFlatButton function MakeFlatBtn(AParent: TWinControl; const ACap: string; ALeft, ATop, AW, AH: Integer; AHandler: TNotifyEvent; ClrNorm: TColor = TColor($00202020); ClrActive: TColor = TColor($00003300); ClrHot: TColor = TColor($00303030); ClrBorder: TColor = TColor($00404040); ClrText: TColor = TColor($00E0E0E0); ClrTextAct: TColor = TColor($0000FF88)): TFlatButton; implementation constructor TFlatButton.Create(AOwner: TComponent); begin inherited Create(AOwner); FActive := False; FHot := False; FClrNorm := TColor($00202020); FClrActive := TColor($00003300); FClrHot := TColor($00303030); FClrBorder := TColor($00404040); FClrText := TColor($00E0E0E0); FClrTextAct := TColor($0000FF88); Cursor := crHandPoint; end; procedure TFlatButton.SetActive(V: Boolean); begin if FActive = V then Exit; FActive := V; Invalidate; end; procedure TFlatButton.Paint; var R: TRect; TW, TH: Integer; BG: TColor; begin R := ClientRect; // Фон if FActive then BG := FClrActive else if FHot then BG := FClrHot else BG := FClrNorm; Canvas.Brush.Color := BG; Canvas.Brush.Style := bsSolid; Canvas.Pen.Style := psClear; Canvas.FillRect(R); // Рамка Canvas.Pen.Style := psSolid; Canvas.Pen.Color := FClrBorder; Canvas.Brush.Style := bsClear; Canvas.Rectangle(R); // Текст if FActive then Canvas.Font.Color := FClrTextAct else Canvas.Font.Color := FClrText; Canvas.Brush.Style := bsClear; TW := Canvas.TextWidth(Caption); TH := Canvas.TextHeight('A'); Canvas.TextOut((Width - TW) div 2, (Height - TH) div 2, Caption); end; procedure TFlatButton.MouseEnter; begin inherited; FHot := True; Invalidate; end; procedure TFlatButton.MouseLeave; begin inherited; FHot := False; Invalidate; end; procedure TFlatButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; end; procedure TFlatButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if (Button = mbLeft) and PtInRect(ClientRect, Point(X, Y)) then if Assigned(FOnClick) then FOnClick(Self); end; function MakeFlatBtn(AParent: TWinControl; const ACap: string; ALeft, ATop, AW, AH: Integer; AHandler: TNotifyEvent; ClrNorm, ClrActive, ClrHot, ClrBorder, ClrText, ClrTextAct: TColor): TFlatButton; begin Result := TFlatButton.Create(AParent); Result.Parent := AParent; Result.Caption := ACap; Result.Left := ALeft; Result.Top := ATop; Result.Width := AW; Result.Height := AH; Result.OnClick := AHandler; Result.ClrNorm := ClrNorm; Result.ClrActive := ClrActive; Result.ClrHot := ClrHot; Result.ClrBorder := ClrBorder; Result.ClrText := ClrText; Result.ClrTextAct := ClrTextAct; Result.Font.Name := 'Courier New'; Result.Font.Size := 8; Result.Font.Color := ClrText; end; end.