اونجا شما این کد رو گذاشتین .
اما خیلی کدتون خطا داره!
اینا چین؟ 'Ç'
function WinToDosStr(WinStr:string):string;
var Nflag :boolean;
Ch : Char;
T,N,M,I,J,DosI :integer;
TmpStr,Str1,Str2 :String;
DosSt :String;
begin
DosSt:='';
// M:=length(WinStr);
// for I:=1 to M do
// if ord(winstr[i])=157 then
// WinStr[i]:=' ';
WinStr:=WinStr+' ';
M:=length(WinStr);
for I:=1 to M do
DosSt:=DosSt + #32;
DosI:=M;
Str1:='';
for I:=1 To M do
begin
Nflag:=False;
case WinStr[i] Of
' ' :Begin
Ch:=#32;
end;
'.','0' .. '9'
: begin
Ch:=chr(ord(WinStr[i])+80);
if (WinStr[i])='.' then
ch:=#140;
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'a' .. 'z',
'A' .. 'Z'
: begin
Ch:=WinStr[i];
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'Â' :begin
ch:=#141;
end;
'Æ' :Begin
Ch:=#142;
end;
'Á' :Begin
Ch:=#143;
end;
'Ç' :begin
Ch:=#145;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1 )
)
then
ch:=#144;
end;
'È' : begin
Ch:=#147;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#146;
end;
'�' : begin
Ch:=#149;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#148;
end;
'Ê' :begin
Ch:=#151;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#150;
end;
'Ë' :begin
Ch:=#153;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#152
end;
'Ì' :begin
Ch:=#155;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#154
end;
'�' :begin
Ch:=#157;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#156;
end;
'Í' :begin
Ch:=#159;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#158;
end;
'Î' :begin
Ch:=#161;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#160;
end;
'Ï' :begin
Ch:=#162;
end;
'Ð' :begin
Ch:=#163;
end;
'Ñ' :begin
Ch:=#164;
end;
'Ò' :begin
Ch:=#165;
end;
'Ž' :begin
Ch:=#166;
end;
'Ó' :begin
Ch:=#168;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#167;
end;
'Ô' :begin
Ch:=#170;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#169;
end;
'Õ' :begin
Ch:=#172;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#171;
end;
'Ö' :begin
Ch:=#174;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#173;
end;
'Ø' :begin
ch:=#175 ;
end;
'Ù' :begin
ch:=#224
end;
'Ú' :begin
Ch:=#227;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1) )
then
ch:=#228;
if ((WinStr[i+1]=' ') or (i=M)) then
if (ch=#228) then
ch:=#225
else
ch:=#226;
end;
'Û' :begin
Ch:=#231;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1) )
then
ch:=#232;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
if (ch=#232) then
ch:=#229
else
ch:=#230;
end;
'Ý' :begin
Ch:=#234;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#233;
end;
'Þ' :begin
Ch:=#236;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#235;
end;
'ß' :begin
Ch:=#238;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#237;
end;
'�' :begin
Ch:=#240;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#239 ;
end;
'á' :begin
Ch:=#243;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#241;
end;
'ã' :begin
Ch:=#245;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ') or (WinStr[i+1]='Â')) then
ch:=#244;
end;
'ä' :begin
Ch:=#247;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#246;
end;
'æ' :begin
ch:=#248 ;
end;
'å' :begin
Ch:=#250;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1 ))
then
ch:=#251;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#249;
end;
'í' :begin
Ch:=#254;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#252;
if (ord(WinStr[i])=236)then
Ch:=#254;
end;
'Ü' :begin
ch:=#139 ;
end;
else
ch:=WinStr[i];
end;
if (Nflag=false) and(ch<>#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;
if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=Ch; Dec(DosI);
end;
str1:='';
end;
end;
if (Nflag=True) and(ch=#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;
end;
WinToDosStr:=copy(DosSt,2,length(DosSt));
end;
تابع تبدیل رشته از فونت ویندوز به داس
نوشته شده توسط mehdi_mohamadi
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول