demos/apitooltipssimple/ToolTip1.pas

   1 ////////////////////////////////////////////////////////////////////////
   2 // An example that demonstrate how to create a standard ToolTip control
   3 // and add tools to it.
   4 // Based on "Using ToolTip Controls" in Win32 Programmer's Reference.
   5 ////////////////////////////////////////////////////////////////////////
   6 // A. Kubaszek  <a_kubaszek@poczta.onet.pl>
   7
   8 unit ToolTip1;
   9
  10 interface
  11   uses
  12     Windows, KOL;
  13
  14 function CreateTooltipWindow (hWndParent, hInstance :HWND) :HWND;
  15 //see MSDN: "Using ToolTip Controls", CreateMyTooltip()
  16 procedure DestroyTooltipWindow(TThwnd :HWND);
  17
  18 function TooltipAddTool(fTThwnd, hwndTool :HWND; const Hint :string) :boolean;
  19 //if Hint<>'' ADDTOOL else DELTOOL
  20
  21 implementation
  22
  23 function CreateTooltipWindow (hWndParent, hInstance :HWND) :HWND;
  24 begin
  25   DoInitCommonControls( ICC_WIN95_CLASSES );
  26     // To ensure that the common control DLL is loaded
  27
  28     // CREATE A TOOLTIP WINDOW
  29   Result := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil,
  30       WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP,
  31       CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
  32       hWndParent, 0, hInstance, nil );
  33   SetWindowPos(Result, HWND_TOPMOST, 0, 0, 0, 0,
  34       SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
  35 end;
  36
  37 procedure DestroyTooltipWindow(TThwnd :HWND);
  38 begin
  39   DestroyWindow(TThwnd);
  40 end;
  41
  42 function TooltipAddTool(fTThwnd, hwndTool :HWND; const Hint :string) :boolean;
  43   var
  44     ti :TTOOLINFO ; // struct specifying info about tool in ToolTip control
  45 begin
  46   Result:=(fTThwnd <> 0) and (hwndTool <> 0);
  47   if not Result then EXIT;
  48     // INITIALIZE MEMBERS OF THE TOOLINFO STRUCTURE
  49   ti.cbSize := sizeof(TTOOLINFO);
  50   ti.uFlags := TTF_SUBCLASS or TTF_IDISHWND;
  51   ti.hwnd := hwndTool;
  52   ti.hinst := 0;
  53   ti.uId := hwndTool;
  54   ti.lpszText := PChar(Hint);
  55
  56   if (Hint <> '') then
  57     Result:=BOOL(SendMessage(fTThwnd, TTM_ADDTOOL, 0, LPARAM(@ti)))
  58   else
  59     SendMessage(fTThwnd, TTM_DELTOOL, 0, LPARAM(@ti));
  60 end;
  61
  62 end.