نحوه تنظیم فونت پنجره دیگر توسط SendMessage؟

[mbshareat]

سلام
من دو روش رو برای تغییر فونت امتحان کردم درست جواب نداد.
یه برنامه ساختم که یه دکمه داره که می خوام قلمش رو به پنجره ای که زیر ماوس قرار داره انتساب بدم.
وقتی یک ادیت روی فرم می ذارم روی این ادیت درست کار می کنه ولی وقتی یه برنامه دیگه اجرا می کنم و می خوام فلمشو با برنامم توسط HotKey تغییر بدم فقط قلم رو عوض می کنه اما قلم رو مثل قلم دکمه فرم من نمی کنه!
لطفا کد برناممو ببینین:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
Procedure WMHotkey( Var msg: TWMHotkey ) ;message WM_HOTKEY;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotKey( Handle, 1, MOD_CONTROL, ord('Q'));
RegisterHotKey( Handle, 2, MOD_CONTROL, ord('W'));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnregisterHotKey(Handle, 1);
UnregisterHotKey(Handle, 2);
end;
procedure A();
Var
hFont :Integer;
hWnd:THandle;
Begin
hWnd := WindowFromPoint(Mouse.CursorPos) ;
hFont := CreateFont(-15, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'Courier');
if hFont <> 0 then
SendMessage(hWnd, WM_SETFONT, hFont, 1);
end;

Procedure TForm1.WMHotkey( Var msg: TWMHotkey ) ;
Var
hWnd:THandle;
Begin
hWnd := WindowFromPoint(Mouse.CursorPos) ;
If msg.hotkey = 1 Then
A;
If msg.hotkey = 2 Then
SendMessage(hWnd,WM_SETFONT,
Button1.Font.Handle,1);
End;
end.

[Felony]

برای اینکه فقط فونت مربوط به پنجره ای که هندلش رو دارید تغییر میدید ؛ WM_SetFont هندل یک کنترل رو میگیره و فونتش رو تغییر میده و کارش رو هم داره به درستی انجام میده ، شما توقع داری با کدی که نوشتی فونت تمام کنترل هایی که مالکشون فرم برنامه مورد نظرتون هست عوض بشه که اشتباه هست !

برای اینکه فونت تمام کنترل های موجود روی فرم رو عوض کنید باید از CallBack Function ها استفاده کنی و لیست کنترل های فرزند مربوط به فرم مورد نظرت رو در بیاری و فونت هر کدوم رو جداگانه تغییر بدی ؛ براتون یک نمونه کد نوشتم :

function EnumChildProc(hWnd: hWnd; lParam: lParam): Boolean; stdcall;
begin
SendMessage(hWnd, WM_SETFONT, lParam, 1);
result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
hFont: Integer;
hWnd: THandle;
Begin
hWnd := WindowFromPoint(Mouse.CursorPos);
hFont := CreateFont(-15, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or
FF_DONTCARE, 'Courier');
if hFont <> 0 then
EnumChildWindows('Program handle here', @EnumChildProc, hFont);
end;

[mbshareat]

سلام جناب تاجیک
توقع نداشتم یکی نصف شب جواب بده.
ببخشید من نمی دونم به جای پنجره باید چی بگم منظورم همون چیزیه که هندلش رو به SendMessage پاس می دیم. چه فرم باشه چه دکمه چه ادیت.
کد شما آموزنده بود. اما مشکل من اینه که من می خوام قلم Courier برای کنترل زیر ماوس ملحوظ بشه اما می بینم قلم کنترل زیر ماوس چیزی مثل MS Sans Serif با استایل Bold میشه.
یعنی اگه ماوس روی ادیت داخل برنامم باشه همون Courier میشه ولی اگه یه دکمه تو برنامه دیگه باشه MS Sans Serif میشه و تو یک برنامه دیگه هم که حتما کامپوننت سفارشی داره اصلا تاثیری نداره!
یه سوال هم در مورد کد شما داشتم. من وقتی form1.Handle رو به جای 'Program handle here' میذارم قلم همه کامپوننتهای فرم رو Courier می کنه اما وقتی هندل کنترل زیر ماوس رو بهش می دم حتی اگه هندل فرم باشه تاثیری نداره! اگه ممکنه کد رو جوری تغییر بدین که با hWnd کار کنه . اصراری ندارم همه کنترلهای فرمی رو یکجا تغییر فونت بدم و اگه فقط کنترل زیر ماوس هم فونتش تغییر کنه خوبه.

[mbshareat]

سلام
آقا من هنوز کنجکاوم کسی جواب نمیده؟
این کد خیلی کوچولو رو امتحان کنین:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
Procedure WMHotkey( Var msg: TWMHotkey ) ;message WM_HOTKEY;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotKey( Handle, 1, MOD_CONTROL, ord('Q'));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnregisterHotKey(Handle, 1);
end;
Procedure TForm1.WMHotkey( Var msg: TWMHotkey ) ;
Var
hWnd:THandle;
hFont: Integer;
Begin
hWnd := WindowFromPoint(Mouse.CursorPos) ;
If msg.hotkey = 1 Then
Begin
hFont:=CreateFont (14, 0, 0, 0, FW_DONTCARE, 0,0,0, ANSI_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH Or FF_SWISS, 'Arial');
SendMessage(hWnd, WM_SETFONT, hFont, 1);
End;
End;
end.
با این کد وقتی ماوس روی کنترلی باشد بت فشار Ctrl+Q باید قلم کنترل Arial بشه.
در فرمی که کدش بالا اومده یک دکمه و یک ادیت داریم و کد باعث میشه قلم همون Arial بشه.
اما اگه یه فرم خالی با یه دکمه درست کنین و برنامه بالا هم در پس زمینه در حال اجرا باشه وقتی ماوس روی دکمه فرم جدید باشه با فشار Ctrl+Q قلم MS Sans Serif میشه اینگار DeleteObject(hFont); هم اجرا کرده باشیم!
چطور می تونم قلم Arial رو برای هر کنترلی که زیر ماوس باشه منظور کنم؟