PureBasic Forums - English

Code: Select all

Global OldCallback,CheckToolTip
Global WideCharBuf_
#WideCharLen_=#MAX_PATH*4
WideCharBuf_=AllocateMemory(1,#WideCharLen_)

Structure TCHITTESTINFO
  pt.POINT
  Flags.l
EndStructure

#TTN_GETDISPINFOW = -530


; BalloonTip Constants
#ToolTip_NoBalloon=-1
#TOOLTIP_NO_ICON      = 0
#TOOLTIP_INFO_ICON    = 1
#TOOLTIP_WARNING_ICON = 2
#TOOLTIP_ERROR_ICON   = 3

Procedure OwnToolTip(WindowId, gadget, text$ , Title$, Icon)
  If Icon=#ToolTip_NoBalloon
    Flag=#WS_POPUP | #TTS_NOPREFIX
  Else
    Flag=#WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON
  EndIf
  ToolTip=CreateWindowEx_(0,"ToolTips_Class32","",Flag,0,0,0,0,WindowID(WindowId),0,GetModuleHandle_(0),0)
  SendMessage_(ToolTip,#TTM_SETTIPTEXTCOLOR,GetSysColor_(#COLOR_INFOTEXT),0)
  SendMessage_(ToolTip,#TTM_SETTIPBKCOLOR,GetSysColor_(#COLOR_INFOBK),0)
  SendMessage_(ToolTip,#TTM_SETMAXTIPWIDTH,0,180)
  Balloon.TOOLINFO\cbSize=SizeOf(TOOLINFO)
  Balloon\uFlags=#TTF_IDISHWND | #TTF_SUBCLASS
  Balloon\hwnd=GadgetID(gadget)
  Balloon\uId=GadgetID(gadget)
  If text$
    Balloon\lpszText=@text$
  Else
    Balloon\lpszText=-1
  EndIf
  SendMessage_(ToolTip, #TTM_ADDTOOL, 0, Balloon)
  If Title$ > "" And Icon>-1
    SendMessage_(ToolTip, #TTM_SETTITLE, Icon, @Title$)
  EndIf
  ProcedureReturn ToolTip
EndProcedure
Procedure MyWindowCallback(WindowId, Message, wParam, lParam) 
  Result = #PB_ProcessPureBasicEvents 
  
  If Message=#wm_notify
    *notify.NMHDR=lParam
    
    If (*notify\code=#TTN_GETDISPINFOW Or *notify\code=#TTN_GETDISPINFO) And wParam=GadgetID(1)
;       ToolTip.TOOLINFO
;       ToolTip\cbSize=SizeOf(TOOLINFO)
;       ToolTip\hwnd=wParam
;       ToolTip\uId=wParam
      
      ;Which Tab?
      GetCursorPos_(Test.TCHITTESTINFO\pt)
      MapWindowPoints_(0,GadgetID(1),Test\pt,1)
      index=SendMessage_(GadgetID(1),#TCM_HITTEST,0,Test)
      ToolTipText$="Work? - "+Str(index+1)
      ;CP_THREAD_ACP
      MultiByteToWideChar_(1,#MB_PRECOMPOSED,@ToolTipText$,Len(ToolTipText$),WideCharBuf_,#WideCharLen_)
      
      *text.NMTTDISPINFO=lParam
      *text\lpszText=WideCharBuf_
      *text\hinst=0
      *text\szText[0]=0
      Result=#False
;       ToolTip\lpszText=@a$
;       SendMessage_(*notify\hwndfrom,#TTM_UPDATETIPTEXT,0,ToolTip)
;       SendMessage_(*notify\hwndfrom,#TTM_ACTIVATE ,0,0)
;       SendMessage_(*notify\hwndfrom,#TTM_update ,0,0)
;       SendMessage_(*notify\hwndfrom,#TTM_ACTIVATE ,#True,0)
      ;Result=#False
    EndIf
  EndIf
  If Result=#PB_ProcessPureBasicEvents And OldCallback
    ProcedureReturn CallWindowProc_(OldCallback,WindowId,Message,wParam,lParam)
  Else
    ProcedureReturn Result 
  EndIf
  
EndProcedure 

If OpenWindow(1,0,0,200,200,#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"Test")
  If CreateGadgetList(WindowID())
    PanelGadget(1,0,0,200,200)
    AddGadgetItem(1,-1,"Test1")
    AddGadgetItem(1,-1,"Test2")
    AddGadgetItem(1,-1,"Test3")
    AddGadgetItem(1,-1,"Test4")
    
    OldCallback=SetWindowLong_(GadgetID(1),#GWL_WNDPROC,@MyWindowCallback())
    
    CheckToolTip=OwnToolTip(1,1,"","",-1);Text immer nachfragen
    
    Repeat
      event=WaitWindowEvent()
      
    Until event=#PB_Event_CloseWindow
  EndIf
EndIf