mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
778 lines
18 KiB
ObjectPascal
778 lines
18 KiB
ObjectPascal
unit FlatSpinEdit;
|
|
|
|
{ Custom integer spin edit with canvas rendering.
|
|
Use instead of TSpinEdit where native widgetset styling is undesirable. }
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types,
|
|
Clipbrd, Math, AppTheme;
|
|
|
|
type
|
|
TFlatSpinPart = (fspNone, fspEdit, fspUp, fspDown);
|
|
|
|
TFlatSpinEdit = class(TCustomControl)
|
|
private
|
|
FValue: Integer;
|
|
FMinValue: Integer;
|
|
FMaxValue: Integer;
|
|
FIncrement: Integer;
|
|
FText: string;
|
|
FCaretPos: Integer;
|
|
FSelStart: Integer;
|
|
FSelLen: Integer;
|
|
FHot: Boolean;
|
|
FEditing: Boolean;
|
|
FDragging: Boolean;
|
|
FHotPart: TFlatSpinPart;
|
|
FDownPart: TFlatSpinPart;
|
|
FOnChange: TNotifyEvent;
|
|
FClrOuterBG: TColor;
|
|
FClrBG: TColor;
|
|
FClrBGHot: TColor;
|
|
FClrBorder: TColor;
|
|
FClrText: TColor;
|
|
FClrTextDim: TColor;
|
|
FClrSelBG: TColor;
|
|
FClrSelText: TColor;
|
|
FClrBtnHot: TColor;
|
|
FClrBtnDown: TColor;
|
|
FClrBtnText: TColor;
|
|
function DpiScale(V: Integer): Integer;
|
|
function ButtonWidth: Integer;
|
|
function EditRect: TRect;
|
|
function UpRect: TRect;
|
|
function DownRect: TRect;
|
|
function PartAt(X, Y: Integer): TFlatSpinPart;
|
|
function HasSelection: Boolean;
|
|
function SelFirst: Integer;
|
|
function SelAfter: Integer;
|
|
function CaretPosAtX(X: Integer): Integer;
|
|
procedure SetValue(V: Integer);
|
|
procedure SetMinValue(V: Integer);
|
|
procedure SetMaxValue(V: Integer);
|
|
procedure SetIncrement(V: Integer);
|
|
procedure SetTextInternal(const S: string; AFireChange: Boolean);
|
|
procedure DeleteSelection;
|
|
procedure InsertText(const S: string);
|
|
procedure UpdateValueFromText;
|
|
procedure CommitText;
|
|
procedure StepValue(Dir: Integer);
|
|
procedure DoChange;
|
|
procedure AppUserInput(Sender: TObject; Msg: Cardinal);
|
|
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;
|
|
procedure DblClick; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: char); override;
|
|
procedure DoEnter; override;
|
|
procedure DoExit; override;
|
|
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
|
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure SetAppTheme(const T: TAppTheme);
|
|
procedure SelectAll;
|
|
|
|
property Value: Integer read FValue write SetValue;
|
|
property MinValue: Integer read FMinValue write SetMinValue;
|
|
property MaxValue: Integer read FMaxValue write SetMaxValue;
|
|
property Increment: Integer read FIncrement write SetIncrement;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property Align;
|
|
property Anchors;
|
|
property Enabled;
|
|
property Font;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Tag;
|
|
property Visible;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
end;
|
|
|
|
implementation
|
|
|
|
const
|
|
BASE_PAD_X = 8;
|
|
BASE_BTN_W = 22;
|
|
|
|
constructor TFlatSpinEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents];
|
|
Width := 96;
|
|
Height := DpiScale(26);
|
|
TabStop := True;
|
|
Cursor := crIBeam;
|
|
|
|
Font.Name := 'Courier New';
|
|
Font.Size := 9;
|
|
|
|
FMinValue := 0;
|
|
FMaxValue := 100;
|
|
FIncrement := 1;
|
|
FValue := 0;
|
|
FText := '0';
|
|
FCaretPos := Length(FText);
|
|
FSelStart := FCaretPos;
|
|
|
|
FClrOuterBG := TColor($00181818);
|
|
FClrBG := TColor($001A1A1A);
|
|
FClrBGHot := TColor($00202020);
|
|
FClrBorder := TColor($00444444);
|
|
FClrText := TColor($00E0E0E0);
|
|
FClrTextDim := TColor($00666666);
|
|
FClrSelBG := TColor($000C3010);
|
|
FClrSelText := TColor($0000FF88);
|
|
FClrBtnHot := TColor($000C3010);
|
|
FClrBtnDown := TColor($00183618);
|
|
FClrBtnText := TColor($0000FF88);
|
|
Application.AddOnUserInputHandler(@AppUserInput);
|
|
end;
|
|
|
|
destructor TFlatSpinEdit.Destroy;
|
|
begin
|
|
Application.RemoveOnUserInputHandler(@AppUserInput);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TFlatSpinEdit.DpiScale(V: Integer): Integer;
|
|
begin
|
|
Result := MulDiv(V, Screen.PixelsPerInch, 96);
|
|
if (V > 0) and (Result < 1) then
|
|
Result := 1;
|
|
end;
|
|
|
|
function TFlatSpinEdit.ButtonWidth: Integer;
|
|
begin
|
|
Result := DpiScale(BASE_BTN_W);
|
|
if Result > Width div 2 then
|
|
Result := Width div 2;
|
|
end;
|
|
|
|
function TFlatSpinEdit.EditRect: TRect;
|
|
begin
|
|
Result := Rect(0, 0, Width - ButtonWidth, Height);
|
|
end;
|
|
|
|
function TFlatSpinEdit.UpRect: TRect;
|
|
begin
|
|
Result := Rect(Width - ButtonWidth, 0, Width, Height div 2);
|
|
end;
|
|
|
|
function TFlatSpinEdit.DownRect: TRect;
|
|
begin
|
|
Result := Rect(Width - ButtonWidth, Height div 2, Width, Height);
|
|
end;
|
|
|
|
function TFlatSpinEdit.PartAt(X, Y: Integer): TFlatSpinPart;
|
|
begin
|
|
if not PtInRect(ClientRect, Point(X, Y)) then
|
|
Exit(fspNone);
|
|
if PtInRect(UpRect, Point(X, Y)) then
|
|
Exit(fspUp);
|
|
if PtInRect(DownRect, Point(X, Y)) then
|
|
Exit(fspDown);
|
|
Result := fspEdit;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.SetAppTheme(const T: TAppTheme);
|
|
begin
|
|
FClrOuterBG := T.Panel;
|
|
FClrBG := T.BtnNorm;
|
|
FClrBGHot := T.BtnHot;
|
|
FClrBorder := T.Border;
|
|
FClrText := T.Text;
|
|
FClrTextDim := T.TextDim;
|
|
FClrSelBG := T.BtnActive;
|
|
FClrSelText := T.BtnTextActive;
|
|
FClrBtnHot := T.BtnActive;
|
|
FClrBtnDown := T.SliderTrackFill;
|
|
FClrBtnText := T.BtnTextActive;
|
|
Font.Color := T.Text;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TFlatSpinEdit.HasSelection: Boolean;
|
|
begin
|
|
Result := FSelLen <> 0;
|
|
end;
|
|
|
|
function TFlatSpinEdit.SelFirst: Integer;
|
|
begin
|
|
if FSelLen >= 0 then
|
|
Result := FSelStart
|
|
else
|
|
Result := FSelStart + FSelLen;
|
|
end;
|
|
|
|
function TFlatSpinEdit.SelAfter: Integer;
|
|
begin
|
|
if FSelLen >= 0 then
|
|
Result := FSelStart + FSelLen
|
|
else
|
|
Result := FSelStart;
|
|
end;
|
|
|
|
function TFlatSpinEdit.CaretPosAtX(X: Integer): Integer;
|
|
var
|
|
I, Pad, RelX, BestDist, Dist: Integer;
|
|
begin
|
|
Pad := DpiScale(BASE_PAD_X);
|
|
RelX := X - Pad;
|
|
Result := 0;
|
|
BestDist := Abs(RelX);
|
|
for I := 1 to Length(FText) do
|
|
begin
|
|
Dist := Abs(RelX - Canvas.TextWidth(Copy(FText, 1, I)));
|
|
if Dist < BestDist then
|
|
begin
|
|
BestDist := Dist;
|
|
Result := I;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.SetTextInternal(const S: string; AFireChange: Boolean);
|
|
begin
|
|
FText := S;
|
|
FCaretPos := EnsureRange(FCaretPos, 0, Length(FText));
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
if AFireChange then
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.SetValue(V: Integer);
|
|
begin
|
|
V := EnsureRange(V, FMinValue, FMaxValue);
|
|
if (FValue = V) and (FText = IntToStr(V)) then Exit;
|
|
FValue := V;
|
|
FText := IntToStr(FValue);
|
|
FCaretPos := Length(FText);
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.SetMinValue(V: Integer);
|
|
begin
|
|
FMinValue := V;
|
|
if FMaxValue < FMinValue then
|
|
FMaxValue := FMinValue;
|
|
SetValue(FValue);
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.SetMaxValue(V: Integer);
|
|
begin
|
|
FMaxValue := V;
|
|
if FMinValue > FMaxValue then
|
|
FMinValue := FMaxValue;
|
|
SetValue(FValue);
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.SetIncrement(V: Integer);
|
|
begin
|
|
FIncrement := Max(1, Abs(V));
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.DeleteSelection;
|
|
var
|
|
A, B: Integer;
|
|
begin
|
|
if not HasSelection then Exit;
|
|
A := SelFirst;
|
|
B := SelAfter;
|
|
Delete(FText, A + 1, B - A);
|
|
FCaretPos := A;
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.InsertText(const S: string);
|
|
begin
|
|
if S = '' then Exit;
|
|
DeleteSelection;
|
|
Insert(S, FText, FCaretPos + 1);
|
|
Inc(FCaretPos, Length(S));
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
UpdateValueFromText;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.UpdateValueFromText;
|
|
var
|
|
Code, V: Integer;
|
|
begin
|
|
Val(FText, V, Code);
|
|
if (Code <> 0) or (V < FMinValue) or (V > FMaxValue) then Exit;
|
|
if FValue = V then Exit;
|
|
FValue := V;
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.CommitText;
|
|
var
|
|
Code, V: Integer;
|
|
begin
|
|
if (FText = '') or (FText = '-') then
|
|
begin
|
|
SetValue(FValue);
|
|
Exit;
|
|
end;
|
|
Val(FText, V, Code);
|
|
if Code <> 0 then
|
|
V := FValue;
|
|
SetValue(V);
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.StepValue(Dir: Integer);
|
|
begin
|
|
CommitText;
|
|
SetValue(FValue + Dir * FIncrement);
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.DoChange;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.AppUserInput(Sender: TObject; Msg: Cardinal);
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
if not FEditing then Exit;
|
|
case Msg of
|
|
LM_LBUTTONDOWN, LM_RBUTTONDOWN, LM_MBUTTONDOWN: ;
|
|
else
|
|
Exit;
|
|
end;
|
|
|
|
P := ScreenToClient(Mouse.CursorPos);
|
|
if PtInRect(ClientRect, P) then Exit;
|
|
|
|
CommitText;
|
|
FDragging := False;
|
|
MouseCapture := False;
|
|
FEditing := False;
|
|
FHot := False;
|
|
FHotPart := fspNone;
|
|
FDownPart := fspNone;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.Paint;
|
|
var
|
|
R, ER, UR, DR, TextR, SelR: TRect;
|
|
Pad, TextY, CaretX, A, B, MidX, MidY, S: Integer;
|
|
BeforeSel, SelText: string;
|
|
|
|
procedure FillPart(const AR: TRect; Part: TFlatSpinPart);
|
|
begin
|
|
if not Enabled then
|
|
Canvas.Brush.Color := FClrBG
|
|
else if FDownPart = Part then
|
|
Canvas.Brush.Color := FClrBtnDown
|
|
else if FHotPart = Part then
|
|
Canvas.Brush.Color := FClrBtnHot
|
|
else if FHot or FEditing or Focused then
|
|
Canvas.Brush.Color := FClrBGHot
|
|
else
|
|
Canvas.Brush.Color := FClrBG;
|
|
Canvas.Pen.Style := psClear;
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.FillRect(AR);
|
|
end;
|
|
|
|
procedure DrawArrow(const AR: TRect; Up: Boolean);
|
|
var
|
|
P: array[0..2] of TPoint;
|
|
Size: Integer;
|
|
begin
|
|
Size := Max(3, DpiScale(4));
|
|
MidX := (AR.Left + AR.Right) div 2;
|
|
MidY := (AR.Top + AR.Bottom) div 2;
|
|
if Up then
|
|
begin
|
|
P[0] := Point(MidX, MidY - Size div 2);
|
|
P[1] := Point(MidX - Size, MidY + Size div 2);
|
|
P[2] := Point(MidX + Size, MidY + Size div 2);
|
|
end
|
|
else
|
|
begin
|
|
P[0] := Point(MidX - Size, MidY - Size div 2);
|
|
P[1] := Point(MidX + Size, MidY - Size div 2);
|
|
P[2] := Point(MidX, MidY + Size div 2);
|
|
end;
|
|
if Enabled then
|
|
Canvas.Brush.Color := FClrBtnText
|
|
else
|
|
Canvas.Brush.Color := FClrTextDim;
|
|
Canvas.Pen.Style := psClear;
|
|
Canvas.Polygon(P);
|
|
end;
|
|
begin
|
|
R := ClientRect;
|
|
ER := EditRect;
|
|
UR := UpRect;
|
|
DR := DownRect;
|
|
|
|
Canvas.Brush.Color := FClrOuterBG;
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.Pen.Style := psClear;
|
|
Canvas.FillRect(R);
|
|
|
|
if FHot or FEditing or Focused then
|
|
Canvas.Brush.Color := FClrBGHot
|
|
else
|
|
Canvas.Brush.Color := FClrBG;
|
|
Canvas.Pen.Color := FClrBorder;
|
|
Canvas.Pen.Style := psSolid;
|
|
Canvas.Pen.Width := 1;
|
|
Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
|
|
|
|
FillPart(UR, fspUp);
|
|
FillPart(DR, fspDown);
|
|
Canvas.Pen.Color := FClrBorder;
|
|
Canvas.Pen.Style := psSolid;
|
|
Canvas.Line(UR.Left, 1, UR.Left, Height - 1);
|
|
Canvas.Line(UR.Left, DR.Top, Width - 1, DR.Top);
|
|
DrawArrow(UR, True);
|
|
DrawArrow(DR, False);
|
|
|
|
Canvas.Font.Assign(Font);
|
|
if Enabled then
|
|
Canvas.Font.Color := FClrText
|
|
else
|
|
Canvas.Font.Color := FClrTextDim;
|
|
Pad := DpiScale(BASE_PAD_X);
|
|
TextR := Rect(ER.Left + Pad, ER.Top, ER.Right - DpiScale(3), ER.Bottom);
|
|
TextY := (Height - Canvas.TextHeight('Ag')) div 2;
|
|
|
|
if HasSelection then
|
|
begin
|
|
A := SelFirst;
|
|
B := SelAfter;
|
|
BeforeSel := Copy(FText, 1, A);
|
|
SelText := Copy(FText, A + 1, B - A);
|
|
SelR := Rect(TextR.Left + Canvas.TextWidth(BeforeSel), TextY,
|
|
TextR.Left + Canvas.TextWidth(BeforeSel + SelText), TextY + Canvas.TextHeight('Ag'));
|
|
Canvas.Brush.Color := FClrSelBG;
|
|
Canvas.Pen.Style := psClear;
|
|
Canvas.FillRect(SelR);
|
|
end;
|
|
|
|
Canvas.Brush.Style := bsClear;
|
|
Canvas.TextRect(TextR, TextR.Left, TextY, FText);
|
|
|
|
if HasSelection then
|
|
begin
|
|
A := SelFirst;
|
|
B := SelAfter;
|
|
BeforeSel := Copy(FText, 1, A);
|
|
SelText := Copy(FText, A + 1, B - A);
|
|
Canvas.Font.Color := FClrSelText;
|
|
Canvas.TextOut(TextR.Left + Canvas.TextWidth(BeforeSel), TextY, SelText);
|
|
end;
|
|
|
|
if FEditing and not HasSelection then
|
|
begin
|
|
S := EnsureRange(FCaretPos, 0, Length(FText));
|
|
CaretX := TextR.Left + Canvas.TextWidth(Copy(FText, 1, S));
|
|
Canvas.Pen.Color := FClrText;
|
|
Canvas.Pen.Style := psSolid;
|
|
Canvas.Pen.Width := 1;
|
|
Canvas.Line(CaretX, TextY, CaretX, TextY + Canvas.TextHeight('Ag'));
|
|
end;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.MouseEnter;
|
|
begin
|
|
inherited;
|
|
FHot := True;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.MouseLeave;
|
|
begin
|
|
inherited;
|
|
FHot := False;
|
|
FHotPart := fspNone;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
Pos: Integer;
|
|
begin
|
|
inherited;
|
|
if (Button <> mbLeft) or not Enabled then Exit;
|
|
SetFocus;
|
|
FEditing := True;
|
|
FDownPart := PartAt(X, Y);
|
|
FHotPart := FDownPart;
|
|
if FDownPart in [fspUp, fspDown] then
|
|
begin
|
|
FDragging := False;
|
|
MouseCapture := True;
|
|
if FDownPart = fspUp then
|
|
StepValue(1)
|
|
else
|
|
StepValue(-1);
|
|
end
|
|
else
|
|
begin
|
|
FDragging := True;
|
|
MouseCapture := True;
|
|
Pos := CaretPosAtX(X);
|
|
FCaretPos := Pos;
|
|
FSelStart := Pos;
|
|
FSelLen := 0;
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Pos: Integer;
|
|
Part: TFlatSpinPart;
|
|
begin
|
|
inherited;
|
|
Part := PartAt(X, Y);
|
|
if FHotPart <> Part then
|
|
begin
|
|
FHotPart := Part;
|
|
if Part = fspEdit then
|
|
Cursor := crIBeam
|
|
else
|
|
Cursor := crDefault;
|
|
Invalidate;
|
|
end;
|
|
|
|
if not FDragging then Exit;
|
|
Pos := CaretPosAtX(X);
|
|
FCaretPos := Pos;
|
|
FSelLen := Pos - FSelStart;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited;
|
|
if Button <> mbLeft then Exit;
|
|
FDragging := False;
|
|
FDownPart := fspNone;
|
|
MouseCapture := False;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.DblClick;
|
|
begin
|
|
inherited;
|
|
if FHotPart <> fspEdit then Exit;
|
|
FEditing := True;
|
|
SelectAll;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
if not Enabled then Exit;
|
|
FEditing := True;
|
|
case Key of
|
|
VK_LEFT:
|
|
begin
|
|
FCaretPos := EnsureRange(FCaretPos - 1, 0, Length(FText));
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
UpdateValueFromText;
|
|
Invalidate;
|
|
Key := 0;
|
|
end;
|
|
VK_RIGHT:
|
|
begin
|
|
FCaretPos := EnsureRange(FCaretPos + 1, 0, Length(FText));
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
UpdateValueFromText;
|
|
Invalidate;
|
|
Key := 0;
|
|
end;
|
|
VK_HOME:
|
|
begin
|
|
FCaretPos := 0;
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
Key := 0;
|
|
end;
|
|
VK_END:
|
|
begin
|
|
FCaretPos := Length(FText);
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
Key := 0;
|
|
end;
|
|
VK_UP:
|
|
begin
|
|
StepValue(1);
|
|
Key := 0;
|
|
end;
|
|
VK_DOWN:
|
|
begin
|
|
StepValue(-1);
|
|
Key := 0;
|
|
end;
|
|
VK_RETURN:
|
|
begin
|
|
CommitText;
|
|
SelectAll;
|
|
Key := 0;
|
|
end;
|
|
VK_ESCAPE:
|
|
begin
|
|
SetTextInternal(IntToStr(FValue), False);
|
|
Key := 0;
|
|
end;
|
|
VK_BACK:
|
|
begin
|
|
if HasSelection then
|
|
DeleteSelection
|
|
else if FCaretPos > 0 then
|
|
begin
|
|
Delete(FText, FCaretPos, 1);
|
|
Dec(FCaretPos);
|
|
end;
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
Key := 0;
|
|
end;
|
|
VK_DELETE:
|
|
begin
|
|
if HasSelection then
|
|
DeleteSelection
|
|
else if FCaretPos < Length(FText) then
|
|
Delete(FText, FCaretPos + 1, 1);
|
|
FSelStart := FCaretPos;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
Key := 0;
|
|
end;
|
|
Ord('A'):
|
|
if ssCtrl in Shift then
|
|
begin
|
|
SelectAll;
|
|
Key := 0;
|
|
end;
|
|
Ord('C'):
|
|
if (ssCtrl in Shift) and HasSelection then
|
|
begin
|
|
Clipboard.AsText := Copy(FText, SelFirst + 1, SelAfter - SelFirst);
|
|
Key := 0;
|
|
end;
|
|
Ord('X'):
|
|
if (ssCtrl in Shift) and HasSelection then
|
|
begin
|
|
Clipboard.AsText := Copy(FText, SelFirst + 1, SelAfter - SelFirst);
|
|
DeleteSelection;
|
|
UpdateValueFromText;
|
|
Invalidate;
|
|
Key := 0;
|
|
end;
|
|
Ord('V'):
|
|
if ssCtrl in Shift then
|
|
begin
|
|
InsertText(Clipboard.AsText);
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.KeyPress(var Key: char);
|
|
begin
|
|
inherited;
|
|
if not Enabled then Exit;
|
|
FEditing := True;
|
|
if Key in ['0'..'9'] then
|
|
begin
|
|
InsertText(Key);
|
|
Key := #0;
|
|
end
|
|
else if (Key = '-') and (FMinValue < 0) and (FCaretPos = 0) and (Pos('-', FText) = 0) then
|
|
begin
|
|
InsertText(Key);
|
|
Key := #0;
|
|
end
|
|
else if Key >= #32 then
|
|
Key := #0;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.DoEnter;
|
|
begin
|
|
inherited;
|
|
FEditing := True;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.DoExit;
|
|
begin
|
|
inherited;
|
|
CommitText;
|
|
FEditing := False;
|
|
FHot := False;
|
|
FHotPart := fspNone;
|
|
FDownPart := fspNone;
|
|
FSelLen := 0;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TFlatSpinEdit.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
|
|
begin
|
|
if Enabled then
|
|
StepValue(1);
|
|
Result := True;
|
|
end;
|
|
|
|
function TFlatSpinEdit.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
|
|
begin
|
|
if Enabled then
|
|
StepValue(-1);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TFlatSpinEdit.SelectAll;
|
|
begin
|
|
FSelStart := 0;
|
|
FSelLen := Length(FText);
|
|
FCaretPos := Length(FText);
|
|
Invalidate;
|
|
end;
|
|
|
|
end.
|