From f89b15730e3678862367f96596352681cdd4e845 Mon Sep 17 00:00:00 2001 From: Uladzimir Karpenka Date: Sat, 2 May 2026 13:52:05 +0300 Subject: [PATCH] add FlatSlider --- FlatSlider.pas | 231 +++++++++++++++++++++++++++++++++++++++++++++++++ MainForm.pas | 28 +++--- ewsdr.lpi | 4 + 3 files changed, 249 insertions(+), 14 deletions(-) create mode 100644 FlatSlider.pas diff --git a/FlatSlider.pas b/FlatSlider.pas new file mode 100644 index 0000000..9df066b --- /dev/null +++ b/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. diff --git a/MainForm.pas b/MainForm.pas index 1d76489..391b0ab 100644 --- a/MainForm.pas +++ b/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 - TrkVolume: TTrackBar; + TrkAGC: TFlatSlider; + 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.Parent := PanelTX; TrkDrive.Left := 34; TrkDrive.Top := 14; - TrkDrive.Width := 150; TrkDrive.Height := 22; + TrkDrive := TFlatSlider.Create(Self); + TrkDrive.Parent := PanelTX; TrkDrive.Left := 34; TrkDrive.Top := 16; + 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; diff --git a/ewsdr.lpi b/ewsdr.lpi index 8984683..d30731c 100644 --- a/ewsdr.lpi +++ b/ewsdr.lpi @@ -115,6 +115,10 @@ + + + +