Falcon13
asked on
Hint/Tooltip display for TRect drawn on TitleBar
Hi,
I created a TRect on Forms TitleBar (and used DrawButtonFace on it and works like a button) and wish
to add hint/tooltip to it.
So far I only found examples which can add hints/tooltip to controls with handles! this Trect is not
a control so is it possible to add tooltip to it? if so how?
Thanks in advance,
P.S. Only answers with fully working source is accepted.
I created a TRect on Forms TitleBar (and used DrawButtonFace on it and works like a button) and wish
to add hint/tooltip to it.
So far I only found examples which can add hints/tooltip to controls with handles! this Trect is not
a control so is it possible to add tooltip to it? if so how?
Thanks in advance,
P.S. Only answers with fully working source is accepted.
ASKER
Hi Slick812,
This code above seems to crash for some reason I couldn't locate. After crashing 2 times in IDE, when run without IDE it gives GPF!
I also noticed
KillTimer(Form1.Handle,1);
is called twice in mousemove event.
Please tell me if you can locate the bug :)
This code above seems to crash for some reason I couldn't locate. After crashing 2 times in IDE, when run without IDE it gives GPF!
I also noticed
KillTimer(Form1.Handle,1);
is called twice in mousemove event.
Please tell me if you can locate the bug :)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Had a detour that gave me some time to mess with the hint thing here is some new code, drop a TApplicationEvents on your form from the Additional tab go to the object inspector for ApplicationEvents1 and double click it's OnMessage Event
procedure TForm1.FormCreate(Sender: TObject);
begin
HintW1 := THintWindow.Create(Form1);
HintW1.Color := clInfoBk;
end;
procedure wTimerProc(Wnd: HWnd; Mesg, TimerID, SysTime: Longint); stdcall;
var
HintStr: String;
MousePt: TPoint;
RectCB: TRect;
begin
if TimerID = 1 then
begin
KillTimer(Form1.Handle,1);
GetCursorPos(MousePt);
GetWindowRect(Form1.Handle , RectCB);
RectCB := Rect(RectCB.Right-92,6+Rec tCB.Top,Re ctCB.Right -70,21+Rec tCB.Top);
if PtInRect(RectCB,MousePt) then
begin
HintStr := 'This is the OK button';
HintW1.ActivateHint(Rect(M ousePt.x + 20, MousePt.y + 20,
MousePt.x + HintW1.Canvas.TextWidth(Hi ntStr) + 29,
MousePt.y + HintW1.Canvas.TextHeight(H intStr) + 20), HintStr);
SetTimer(Form1.Handle,2,50 ,@wTimerPr oc);
end;
end else
if TimerID = 2 then
begin
KillTimer(Form1.Handle,2);
Show1 := True;
end else
if TimerID = 3 then
begin
KillTimer(Form1.Handle,3);
DoHint := True;
end;
end;
procedure TForm1.WMNcPaint(var Message: TMessage);
var
RectCB: TRect;
NcDC: HDC;
begin
inherited ;
RectCB := Rect(Width-92,6,Width-70,2 1);
NcDC := GetWindowDC(Form1.Handle);
DrawFrameControl(NcDC,Rect CB,DFC_BUT TON,DFCS_B UTTONPUSH) ;
SetBkMode(NcDC,TRANSPARENT );
TextOut(NcDC,Width-89,5,'o k',2);
ReleaseDC(Form1.Handle, NcDC);
end ;
procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
Pt1: TPoint;
RectCB: TRect;
begin
inherited;
if Message.wParam = HTCAPTION then
begin
GetWindowRect(Form1.Handle , RectCB);
RectCB := Rect(RectCB.Right-92,6+Rec tCB.Top,Re ctCB.Right -70,21+Rec tCB.Top);
Pt1.x := LOWORD(Message.lParam);
Pt1.y := HIWORD(Message.lParam);
if PtInRect(RectCB,Pt1) then
begin
if not Show1 and DoHint then
hHintTimer := SetTimer(Form1.Handle,1,30 0,@wTimerP roc);
Exit;
end else
KillTimer(Form1.Handle,1);
end;
KillTimer(Form1.Handle,1);
Message.Result := 1;
end;
procedure TForm1.ApplicationEvents1M essage(var Msg: tagMSG;
var Handled: Boolean);
begin
if Show1 then
begin
if HintW1.IsHintMsg(Msg) then
begin
HintW1.ReleaseHandle;
Show1 := False;
DoHint := False;
SetTimer(Form1.Handle,3,15 0,@wTimerP roc);
end;
end;
end;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
the HintW1.IsHintMsg(Msg) in the ApplicationEvents1Message is alot better fo making the hint window go away
procedure TForm1.FormCreate(Sender: TObject);
begin
HintW1 := THintWindow.Create(Form1);
HintW1.Color := clInfoBk;
end;
procedure wTimerProc(Wnd: HWnd; Mesg, TimerID, SysTime: Longint); stdcall;
var
HintStr: String;
MousePt: TPoint;
RectCB: TRect;
begin
if TimerID = 1 then
begin
KillTimer(Form1.Handle,1);
GetCursorPos(MousePt);
GetWindowRect(Form1.Handle
RectCB := Rect(RectCB.Right-92,6+Rec
if PtInRect(RectCB,MousePt) then
begin
HintStr := 'This is the OK button';
HintW1.ActivateHint(Rect(M
MousePt.x + HintW1.Canvas.TextWidth(Hi
MousePt.y + HintW1.Canvas.TextHeight(H
SetTimer(Form1.Handle,2,50
end;
end else
if TimerID = 2 then
begin
KillTimer(Form1.Handle,2);
Show1 := True;
end else
if TimerID = 3 then
begin
KillTimer(Form1.Handle,3);
DoHint := True;
end;
end;
procedure TForm1.WMNcPaint(var Message: TMessage);
var
RectCB: TRect;
NcDC: HDC;
begin
inherited ;
RectCB := Rect(Width-92,6,Width-70,2
NcDC := GetWindowDC(Form1.Handle);
DrawFrameControl(NcDC,Rect
SetBkMode(NcDC,TRANSPARENT
TextOut(NcDC,Width-89,5,'o
ReleaseDC(Form1.Handle, NcDC);
end ;
procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
Pt1: TPoint;
RectCB: TRect;
begin
inherited;
if Message.wParam = HTCAPTION then
begin
GetWindowRect(Form1.Handle
RectCB := Rect(RectCB.Right-92,6+Rec
Pt1.x := LOWORD(Message.lParam);
Pt1.y := HIWORD(Message.lParam);
if PtInRect(RectCB,Pt1) then
begin
if not Show1 and DoHint then
hHintTimer := SetTimer(Form1.Handle,1,30
Exit;
end else
KillTimer(Form1.Handle,1);
end;
KillTimer(Form1.Handle,1);
Message.Result := 1;
end;
procedure TForm1.ApplicationEvents1M
var Handled: Boolean);
begin
if Show1 then
begin
if HintW1.IsHintMsg(Msg) then
begin
HintW1.ReleaseHandle;
Show1 := False;
DoHint := False;
SetTimer(Form1.Handle,3,15
end;
end;
end;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
the HintW1.IsHintMsg(Msg) in the ApplicationEvents1Message is alot better fo making the hint window go away
ASKER
Hi Slick812!
First of all thanks for your reply.
Now, your first comment made your original code work indeed :)
but second comment (had a detour...) didn't pop the help window at all...
I go ahead ad give you credits tho.... :)
(How on earth standard Close box, minimize box, etc have slowly opening hints and Delphi ones are instant popups? 1st one looks more cool, you have any ideas?)
First of all thanks for your reply.
Now, your first comment made your original code work indeed :)
but second comment (had a detour...) didn't pop the help window at all...
I go ahead ad give you credits tho.... :)
(How on earth standard Close box, minimize box, etc have slowly opening hints and Delphi ones are instant popups? 1st one looks more cool, you have any ideas?)
ASKER
Optimal solution would be a mimic of standard windows tip style :p
I searched ALL over for this information but there is simply nobody who could do it neither free, nor commercial. :\
One of the best examples I found is the TDanHint3.0 (on Torry I think). Also on about.com/delphi there is a very detailed explanation of hints...
Thanks again for your replies :)
If you ever find an answer please let me know!
falcon
I searched ALL over for this information but there is simply nobody who could do it neither free, nor commercial. :\
One of the best examples I found is the TDanHint3.0 (on Torry I think). Also on about.com/delphi there is a very detailed explanation of hints...
Thanks again for your replies :)
If you ever find an answer please let me know!
falcon
private
{ Private declarations }
procedure WMNcPaint(var Message: TMessage); message WM_NCPAINT;
procedure WMNCMOUSEMOVE(var Message: TMessage); message WM_NCMOUSEMOVE;
var
Form1: TForm1;
Show1: Boolean;
hHintTimer: THandle;
HintW1: THintWindow;
implementation
{$R *.DFM}
procedure TimerProc(Wnd: HWnd; Mesg, TimerID, SysTime: Longint); stdcall;
var
HintStr: String;
MousePt: TPoint;
begin
if TimerID = 1 then
begin
KillTimer(Form1.Handle,1);
GetCursorPos(MousePt);
HintStr := 'This is the OK button';
HintW1.ActivateHint(Rect(M
MousePt.x + HintW1.Canvas.TextWidth(Hi
MousePt.y + HintW1.Canvas.TextHeight(H
Show1 := True;
end;
end;
procedure TForm1.WMNcPaint(var Message: TMessage);
var
RectCB: TRect;
NcDC: HDC;
begin
inherited ;
RectCB := Rect(Width-92,6,Width-70,2
NcDC := GetWindowDC(Form1.Handle);
DrawFrameControl(NcDC,Rect
SetBkMode(NcDC,TRANSPARENT
TextOut(NcDC,Width-89,5,'o
ReleaseDC(Form1.Handle, NcDC);
end ;
procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
Pt1: TPoint;
RectCB: TRect;
begin
inherited;
if Message.wParam = HTCAPTION then
begin
RectCB := Rect(Width-92+Left,6+Top,W
Pt1.x := LOWORD(Message.lParam);
Pt1.y := HIWORD(Message.lParam);
if PtInRect(RectCB,Pt1) then
begin
if not Show1 then
hHintTimer := SetTimer(Form1.Handle,1,50
Exit;
end else
KillTimer(Form1.Handle,1);
end;
KillTimer(Form1.Handle,1);
Message.Result := 1 ;
if Show1 then
begin
HintW1.ReleaseHandle;
Show1 := False;
end;
end ;
- - - - - - - - - - - - - - - - - - -
you may need to get the mouse move on the RectCB to hide the Hint Window when it is showing. Ask questions if it is unclear.