Bonjour,
Je souhaite insérer des commentaires (comme sur excel) dans une fenêtre en survolant la listicongadget sans cliquer. Avez-vous une astuce simple pour récupérer ligne et colonne au fur et à mesure du passage de la souris ?
Je vous remercie.
lisicongadget texte survolé par la souris
- microdevweb
- Messages : 1800
- Inscription : mer. 29/juin/2011 14:11
- Localisation : Belgique
Re: lisicongadget texte survolé par la souris
Oui avec des api window,
Lien RSbasic avec beaucoup de possibilités
Lien RSbasic avec beaucoup de possibilités
Code : Tout sélectionner
EnableExplicit
Global ListIconProc
Global ToolTipWindow
Global LastListIconItemX
Global LastListIconItemY
Procedure CreateToolTipWindow(Window, Gadget)
Protected TOOLINFO.TOOLINFO
ToolTipWindow = CreateWindowEx_(0, #TOOLTIPS_CLASS, 0, #WS_POPUP | #TTS_ALWAYSTIP, 0, 0, 0, 0, WindowID(Window), 0, GetModuleHandle_(0), 0)
TOOLINFO.TOOLINFO\cbSize = SizeOf(TOOLINFO)
TOOLINFO\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
TOOLINFO\hwnd = WindowID(Window)
TOOLINFO\uId = GadgetID(Gadget)
TOOLINFO\lpszText = @""
SendMessage_(ToolTipWindow, #TTM_ADDTOOL, 0, TOOLINFO)
SendMessage_(ToolTipWindow, #TTM_ACTIVATE, 0, 0)
SendMessage_(ToolTipWindow, #TTM_SETMAXTIPWIDTH, 0, 1024)
SendMessage_(ToolTipWindow, #TTM_SETDELAYTIME, #TTDT_INITIAL, 0)
SendMessage_(ToolTipWindow, #TTM_SETDELAYTIME, #TTDT_AUTOPOP, 30000)
SendMessage_(ToolTipWindow, #TTM_SETMAXTIPWIDTH, 0, 500)
EndProcedure
Procedure ChangeToolTipWindow(Window, Gadget, Text.s)
Protected TOOLINFO.TOOLINFO
TOOLINFO.TOOLINFO\cbSize = SizeOf(TOOLINFO)
TOOLINFO\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
TOOLINFO\hWnd = WindowID(Window)
TOOLINFO\uId = GadgetID(Gadget)
TOOLINFO\lpszText = @Text
SendMessage_(ToolTipWindow, #TTM_SETTOOLINFO, 0, TOOLINFO)
EndProcedure
Procedure ListIconProc(hWnd, uMsg, wParam, lParam)
Protected LVHITTESTINFO.LVHITTESTINFO
Select uMsg
Case #WM_MOUSELEAVE
SendMessage_(ToolTipWindow, #TTM_ACTIVATE, 0, 0)
LastListIconItemX = -1
Case #WM_MOUSEMOVE
LVHITTESTINFO\pt\x = lparam & $FFFF
LVHITTESTINFO\pt\y = lparam >> 16
SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, LVHITTESTINFO)
If LVHITTESTINFO\iItem = -1
SendMessage_(ToolTipWindow, #TTM_ACTIVATE, 0, 0)
LastListIconItemX = -1
Else
If LastListIconItemX <> LVHITTESTINFO\iItem Or LastListIconItemY <> LVHITTESTINFO\iSubItem
SendMessage_(ToolTipWindow, #TTM_ACTIVATE, 1, 0)
SendMessage_(ToolTipWindow, #TTM_POPUP, 0, 0)
ChangeToolTipWindow(0, GetProp_(hWnd, "PB_ID"), GetGadgetItemText(GetProp_(hWnd, "PB_ID"), LVHITTESTINFO\iItem, LVHITTESTINFO\iSubItem))
LastListIconItemX = LVHITTESTINFO\iItem
LastListIconItemY = LVHITTESTINFO\iSubItem
EndIf
EndIf
EndSelect
ProcedureReturn CallWindowProc_(ListIconProc, hWnd, uMsg, wParam, lParam)
EndProcedure
If OpenWindow(0, 0, 0, 250, 200, "Window", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(1, 0, 0, WindowWidth(0), WindowHeight(0), "Spalte", 200, 0)
AddGadgetItem(1, -1, "Überall dieselbe alte Leier. " + Chr(13) + "Das Layout ist fertig, der Text lässt auf sich warten.", 0, 0)
AddGadgetItem(1, -1, "Das Layout ist fertig, der Text lässt auf sich warten. " + Chr(13) + "Überall dieselbe alte Leier.", 0, 0)
CreateToolTipWindow(0, 1)
ListIconProc = SetWindowLongPtr_(GadgetID(1), #GWL_WNDPROC, @ListIconProc())
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndIf
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Work at Centre Spatial de Liège