mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
313 lines
8.7 KiB
ObjectPascal
313 lines
8.7 KiB
ObjectPascal
unit SampleRateOverlay;
|
|
|
|
{
|
|
Bitmap overlay для выбора sample rate (span) спектра.
|
|
Рисуется прямо в bitmap спектра, как AlertOverlay, поэтому фон под ним
|
|
смешивается вручную через alpha.
|
|
}
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE Delphi}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Controls, Graphics, Types, Math;
|
|
|
|
type
|
|
TSpanSelectEvent = procedure(SampleRate: Integer) of object;
|
|
THidePanelEvent = procedure of object;
|
|
|
|
TSampleRateOverlay = class(TComponent)
|
|
private
|
|
FCurrentRate: Integer;
|
|
FPanelHidden: Boolean;
|
|
FOnSpanSelect: TSpanSelectEvent;
|
|
FOnHidePanel: THidePanelEvent;
|
|
FOnInvalidate: TNotifyEvent;
|
|
FLeft: Integer;
|
|
FTop: Integer;
|
|
FWidth: Integer;
|
|
FHeight: Integer;
|
|
|
|
FHitRects: array[0..6] of TRect; // [0]=hide button, [1..6]=span buttons
|
|
FHitValues: array[0..6] of Integer; // 0=hide, else sample rate
|
|
FHitCount: Integer;
|
|
FHotIdx: Integer;
|
|
|
|
procedure DrawSelf(Target: TBitmap; C: TCanvas; OriginX, OriginY, W, H: Integer);
|
|
procedure RegisterHit(const HR: TRect; Value: Integer);
|
|
procedure RequestInvalidate;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
|
procedure DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer);
|
|
function HandleMouseMove(X, Y: Integer): Boolean;
|
|
function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
|
|
function HandleMouseLeave: Boolean;
|
|
procedure SetCurrentRate(Rate: Integer);
|
|
procedure SetPanelHidden(Hidden: Boolean);
|
|
property Left: Integer read FLeft;
|
|
property Top: Integer read FTop;
|
|
property Width: Integer read FWidth;
|
|
property Height: Integer read FHeight;
|
|
property HotIdx: Integer read FHotIdx;
|
|
property OnSpanSelect: TSpanSelectEvent read FOnSpanSelect write FOnSpanSelect;
|
|
property OnHidePanel: THidePanelEvent read FOnHidePanel write FOnHidePanel;
|
|
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
|
|
end;
|
|
|
|
implementation
|
|
|
|
const
|
|
SPAN_RATES: array[0..5] of Integer = (48000, 96000, 192000, 384000, 768000, 1536000);
|
|
SPAN_NAMES: array[0..5] of string = ('48k', '96k', '192k', '384k', '768k', '1536k');
|
|
|
|
HIDE_W = 22;
|
|
SPAN_H = 18;
|
|
PAD_X = 4;
|
|
PAD_Y = 4;
|
|
BTN_GAP = 3;
|
|
|
|
CLR_TEXT = TColor($00D8E6EE);
|
|
CLR_BTN_BDR = TColor($00685624);
|
|
|
|
procedure BlendRect(Target: TBitmap; const Rct: TRect; R, G, B, Alpha: Byte);
|
|
var
|
|
Y, X, InvA: Integer;
|
|
Row: PByte;
|
|
RR: TRect;
|
|
begin
|
|
if (Target = nil) or (Alpha = 0) then Exit;
|
|
RR := Rct;
|
|
if RR.Left < 0 then RR.Left := 0;
|
|
if RR.Top < 0 then RR.Top := 0;
|
|
if RR.Right > Target.Width then RR.Right := Target.Width;
|
|
if RR.Bottom > Target.Height then RR.Bottom := Target.Height;
|
|
if (RR.Right <= RR.Left) or (RR.Bottom <= RR.Top) then Exit;
|
|
|
|
InvA := 255 - Alpha;
|
|
Target.BeginUpdate(False);
|
|
try
|
|
for Y := RR.Top to RR.Bottom - 1 do
|
|
begin
|
|
Row := PByte(Target.ScanLine[Y]);
|
|
if Row = nil then Continue;
|
|
Inc(Row, RR.Left * 4);
|
|
for X := RR.Left to RR.Right - 1 do
|
|
begin
|
|
Row[0] := Byte((Alpha * B + InvA * Row[0]) div 255);
|
|
Row[1] := Byte((Alpha * G + InvA * Row[1]) div 255);
|
|
Row[2] := Byte((Alpha * R + InvA * Row[2]) div 255);
|
|
Inc(Row, 4);
|
|
end;
|
|
end;
|
|
finally
|
|
Target.EndUpdate(False);
|
|
end;
|
|
end;
|
|
|
|
function SpanBtnWidth(const Name: string; C: TCanvas): Integer;
|
|
begin
|
|
C.Font.Name := 'Courier New';
|
|
C.Font.Size := 7;
|
|
C.Font.Style := [];
|
|
Result := C.TextWidth(Name) + 10;
|
|
if Result < 36 then Result := 36;
|
|
end;
|
|
|
|
constructor TSampleRateOverlay.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FCurrentRate := 192000;
|
|
FPanelHidden := False;
|
|
FHitCount := 0;
|
|
FHotIdx := -1;
|
|
FWidth := 320;
|
|
FHeight := SPAN_H + PAD_Y * 2;
|
|
end;
|
|
|
|
procedure TSampleRateOverlay.RequestInvalidate;
|
|
begin
|
|
if Assigned(FOnInvalidate) then FOnInvalidate(Self);
|
|
end;
|
|
|
|
procedure TSampleRateOverlay.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
|
begin
|
|
if (FLeft = ALeft) and (FTop = ATop) and
|
|
(FWidth = AWidth) and (FHeight = AHeight) then Exit;
|
|
FLeft := ALeft;
|
|
FTop := ATop;
|
|
FWidth := AWidth;
|
|
FHeight := AHeight;
|
|
RequestInvalidate;
|
|
end;
|
|
|
|
procedure TSampleRateOverlay.RegisterHit(const HR: TRect; Value: Integer);
|
|
begin
|
|
if FHitCount > High(FHitRects) then Exit;
|
|
FHitRects[FHitCount] := HR;
|
|
FHitValues[FHitCount] := Value;
|
|
Inc(FHitCount);
|
|
end;
|
|
|
|
procedure TSampleRateOverlay.DrawSelf(Target: TBitmap; C: TCanvas;
|
|
OriginX, OriginY, W, H: Integer);
|
|
var
|
|
X, I, TW, TH, BtnW, ContentW: Integer;
|
|
HR, FullR: TRect;
|
|
IsAct, IsHot: Boolean;
|
|
Cap: string;
|
|
begin
|
|
if (Target = nil) or (C = nil) then Exit;
|
|
FHitCount := 0;
|
|
|
|
C.Font.Name := 'Courier New';
|
|
C.Font.Size := 7;
|
|
C.Font.Style := [];
|
|
TH := C.TextHeight('A');
|
|
|
|
ContentW := PAD_X + HIDE_W + BTN_GAP;
|
|
for I := 0 to High(SPAN_NAMES) do
|
|
begin
|
|
Inc(ContentW, SpanBtnWidth(SPAN_NAMES[I], C));
|
|
if I < High(SPAN_NAMES) then Inc(ContentW, BTN_GAP);
|
|
end;
|
|
Inc(ContentW, PAD_X);
|
|
if ContentW > W then ContentW := W;
|
|
|
|
FullR := Rect(OriginX, OriginY, OriginX + ContentW, OriginY + H);
|
|
BlendRect(Target, FullR, $14, $14, $14, 104);
|
|
BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Right, FullR.Top + 1),
|
|
$80, $80, $80, 56);
|
|
BlendRect(Target, Rect(FullR.Left, FullR.Bottom - 1, FullR.Right, FullR.Bottom),
|
|
$00, $00, $00, 48);
|
|
BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Left + 1, FullR.Bottom),
|
|
$80, $80, $80, 42);
|
|
BlendRect(Target, Rect(FullR.Right - 1, FullR.Top, FullR.Right, FullR.Bottom),
|
|
$00, $00, $00, 42);
|
|
|
|
X := OriginX + PAD_X;
|
|
|
|
HR := Rect(X, OriginY + PAD_Y, X + HIDE_W, OriginY + PAD_Y + SPAN_H);
|
|
IsHot := FHotIdx = 0;
|
|
if IsHot then BlendRect(Target, HR, $1D, $4B, $62, 206)
|
|
else BlendRect(Target, HR, $18, $3F, $54, 182);
|
|
C.Pen.Style := psSolid;
|
|
C.Pen.Color := CLR_BTN_BDR;
|
|
C.Brush.Style := bsClear;
|
|
C.Rectangle(HR);
|
|
C.Font.Size := 8;
|
|
if FPanelHidden then Cap := '>' else Cap := '<';
|
|
TW := C.TextWidth(Cap);
|
|
C.Font.Color := CLR_TEXT;
|
|
C.Brush.Style := bsClear;
|
|
C.TextOut(HR.Left + (HIDE_W - TW) div 2,
|
|
HR.Top + (SPAN_H - TH) div 2, Cap);
|
|
C.Font.Size := 7;
|
|
RegisterHit(HR, 0);
|
|
Inc(X, HIDE_W + BTN_GAP);
|
|
|
|
for I := 0 to High(SPAN_RATES) do
|
|
begin
|
|
BtnW := SpanBtnWidth(SPAN_NAMES[I], C);
|
|
HR := Rect(X, OriginY + PAD_Y, X + BtnW, OriginY + PAD_Y + SPAN_H);
|
|
IsAct := SPAN_RATES[I] = FCurrentRate;
|
|
IsHot := FHotIdx = I + 1;
|
|
|
|
if IsAct then BlendRect(Target, HR, $20, $5A, $78, 220)
|
|
else if IsHot then BlendRect(Target, HR, $1D, $4B, $62, 206)
|
|
else BlendRect(Target, HR, $18, $3F, $54, 182);
|
|
C.Pen.Style := psSolid;
|
|
C.Pen.Color := CLR_BTN_BDR;
|
|
C.Brush.Style := bsClear;
|
|
C.Rectangle(HR);
|
|
|
|
TW := C.TextWidth(SPAN_NAMES[I]);
|
|
C.Font.Color := CLR_TEXT;
|
|
C.Brush.Style := bsClear;
|
|
C.TextOut(HR.Left + (BtnW - TW) div 2,
|
|
HR.Top + (SPAN_H - TH) div 2, SPAN_NAMES[I]);
|
|
|
|
RegisterHit(HR, SPAN_RATES[I]);
|
|
Inc(X, BtnW + BTN_GAP);
|
|
end;
|
|
end;
|
|
|
|
procedure TSampleRateOverlay.DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer);
|
|
begin
|
|
if (FWidth <= 0) or (FHeight <= 0) then Exit;
|
|
if (FLeft >= W) or (FTop >= H) then Exit;
|
|
DrawSelf(Target, C, FLeft, FTop, Min(FWidth, W - FLeft), Min(FHeight, H - FTop));
|
|
end;
|
|
|
|
function TSampleRateOverlay.HandleMouseMove(X, Y: Integer): Boolean;
|
|
var
|
|
I, OldHot: Integer;
|
|
begin
|
|
Result := False;
|
|
OldHot := FHotIdx;
|
|
FHotIdx := -1;
|
|
for I := 0 to FHitCount - 1 do
|
|
if PtInRect(FHitRects[I], Point(X, Y)) then
|
|
begin
|
|
FHotIdx := I;
|
|
Break;
|
|
end;
|
|
if FHotIdx <> OldHot then
|
|
begin
|
|
RequestInvalidate;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function TSampleRateOverlay.HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
if Button <> mbLeft then Exit;
|
|
for I := 0 to FHitCount - 1 do
|
|
if PtInRect(FHitRects[I], Point(X, Y)) then
|
|
begin
|
|
if FHitValues[I] = 0 then
|
|
begin
|
|
if Assigned(FOnHidePanel) then FOnHidePanel;
|
|
end
|
|
else
|
|
begin
|
|
if Assigned(FOnSpanSelect) then FOnSpanSelect(FHitValues[I]);
|
|
end;
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TSampleRateOverlay.HandleMouseLeave: Boolean;
|
|
begin
|
|
Result := False;
|
|
if FHotIdx >= 0 then
|
|
begin
|
|
FHotIdx := -1;
|
|
RequestInvalidate;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TSampleRateOverlay.SetCurrentRate(Rate: Integer);
|
|
begin
|
|
if FCurrentRate = Rate then Exit;
|
|
FCurrentRate := Rate;
|
|
RequestInvalidate;
|
|
end;
|
|
|
|
procedure TSampleRateOverlay.SetPanelHidden(Hidden: Boolean);
|
|
begin
|
|
if FPanelHidden = Hidden then Exit;
|
|
FPanelHidden := Hidden;
|
|
RequestInvalidate;
|
|
end;
|
|
|
|
end.
|