replace characters while typing

Mirror

replace characters while typing (Views: 703)

Problem/Question/Abstract:

Replace chracters while typing

This code allows you to replaces umlauts (i.e. 'ä', 'ö', etc.) with 'ae', 'oe', etc. while typing.

Answer:

procedure TForm1.AppOnMessage(var Msg: TMsg; var Handled: Boolean);
type
TReplacement = record
chIn: Char;
chOut: string[2]
end;
TReplacements = array[0..6] of TReplacement;
const
Replacements: TReplacements = ((chIn: 'ä'; chOut: 'ae'),
(chIn: 'ö'; chOut: 'oe'),
(chIn: 'ü'; chOut: 'ue'),
(chIn: 'Ä'; chOut: 'Ae'),
(chIn: 'Ö'; chOut: 'Oe'),
(chIn: 'Ü'; chOut: 'Ue'),
(chIn: 'ß'; chOut: 'ss'));
var
i: Integer;
c: Char;
begin
Handled := False;
if Msg.Message = WM_CHAR then
begin
if Chr(Msg.wParam) in ['ä', 'ö', 'ü', 'Ä', 'Ö', 'Ü', 'ß'] then
begin
for i := Low(Replacements) to High(Replacements) do
if Chr(Msg.wParam) = Replacements[i].chIn then
begin
Msg.wParam := Ord(Replacements[i].chOut[1]);
with Longrec(Msg.lParam) do
Hi := (Hi and $FF00) or VKKeyScan(Replacements[i].chOut[2]);
PostMessage(Msg.hwnd, WM_CHAR, Ord(Replacements[i].chOut[2]),
Msg.wParam);
with Longrec(Msg.lParam) do
Hi := (Hi and $FF00) or VKKeyScan(Char(Msg.wParam));
Break;
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppOnMessage;
end;

<< Back to main page