سلام
من یک 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 امتحان کردم ولی جواب نگرفتم.
پاسخ با نقل قول