|
|
|
Odstranění diakritiky
|
04.12.2009
|
Úvod
Funkce nahradí vybrané znaky za písmena bez diakritiky. Další znaky se dají jednoduše doplňovat. Jde také použít pro jíné výměny znaků.
Prvky
Button1
Memo1 (Lines: žluťoučký kůň)
Kód
function BezDiakritiky(Str: string): string;
var i: Integer;
begin
for i := 1 to Length(Str) do
begin
case Str[i] of
'ě': Result := Result + 'e';
'š': Result := Result + 's';
'č': Result := Result + 'c';
'ř': Result := Result + 'r';
'ž': Result := Result + 'z';
'ý': Result := Result + 'y';
'á': Result := Result + 'a';
'í': Result := Result + 'i';
'é': Result := Result + 'e';
'ů': Result := Result + 'u';
'ú': Result := Result + 'u';
'ť': Result := Result + 't';
'ň': Result := Result + 'n';
else Result := Result + Str[i];
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text:=BezDiakritiky(Memo1.Text);
end;
|
|
|