replace characters while typing

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;