Solved

Hint/Tooltip display for TRect drawn on TitleBar

Posted on 2002-05-14
6
440 Views
Last Modified: 2010-04-04
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.
0
Comment
Question by:Falcon13
  • 3
  • 3
6 Comments
 
LVL 33

Expert Comment

by:Slick812
ID: 7017109
hello Falcon13, here's some code that can give you a hint anywhere on the screen, by defining the RectCB


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(MousePt.x + 10, MousePt.y + 10,
  MousePt.x + HintW1.Canvas.TextWidth(HintStr) + 19,
  MousePt.y + HintW1.Canvas.TextHeight(HintStr) + 10), HintStr);
  Show1 := True;
  end;
end;

procedure TForm1.WMNcPaint(var Message: TMessage);
var
RectCB: TRect;
NcDC: HDC;
begin
  inherited ;
RectCB := Rect(Width-92,6,Width-70,21);
NcDC := GetWindowDC(Form1.Handle);
DrawFrameControl(NcDC,RectCB,DFC_BUTTON,DFCS_BUTTONPUSH);
SetBkMode(NcDC,TRANSPARENT);
TextOut(NcDC,Width-89,5,'ok',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
  RectCB := Rect(Width-92+Left,6+Top,Width-70+Left,21+Top);
  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,500,@TimerProc);
    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.
0
 

Author Comment

by:Falcon13
ID: 7071488
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 :)

0
 
LVL 33

Accepted Solution

by:
Slick812 earned 100 total points
ID: 7073541
There's no Bug, I just thought you'd know that you need to Create a THintWindow brfore you access it's properties, sorry. Add this to your Form Create.

procedure TForm1.FormCreate(Sender: TObject);
begin
HintW1 := THintWindow.Create(Form1);
HintW1.Color := clInfoBk;
end;

and this code is just meant to be a for a "Demo" to show how to call up a Delphi Hint window and not a full Hint function. The main point here is the Hint Activate.

HintStr := 'This is the OK button';

 HintW1.ActivateHint(Rect(MousePt.x + 10, MousePt.y + 10,
 MousePt.x + HintW1.Canvas.TextWidth(HintStr) + 19,
 MousePt.y + HintW1.Canvas.TextHeight(HintStr) + 10), HintStr);
0
Is Your AD Toolbox Looking More Like a Toybox?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

 
LVL 33

Expert Comment

by:Slick812
ID: 7073670
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+RectCB.Top,RectCB.Right-70,21+RectCB.Top);
 if PtInRect(RectCB,MousePt) then
   begin
   HintStr := 'This is the OK button';
   HintW1.ActivateHint(Rect(MousePt.x + 20, MousePt.y + 20,
   MousePt.x + HintW1.Canvas.TextWidth(HintStr) + 29,
   MousePt.y + HintW1.Canvas.TextHeight(HintStr) + 20), HintStr);
   SetTimer(Form1.Handle,2,50,@wTimerProc);
   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,21);
NcDC := GetWindowDC(Form1.Handle);
DrawFrameControl(NcDC,RectCB,DFC_BUTTON,DFCS_BUTTONPUSH);
SetBkMode(NcDC,TRANSPARENT);
TextOut(NcDC,Width-89,5,'ok',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+RectCB.Top,RectCB.Right-70,21+RectCB.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,300,@wTimerProc);
   Exit;
   end else
   KillTimer(Form1.Handle,1);

 end;
KillTimer(Form1.Handle,1);

Message.Result := 1;
end;

procedure TForm1.ApplicationEvents1Message(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,150,@wTimerProc);
   end;
 end;
end;

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

the HintW1.IsHintMsg(Msg) in the ApplicationEvents1Message is alot better fo making the hint window go away
0
 

Author Comment

by:Falcon13
ID: 7076973
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?)
0
 

Author Comment

by:Falcon13
ID: 7076981
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
0

Featured Post

Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This video shows how to quickly and easily add an email signature for all users on Exchange 2016. The resulting signature is applied on a server level by Exchange Online. The email signature template has been downloaded from: www.mail-signatures…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question