فارسي كردن Dialog ها در دلفي XE2

[rezamahdizadeh]

آيا كد فارسي كردن Dialog ها در دلفي XE2 كسي دارد؟

[BORHAN TEC]

سلام
به این صفحات مراجعه کنید:
http://delphi.about.com/od/objectpascalide/l/aa020502a.htm
http://www.delphipages.com/forum/showthread.php?t=100759
http://www.codeproject.com/Questions/536483/HookingplusMessageBoxplustopluschangeplusbuttonplu

بنده شخصاً راه حل آخر رو توصیه می کنم. در ضمن کدهای مربوطه رو برای راحتی کار به دلفی ترجمه کردم که برای استفاده از آن می توانید به صورت زیر عمل کنید:
ابتدا این توابع رو تعریف کنید:
function ChangeCaptions(nCode: Integer; aWPARAM: WPARAM; aLPARAM: lParam)
: LRESULT stdcall;
begin
if (nCode = HCBT_ACTIVATE) then
begin
SetWindowText(GetDlgItem(aWPARAM, IDOK), 'تایید');
SetWindowText(GetDlgItem(aWPARAM, IDCANCEL), 'انصراف');
SetWindowText(GetDlgItem(aWPARAM, IDYES), 'بلی');
SetWindowText(GetDlgItem(aWPARAM, IDNO), 'خیر');
end;
Result := 0;
end;

function addon_gui_messagebox(parentHWnd: THandle; aHINSTANCE: HINST;
title, text: PWideChar; aType: Integer): Integer;
var
ret: Integer;
hook: THandle;
begin
hook := SetWindowsHookEx(WH_CBT, ChangeCaptions, HINSTANCE,
GetCurrentThreadId());
ret := MessageBox(parentHWnd, text, title, aType);
UnhookWindowsHookEx(hook);
Result := ret;
end;

حال به صورت زیر می توانید از توابع بالا استفاده کنید:
procedure TForm4.Button1Click(Sender: TObject);
begin
addon_gui_messagebox(Handle, HINSTANCE, 'عنوان', 'متن پیام',
MB_YESNO or MB_ICONQUESTION or MB_RIGHT or MB_RTLREADING);
end;
توجه داشته باشید که در کد بالا اول باید عنوان رو وارد کنید و بعد متن پیام! نمیدونم که چرا این سایت اینها رو جابه جا نشون میده؟! :لبخندساده:
موفق باشید...

[esmit61]

من اینجوری استفاده میکنم:
function TfrmMSG.CustomMsg(const DlgCaption,Text:string;
MsgType:TMsgDlgType; Buttons:TMsgDlgButtons):integer;
var

MsgBox : TForm;
i : byte;
// PicWidth : integer;
begin
MsgBox := CreateMessageDialog(Text,MsgType,Buttons);
try
with (MsgBox.Controls[1] as Tlabel) do
begin
Font.Name := 'Tahoma';
Font.Style := Font.Style ;//+ [fsBOLD];
Font.Size := 8;
WordWrap := False;
end;
with MsgBox do
begin
BiDiMode := bdRightToLeft;
Font.Name := 'Tahoma';
Font.Size := 8;
Caption := DlgCaption;
// Width := (Controls[0] as TImage).Width +(Controls[1] as Tlabel).Width + 100;
end;
//تغییر کپشنها
for i := 0 to MsgBox.ControlCount-1 do
if (MsgBox.Controls[i] is TButton) then
with (MsgBox.Controls[i] as TButton) do
begin
if (UpperCase(Caption) = '&OK') then Caption := 'ÊÇííÏ'
else if (UpperCase(Caption) = '&YES') then Caption := 'Èáå'
else if (UpperCase(Caption) = '&NO') then begin Caption := '뒄'; Default:= True; end
else if (UpperCase(Caption) = 'CANCEL') then Caption := 'ÇäÕÑÇÝ'
else if (UpperCase(Caption) = '&ABORT') then Caption := 'áÛæ'
else if (UpperCase(Caption) = '&RETRY') then Caption := 'ÏæÈÇÑå'
else if (UpperCase(Caption) = '&IGNORE') then Caption := 'ÑÏ'
else if (UpperCase(Caption) = '&ALL') then Caption := 'åãå'
else if (UpperCase(Caption) = 'N&O TO ALL') then Caption := 'ÎíÑ Èå åãå'
else if (UpperCase(Caption) = 'YES TO &ALL') then Caption := 'Èáí Èå åãå'
else Caption := 'ÊÇííÏ';
end; {with}
case MsgType of
mtWarning :MessageBeep(MB_ICONWARNING);
mtError :MessageBeep(MB_ICONERROR);
mtInformation :MessageBeep(MB_ICONINFORMATION);
mtConfirmation:MessageBeep(MB_ICONINFORMATION);
end;
Result := MsgBox.ShowModal;
finally
MsgBox.Free;
end; {try}

[rezamahdizadeh]

من اینجوری استفاده میکنم:
function TfrmMSG.CustomMsg(const DlgCaption,Text:string;
MsgType:TMsgDlgType; Buttons:TMsgDlgButtons):integer;
var

MsgBox : TForm;
i : byte;
// PicWidth : integer;
begin
MsgBox := CreateMessageDialog(Text,MsgType,Buttons);
try
with (MsgBox.Controls[1] as Tlabel) do
begin
Font.Name := 'Tahoma';
Font.Style := Font.Style ;//+ [fsBOLD];
Font.Size := 8;
WordWrap := False;
end;
with MsgBox do
begin
BiDiMode := bdRightToLeft;
Font.Name := 'Tahoma';
Font.Size := 8;
Caption := DlgCaption;
// Width := (Controls[0] as TImage).Width +(Controls[1] as Tlabel).Width + 100;
end;
//تغییر کپشنها
for i := 0 to MsgBox.ControlCount-1 do
if (MsgBox.Controls[i] is TButton) then
with (MsgBox.Controls[i] as TButton) do
begin
if (UpperCase(Caption) = '&OK') then Caption := 'ÊÇííÏ'
else if (UpperCase(Caption) = '&YES') then Caption := 'Èáå'
else if (UpperCase(Caption) = '&NO') then begin Caption := '뒄'; Default:= True; end
else if (UpperCase(Caption) = 'CANCEL') then Caption := 'ÇäÕÑÇÝ'
else if (UpperCase(Caption) = '&ABORT') then Caption := 'áÛæ'
else if (UpperCase(Caption) = '&RETRY') then Caption := 'ÏæÈÇÑå'
else if (UpperCase(Caption) = '&IGNORE') then Caption := 'ÑÏ'
else if (UpperCase(Caption) = '&ALL') then Caption := 'åãå'
else if (UpperCase(Caption) = 'N&O TO ALL') then Caption := 'ÎíÑ Èå åãå'
else if (UpperCase(Caption) = 'YES TO &ALL') then Caption := 'Èáí Èå åãå'
else Caption := 'ÊÇííÏ';
end; {with}
case MsgType of
mtWarning :MessageBeep(MB_ICONWARNING);
mtError :MessageBeep(MB_ICONERROR);
mtInformation :MessageBeep(MB_ICONINFORMATION);
mtConfirmation:MessageBeep(MB_ICONINFORMATION);
end;
Result := MsgBox.ShowModal;
finally
MsgBox.Free;
end; {try}


اشکال این کد اینه موقعیت لیبل و دکمه ها و آیکون راست به چپ نیست با وجود اینکه فرم راست به چپ مقداردهی شده است.

[hadisalahi2]

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