TNumberBox Min/Max-Eingabeproblem

[idontknow]

Ich hab eine Helper-Klasse geschrieben, mit der das ganze nun für meine Anwendung gut funktioniert.

Falls jemand dasselbe Problem hat, einfach die Unit einbinden und im FormCreate eine Zeile hinzufügen:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  TNumberBoxHelper.InitializeNumberBoxes(Self); // rekursiv alle TNumberBox'en auf den Class Helper einschwören
end;

Delphi-Quellcode:

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.

[BerndS]

Ich habe mich gerade mit der Numberbox beschäftigt. Um die Eingabeprüfung er Numberbox zu deaktivieren musste ich

Delphi-Quellcode:

 
NumberBox1.min := Double.NegativeInfinity;
NumberBox1.max := Double.PositiveInfinity;

setzen.

Beim Setzen von Min und Max auf 0 wurde bei OnExit der Text immer alles auf 0 zurückgesetzt.

[TurboMagic]

Zitat von idontknow:

Ich hab eine Helper-Klasse geschrieben, mit der das ganze nun für meine Anwendung gut funktioniert.

Hallo,

schön, dass du dir damit helfen konntest und auch dass du uns das zur Verfügung stellst.
Nur: es wäre echt gut, wenn du das Problem auch bei QP einstellst, damit dieser Helper
in Zukunft mal irgendwann wieder überflüssig wird.

Falls nicht klar sein sollte was QP ist: https://www.quality.embarcadero.com

Grüße
TurboMagic