unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1 : TButton;
Button2 : TButton;
Button3 : TButton;
Edit1 : TEdit;
Edit2 : TEdit;
procedure Button1Click(Sender : TObject);
procedure Button2Click(Sender : TObject);
procedure Button3Click(Sender : TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1 : TForm1;
implementation
uses lazutf8;
{$R *.lfm}
{ TForm1 }
function RemoveAccent(Str: String): String;
const
WithAccents = 'àâêôûãõáéíóúçüÀÃÂÊÔÛÕÁÉÍÓÚÇÜ';
NoAccent = 'aaeouaoaeioucuAAAEOUOAEIOUCU';
var
x: Integer;
begin
for x := 1 to Length(Str) do
if Pos(Str[x],WithAccents) <> 0 then
Str[x] := NoAccent[Pos(Str[x], WithAccents)];
Result := Str;
end;
function RemoveDiacritics(S :utf8string):utf8string;
// It should work for several languages
// Portuguese, Spanish and Italian, maybe for French, German and more
const
AccentedChars :array[0..53] of utf8string = ('á','à','ã','â','ä','é','è','ê','ë','í','ì','ï','î','ó','ò','õ','ô','ö','ø','ú','ù','ü','û','ç','ñ','ÿ','ý',
'Á','À','Ã','Â','Ä','É','È','Ê','Ë','Í','Ì','Ï','Î','Ó','Ò','Õ','Ô','Ö','Ø','Ú','Ù','Ü','Û','Ç','Ñ','Y','Ý');
NormalChars :array[0..53] of utf8string = ('a','a','a','a','a','e','e','e','e','i','i','i','i','o','o','o','o','oe','o','u','u','u','u','c','n','y','y',
'A','A','A','A','A','E','E','E','E','I','I','I','I','O','O','O','O','OE','O','U','U','U','U','C','N','Y','Y');
var
i, j :integer;
begin
Result := S;
for i := 0 to High(AccentedChars) do
Result := StringReplace(Result, AccentedChars[i], NormalChars[i], [rfReplaceAll]);
end;
function RemoveAcento(Str: String): String;
const
ComAcento = 'àâêôûãõáéíóúçüÀÃÂÊÔÛÕÁÉÍÓÚÇÜ';
SemAcento = 'aaeouaoaeioucuAAAEOUOAEIOUCU';
var
x: Integer;
begin
for x := 1 to UTF8Length(utf8string(Str)) do
if UTF8Pos(utf8string(Str[x]),utf8string(ComAcento)) <> 0 then
Str[x] := SemAcento[UTF8Pos(utf8string(Str[x]), utf8string(ComAcento))];
Result := Str;
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
Edit2.Text := RemoveDiacritics(Edit1.Text);
end;
procedure TForm1.Button2Click(Sender : TObject);
begin
Edit2.Text := RemoveAcento(Edit1.Text);
end;
procedure TForm1.Button3Click(Sender : TObject);
begin
Edit2.Text := RemoveAccent(Edit1.Text);
end;
end.
object Form1: TForm1
Left = 234
Height = 237
Top = 194
Width = 320
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Remove Accent'
ClientHeight = 237
ClientWidth = 320
Position = poScreenCenter
LCLVersion = '0.9.31'
object Button1: TButton
Cursor = crHandPoint
Left = 64
Height = 25
Top = 120
Width = 180
Caption = 'Remove 1 (typo)'
OnClick = Button1Click
TabOrder = 0
end
object Edit1: TEdit
Left = 12
Height = 27
Top = 20
Width = 284
TabOrder = 1
Text = 'JAPÃO.pdf'
end
object Edit2: TEdit
Left = 12
Height = 27
Top = 64
Width = 284
TabOrder = 2
end
object Button2: TButton
Cursor = crHandPoint
Left = 64
Height = 25
Top = 160
Width = 180
Caption = 'Remove 2 (meulinux)'
OnClick = Button2Click
TabOrder = 3
end
object Button3: TButton
Cursor = crHandPoint
Left = 64
Height = 25
Top = 200
Width = 180
Caption = 'Remove 3 (original)'
OnClick = Button3Click
TabOrder = 4
end
end