Fórum Uma solução para imprimir com acento em matricial #365883
06/11/2008
0
boa tarde pessoal.
aqui vai uma função que eu mexi para imprimir com acento em matricial, não sei se esta 100¬, mas se alguém achar um erro e arrumar poste aqui.
function Acentos(Str: String): String;
const
ComAcento = ´àâêôûãõáéíóúçüÀÂÊÔÛÃÕÁÉÍÓÚÇÜ´;
SemAcento = ´aaeouaoaeioucuAAEOUAOAEIOUCU´;
Acento: Array[1..28] of Integer = (96, 94, 94, 94, 94, 126, 126, 180, 180, 180,
180, 180, 44, 168, 96, 94, 94, 94, 94, 126,
126, 180, 180, 180, 180, 180, 44, 168);
var
x: Integer;
a: String[1];
begin
For x := 1 to Length(Str) do
begin
If Pos(Str[x], ComAcento) <> 0 then
begin
a := Str[x];
Str[x] := SemAcento[Pos(Str[x], ComAcento)];
Insert(Chr(8), Str, x + 1);
If Pos(a, ComAcento) in [8..12, 22..26] then
Insert(´´´´, Str, x + 2)
Else
Insert(Chr(Acento[Pos(a, ComAcento)]), Str, x + 2);
end;
end;
Result := Str;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
F: TextFile;
begin
AssignFile(F, ´LPT1´);
Rewrite(F);
try
WriteLn(F, Acentos(´Este é um teste.´));
WriteLn(F, Acentos(´Acentuação.´));
WriteLn(F, Acentos(´Vovô.´));
WriteLn(F, Acentos(´Último.´));
finally
CloseFile(F);
end
end;
aqui vai uma função que eu mexi para imprimir com acento em matricial, não sei se esta 100¬, mas se alguém achar um erro e arrumar poste aqui.
function Acentos(Str: String): String;
const
ComAcento = ´àâêôûãõáéíóúçüÀÂÊÔÛÃÕÁÉÍÓÚÇÜ´;
SemAcento = ´aaeouaoaeioucuAAEOUAOAEIOUCU´;
Acento: Array[1..28] of Integer = (96, 94, 94, 94, 94, 126, 126, 180, 180, 180,
180, 180, 44, 168, 96, 94, 94, 94, 94, 126,
126, 180, 180, 180, 180, 180, 44, 168);
var
x: Integer;
a: String[1];
begin
For x := 1 to Length(Str) do
begin
If Pos(Str[x], ComAcento) <> 0 then
begin
a := Str[x];
Str[x] := SemAcento[Pos(Str[x], ComAcento)];
Insert(Chr(8), Str, x + 1);
If Pos(a, ComAcento) in [8..12, 22..26] then
Insert(´´´´, Str, x + 2)
Else
Insert(Chr(Acento[Pos(a, ComAcento)]), Str, x + 2);
end;
end;
Result := Str;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
F: TextFile;
begin
AssignFile(F, ´LPT1´);
Rewrite(F);
try
WriteLn(F, Acentos(´Este é um teste.´));
WriteLn(F, Acentos(´Acentuação.´));
WriteLn(F, Acentos(´Vovô.´));
WriteLn(F, Acentos(´Último.´));
finally
CloseFile(F);
end
end;
Leufmt
Curtir tópico
+ 0
Responder
Clique aqui para fazer login e interagir na Comunidade :)