init

2026-08-25 17:27:32 +00:00 · 2026-03-05 16:19:26 +03:00
parent 02666e7d22
commit 7521a46bbc
24 changed files with 12693 additions and 33 deletions
@@ -0,0 +1,170 @@
+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.