add FlatSlider

FlatSlider.pas

@@ -0,0 +1,231 @@
+unit FlatSlider;
+
+{ Кастомный горизонтальный ползунок с тёмной темой — замена TTrackBar.
+  Полностью отрисован через Canvas, одинаково выглядит на Windows и Linux. }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Graphics, LCLType, Types, Math;
+
+type
+  TFlatSlider = class(TGraphicControl)
+  private
+    FMin:      Integer;
+    FMax:      Integer;
+    FPosition: Integer;
+    FReversed: Boolean;
+    FDragging: Boolean;
+    FHot:      Boolean;
+    FOnChange: TNotifyEvent;
+    procedure SetPosition(V: Integer);
+    procedure SetMin(V: Integer);
+    procedure SetMax(V: Integer);
+    function  PosToX(APos: Integer): Integer;
+    function  XToPos(AX: Integer): Integer;
+  protected
+    procedure Paint; override;
+    procedure MouseEnter; override;
+    procedure MouseLeave; 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;
+    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
+    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+
+    property Min:      Integer read FMin      write SetMin;
+    property Max:      Integer read FMax      write SetMax;
+    property Position: Integer read FPosition write SetPosition;
+    property Reversed: Boolean read FReversed write FReversed;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Enabled;
+    property Visible;
+  end;
+
+implementation
+
+const
+  THUMB_R = 6;             // радиус ручки (px)
+  TRACK_H = 4;             // высота рельса (px)
+  PAD     = THUMB_R + 2;  // боковой отступ чтобы ручка не вылезала
+
+  CLR_BG          = TColor($00181818);  // совпадает с CLR_PANEL
+  CLR_TRACK_EMPTY = TColor($00323232);
+  CLR_TRACK_FILL  = TColor($00205018);  // тёмно-зелёный, как тема
+  CLR_THUMB_NORM  = TColor($00407840);
+  CLR_THUMB_HOT   = TColor($0066BB66);
+  CLR_THUMB_DRAG  = TColor($0099EE99);
+  CLR_THUMB_BDR   = TColor($00122012);
+
+constructor TFlatSlider.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMin      := 0;
+  FMax      := 100;
+  FPosition := 0;
+  FReversed := False;
+  FDragging := False;
+  FHot      := False;
+  Cursor    := crHandPoint;
+end;
+
+procedure TFlatSlider.SetPosition(V: Integer);
+var
+  C: Integer;
+begin
+  C := EnsureRange(V, FMin, FMax);
+  if FPosition = C then Exit;
+  FPosition := C;
+  Invalidate;
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TFlatSlider.SetMin(V: Integer);
+begin
+  if FMin = V then Exit;
+  FMin := V;
+  if FPosition < FMin then FPosition := FMin;
+  Invalidate;
+end;
+
+procedure TFlatSlider.SetMax(V: Integer);
+begin
+  if FMax = V then Exit;
+  FMax := V;
+  if FPosition > FMax then FPosition := FMax;
+  Invalidate;
+end;
+
+// Позиция значения → пиксельная X-координата ручки
+function TFlatSlider.PosToX(APos: Integer): Integer;
+var
+  Range, TrackW: Integer;
+begin
+  Range  := FMax - FMin;
+  TrackW := Width - PAD * 2;
+  if (Range <= 0) or (TrackW <= 0) then begin Result := PAD; Exit; end;
+  if FReversed then
+    Result := PAD + Round((FMax - APos) / Range * TrackW)
+  else
+    Result := PAD + Round((APos - FMin) / Range * TrackW);
+end;
+
+// Пиксельная X-координата → значение позиции
+function TFlatSlider.XToPos(AX: Integer): Integer;
+var
+  Range, TrackW, RawX: Integer;
+begin
+  Range  := FMax - FMin;
+  TrackW := Width - PAD * 2;
+  RawX   := EnsureRange(AX - PAD, 0, TrackW);
+  if (TrackW <= 0) or (Range <= 0) then begin Result := FMin; Exit; end;
+  if FReversed then
+    Result := FMax - Round(RawX / TrackW * Range)
+  else
+    Result := FMin + Round(RawX / TrackW * Range);
+  Result := EnsureRange(Result, FMin, FMax);
+end;
+
+procedure TFlatSlider.Paint;
+var
+  CY, TX, FL, FR: Integer;
+  TR: TRect;
+  ThC: TColor;
+begin
+  CY := Height div 2;
+  TX := PosToX(FPosition);
+
+  Canvas.Brush.Color := CLR_BG;
+  Canvas.Brush.Style := bsSolid;
+  Canvas.Pen.Style   := psClear;
+  Canvas.FillRect(ClientRect);
+
+  // Рельс — весь
+  TR := Rect(PAD, CY - TRACK_H div 2,
+             Width - PAD, CY + (TRACK_H + 1) div 2);
+  Canvas.Brush.Color := CLR_TRACK_EMPTY;
+  Canvas.RoundRect(TR.Left, TR.Top, TR.Right, TR.Bottom, TRACK_H, TRACK_H);
+
+  // Рельс — заполненная часть
+  if not FReversed then begin FL := PAD; FR := TX; end
+  else                  begin FL := TX;  FR := Width - PAD; end;
+  if FR > FL then
+  begin
+    Canvas.Brush.Color := CLR_TRACK_FILL;
+    Canvas.RoundRect(FL, TR.Top, FR, TR.Bottom, TRACK_H, TRACK_H);
+  end;
+
+  // Ручка — круг
+  if      FDragging then ThC := CLR_THUMB_DRAG
+  else if FHot      then ThC := CLR_THUMB_HOT
+  else                   ThC := CLR_THUMB_NORM;
+  Canvas.Brush.Color := ThC;
+  Canvas.Pen.Color   := CLR_THUMB_BDR;
+  Canvas.Pen.Style   := psSolid;
+  Canvas.Pen.Width   := 1;
+  Canvas.Ellipse(TX - THUMB_R, CY - THUMB_R,
+                 TX + THUMB_R + 1, CY + THUMB_R + 1);
+end;
+
+procedure TFlatSlider.MouseEnter;
+begin
+  inherited;
+  FHot := True;
+  Invalidate;
+end;
+
+procedure TFlatSlider.MouseLeave;
+begin
+  inherited;
+  FHot := False;
+  Invalidate;
+end;
+
+procedure TFlatSlider.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  inherited;
+  if Button = mbLeft then
+  begin
+    FDragging := True;
+    SetPosition(XToPos(X));
+  end;
+end;
+
+procedure TFlatSlider.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+  inherited;
+  if FDragging then
+    SetPosition(XToPos(X));
+end;
+
+procedure TFlatSlider.MouseUp(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  inherited;
+  if Button = mbLeft then
+  begin
+    FDragging := False;
+    Invalidate;
+  end;
+end;
+
+function TFlatSlider.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
+begin
+  SetPosition(FPosition + 1);
+  Result := True;
+end;
+
+function TFlatSlider.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
+begin
+  SetPosition(FPosition - 1);
+  Result := True;
+end;
+
+end.

MainForm.pas

@@ -22,7 +22,7 @@ unit MainForm;
 interface
 
 uses
-  Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, FlatButton, Forms, Controls, Graphics, Dialogs,
+  Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, FlatButton, FlatSlider, Forms, Controls, Graphics, Dialogs,
   StdCtrls, ExtCtrls, ComCtrls, Buttons, Menus, Math, Types,
   LCLIntf, LCLType, GraphType,
   HPSDRProtocol, HPSDRNetwork,
@@ -301,8 +301,8 @@ type
     PanelRX:      TPanel;
       BtnAGCMode: array[0..4] of TFlatButton;  // FAST MED SLOW LONG OFF
       LblAGCTop:  TLabel;    // показывает значение уровня
-      TrkAGC:     TTrackBar; // ползунок уровня AGC
+      TrkAGC:     TFlatSlider;
-      TrkVolume:  TTrackBar;
+      TrkVolume:  TFlatSlider;
       BtnNR: TFlatButton;
       BtnNB: TFlatButton;
       BtnSNB: TFlatButton;
@@ -316,7 +316,7 @@ type
 
     PanelTX:      TPanel;
       LblDrv:     TLabel;
-      TrkDrive:   TTrackBar;
+      TrkDrive:   TFlatSlider;
       BtnMOX: TFlatButton;
       PbFwdPower: TPaintBox;
       PbSWR:      TPaintBox;
@@ -1529,12 +1529,12 @@ begin
 
   // AGC level slider
   MakeLbl(PanelRX, 'THRESH', 4, 50);
-  TrkAGC := TTrackBar.Create(Self);
+  TrkAGC := TFlatSlider.Create(Self);
   TrkAGC.Parent := PanelRX; TrkAGC.Left := 56; TrkAGC.Top := 46;
-  TrkAGC.Width := LEFT_W - 96; TrkAGC.Height := 20;
+  TrkAGC.Width := LEFT_W - 96; TrkAGC.Height := 16;
   TrkAGC.Min := 20; TrkAGC.Max := 120;   // 20..120 → −20..-120 dBm
   TrkAGC.Position := FAGCTop;
-  TrkAGC.TickStyle := tsNone; TrkAGC.Reversed := True;
+  TrkAGC.Reversed := True;
   TrkAGC.OnChange := TrkAGCChange;
 
   LblAGCTop := TLabel.Create(Self);
@@ -1546,11 +1546,11 @@ begin
 
   // VOL
   MakeLbl(PanelRX, 'VOL', 4, 74);
-  TrkVolume := TTrackBar.Create(Self);
+  TrkVolume := TFlatSlider.Create(Self);
   TrkVolume.Parent := PanelRX; TrkVolume.Left := 34; TrkVolume.Top := 70;
-  TrkVolume.Width := LEFT_W - 38; TrkVolume.Height := 20;
+  TrkVolume.Width := LEFT_W - 38; TrkVolume.Height := 16;
   TrkVolume.Min := 0; TrkVolume.Max := 100;
-  TrkVolume.Position := FVolume; TrkVolume.TickStyle := tsNone;
+  TrkVolume.Position := FVolume;
   TrkVolume.OnChange := TrkVolumeChange;
 
   // NR NB SNB ANF MUTE
@@ -1581,11 +1581,11 @@ begin
   LblDrv.Caption := 'DRV'; LblDrv.Font.Color := CLR_TEXTDIM;
   LblDrv.Font.Name := 'Courier New'; LblDrv.Font.Size := 7;
 
-  TrkDrive := TTrackBar.Create(Self);
+  TrkDrive := TFlatSlider.Create(Self);
-  TrkDrive.Parent := PanelTX; TrkDrive.Left := 34; TrkDrive.Top := 14;
+  TrkDrive.Parent := PanelTX; TrkDrive.Left := 34; TrkDrive.Top := 16;
-  TrkDrive.Width := 150; TrkDrive.Height := 22;
+  TrkDrive.Width := 150; TrkDrive.Height := 16;
   TrkDrive.Min := 0; TrkDrive.Max := 100; TrkDrive.Position := 50;
-  TrkDrive.TickStyle := tsNone; TrkDrive.OnChange := TrkDriveChange;
+  TrkDrive.OnChange := TrkDriveChange;
 
   BtnMOX := MakeBtn(PanelTX, 'MOX', 2, 38, 70, 32, BtnMOXClick);
   BtnMOX.Font.Size := 12; BtnMOX.Font.Bold := True;

ewsdr.lpi

@@ -115,6 +115,10 @@
         <Filename Value="FlatButton.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="FlatSlider.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
       <Unit>
         <Filename Value="FreqDisplay.pas"/>
         <IsPartOfProject Value="True"/>