PureBasic Forums - English

Posted: **Thu Nov 09, 2023 6:32 pm**

@Mijikai

Thank you, I was already looking for the code ...

But don't use SysAllocString, just the pointer to the text.
TTM_AddTool creates a copy of the text itself.
Rect was wrong because tooltip is subclass from gadget

Update
- hInst not used
- Added FreeToolTip for release resources

Code: Select all

EnableExplicit

Procedure.i ToolTip(Gadget, Text.s, Width = 150)
  Protected hwnd.i
  Protected ti.TOOLINFO
  If IsGadget(Gadget)
    ti\cbSize = SizeOf(TOOLINFO)
    ti\uFlags = #TTF_SUBCLASS
    ti\hWnd = GadgetID(Gadget)
    ti\uId = Gadget
    ti\lpszText = @Text
    ti\rect\left = 0
    ti\rect\top = 0
    ti\rect\right = GadgetWidth(Gadget)
    ti\rect\bottom = GadgetHeight(Gadget)
    hwnd = CreateWindowEx_(#Null,#TOOLTIPS_CLASS,#Null,
                                   #WS_POPUP|#TTS_ALWAYSTIP,
                                   #CW_USEDEFAULT,#CW_USEDEFAULT,#CW_USEDEFAULT,
                                   #CW_USEDEFAULT,ti\hWnd,#Null,ti\hInst,#Null)
    If hwnd
      SetProp_(ti\hWnd, "MyToolTipHandle", hwnd)
      SendMessage_(hwnd,#TTM_ADDTOOL,#Null,@ti)
      SendMessage_(hwnd,#TTM_SETMAXTIPWIDTH,#Null,Width)
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure FreeToolTip(Gadget)
  Protected r1, hwnd, ti.TOOLINFO
  If IsGadget(Gadget)
    hwnd = RemoveProp_(GadgetID(Gadget), "MyToolTipHandle")
    If hwnd
      ti\cbSize = SizeOf(TOOLINFO)
      ti\hWnd = GadgetID(Gadget)
      ti\uId = Gadget
      SendMessage_(hwnd,#TTM_DELTOOL,#Null,@ti)
    EndIf
  EndIf
EndProcedure

    
Procedure.i Main()
  If OpenWindow(0,0,0,800,600,"Dummy",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    ButtonGadget(1,10,30,200,30,"Hello World!")
    ToolTip(1,"Hello World!" + #CR$ + "How does this magic work?" + #CR$ + "Black Magic!!!!")
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
              FreeToolTip(1)
          EndSelect
      EndSelect
    ForEver
    FreeToolTip(1)      
    CloseWindow(0)  
  EndIf
  ProcedureReturn #Null
EndProcedure

End Main()

Posted: **Thu Nov 09, 2023 7:00 pm**

Thank you @mk-soft now its flawless, you also added the Width as parameter

Posted: **Thu Nov 09, 2023 7:23 pm**

A little more ...

Update viewtopic.php?p=610526#p610526
- ti\hInst not used, because text not from resources
- Added FreeToolTip for release resources

Posted: **Thu Nov 09, 2023 8:54 pm**

Nice @mk-soft
i also took another look and changed some things.

Code: Select all

EnableExplicit

Procedure.i ToolTipCreate(Gadget.i,Text.s,Width.i = 150)
  Protected hwnd.i
  Protected ti.TOOLINFO
  If IsGadget(Gadget)
    ti\cbSize = SizeOf(TOOLINFO)
    ti\uFlags = #TTF_SUBCLASS
    ti\hWnd = GadgetID(Gadget)
    ti\lpszText = @Text
    ti\rect\right = GadgetWidth(Gadget)
    ti\rect\bottom = GadgetHeight(Gadget)
    hwnd = FindWindow_(#TOOLTIPS_CLASS,Str(ti\hWnd))
    If Not hwnd
      hwnd = CreateWindowEx_(#Null,#TOOLTIPS_CLASS,Str(ti\hWnd),
                             #WS_POPUP|#TTS_ALWAYSTIP,
                             #CW_USEDEFAULT,#CW_USEDEFAULT,#CW_USEDEFAULT,
                             #CW_USEDEFAULT,ti\hWnd,#Null,#Null,#Null)
      
      If hwnd
        SendMessage_(hwnd,#TTM_ADDTOOL,#Null,@ti)
        SendMessage_(hwnd,#TTM_SETMAXTIPWIDTH,#Null,Width)
        ProcedureReturn #True
      EndIf
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.i ToolTipRelease(Gadget.i)
  Protected hwnd.i
  Protected ti.TOOLINFO
  If IsGadget(Gadget)
    ti\cbSize = SizeOf(TOOLINFO)
    ti\hWnd = GadgetID(Gadget)
    hwnd = FindWindow_(#TOOLTIPS_CLASS,Str(ti\hWnd))
    If hwnd
      SendMessage_(hwnd,#TTM_DELTOOL,#Null,@ti)
      SendMessage_(hwnd,#WM_CLOSE,#Null,#Null)
    EndIf
  EndIf
  ProcedureReturn #Null
EndProcedure

    
Procedure.i Main()
  If OpenWindow(0,0,0,800,600,"Dummy",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    ButtonGadget(1,10,30,200,30,"Hello World!")
    ButtonGadget(2,10,90,200,30,"Hello World!")
    ToolTipCreate(1,"Hello World!" + #CR$ + "How does this magic work?" + #CR$ + "Black Magic!!!!")
    ToolTipCreate(2,"Hello World!" + #CR$ + "How does this magic work?" + #CR$ + "Black Magic!!!!")
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
              ToolTipRelease(1)
          EndSelect
      EndSelect
    ForEver
    ToolTipRelease(1) 
    ToolTipRelease(2)
    CloseWindow(0)  
  EndIf
  ProcedureReturn #Null
EndProcedure

End Main()

Posted: **Thu Jun 06, 2024 11:55 pm**

Thank @mk-soft @Mijikai for sharing.

I want to add background color and text color. But why don't they work ?

Code: Select all

SendMessage_(hwnd, #TTM_SETDELAYTIME, #TTDT_INITIAL, 0)
SendMessage_(hwnd, #TTM_SETTIPBKCOLOR, #Black, 0)                    ;BackColor Tooltip
SendMessage_(hwnd, #TTM_SETTIPTEXTCOLOR, #Red, 0)             ;TextColor Tooltip

Posted: **Fri Jun 07, 2024 3:47 am**

https://learn.microsoft.com/en-us/windo ... tipbkcolor
Look at "remarks", no effect when using visual styles.

PureBasic Forums - English

GadgetTooltip, using lines instead of single line

Re: GadgetTooltip, using lines instead of single line

Re: GadgetTooltip, using lines instead of single line

Re: GadgetTooltip, using lines instead of single line

Re: GadgetTooltip, using lines instead of single line

Re: GadgetTooltip, using lines instead of single line

Re: GadgetTooltip, using lines instead of single line