Everyone knows that the node on TreeView will appear on the mouse to move, this is in-place tooltips. The following code implements this function on the listbox (the following code is only tested on standard Listbox, if it is self-drawn, you want to modify):
{Copy the following code directly to the new engine1.pas file to run, do not need to add any controls}
/ / -------------------------------------------------------------------------------------------- ------------------------------ // implement in-place Tooltips // original author in the ListBox: Joe Huang Email: Happyjoe @ 21cn.com ///// -------------------------------------------------------------------------------------------------------------------------------------- ------------------------------------
Unit unit1;
Interface
Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, CommCtrl
Type // Remote TListBox Intercepted CM_Mouseleave Message TNewlistBox = Class (TListBox) protected {protected deflarations} procedure wndproc (var message: tMessage); override;
type TForm1 = class (TForm) procedure FormCreate (Sender: TObject); private {Private declarations} GHWND: HWND; TipVisable: Boolean; OldIndex, CurrentIndex: Integer; ti: TOOLINFO; ListBox1: TListBox;
Procedure InitListBox; // Dynamically generate listbox1 procedure createtipsWindow; // Generate Tooltip Window Procedure HidetipsWindow; // Hide Tooltip Window
// Intercept the WM_NOTIFY message, dynamically change the contents of Tooltip Window displayed Procedure Wmnotify; Message WM_NOTIFY;
procedure ListBox_MouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ListBox_MouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); public {Public declarations} end;
Var Form1: TFORM1;
IMPLEMentation
{$ R * .dfm}
{TNewlistbox}
Procedure TNewlistBox.WndProc (Var Message: TMessage); Begin Case Message.msg of CM_MouseLeave: Form1.hidetipsWindow; End; Inherited WndProc (Message); end; {tform1}
Procedure TForm1.initListBox; Begin ListBox1: = TNewlistBox.create (self); listbox1.parent: = self; listbox1.left: = 50; listbox1.top: = 50; listbox1.width: = 200; listbox1.height: = 200 ; Add a few items for test ('happyjoe'); listbox1.items.append ('please send me email: happyjoe@21cn.com'); ListBox1.Items.Append ('Delphi 5 Developer Guide '); ListBox1.Items.Append (' Delphi 5.x ADO / MTS / COM Advanced Program Design);
ListBox1.onmousemove: = listbox_mousemove; listbox1.onmousedown: = listbox_mousedown;
Procedure TForm1.FormCreate (Sender: Tobject); Begin Self.font.name: = 'Taoma'; InitListBox; CreateTipsWindow; End;
procedure TForm1.CreateTipsWindow; var iccex: tagINITCOMMONCONTROLSEX; begin // Load the ToolTip class from the DLL iccex.dwSize: = sizeof (tagINITCOMMONCONTROLSEX); iccex.dwICC:. = ICC_BAR_CLASSES; InitCommonControlsEx (iccex);
. // Create the ToolTip control GHWND: = CreateWindow (TOOLTIPS_CLASS, '', WS_POPUP, Integer (CW_USEDEFAULT), Integer (CW_USEDEFAULT), Integer (CW_USEDEFAULT), Integer (CW_USEDEFAULT), 0, 0, hInstance, nil);
// Prepare TOOLINFO structure for use as tracking ToolTip ti.cbSize: = sizeof (ti); ti.uFlags:. = TTF_IDISHWND TTF_TRACK TTF_ABSOLUTE TTF_TRANSPARENT; ti.hwnd: = Self.Handle; ti.uId: = ListBox1. HINDLE; TI.HINST: = Hinstance; Ti.lpsztext: = LPSTR_TEXTCALLBACK; Ti.Rect.Left: = 0; Ti.Rect.top: = 0; Ti.Rect.Bottom: = 0; Ti.Rect.right: = 0; SendMessage (GHWND, WM_SETFONT, ListBox1.Font.Handle, Integer (LongBool (false)); sendMessage (GHWND, TTM_ADDTOOL, 0, Integer (@ti));
procedure TForm1.WMNotify (var Msg: TMessage); var phd: PHDNotify; NMTTDISPINFO: PNMTTDispInfo; begin phd: = PHDNotify (Msg.lParam); if phd.Hdr.hwndFrom = GHWND then begin if phd.Hdr.code = TTN_NEEDTEXT then Begin NMTTDISPINFO: = PNMTTDISPINFO (PHD); NMTTDISPINFO.LPSZTEXT: = PCHAR (ListBox1.items [currentIndIndex]); end; end;
procedure TForm1.ListBox_MouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if TipVisable then // When the mouse is pressed, Tooltip Window displays hidden begin SendMessage (GHWND, TTM_TRACKACTIVATE, Integer ( LongBool (false), 0); tipvisable: = false; end;
procedure TForm1.ListBox_MouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); var Index: Integer; APoint: TPoint; ARect: TRect; ScreenRect: TRect; begin Index: = ListBox1.ItemAtPos (Point (X, Y ); if index = -1 Then // If there is no Item under the mouse, you will hide Begin SendMessage (Ghwnd, TTM_TRACKACKACTIVATE, INTEGER (LONGBOOL (FALSE)), 0); OldIndex: = -1; TipVisable: = False; exit; end; currentIndex: = index; if index = OldIndex kilover; // If the mouse moves on the same item, exit processing if tipvisable kiln // Show Tooltip Window hide Begin SendMessage (GHWND, TTM_TRACKACKACKACTIVATE, INTEGER (LongBool (false), 0); ilindex: = -1; tipvisable: = false; ELSE BEGIN ARECT: = ListBox1.ItemRect (index); // Determine if the item is completely displayed (all "right - all) Left - 2)> = ListBox1.Canvas.TextWidth (ListBox1.Items [Index]) then begin oldIndex: = -1; exit; end; aPoint: = ListBox1.ClientToScreen (ARect.TopLeft); windows.GetClientRect (GetDesktopWindow, screenRect ); / / Judge Tooltip W Whether it will exceed the screen range after INDOW, here only judge the right border if listbox1.canvas.textwidth (listbox1.items [index]) apoint.x> ScreenRect.right dam, Apoint.x: = ScreenRect.right - listbox1.canvas .TextWidth (ListBox1.items [Index]) - 5; SendMessage (GHWND, TTM_TRACKPOSITION, 0, MAKELPAR (Apoint.x - 1, apoint.y - 2)); sendMessage (Ghwnd, TTM_TRACKACKACTIVATE, INTEGER , Integer (@ti)); Oldindex: = index; tipvisable: = true; end;
Procedure TForm1.hidetipsWindow; Begin IF TipVisable The Begin SendMessage (ghwnd, ttm_trackactivate, integer (longbool (false)), 0); OldIndex: = -1; tipvisable: = false; end; end; end.
