PDA

View Full Version : سوال: آیا راهی هست که بدون اینکه فرم بالایی پایین فرم زیرش بره فوکوس رو به فرم زیرش منتقل کنه؟



mbshareat
سه شنبه 29 فروردین 1391, 00:42 صبح
سلام
من یک Hint ساده ساختم.فقط یه مشکل داره وقتی نمایش داده میشه فرم زیر Hint غیر فعال میشه.
اگه ممکنه این کد رو ببینین (البته لازم نیست تو جزئیات ترسیم خورد بشین!):









unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
THintTimer = class(TTimer)
private
procedure HintTime(Sender: TObject);
end;

var
Form1: TForm1;
HintForm:TForm;
HintVisible:Boolean;
HintObjHandle:THandle;
implementation

{$R *.dfm}

procedure ShowMyHint(AHint:String);
Var
Tim:THintTimer;
ActiveWnd:THandle;
Img:TImage;
begin
ActiveWnd:=GetForeGroundWindow;
If HintVisible=true Then
Begin
HintForm.Left:=Mouse.CursorPos.X+15;
HintForm.Top:=Mouse.CursorPos.Y+5;
Exit;
End;
HintObjHandle:=
WindowFromPoint(Mouse.CursorPos);
HintForm := TForm.Create(Application);
With HintForm Do
Begin
BorderStyle:=bsNone;
TransparentColorValue:=clFuchsia;
TransparentColor:=True;
Left:=Mouse.CursorPos.X+15;
Top:=Mouse.CursorPos.Y+5;
Canvas.Font.Name:='Tahoma';
Canvas.Font.Size:=12;
Width:=Canvas.TextWidth(AHint)+15;
Height:=30;
End;
Img:=TImage.Create(HintForm);
With Img Do
Begin
Parent:=HintForm;
Picture.Bitmap.Width:=HintForm.Width;
Picture.Bitmap.Height:=HintForm.Height;
Picture.Bitmap.Canvas.Pen.Color:=clRed;
Picture.Bitmap.Canvas.Brush.Color:=clFuchsia;
Canvas.Rectangle
(-1,-1,HintForm.Width+1,HintForm.Height+1);
Picture.Bitmap.Canvas.Brush.Color:=clred;
Canvas.RoundRect
(0,0,HintForm.Width,HintForm.Height,9,9);
Picture.Bitmap.Canvas.Brush.Color:=clWhite;
Canvas.RoundRect
(1,1,HintForm.Width-1,HintForm.Height-1,9,9);
Canvas.Font:=HintForm.Canvas.Font;
Canvas.Font.Color:=clBlue;
Canvas.TextOut(5,5,AHint);
End;
Tim:=THintTimer.Create(HintForm);
With Tim Do
Begin
OnTimer:=Tim.HintTime;
Interval:=100;
End;
HintForm.FormStyle:=fsStayOnTop;
// SetForeGroundWindow(HintForm.Handle);
HintForm.Show;
HintVisible:=True;
end;

{ THintTimer }

procedure THintTimer.HintTime(Sender: TObject);
begin
If (HintVisible=True)
And (WindowFromPoint(Mouse.CursorPos)
<>HintObjHandle) Then
Begin
HintVisible:=False;
FreeAndNil(HintForm);
End;
end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
ShowMyHint('Test');
end;

end.
چطور می تونم فرمی که دکمه داره رو فعال کنم بدون اینکه Hint بره زیر فرم؟:اشتباه:
من انواع Message و پروسیجر مربوط به فوکوس پنجره رو در مورد ActiveWnd امتحان کردم ولی جواب نگرفتم.:افسرده:

mbshareat
سه شنبه 29 فروردین 1391, 09:56 صبح
سلام
کد بالون رو توی سایت گذاشته بودند. بهش ور رفتم گذاشتم تو برنامه مشکل حل شد.
به جای
HintForm.Show;
باید این کد رو گذاشت:
SetWindowPos(HintForm.Handle, HWND_TOP, 0, 0, 0, 0,
SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);