Solved

Hint/Tooltip display for TRect drawn on TitleBar

Posted on 2002-05-14
6
441 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 34

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 34

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
Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 34

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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

820 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