Of course this does not work, since OnKeyPress does exactly as the event
name indicates: it handles the pressing of a key. If you want to filter data
pasted to the control, you must override its handling of the WM_PASTE
message, which involves either deriving a new component, or subclassing the
edit control's window.
And there are more messages that must be changed: WM_SETTEXT and
EM_REPLACESEL.
Example: This is TFilteredEdit, which implements the DisallowedCharacters
property, a string that contains all characters not allowed in the control.
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Clipbrd;
type
TEmReplaceSel = packed record
Msg: Cardinal;
fCanUndo: BOOL;
lpszReplace: PChar;
Result: Longint;
end;
TFilteredEdit = class(TEdit)
private
FDisallowedCharacters: string;
function FilterText(const Text: string): string;
procedure SetDisallowedCharacters(const Value: string);
procedure WmPaste(var Msg: TMessage); message WM_PASTE;
procedure EmReplaceSel(var Msg: TEmReplaceSel); message EM_REPLACESEL;
procedure WmSetText(var Msg: TWmSetText); message WM_SETTEXT;
protected
procedure KeyPress(var Key: Char); override;
published
property DisallowedCharacters: string
read FDisallowedCharacters write SetDisallowedCharacters;
end;
{ TFilteredEdit }
procedure TFilteredEdit.EmReplaceSel(var Msg: TEmReplaceSel);
var
FilteredText: string;
begin
FilteredText := FilterText(Msg.lpszReplace);
Msg.lpszReplace := Pchar(FilteredText);
inherited;
end;
function TFilteredEdit.FilterText(const Text: string): string;
var
L, I, J: Integer;
begin
L := Length(Text);
SetLength(Result, L);
J := 0;
for I := 1 to L do
if Pos(Text[I], FDisallowedCharacters) = 0 then
begin
Inc(J);
Result[J] := Text[I];
end;
SetLength(Result, J);
end;
procedure TFilteredEdit.KeyPress(var Key: Char);
begin
if Pos(Key, FDisallowedCharacters) > 0 then
Key := #0;
inherited;
end;
procedure TFilteredEdit.SetDisallowedCharacters(const Value: string);
var
OldText, NewText: string;
begin
if Value <> FDisallowedCharacters then
begin
FDisallowedCharacters := Value;
OldText := Text;
NewText := FilterText(OldText);
if NewText <> OldText then
Text := NewText;
end;
end;
procedure TFilteredEdit.WmPaste(var Msg: TMessage);
begin
Text := FilterText(Clipboard.AsText);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
with TFilteredEdit.Create(Self) do
try
Name := 'ED';
Parent := Self;
Left := 40;
Top := 40;
except
Free;
raise;
end;
ED.DisallowedCharacters := '^';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ED.Text := Edit1.Text;
end;
procedure TFilteredEdit.WmSetText(var Msg: TWmSetText);
var
NewText: string;
begin
if Msg.Text^ <> #0 then
begin
NewText := FilterText(Msg.Text);
Msg.Text := PChar(NewText);
end;
inherited;
end;
Peter Laman
Senior Software Engineer
Lance ICT Group
Roermond, the Netherlands
http://www.lance-safety.com
-
"Nobody ever died of hard work", they say. But why take the risk? (Ronald
Reagan)
__________________________________________________
Delphi-Talk mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi-talk
