PureBasic Forums - English

Code: Select all

Procedure IsMouseOver(hWnd) 
    GetWindowRect_(hWnd,r.RECT) 
    GetCursorPos_(p.POINT) 
    Result = PtInRect_(r,p\y << 32 + p\x) 
    ProcedureReturn Result 
EndProcedure 
  
LoadFont(0,"Georgia",14)
OpenWindow(0, 0, 0, 640, 340, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(0,  10,  10, 300, 280, "Column 0", 120,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
    SetGadgetFont(0,FontID(0))
      For x = 1 To 6      
        AddGadgetColumn(0, x, "Column " + Str(x), 120)
      Next
      For x = 0 To 20
          AddGadgetItem(0, -1, "Row : "+Str(x)+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5")
      Next
  
  ListIconGadget(1,  330,  10, 300, 280, "Column 0", 120,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
      For x = 1 To 6      
        AddGadgetColumn(1, x, "Column " + Str(x), 120)
      Next
      For x = 0 To 20
          AddGadgetItem(1, -1, "Row : "+Str(x)+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5")
      Next
      
      GadgetToolTip(0, "")
      ttip = FindWindow_("tooltips_class32",0)
      SendMessage_(ttip, #TTM_SETDELAYTIME, #TTDT_AUTOMATIC,200)      
      SendMessage_(ttip, #TTM_SETDELAYTIME, #TTDT_INITIAL,10)
      ti.TOOLINFO
      ti\cbSize   = SizeOf(ti)
      ti\uFlags   = #TTF_IDISHWND | #TTF_SUBCLASS
      ti\uId= GadgetID(0)
      
      i.LVHITTESTINFO
Repeat
  Select WaitWindowEvent()  
        Case #PB_Event_CloseWindow
              Quit = 1
              
        Case #WM_MOUSEMOVE
          If IsMouseOver(GadgetID(0))
              GetCursorPos_(p.POINT)
              ScreenToClient_ (GadgetID(0), @p)            
              i\pt\x = p\x : i\pt\y = p\y
              SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST ,0,@i)              
              If i\iItem <> olditem Or i\iSubItem <> oldsubitem Or Run = 0
                Run = 1
                SendMessage_(ttip, #TTM_DELTOOL, 0, ti)
                Text$ ="ToolTip for Item "+Str(i\iItem) + " Sub " +Str(i\iSubItem)
                ti\lpszText = @Text$
                SendMessage_(ttip, #TTM_ADDTOOL, 0, ti)  
                olditem = i\iItem : oldsubitem = i\iSubItem
              EndIf
          EndIf

  EndSelect 
Until Quit = 1

Code: Select all

Global ti.TOOLINFO,ttip
      ti\cbSize   = SizeOf(ti)
      ti\uFlags   = #TTF_IDISHWND | #TTF_SUBCLASS

LoadFont(0,"Arial",12)
  
Procedure winCB(hWnd, uMsg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents 
  Static item, subitem, olditem, oldsubitem ,Run
  Select uMsg
    Case #WM_NOTIFY
       *nmhdr.NMHDR = lParam
       If *nmhdr\hwndFrom = GadgetID(0)
          *nmlv.NM_LISTVIEW = lParam
          If *nmlv\hdr\code = #LVN_HOTTRACK           
            item = *nmlv\iitem             
            subitem = *nmlv\isubitem
            If (item <> olditem  Or subitem <> oldsubitem Or Run = 0) And item >= 0
              Run = 1
              SendMessage_(ttip, #TTM_DELTOOL, 0, ti)
              Text$ ="ToolTip for Item "+Str(item) + " Sub " +Str(subitem)
              ti\lpszText = @Text$
              SendMessage_(ttip, #TTM_ADDTOOL, 0, ti)              
              olditem = item: oldsubitem = subitem
            EndIf                   
          EndIf
       EndIf     
  EndSelect
  
  ProcedureReturn result
EndProcedure

  If OpenWindow(0, 0, 0, 640, 300, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
      ListIconGadget(0,  10,  10, 620, 280, "Column 0", 200,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
      SetGadgetFont(0,FontID(0))
      AddGadgetColumn(0, 1, "Column 1" , 200)
      For x = 0 To 100
        AddGadgetItem(0, x, "Item "+Str(x)+Chr(10)+"Item "+Str(x))
      Next
      
      GadgetToolTip(0, "")
      ttip = FindWindow_("tooltips_class32",0)
      SendMessage_(ttip, #TTM_SETDELAYTIME, #TTDT_AUTOMATIC,200)      
      SendMessage_(ttip, #TTM_SETDELAYTIME, #TTDT_INITIAL,10)

      ti\uId= GadgetID(0)

      SetWindowCallback(@winCB())
  EndIf
Repeat
  Select WaitWindowEvent()     
      Case #PB_Event_CloseWindow
            Quit = 1
       
     
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 0
               Debug GetGadgetState(0)
          EndSelect         
  EndSelect

Until Quit = 1
End