1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
| unit KGF_unit_FloatEdit;
{
KGF_unit_FloadEdit
derived from TEdit, designed to enter floating point values
the input format is [+|-]Fn.m
with: n=integer part (including the optional sign)
m = fractional part (excluding the decimal separator)
The current version forces the decimal separator to ".".
Special thanks to XeGregory and AndNotor. Their help has been decisif !
This piece of software if totally free of charge for anybody and any useage.
Their is no warranty nor garanty whatsoever.
Final notice:
The TFloatEdit component advantageously replaces TMaskEdit for the scope of its action.
At any position, entering a sign character (- or +) changes the sign without changing the cursor position.
At any position, a decimal separator removes an existing separator without changing the cursor position.
When no decimal separator is present, entering a decimal separator inserts it at the current position.
In any case, invalid characters are ignored, valid characters in invalid positions are ignored.
Author: Klaus Fischer
Created: 06/10/2025
Language: Delphi 6 Personal Edition
Version: V1.1
Contact: fischer.klaus@orange.fr
Modification history:
Date Version Author Notes
-------------------------------------------------------------------------------------
06/10/2025 V1.0 Klaus Initial version
07/10/2025 V1.1 Klaus applying tip from AndNotor: separating methods and dubbling the constructor
replacing "get SelStart" by GetCurrentCharacterPos method
adding the Alignment property
(found at https://stackoverflow.com/questions/4455355/how-to-set-textalignment-in-tedit-control)
}
interface
uses
Windows, Messages, Controls, StdCtrls, Classes, SysUtils, StrUtils, Types, Dialogs;
type TGetCaretPos = function(var aPoint: TPoint): boolean; stdcall;
type TFloatEdit = class(TEdit)
private
fSigned: boolean; // flag "a +/- sign may be present"
fAlignment:TAlignment;
fKommaPresent: boolean; // internal flag: "a decimal point is present"
fSignPresent: boolean; // internal flag: "a sign is present"
fIntegerPart: integer; // maximum length of the integer part (including the optiional sign)
fFractionalPart: integer; // maximum length of the fractional part (excluding the decimal point)
fActualIntegerPart: integer; // internal variable: actual length of the integer part
fActualFractionalPart: integer; // internal variable: actual length of the fractional part
fWin32Handle: hwnd; // handle for dynamically loaded User32.dll
fGetCaretPos: TGetCaretPos; // loaded GetCaretPos function
procedure FloatEditKeyPress(Sender : TObject; var Key : Char);
procedure FloatEditCMExit(var Message: TCMExit); message CM_EXIT;
procedure SetAlignment(Value:TAlignment);
protected
procedure CreateParams(var Params:TCreateParams);override; // found at https://stackoverflow.com/questions/4455355/how-to-set-textalignment-in-tedit-control
public // contribution by AndNotor: separating public and published methods
constructor Create(aOwner: TComponent); override;
constructor CreateNew(aSig: boolean; aInt, aFract: integer);
destructor Destroy; override;
procedure SetValue(const aValue: string); // DO NOT USE DIRECTLY THE TEXT PROPERTY !
function GetCurrentCharacterPos: integer;
procedure SetCurrentCharacterPos(p: integer);
published
property Signed: boolean read fSigned write fSigned;
property IntegerPart: integer read fIntegerPart write fIntegerPart;
property FractionalPart: integer read fFractionalPart write fFractionalPart;
property Alignment:TAlignment read FAlignment write SetAlignment default taLeftJustify;
end;
implementation
// =============== TFloatEdit =================
// helper functions
function TFloatEdit.GetCurrentCharacterPos: integer;
var
pt: TPoint;
begin
fGetCaretPos(pt); // get the real caret position in client coordinates
result := SendMessage(Handle,EM_CHARFROMPOS,0,MAKELPARAM(pt.X,pt.Y)); // obtain the character position
end;
procedure TFloatEdit.SetCurrentCharacterPos(p: integer);
var
pt: TPoint;
begin
Selstart := p; // move the caret
end;
// creates the object initially defining some values
constructor TFloatEdit.Create(aOwner: TComponent); // contribution de AndNotor
begin
inherited;
fsigned := true;
fIntegerPart := 1;
fFractionalPart := 2;
fActualIntegerPart := 0;
fActualFractionalPart := 0;
fAlignment := taLeftJustify;
OnKeyPress := FloatEditKeyPress;
fWin32Handle := LoadLibrary('Win32.dll');
fGetCaretPos := GetProcAddress(fWin32Handle,'GetCaretPos');
end;
// creates the object initially defining some values
constructor TFloatEdit.CreateNew(aSig: boolean; aInt, aFract: integer);
begin
Create(nil);
fsigned := aSig;
if aInt<1 then aInt := 1;
fIntegerPart := aInt;
if aFract<0 then aFract := 0;
fFractionalPart := aFract;
fActualIntegerPart := 0;
fActualFractionalPart := 0;
fAlignment := taLeftJustify;
OnKeyPress := FloatEditKeyPress;
fWin32Handle := LoadLibrary('User32.dll');
fGetCaretPos := GetProcAddress(fWin32Handle,'GetCaretPos');
end;
// properly remove the object
destructor TFloatEdit.Destroy;
begin
OnKeyPress := nil; // inactivate the KeyPress event
FreeLibrary(fWin32Handle); // unload User32.dll
inherited;
end;
// method to replace the TEXT property which MUST NOT be used !
procedure TFloatEdit.SetValue(const aValue: string);
var
s: string;
p, ni, nf: integer;
begin
{ s'assurer que le contrôle est valide avant d'écrire dans Text }
if csDestroying in ComponentState then Exit; // contribution from XeGregory
s := aValue; // get the new value
s := StringReplace(s,',','.',[rfReplaceAll]); // force "." as decimal point
p := Pos('.', aValue); // search for a decimal point
fKommaPresent := Pos('.', aValue) > 0; // remember if a decimal point is present
fSignPresent := (Pos('+', aValue) > 0) or (Pos('-', aValue) > 0); // remember if a sign is present
if fSignPresent and not Signed then exit; // abort if sign present and not allowed
if fKommaPresent then begin // check if sign present
ni := p - 1; // yes: determine the size of both parts
nf := Length(s) - p;
end else begin
ni := Length(s); // no: determine the size of sole integer part
nf := 0;
end;
if (ni>fIntegerPart) or (nf>fFractionalPart) then exit; // abort if size limits are exceeded
Text := s; // set the new text into the FloatEdit
end;
// event called at each key pressed while FloatEdit has focus
procedure TFloatEdit.FloatEditKeyPress(Sender : TObject; var Key : Char);
var
s: string;
p, p1, ni, nf, cp: integer;
KP, SP: boolean;
begin
if not (Key in ['0'..'9','.',',','+','-',#8]) then begin // filter the allowed character set
Key := #0;
exit;
end;
s := Text; // get the actual content of the control
cp := GetCurrentCharacterPos + 1; // get the actual character position
// decimal separator key
if (Key=',') or (Key='.') then begin // a decimal separator was entered ?
if fFractionalPart=0 then begin // no fractional part allowed ?
Key := #0;
end else begin // here, fractional part is allowed
if fKommaPresent then begin // have we actually a decimal separator ?
p := pos('.',s); // find it
if cp>=p then cp := cp - 1; // anticipate the deletion
s := StringReplace(s,'.','',[rfReplaceAll]); // remove it
Text := s; // set the new text value
SetCurrentCharacterPos(cp); // restore the cursor position
Key := #0; // Key is fully handled
fKommaPresent := false; // remember "no decimal point present"
end else begin // here, no decimal point was present
p := cp; // get the actual cursor position
if p<(Length(s)-fFractionalPart) then begin // to many potential fractional digits ?
Key := #0; // so abort this action !
exit;
end;
fKommaPresent := true; // so, remember it now
end; // and let Key action take place
end;
exit; // all done for decimal separator key
end;
// sign key
if (Key='-') or (Key='+') then begin // a sign key was entered ?
if fSignPresent then Delete(s,1,1) // if a sign was present, so remove it
else cp := cp + 1; // update the cursor position after insertion
s := Key + s; // add the new sign
Text := s; // update the text in the control
fSignPresent := true; // remeber the sign presence
SetCurrentCharacterPos(cp-1); // restore the cursor position
Key := #0; // Key is fully handled
exit; // all done for sign key
end;
// DEL key
if Key=#8 then begin // DEL key ?
if cp>0 then begin // if not at beginning:
cp := cp - 1;
Delete(s,cp,1); // remove the preceeding character
SetValue(s); // update the text AND all iinternal flags
SetCurrentCharacterPos(cp-1); // update the cursor position
end;
Key := #0; // all done for DEL key
exit;
end;
// here, handle all numeric characters
// recheck the internal markers
p := Pos('.', s); // check if decimal sepaator present
KP := p > 0; // build temporary decimal point flag
SP := (Pos('+', s) > 0) or (Pos('-', s) > 0); // build temporary sign flag
if KP then begin // is decimal separator present ?
ni := p - 1; // yes: determine length of both parts
nf := Length(s) - p;
end else begin
ni := Length(s); // no: determine length of sole fractional part
nf := 0;
end;
// now abort if position in integer part and max length achieved, same for fractional part
if ((cp<=ni) and (ni>=fIntegerPart)) or ((cp>ni) and (nf>=fFractionalPart)) then begin
Key := #0; // abort if maximum length achieved
exit;
end;
// nos add the new character
s := LeftStr(s,cp-1) + Key + MidStr(s,cp,Length(s)); // build the new string
SetValue(s); // replace the value updating internal markers
Key := #0; // character handling colpleted
SetCurrentCharacterPos(cp); // restore the cursor position
// here: all done for normal character
end;
procedure TFloatEdit.FloatEditCMExit(var Message: TCMExit); // contribution of XeGregory
begin
inherited;
{ reconstruire les flags après édition (utile après collage ou suppressions) }
fKommaPresent := (Pos('.', Text) > 0) or (Pos(',', Text) > 0);
fSignPresent := (Pos('+', Text) > 0) or (Pos('-', Text) > 0);
end;
// found at https://stackoverflow.com/questions/4455355/how-to-set-textalignment-in-tedit-control
procedure TFloatEdit.SetAlignment(Value:TAlignment);
begin
if FAlignment<>Value
then begin
FAlignment:=Value;
RecreateWnd;
end;
end;
procedure TFloatEdit.CreateParams(var Params:TCreateParams);
const
Alignments:array[TAlignment] of Cardinal=(ES_LEFT,ES_RIGHT,ES_CENTER);
begin
inherited CreateParams(Params);
Params.Style:=Params.Style or Alignments[FAlignment];
end;
end. |
Changer la propriété Text d'un TEdit dérivé provoque un crash !
Répondre avec citation
Partager