unit lib_NumberBoxHelper;
// Eine kleine Helper-Klasse für TNumberBox.
// 25.11.2021, idontknow
//
// TNumberBox lässt normalerweise keine Eingabe von Ziffern zu, sobald diese einzeln betrachtet bereits die Min/Max-Grenzen
// verletzen. Eine NumberBox mit Min=5 und Max=90 wird den Wert 45 nicht akzeptieren wenn dieser eingetippt wird, weil bereits
// die Ziffer 4 die untere Grenze verletzt.
//
// Diese Helper-Klasse legt bei Aufruf von TNumberBox.Init ein TNumberBoxHelper-Objekt an.
// TNumberBox.Min und Max werden daraufhin auf 0 gesetzt, TNumberBox nimmt somit jeden Wert an.
// Bei OnExit oder nach Ablauf eines Timers, der gestartet wird, sobald die bisherige Eingabe die Min/Max-Bedingung nicht erfüllt,
// wird TNumberBox.Value korrigiert.
//
// Beispiel für Benutzung, die Numberboxen seien mit OnChange=NumberBoxValueChanged auf dem Form festgelegt:
//
// procedure TForm1.FormCreate(Sender: TObject);
// begin
// TNumberBoxHelper.InitializeNumberBoxes(Self); // rekursiv alle TNumberBox'en auf den Class Helper einschwören
// end;
//
// procedure TForm1.NumberBoxValueChanged(Sender: TObject);
// var
// NumberBox: TNumberBox;
// Text: String;
// begin
// NumberBox := TNumberBox(Sender);
//
// if NumberBox.Mode = nbmInteger then
// Text := Format('NumberBox: %s, LastValue: %d, Value: %d', [NumberBox.Name, NumberBox.PreviousValueInt, NumberBox.ValueInt]);
//
// if NumberBox.Mode = nbmFloat then
// Text := Format('NumberBox: %s, LastValue: %.2f, Value: %.2f', [NumberBox.Name, NumberBox.PreviousValueFloat, NumberBox.ValueFloat]);
//
// Memo1.Lines.Add(Text);
// end;
//
// Achtung: TNumberBox.Tag (von TControl geerbt) brauche ich blöderweise in meiner Application auch.
// Hier wird Tag verwendet (weil ein class helper keine neuen Felder haben kann), um einen Zeiger auf das TNumberBoxHelper-Objekt
// zu haben.
// Lösung: Ich verwende überall TControl(Self).Tag zum Zugriff auf den "TNumberBoxHelper-Objekt-Zeiger"
// und ein neu eingeführtes Property TNumberBoxHelperClass.Tag zum Zugriff auf TNumberBoxHelper.Tag.
// Nach aussen gibt es somit weiterhin ein frei verwendbares Tag-Property.
interface
uses
System.Classes,
Vcl.Controls,
Vcl.NumberBox,
Vcl.ExtCtrls, System.Math;
const
DetermineUpDownIntervalms = 100;
type
TNumberBoxHelper =
class(TControl)
// damit die Objekte automatisch aufgeräumt werden...
private
MinValue, MaxValue, Value, PreviousValue: Extended;
// Value und PreviousValue sind gültige Werte
Input: Extended;
// Input kann eine ungültige Eingabe ausserhalb des MinMaxRange sein
Tag: NativeUint;
Changed: Boolean;
LastKeyPressedAt: Int64;
onChange: TNotifyEvent;
onEnter: TNotifyEvent;
onExit: TNotifyEvent;
public
class procedure InitializeNumberBoxes(WinControl: TWinControl);
end;
TNumberBoxHelperClass =
class helper
for TNumberBox
private
// NumberBoxHelper: TNumberBoxHelper; leider keine Felder in class helper, daher verwende ich TNumberBox.Tag
class var ValidationTimer: TTimer;
procedure ValidationTimerElapsed(Sender: TObject);
procedure CreateValidationTimer;
function GetMaxValue: Extended;
function GetMinValue: Extended;
function GetTag: NativeUInt;
// Beschafft Tag aus TNumberBoxHelper, darin steht das ursprüngliche TNumberBox.Tag
procedure SetMaxValue(
const Value: Extended);
procedure SetMinValue(
const Value: Extended);
procedure SetTag(
const Value: NativeUInt);
procedure DoValidateChar(AChar: Char;
var AValidated: Boolean);
public
procedure Init;
procedure DoEnterOrChange(Sender: TObject);
procedure DoChange(Sender: TObject);
procedure DoEnter(Sender: TObject);
procedure DoExit(Sender: TObject);
function Correct: Boolean;
function PreviousValueInt: Integer;
function PreviousValueFloat: Extended;
class procedure ForceCorrection;
published
property Tag: NativeUInt
read GetTag
write SetTag;
property MinValue: Extended
read GetMinValue
write SetMinValue;
property MaxValue: Extended
read GetMaxValue
write SetMaxValue;
end;
implementation
class procedure TNumberBoxHelper.InitializeNumberBoxes(WinControl: TWinControl);
var
i: Integer;
Control: TControl;
begin
for i := 0
to WinControl.ControlCount-1
do
begin
Control := WinControl.Controls[i];
if Control.InheritsFrom(TNumberBox)
then
TNumberBox(Control).Init
else
if Control.InheritsFrom(TWinControl)
then
InitializeNumberBoxes(TWinControl(Control));
end;
end;
{ TNumberBoxHelperClass }
procedure TNumberBoxHelperClass.DoValidateChar(AChar: Char;
var AValidated: Boolean);
var
NumberBoxHelper: TNumberBoxHelper;
begin
// Das ist hier der Weg rauszufinden, ober der User eine Zahl eintippt oder die Up/Down-Buttons verwendet...
AValidated := TRUE;
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
NumberBoxHelper.LastKeyPressedAt := Int64(TThread.GetTickCount64);
end;
procedure TNumberBoxHelperClass.DoExit(Sender: TObject);
var
NumberBox: TNumberBox;
begin
if not Assigned(ValidationTimer)
then
CreateValidationTimer;
ValidationTimer.Tag := 0;
ValidationTimer.Enabled := FALSE;
NumberBox := TNumberBox(Sender);
NumberBox.Correct;
end;
procedure TNumberBoxHelperClass.CreateValidationTimer;
begin
ValidationTimer := TTimer.Create(Self);
ValidationTimer.OnTimer := ValidationTimerElapsed;
ValidationTimer.Tag := 0;
ValidationTimer.Enabled := FALSE;
end;
procedure TNumberBoxHelperClass.DoChange(Sender: TObject);
begin
DoEnterOrChange(Sender);
end;
procedure TNumberBoxHelperClass.DoEnter(Sender: TObject);
var
NumberBox: TNumberBox;
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBox := TNumberBox(Sender);
NumberBoxHelper := TNumberBoxHelper(TControl(NumberBox).Tag);
if Assigned(NumberBoxHelper.onEnter)
then
NumberBoxHelper.onEnter(Sender);
DoEnterOrChange(Sender);
end;
procedure TNumberBoxHelperClass.DoEnterOrChange(Sender: TObject);
var
NumberBox: TNumberBox;
NumberBoxHelper: TNumberBoxHelper;
begin
if not Assigned(ValidationTimer)
then
CreateValidationTimer;
ValidationTimer.Enabled := FALSE;
ValidationTimer.Tag := NativeUInt(Sender);
NumberBox := TNumberBox(Sender);
NumberBoxHelper := TNumberBoxHelper(TControl(NumberBox).Tag);
if SameValue(Abs(NumberBox.Value - NumberBoxHelper.Value), NumberBox.SmallStep)
or SameValue(Abs(NumberBox.Value - NumberBoxHelper.Input), NumberBox.SmallStep)
then
begin
// wenn der Unterschied +- SmallStep beträgt UND die letzte Tastatureingabe in das Eingabefeld länger als ~100ms her ist,
// dann wurde mit hoher Wahrscheinlichkeit eine Up/Down-Taste gedrückt -> Wert sofort korrigieren
if ((Int64(TThread.GetTickCount64) - NumberBoxHelper.LastKeyPressedAt) > DetermineUpDownIntervalms)
then
begin
NumberBox.Correct;
NumberBoxHelper.Input := NumberBox.Value;
end;
end
else begin
NumberBoxHelper.Input := NumberBox.Value;
// speichert jede (auch ungültige) Eingabe, die vielleicht gleich durch Up/Down inkrementiert/dekrementiert wird.
ValidationTimer.Enabled := TRUE;
end;
end;
function TNumberBoxHelperClass.Correct: Boolean;
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
if Value < NumberBoxHelper.MinValue
then
Value := NumberBoxHelper.MinValue
else
if Value > NumberBoxHelper.MaxValue
then
Value := NumberBoxHelper.MaxValue;
Result := NumberBoxHelper.Value <> Value;
NumberBoxHelper.Changed := NumberBoxHelper.Changed
or Result;
NumberBoxHelper.Value := Value;
if NumberBoxHelper.Changed
then
begin
if Assigned(NumberBoxHelper.onChange)
then
NumberBoxHelper.onChange(Self);
NumberBoxHelper.PreviousValue := NumberBoxHelper.Value;
NumberBoxHelper.Changed := FALSE;
end;
end;
procedure TNumberBoxHelperClass.ValidationTimerElapsed(Sender: TObject);
begin
ForceCorrection;
end;
class procedure TNumberBoxHelperClass.ForceCorrection;
var
NumberBox: TNumberBox;
begin
// wird von ValidationTimerElapsed aufgerufen oder kann vom Benutzer aufgerufen werden.
// Vom Benutzer normalerweise nicht nötig, weil onExit ebenfalls ForceCorrection aufruft.
if ValidationTimer.Enabled
then
begin
ValidationTimer.Enabled := FALSE;
NumberBox := TNumberbox(ValidationTimer.Tag);
NumberBox.Correct;
end;
end;
procedure TNumberBoxHelperClass.Init;
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper.Create(Self);
// Die Min/Max-Werte im NumberBoxHelper ablegen...
NumberBoxHelper.MinValue := TCustomNumberBox(Self).MinValue;
NumberBoxHelper.MaxValue := TCustomNumberBox(Self).MaxValue;
NumberBoxHelper.Value := Value;
NumberBoxHelper.PreviousValue := Value;
NumberBoxHelper.Input := Value;
NumberBoxHelper.Changed := FALSE;
NumberBoxHelper.onEnter := OnEnter;
NumberBoxHelper.onExit := OnExit;
NumberBoxHelper.onChange := OnChange;
Self.onValidateChar := DoValidateChar;
NumberBoxHelper.Tag := TControl(Self).Tag;
// Tag in Sicherheit bringen...
TControl(Self).Tag := NativeUint(NumberBoxHelper);
// und ab jetzt intern verwenden... Das Ursprungs-Tag mit TNumberBox.getTag ermitteln.
OnEnter :=
nil;
OnChange :=
nil;
OnExit :=
nil;
// ... und hier auf 0 setzen, damit künftig jeder Wert bei der Eingabe akzeptiert wird
TCustomNumberBox(Self).MinValue := 0;
TCustomNumberBox(Self).MaxValue := 0;
NumberBoxHelper.LastKeyPressedAt := Int64(TThread.GetTickCount64) - 1000;
Correct;
// Den Wert ggf. schon mal in die Begrenzung fahren, jedoch ohne OnChange.
OnEnter := DoEnter;
OnChange := DoChange;
OnExit := DoExit;
end;
function TNumberBoxHelperClass.PreviousValueInt: Integer;
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
Result := Round(NumberBoxHelper.PreviousValue);
end;
function TNumberBoxHelperClass.PreviousValueFloat: Extended;
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
Result := NumberBoxHelper.PreviousValue;
end;
procedure TNumberBoxHelperClass.SetMaxValue(
const Value: Extended);
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
NumberBoxHelper.MaxValue := Value;
end;
procedure TNumberBoxHelperClass.SetMinValue(
const Value: Extended);
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
NumberBoxHelper.MinValue := Value;
end;
procedure TNumberBoxHelperClass.SetTag(
const Value: NativeUInt);
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
NumberBoxHelper.Tag := Value;
end;
function TNumberBoxHelperClass.GetMaxValue: Extended;
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
Result := NumberBoxHelper.MaxValue;
end;
function TNumberBoxHelperClass.GetMinValue: Extended;
var
NumberBoxHelper: TNumberBoxHelper;
begin
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
Result := NumberBoxHelper.MinValue;
end;
function TNumberBoxHelperClass.GetTag: NativeUInt;
var
NumberBoxHelper: TNumberBoxHelper;
begin
// weil wir TNumberBox.Tag zum Speichern des NumberBoxHelper verwenden...
NumberBoxHelper := TNumberBoxHelper(TControl(Self).Tag);
// gibt es stattdessen ein Tag-Feld im NumberBoxHelper...
Result := NumberBoxHelper.Tag;
end;
end.