replace characters while typing (Views: 29)
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; |