So...
A tooltip which will be displayed for the full time (e.g. 10 seconds) disappear automatically. After that, it will never come again. With two messages (#TTM_DELTOOL and #TTM_ADDTOOL) the tooltip can be reanimated.
But as soon I the function SysTrayBalloon_ (in the procedure Hack) will be used, the tooltip content will be changed -- is the Toolinfo a single memory buffer only?
Code: Select all
; Define
EnableExplicit
#DisplayLen=60
#HotKeyMax=25
#CatMax=9
Global HandleMyOpts
Global Char; Aktueller Buchstabe
Global Quit; Flag
Global Dummy; Dummy
Global Reset;
Global EventCode; Unterscheidung Nachricht (Maus/Tastenevent)
Global GadgetCode; Unterscheidung Gadget (Event-Auslöser)
Global MenuCode; Unterscheidung Menu (Event-Auslöser)
Global TypeCode; Unterscheidung Event (Auslöser)
Global MyCode.s; Eingegebener Code (komplett)
Global Code.s; Textbaustein,eingegebener Code etc.
Global MyInfo.s; Informationszeile für SystrayTooltip
Global OptExtrasFlag=1
Global OptTooltip=1
Global Dim Text.s(#HotKeyMax,#CatMax)
Global Dim Title.s(#HotKeyMax)
#WaitTick=25
#WaitClocking=250;
#ProgramName="xxxxx"
#ProgramTitle=#ProgramName+" V1.o"
#Functiontext=":t: Tabulator"+#CR$+":n: neue Zeile"+#CR$+":d: Datum"+#CR$+":u: Uhrzeit"+#CR$+":_: Bedingtes Leerzeichen"+#CR$+":a: Akademischer Grad"+#CR$+":v: Vorname"+#CR$+":x: Herr/Frau Nachname"+#CR$+":y: Herrn/Frau Nachname"+#CR$+":z: Nachname"+#CR$+":[a|b] artspezifischer Text"+#CR$+":^: Großschreibung"+#CR$+":#: Variablentexte (1-5)"
#MOD_WIN=8
Enumeration
#MyOpts
#MyPopup
#SysTray
;
#OptInfo
#OptOk
#Popup
;
#PopupStart
#PopupOptions
#PopupEnde
;
#PopupA=1000
; :
#PopupZ=#PopupA+250
#PopupZ9=#PopupZ+9
EndEnumeration
Structure NOTIFYICONDATA_
cbSize.l
hwnd.i
uId.l
uFlags.l
uCallbackMessage.l
hIcon.i
StructureUnion
szTip.s{64}
szTipEx.s{128}
EndStructureUnion
dwState.l
dwStateMask.l
szInfo.s{256}
StructureUnion
uTimeout.l
uVersion.l
EndStructureUnion
szInfoTitle.s{64}
dwInfoFlags.l
guidItem.GUID
hBalloonIcon.i
EndStructure
Global ToolTipID
Global ToolInfo.TOOLINFO
#HoverNil=-1
Global _LastHover=#HoverNil
; EndDefine
; Define Textbausteine
DataSection
Popup:
Data.b 'S'
Data.s "Scripts..."
Data.s "Heute ist der :d:."
Data.s "Es ist :u:."
Data.s "Mein Name ist :a::_::v::_::z:."
Data.s "Ich bin ein:[|e] :[Mann|Frau]!"
Data.s "Variable!:!:n:1=:1::n:2=:2::"
Data.s ""
Data.b 'X'
Data.s "Hi"
Data.s "A"
Data.s "B"
Data.s "C"
Data.s "D"
Data.s ""
Data.s "~"
EndDataSection
; EndDefine
Procedure.s Shorten(s.s,len=#DisplayLen)
If Len(s)>len
s=Left(s,len-2)+"…"
EndIf
ReplaceString(s,#CRLF$,"¦•",#PB_String_InPlace)
ProcedureReturn s
EndProcedure
Procedure SystrayBalloon_(Title.s,Message.s,Flags)
#TenSeconds=10000; kürzer gehts nicht
Protected nId.NOTIFYICONDATA_
If OSVersion() >=#PB_OS_Windows_Vista
nId\cbSize=SizeOf(NOTIFYICONDATA_)
ElseIf OSVersion() >=#PB_OS_Windows_XP
nId\cbSize=OffsetOf(NOTIFYICONDATA_\hBalloonIcon)
ElseIf OSVersion() >=#PB_OS_Windows_2000
nId\cbSize=OffsetOf(NOTIFYICONDATA_\guidItem)
Else
nId\cbSize=OffsetOf(NOTIFYICONDATA_\szTip) + SizeOf(NOTIFYICONDATA_\szTip)
EndIf
If nId\cbSize
nId\uVersion=4
Shell_NotifyIcon_(#NIM_SETVERSION,@nId)
nId\uId=#SysTray
nId\hwnd=HandleMyOpts
nId\dwInfoFlags=flags
nId\uFlags=#NIF_INFO
nId\uTimeout=#TenSeconds
nId\szInfo=Left(Message,255)
nId\szInfoTitle=Left(Title,63)
ProcedureReturn Shell_NotifyIcon_(#NIM_MODIFY,@nId)
EndIf
;ProcedureReturn #False
EndProcedure
Procedure GadgetToolTip_(Win,Id,Style,Center,Icon ,FgColor,BgColor,Title.s,Tip.s)
; Wegen Windows-Bug (Tooltip verschwindet nach Timeout auf ewig) nun global...
; Protected ToolTipID
; Protected ToolInfo.TOOLINFO
ToolTipID=CreateWindowEx_(0,"Tooltips_Class32","",#TTS_BALLOON*Style,0,0,0,0,0,0,0,0)
If FgColor
SendMessage_(ToolTipID,#TTM_SETTIPTEXTCOLOR,FgColor,0); Set the tip text color, also the tip outline color for balloon tooltips
EndIf
If BgColor
SendMessage_(ToolTipID,#TTM_SETTIPBKCOLOR,BgColor,0); Set the tip background color
EndIf
ToolInfo\cbSize = SizeOf(TOOLINFO)
ToolInfo\uFlags=#TTF_IDISHWND|#TTF_SUBCLASS|(#TTF_CENTERTIP*Center)
ToolInfo\hWnd=WindowID(Win)
ToolInfo\uId=GadgetID(Id)
ToolInfo\lpszText=@Tip
SendMessage_(ToolTipID,#TTM_SETDELAYTIME,#TTDT_INITIAL,100)
;SendMessage_(ToolTipID,#TTM_SETDELAYTIME,#TTDT_RESHOW,1000); ?????
SendMessage_(ToolTipID,#TTM_SETDELAYTIME,#TTDT_AUTOPOP,10000)
SendMessage_(ToolTipID,#TTM_ADDTOOL,0,ToolInfo); Register tooltip with the control
SendMessage_(ToolTipID,#TTM_SETMAXTIPWIDTH,0,150); Set as a multiline tooltip with wordwrap
SendMessage_(ToolTipID,#TTM_SETTITLE,Icon,Title); Set the icon style and tip title
EndProcedure
Procedure CreateMyMenu()
Protected i,j,n
If IsMenu(#MyPopup) : FreeMenu(#MyPopup) : EndIf
CreatePopupMenu(#MyPopup)
Restore Popup:
Repeat
Read.b Char
Char=Char&$DF
If (Char<'A') Or (Char>'Z')
Break
EndIf
Char-'A'
Read.s Code
If Code=""
Break
EndIf
OpenSubMenu("[&"+Chr(Char+'A')+"] "+Code);+#TAB$+"&"+Chr(Char+'A'))
Title(Char)=Code
For i=1 To 9
Read.s Code
If (Code="")
CloseSubMenu()
Break
EndIf
Text(Char,i)=Code
If Len(Code)>#DisplayLen
Code=Left(Code,#DisplayLen-2)+"..."
EndIf
MenuItem(#PopupA+10*Char+i,"[&"+Chr(i+'0')+"] "+Code);+#TAB$+"&"+Chr(i+'0'))
Next i
ForEver
MenuBar()
MenuItem(#PopupEnde,"Quit");+#TAB$+"&0")
EndProcedure
Procedure.l EventHoverGadget()
Protected cursor.POINT,hndl.l
If GetCursorPos_(cursor.POINT)
hndl=WindowFromPoint_(PeekQ(@cursor))
If hndl
hndl=GetDlgCtrlID_(hndl)
If hndl
ProcedureReturn hndl
EndIf
EndIf
EndIf
ProcedureReturn #HoverNil
EndProcedure
Procedure Hack(h,m,w,l)
Protected n
Select m
Case #WM_MENUSELECT
If OptTooltip
n=w&$ffff
If (n>=#PopupA) And (n<=#PopupZ9)
n-#PopupA
; Debug n
SystrayBalloon_("Textbaustein '"+Chr(n/10+'A')+Chr(n%10+'0')+"':",Shorten(Text(n/10,n%10),255),#NIIF_INFO)
EndIf
EndIf
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure Init()
CreateMyMenu()
; ~~~ Optionen ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
HandleMyOpts=OpenWindow(#MyOpts,0,0,100,250,#ProgramName,#PB_Window_ScreenCentered|#PB_Window_Invisible|#PB_Window_SystemMenu)
TextGadget(#OptInfo,10,10,40,40,"info",#PB_Text_Center|#PB_Text_Border|#SS_CENTERIMAGE|#SS_NOTIFY)
GadgetToolTip_(#MyOpts,#OptInfo,1,0,1,0,0,"Sonderfunktionen",#Functiontext)
ButtonGadget(#Popup,10,100,80,35,"&Popup")
ButtonGadget(#OptOk,10,200,80,35,"&Ok",#PB_Button_Default)
; ~~~ Timer & Callback ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTimer_(HandleMyOpts,0,#WaitClocking,0)
SetWindowCallback(@Hack())
; ~~~ SysTray ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
AddSysTrayIcon(#SysTray,HandleMyOpts,LoadIcon_(#Null,#IDI_HAND))
SysTrayIconToolTip(#SysTray,#ProgramTitle)
; ~~~ Display Options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
HideWindow(#MyOpts,#False)
EndProcedure
Procedure Main()
Protected i,j
Init()
quit=#False
Repeat
EventCode=WaitWindowEvent(100)
Select EventCode
Case #WM_MOUSEMOVE
Dummy=EventHoverGadget()
If (Dummy<>_LastHover)
_LastHover=Dummy
Debug Dummy
If (Dummy<>#HoverNil)
Select Dummy
Case #OptInfo
; "Resolve" windows bug with lost tooltip... (works only with active lines 1 and 3)
SendMessage_(ToolTipID,#TTM_DELTOOL,0,@ToolInfo); Line 1
SendMessage_(ToolTipID,#TTM_ADDTOOL,0,@ToolInfo); Line 2
Debug PeekS(TOOLINFO\lpszText)
;GadgetToolTip_(#MyOpts,#OptInfo,1,0,1,0,0,"Sonderfunktionen",#Functiontext); Line 3
Case #Popup
DisplayPopupMenu(#MyPopup,HandleMyOpts)
; How to hide the Popup menu when the mouse cursor is outside of it???
EndSelect
EndIf
EndIf
Case #PB_Event_Menu,#PB_Event_Gadget; ~~~~~~ Menü / Popup / Gadget / Shortcut ~~~~~~
TypeCode=EventType()
MenuCode=EventMenu()
GadgetCode=EventGadget()
Select GadgetCode
Case #Popup
DisplayPopupMenu(#MyPopup,HandleMyOpts)
Case #PopupEnde,#OptOk
quit=#True
EndSelect
Case #PB_Event_CloseWindow
quit=#True
Case #PB_Event_SysTray; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Mausklick im Systray ~~~~~~
Select EventType()
Case #PB_EventType_RightClick,#PB_EventType_LeftClick
DisplayPopupMenu(#MyPopup,HandleMyOpts)
Case #PB_EventType_LeftDoubleClick
quit=#True
EndSelect
EndSelect
Until quit
EndProcedure
Main()
)...
there's no possible to make the timeout shorter than 10 seconds, I didn't know that 
now I played around with these two functions and they work fine!
except a windows bug that a disappeared tooltip never comes back