mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
init
This commit is contained in:
+394
@@ -0,0 +1,394 @@
|
||||
unit FreqDisplay;
|
||||
|
||||
{
|
||||
TFreqDisplay — цифровой дисплей частоты с управлением по разрядам
|
||||
===================================================================
|
||||
Отображает частоту в Гц вида 14.201.123
|
||||
Наводишь мышь на цифру → подсветка разряда.
|
||||
Колёсико мыши → меняет выделенный разряд (+/- 10^N).
|
||||
Стрелки Left/Right → переключают активный разряд.
|
||||
Стрелки Up/Down → меняют активный разряд.
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, Graphics, LCLType, Math;
|
||||
|
||||
type
|
||||
TFreqChangeEvent = procedure(Sender: TObject; NewFreq: Int64) of object;
|
||||
|
||||
TFreqDisplay = class(TCustomControl)
|
||||
private
|
||||
FFrequency: Int64;
|
||||
FMinFreq: Int64;
|
||||
FMaxFreq: Int64;
|
||||
FFontSize: Integer;
|
||||
FFontName: string;
|
||||
FColorNormal: TColor;
|
||||
FColorHover: TColor;
|
||||
FColorDim: TColor;
|
||||
FOnChange: TFreqChangeEvent;
|
||||
|
||||
FHoverDigit: Integer; // 0=единицы .. 8=100МГц, -1=нет
|
||||
FDigitX: array[0..8] of Integer; // X левого края каждой цифры
|
||||
FDigitW: Integer;
|
||||
FCharH: Integer;
|
||||
|
||||
procedure SetFrequency(V: Int64);
|
||||
procedure SetFontSize(V: Integer);
|
||||
function ClampFreq(V: Int64): Int64;
|
||||
function DigitAtX(X: Integer): Integer;
|
||||
function DigitStep(D: Integer): Int64;
|
||||
procedure ChangeByDigit(D, Delta: Integer);
|
||||
procedure BuildDigitMap(const S: string; StartX: Integer);
|
||||
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseLeave; override;
|
||||
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
||||
MousePos: TPoint): Boolean; override;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
procedure Click; override;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
property Frequency: Int64 read FFrequency write SetFrequency;
|
||||
property MinFreq: Int64 read FMinFreq write FMinFreq;
|
||||
property MaxFreq: Int64 read FMaxFreq write FMaxFreq;
|
||||
property FontSize: Integer read FFontSize write SetFontSize;
|
||||
property FontName: string read FFontName write FFontName;
|
||||
property ColorNormal: TColor read FColorNormal write FColorNormal;
|
||||
property ColorHover: TColor read FColorHover write FColorHover;
|
||||
property ColorDim: TColor read FColorDim write FColorDim;
|
||||
property OnChange: TFreqChangeEvent read FOnChange write FOnChange;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TFreqDisplay.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FFrequency := 14200000;
|
||||
FMinFreq := 0;
|
||||
FMaxFreq := 2000000000;
|
||||
FFontSize := 20;
|
||||
FFontName := 'Courier New';
|
||||
FColorNormal := TColor($00E8F0FF);
|
||||
FColorHover := TColor($0040DDFF);
|
||||
FColorDim := TColor($00607080);
|
||||
FHoverDigit := -1;
|
||||
FDigitW := 14;
|
||||
FCharH := 24;
|
||||
TabStop := True;
|
||||
Width := 220;
|
||||
Height := 40;
|
||||
end;
|
||||
|
||||
function TFreqDisplay.ClampFreq(V: Int64): Int64;
|
||||
begin
|
||||
if V < FMinFreq then Result := FMinFreq
|
||||
else if V > FMaxFreq then Result := FMaxFreq
|
||||
else Result := V;
|
||||
end;
|
||||
|
||||
function TFreqDisplay.DigitStep(D: Integer): Int64;
|
||||
var
|
||||
i: Integer;
|
||||
Result_: Int64;
|
||||
begin
|
||||
Result_ := 1;
|
||||
for i := 0 to D - 1 do
|
||||
Result_ := Result_ * 10;
|
||||
Result := Result_;
|
||||
end;
|
||||
|
||||
function TFreqDisplay.DigitAtX(X: Integer): Integer;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
if FDigitW = 0 then Exit;
|
||||
for i := 0 to 8 do
|
||||
if (X >= FDigitX[i]) and (X < FDigitX[i] + FDigitW) then
|
||||
begin
|
||||
Result := i;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Строим карту FDigitX из строки вида "14.201.123"
|
||||
// Цифры нумеруются справа налево: digit0=единицы, digit8=сотни млн
|
||||
procedure TFreqDisplay.BuildDigitMap(const S: string; StartX: Integer);
|
||||
var
|
||||
Xs: array[0..11] of Integer; // X каждого символа строки (макс 12 симв)
|
||||
ci: Integer;
|
||||
xi: Integer;
|
||||
dIdx: Integer;
|
||||
len: Integer;
|
||||
begin
|
||||
len := Length(S);
|
||||
if len > 12 then len := 12;
|
||||
|
||||
xi := StartX;
|
||||
for ci := 0 to len - 1 do
|
||||
begin
|
||||
Xs[ci] := xi;
|
||||
Inc(xi, Canvas.TextWidth(S[ci + 1]));
|
||||
end;
|
||||
|
||||
// Назначаем digit индексы справа налево, пропуская точки
|
||||
dIdx := 0;
|
||||
for ci := len - 1 downto 0 do
|
||||
begin
|
||||
if S[ci + 1] <> '.' then
|
||||
begin
|
||||
if dIdx <= 8 then
|
||||
FDigitX[dIdx] := Xs[ci];
|
||||
Inc(dIdx);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.Paint;
|
||||
var
|
||||
C: TCanvas;
|
||||
S: string;
|
||||
Hz: Int64;
|
||||
Mhz: Integer;
|
||||
KHz: Integer;
|
||||
Ones: Integer;
|
||||
TotalW: Integer;
|
||||
StartX: Integer;
|
||||
ChW, ChH: Integer;
|
||||
xi: Integer;
|
||||
ci: Integer;
|
||||
ch: Char;
|
||||
dIdx: Integer;
|
||||
col: TColor;
|
||||
DiChar: array[0..11] of Integer;
|
||||
tmpIdx: Integer;
|
||||
len: Integer;
|
||||
begin
|
||||
C := Canvas;
|
||||
|
||||
// Фон — прозрачный (наследует от Panel)
|
||||
C.Brush.Style := bsClear;
|
||||
C.FillRect(ClientRect);
|
||||
|
||||
C.Font.Name := FFontName;
|
||||
C.Font.Size := FFontSize;
|
||||
C.Font.Bold := True;
|
||||
C.Font.Style := [fsBold];
|
||||
|
||||
ChW := C.TextWidth('0');
|
||||
ChH := C.TextHeight('0');
|
||||
FDigitW := ChW;
|
||||
FCharH := ChH;
|
||||
|
||||
Hz := Abs(FFrequency);
|
||||
Mhz := Hz div 1000000;
|
||||
KHz := (Hz div 1000) mod 1000;
|
||||
Ones := Hz mod 1000;
|
||||
S := Format('%d.%3.3d.%3.3d', [Mhz, KHz, Ones]);
|
||||
|
||||
TotalW := C.TextWidth(S);
|
||||
StartX := (Width - TotalW) div 2;
|
||||
if StartX < 2 then StartX := 2;
|
||||
|
||||
// Строим карту digit → X
|
||||
BuildDigitMap(S, StartX);
|
||||
|
||||
// Строим обратную карту символ → digit index
|
||||
len := Length(S);
|
||||
if len > 12 then len := 12;
|
||||
tmpIdx := 0;
|
||||
for ci := len - 1 downto 0 do
|
||||
begin
|
||||
if S[ci + 1] <> '.' then
|
||||
begin
|
||||
DiChar[ci] := tmpIdx;
|
||||
Inc(tmpIdx);
|
||||
end
|
||||
else
|
||||
DiChar[ci] := -1;
|
||||
end;
|
||||
|
||||
// Рисуем
|
||||
xi := StartX;
|
||||
for ci := 0 to len - 1 do
|
||||
begin
|
||||
ch := S[ci + 1];
|
||||
dIdx := DiChar[ci];
|
||||
|
||||
if ch = '.' then
|
||||
col := FColorDim
|
||||
else if dIdx = FHoverDigit then
|
||||
col := FColorHover
|
||||
else
|
||||
col := FColorNormal;
|
||||
|
||||
// Фоновая подсветка активного разряда
|
||||
if (dIdx >= 0) and (dIdx = FHoverDigit) then
|
||||
begin
|
||||
C.Brush.Color := TColor($00182838);
|
||||
C.Brush.Style := bsSolid;
|
||||
C.FillRect(Rect(xi - 1, 2, xi + ChW + 1, Height - 2));
|
||||
C.Brush.Style := bsClear;
|
||||
end;
|
||||
|
||||
C.Font.Color := col;
|
||||
C.Brush.Style := bsClear;
|
||||
C.TextOut(xi, (Height - ChH) div 2, ch);
|
||||
Inc(xi, C.TextWidth(ch));
|
||||
end;
|
||||
|
||||
// Рамка фокуса
|
||||
if Focused then
|
||||
begin
|
||||
C.Pen.Color := TColor($00004060);
|
||||
C.Pen.Style := psDot;
|
||||
C.Pen.Width := 1;
|
||||
C.Brush.Style := bsClear;
|
||||
C.Rectangle(1, 1, Width - 2, Height - 2);
|
||||
C.Pen.Style := psSolid;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.ChangeByDigit(D, Delta: Integer);
|
||||
var
|
||||
Step: Int64;
|
||||
Base: Int64;
|
||||
NewFreq: Int64;
|
||||
begin
|
||||
if D < 0 then Exit;
|
||||
Step := DigitStep(D);
|
||||
// Нижняя граница текущего разряда (кратная Step)
|
||||
Base := (FFrequency div Step) * Step;
|
||||
if Delta > 0 then
|
||||
begin
|
||||
// Вверх: от нижней границы + шаг
|
||||
// 7.129.054 + 100 → base=7.129.000 → 7.129.000 + 100 = 7.129.100
|
||||
NewFreq := Base + Step * Delta;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Вниз:
|
||||
// Если уже кратна — просто шагаем: 7.129.100 - 100 = 7.129.000
|
||||
// Если не кратна — возвращаем нижнюю границу: 7.129.054 → 7.129.000
|
||||
if FFrequency = Base then
|
||||
NewFreq := Base + Step * Delta // кратна → шагаем
|
||||
else
|
||||
NewFreq := Base; // не кратна → снэп к нижней границе
|
||||
end;
|
||||
NewFreq := ClampFreq(NewFreq);
|
||||
if NewFreq <> FFrequency then
|
||||
begin
|
||||
FFrequency := NewFreq;
|
||||
Invalidate;
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self, FFrequency);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
d: Integer;
|
||||
begin
|
||||
inherited;
|
||||
d := DigitAtX(X);
|
||||
if d <> FHoverDigit then
|
||||
begin
|
||||
FHoverDigit := d;
|
||||
Invalidate;
|
||||
end;
|
||||
if d >= 0 then Cursor := crHandPoint
|
||||
else Cursor := crDefault;
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.MouseLeave;
|
||||
begin
|
||||
inherited;
|
||||
if FHoverDigit <> -1 then
|
||||
begin
|
||||
FHoverDigit := -1;
|
||||
Invalidate;
|
||||
end;
|
||||
Cursor := crDefault;
|
||||
end;
|
||||
|
||||
function TFreqDisplay.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
||||
MousePos: TPoint): Boolean;
|
||||
var
|
||||
d: Integer;
|
||||
Delta: Integer;
|
||||
Local: TPoint;
|
||||
begin
|
||||
Result := False;
|
||||
Local := ScreenToClient(MousePos);
|
||||
d := FHoverDigit;
|
||||
if d < 0 then
|
||||
d := DigitAtX(Local.X);
|
||||
if d >= 0 then
|
||||
begin
|
||||
if WheelDelta > 0 then Delta := 1 else Delta := -1;
|
||||
ChangeByDigit(d, Delta);
|
||||
Result := True; // обработали — не передаём дальше
|
||||
end;
|
||||
if not Result then
|
||||
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
d: Integer;
|
||||
begin
|
||||
d := FHoverDigit;
|
||||
if d < 0 then d := 3; // по умолчанию — кГц
|
||||
case Key of
|
||||
VK_UP: begin ChangeByDigit(d, +1); Key := 0; end;
|
||||
VK_DOWN: begin ChangeByDigit(d, -1); Key := 0; end;
|
||||
VK_LEFT: begin
|
||||
if FHoverDigit < 0 then FHoverDigit := 3;
|
||||
if FHoverDigit < 8 then Inc(FHoverDigit);
|
||||
Invalidate; Key := 0;
|
||||
end;
|
||||
VK_RIGHT: begin
|
||||
if FHoverDigit < 0 then FHoverDigit := 3;
|
||||
if FHoverDigit > 0 then Dec(FHoverDigit);
|
||||
Invalidate; Key := 0;
|
||||
end;
|
||||
end;
|
||||
inherited KeyDown(Key, Shift);
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.Click;
|
||||
begin
|
||||
inherited;
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.SetFrequency(V: Int64);
|
||||
begin
|
||||
V := ClampFreq(V);
|
||||
if V <> FFrequency then
|
||||
begin
|
||||
FFrequency := V;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFreqDisplay.SetFontSize(V: Integer);
|
||||
begin
|
||||
if V <> FFontSize then
|
||||
begin
|
||||
FFontSize := V;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user