PureBasic Forums - English

Code: Select all

; ToolTipID() code from netmaestro
; http://www.purebasic.fr/english/viewtopic.php?t=36765&start=0
Procedure EnumProc(hwnd, lparam)
  Shared ctrl
  cn$ = Space(100)
  GetClassName_(hwnd, @cn$, 99)
  If UCase(cn$) = "TOOLTIPS_CLASS32"
    With ti.TOOLINFO
      \cbSize = SizeOf(TOOLINFO)
      \hwnd = GetParent_(ctrl)
      \uid = ctrl
    EndWith
    If SendMessage_(hwnd, #TTM_GETTOOLINFO, 0, @ti)
      PokeI(lparam, hwnd)
      ProcedureReturn 0
    Else
      ProcedureReturn 1
    EndIf
  Else
    ProcedureReturn 1
  EndIf
EndProcedure
ProcedureDLL.i ToolTipID(gadget)
  Shared ctrl
  ctrl = gadget
  EnumWindows_(@EnumProc(),@TTID)
  ProcedureReturn TTID
EndProcedure
OpenWindow(0, 180, 400, 270, 100, "GadgetTooltip")
ButtonGadget(0, 10, 30, 250, 30, "Button with Tooltip")
GadgetToolTip(0, "Multiline Tooltip" + #CRLF$ + "with [CR][LF].")
;////////
; This sendmessage() resets the Windows 10 desktop screen for several seconds.
; But the code still creates a multiline tooltip.
SendMessage_(ToolTipID(GadgetID(0)), #TTM_SETMAXTIPWIDTH, 0, 100)
;////////
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

Code: Select all

If OpenWindow(0, 0, 0, 220, 220, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CanvasGadget(0, 10, 10, 200, 90)
    GadgetToolTip(0, "Tooltip for Button 0"+#CRLF$+"         It is OK"+#CRLF$+"     Just for now")
    CanvasGadget(1, 10, 110, 200, 100)
    GadgetToolTip(1, "Tooltip for Button 1"+#CRLF$+"         It is OK"+#CRLF$+"     Just for now")
    ttip = FindWindow_("tooltips_class32",0)
    SetWindowTheme_(ttip, @null.w, @null.w) 
    SendMessage_(ttip,#TTM_SETTIPTEXTCOLOR,#Red,0)
    SendMessage_(ttip,#TTM_SETTIPBKCOLOR,$CBFEFD,0)
    SendMessage_(ttip,#TTM_SETMAXTIPWIDTH,0,150)
    r.RECT : r\left = 4: r\right = 4: r\top = 4: r\bottom = 4
    SendMessage_(ttip,#TTM_SETMARGIN,0,r)
    SetWindowLongPtr_(ttip,#GWL_STYLE,GetWindowLongPtr_(ttip, #GWL_STYLE)|#TTS_BALLOON)
    
    Repeat
      Event = WaitWindowEvent()
          
      If Event = #PB_Event_Gadget And EventGadget() = 0 
        If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(0, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
          If StartDrawing(CanvasOutput(0))
            x = GetGadgetAttribute(0, #PB_Canvas_MouseX)
            y = GetGadgetAttribute(0, #PB_Canvas_MouseY)
            Circle(x, y, 10, RGB(Random(255), Random(255), Random(255)))
            StopDrawing()
          EndIf
        EndIf
      EndIf    
      
    Until Event = #PB_Event_CloseWindow
  EndIf

Code: Select all

GadgetToolTip(0, "Multiline Tooltip" + #CRLF$ + "with [CR][LF].")
ttid = ToolTipID(GadgetID(0))
;////////
; This sendmessage() resets the Windows 10 desktop screen for several seconds.
; But the code still creates a multiline tooltip.
SendMessage_(ttid, #TTM_SETMAXTIPWIDTH, 0, 100)
;////////

Code: Select all

SendMessage_(hwnd, #TTM_GETTOOLINFO, 0, @ti);<-- THIS LINE RESETS WINDOWS 10 DESKTOP!?
; NOT This...
SendMessage_(ttid, #TTM_SETMAXTIPWIDTH, 0, 150)

Code: Select all

  CompilerIf 1
    ; ToolTipID() code from TS-Soft
    ; http://www.purebasic.fr/english/viewtopic.php?t=36765&start=0
    Import ""
      PB_Object_GetThreadMemory(*Mem)
      PB_Gadget_Globals
    EndImport
    Structure GadgetGlobals
      CurrentWindow.i
      FirstOptionGadget.i
      DefaultFont.i
      *PanelStack
      PanelStackIndex.l
      PanelStackSize.l
      ToolTipWindow.i
    EndStructure
    Procedure.i ToolTipID(hGadget.i) ; hGadget not required, but shown to compare netmaestro's function.
      Protected *gg.GadgetGlobals
      *gg = PB_Object_GetThreadMemory(PB_Gadget_Globals)
      ProcedureReturn *gg\ToolTipWindow
    EndProcedure
  CompilerElseIf 0
    ; ToolTipID() code from netmaestro
    ; http://www.purebasic.fr/english/viewtopic.php?t=36765&start=0
    Procedure.i ToolTipID(hGadget.i)
      Shared ctrl
      ctrl = hGadget
      EnumWindows_(@EnumProc(),@TTID)
      ProcedureReturn TTID
    EndProcedure
    Procedure EnumProc(hwnd, lparam)
      Shared ctrl
      cn$ = Space(#MAX_PATH)
      GetClassName_(hwnd, @cn$, 99)
      If LCase(cn$) = "tooltips_class32"
        With ti.TOOLINFO
          \cbSize = SizeOf(TOOLINFO)
          \hwnd = GetParent_(ctrl)
          \uid = ctrl
        EndWith
        If SendMessage_(hwnd, #TTM_GETTOOLINFO, 0, @ti);<-- THIS LINE RESETS WINDOWS 10 DESKTOP!?
          PokeI(lparam, hwnd)
          ProcedureReturn 0
        Else
          ProcedureReturn 1
        EndIf
      Else
        ProcedureReturn 1
      EndIf
    EndProcedure
  CompilerEndIf
  OpenWindow(0, 180, 400, 270, 100, "GadgetTooltip on Windows 10")
  ButtonGadget(0, 10, 30, 250, 30, "Button with Multi-line Tooltip")
  GadgetToolTip(0, "Multi-line Tooltip" + #CRLF$ + "with [CR][LF].")
  If 1
    SendMessage_(ToolTipID(GadgetID(0)), #TTM_SETMAXTIPWIDTH, 0, 150)
  EndIf
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow

Code: Select all

OpenWindow(0,0,0,300,200,"Tooltips Demo",#WS_SYSMENU | #WS_CAPTION | 1)
ButtonGadget(0,5,5,105,25,"New Document")

hwndToolTip = CreateWindowEx_(0,"tooltips_class32",0,0 | #TTS_CLOSE,0,0,0,0,0,0,0,0)
SendMessage_(hwndToolTip,#TTM_SETMAXTIPWIDTH,0,300)
SendMessage_(hwndToolTip,#TTM_SETTITLE,1,"Caption")

Procedure AddToolTip(hwnd,Gadget,Text.s)
	Protected tti.TOOLINFO
	
	tti\cbSize = SizeOf(TOOLINFO)
	tti\uFlags = #TTF_SUBCLASS
	tti\hwnd = GadgetID(Gadget)
	tti\rect\right = GadgetWidth(Gadget)
	tti\rect\bottom = GadgetHeight(Gadget)
	tti\lpszText = @Text
	
	ProcedureReturn SendMessage_(hwnd,#TTM_ADDTOOL,0,tti)
EndProcedure

AddToolTip(hwndToolTip,0,"New Document" + #CRLF$ + "Multiline")

While WaitWindowEvent() ! #PB_Event_CloseWindow : Wend