unit PB.Vcl.FilteredEdit;
interface
uses
System.SysUtils, System.Classes,
Vcl.Controls,
Vcl.StdCtrls,
Winapi.Windows,
Winapi.Messages;
type
TPBAcceptCharEventHandler =
procedure (Sender: TComponent;
const aChar: Char;
var Accept: boolean)
of object;
TPBDefaultFilter = (dfNone, dfCustom, dfHexDigits, dfDecimalDigits, dfOctalDigits);
TPBCustomFilteredEdit =
class(TCustomEdit)
strict private
FCustomFilter: TSysCharset;
FDefaultFilter: TPBDefaultFilter;
FOnAcceptChar: TPBAcceptCharEventHandler;
FOvertypeMode: boolean;
FPasteReplacesAll: boolean;
strict protected
function CharIsAcceptable(
const aChar: Char): boolean;
virtual;
function ClipboardContentIsAcceptable: boolean;
procedure SetCustomFilter(
const Value: TSysCharset);
protected
procedure KeyDown(
var Key: Word; Shift: TShiftState);
override;
procedure KeyPress(
var Key: Char);
override;
procedure WMCut(
var Message: TWMCut);
message WM_CUT;
procedure WMPaste(
var Message: TWMPaste);
message WM_PASTE;
public
constructor Create(aOwner: TComponent);
override;
property CustomFilter: TSysCharset
read FCustomFilter
write SetCustomFilter;
property DefaultFilter: TPBDefaultFilter
read FDefaultFilter
write
FDefaultFilter
default dfNone;
property OvertypeMode: boolean
read FOvertypeMode
write FOvertypeMode
default
true;
property PasteReplacesAll: boolean
read FPasteReplacesAll
write
FPasteReplacesAll
default true;
property OnAcceptChar: TPBAcceptCharEventHandler
read FOnAcceptChar
write
FOnAcceptChar;
end;
TPBFilteredEdit =
class(TPBCustomFilteredEdit)
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BevelEdges;
property BevelInner;
property BevelKind
default bkNone;
property BevelOuter;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DefaultFilter;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property OvertypeMode;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property PasteReplacesAll;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property TextHint;
property Touch;
property Visible;
property StyleElements;
property OnAcceptChar;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGesture;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
uses Vcl.Clipbrd;
const
PredefinedFilters:
array [TPBDefaultFilter]
of TSysCharSet =
([],
// dfNone
[],
// dfCustom
['
0'..'
9','
A'..'
F','
a'..'
f'],
//dfHexDigits
['
0'..'
9'],
//dfDecimalDigits,
['
0'..'
7']
// dfOctalDigits
);
procedure Register;
begin
RegisterComponents('
Samples', [TPBFilteredEdit]);
end;
constructor TPBCustomFilteredEdit.Create(aOwner: TComponent);
begin
inherited;
// set defaults
MaxLength := 32;
FDefaultFilter := dfNone;
FCustomFilter := [];
FOvertypeMode := true;
FPasteReplacesAll := true;
end;
function TPBCustomFilteredEdit.CharIsAcceptable(
const aChar: Char): boolean;
begin
case DefaultFilter
of
dfNone : Result := true;
dfCustom: Result := CharInSet(aChar, FCustomFilter);
else
Result := CharInSet(aChar, PredefinedFilters[DefaultFilter]);
end;
{case}
if Assigned(FOnAcceptChar)
then
FOnAcceptChar(self, aChar, Result);
end;
function TPBCustomFilteredEdit.ClipboardContentIsAcceptable: boolean;
var
LLen: Integer;
LText:
string;
I: Integer;
begin
Result := Clipboard.HasFormat(CF_TEXT);
if Result
then begin
LText := Clipboard.AsText;
if PasteReplacesAll
then
LLen := LText.Length
else
LLen := LText.Length + GetTextLen - SelLength;
Result := LLen <= MaxLength;
if Result
then begin
for I := Low(LText)
to High(LText)
do
if not CharIsAcceptable(LText[I])
then begin
Result := false;
Break;
end;
{if}
end;
{if}
end;
{if}
end;
procedure TPBCustomFilteredEdit.KeyDown(
var Key: Word; Shift: TShiftState);
begin
// block delete and old-style clipboard keys to simplify the logic
if OvertypeMode
and (Key
in [VK_DELETE, VK_INSERT])
then
Key := 0;
inherited;
end;
procedure TPBCustomFilteredEdit.KeyPress(
var Key: Char);
begin
// Ctrl-A, Ctrl-C and Ctrl-V are the only acceptable control characters!
// We need those to support clipboard copy and paste and select all.
if (Key < #32)
and not CharInSet(Key, [^A, ^C, ^V])
then
if OvertypeMode
then
Key := #0
else
if Key <> ^H
then //allow backspace if insert mode
Key := #0;
if (Key >= #32)
and not CharIsAcceptable(Key)
then
Key := #0;
if (Key <> #0)
and OvertypeMode
then begin
// emulate overtype mode by selecting one character, but only if this
// is not a clipboard shortcut
if Key >= #32
then
SelLength := 1;
end;
{if}
inherited;
end;
procedure TPBCustomFilteredEdit.SetCustomFilter(
const Value: TSysCharset);
begin
FCustomFilter := Value;
if Value = []
then
FDefaultFilter := dfNone
else
FDefaultFilter := dfCustom;
end;
procedure TPBCustomFilteredEdit.WMCut(
var Message: TWMCut);
begin
// block cut to clipboard
Message.Result := 0;
end;
procedure TPBCustomFilteredEdit.WMPaste(
var Message: TWMPaste);
begin
if ClipboardContentIsAcceptable
then begin
if PasteReplacesAll
then
SelectAll;
inherited;
end;
end;
end.