تابع تبدیل رشته از فونت ویندوز به داس

[ashkan12345]

من توی همه سایت سرچ کردم.
اما یک تابع جامع که یک رشته رو بگیره و از فونت ویندوز به فونت داس (ایران سیستم)تبدیل کنه پیدا نکردم!

تابعی که خودم دارم مشکل داره (همه حروف رو به شکل حرف کامل می نویسه مثلا ح س ی ن به جای حسین)
کد دلفیشو میخام.
اگه با زبان دیگه هم باشه عیبی نداره . مجبورم تبدیلش کنم.

[mehdi_mohamadi]

سلام دوست عزیز
اگه توی لینکهای من جستجو کنی حتما" تابع را پیدا می کنی

[mehdi_mohamadi]

اینم لینک تابع

http://barnamenevis.org/forum/showthread.php?t=68303

موفق باشی

[ashkan12345]

اونجا شما این کد رو گذاشتین .
اما خیلی کدتون خطا داره!

اینا چین؟ 'Ç'



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;

[ashkan12345]

من میخام رشته فارسی رو به رشته تحت داس تبدیل کنم ها!

[mehdi_mohamadi]

من دارم از این تابع استفاده می کنم ولی هیچ خطایی نمی ده

[ir_programmer]

جناب مهندس محمدی.
به دوست من کمک کن کارش حل بشه.

[AlirezaBahredar]

من دارم از این تابع استفاده می کنم ولی هیچ خطایی نمی ده

اشکان درست میگه....
شما دارید توی Case تون از یک String استفاده میکنید(!!!) درصورتی که در دلفی 7 در Case فقط می تونی از Char استفاده کنی.به اصطلاح Case String در دلفی 7 نداریم.
حالا اینکه شما چجوری داری از این کد استفاده می کنی الله اعلم (!!!!!!!!!!!!!!!!!!!!!)

[arshia_]

حدس می زنم این مشکل از کپی کردن کد در سایت ایجاد شده
اونا رشته نیستند بلکه در این کد اونطوری نمایش داده می شه
اگر ممکنه فایل متن رو به صورت فشرده به این تاپیک ضمیمه کنید تا مشکلات حل بشه

[ashkan12345]

میشه فایل صحیح رو ضمیمه کنید. ممنون میشم.

[hossein taghi zadeh]

با سلام

لینک (http://barnamenevis.org/forum/showthread.php?t=77781)

[mehdi_mohamadi]

با سلام خدمت دوستان
این فایل را دوباره تست کردم و هیچ مشکلی نداشت
موفق باشید

[ashkan12345]

ممنونم. الهی خیر ببینین.