Code: Alles auswählen
Declare ToolTipCreate(mainwindow, gadget, text$, title$)
Declare ToolTipTextlvg1(item, subitem)
Declare WindowCallback(hWnd, message, wParam, lParam)
Declare.s Demodaten()
Declare.s ToolTipTextlvg1daten(item, subitem)
Enumeration
#but1
#but2
#but3
#but4
#lvg1
#win1
#font1
EndEnumeration
;Global erklärt weils einfacher ist
Global hdflag, lvid1, hdid1, ttlvg1
LoadFont(#font1, "Arial", 11)
OpenWindow(#win1,0,0,900,480,"ListIcon Gadget",#PB_Window_SystemMenu|1)
SetWindowCallback(@WindowCallback())
ButtonGadget(#but1,10,430,80,45,"tue nix")
ButtonGadget(#but2,120,430,80,45,"tue nix")
ButtonGadget(#but3,230,430,80,45,"tue nix")
lvflags = #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect
lvflags | #PB_ListIcon_MultiSelect | #PB_ListIcon_CheckBoxes
lvid1 = ListIconGadget(#lvg1,10,10,600,400,"Spalte 0",70,lvflags)
hdid1 = SendMessage_(lvid1, #LVM_GETHEADER, 0, 0)
AddGadgetColumn(#lvg1,1,"Spalte 1",155)
AddGadgetColumn(#lvg1,2,"Spalte 2",155)
AddGadgetColumn(#lvg1,3,"Spalte 3",155)
AddGadgetColumn(#lvg1,4,"Spalte 4",155)
SetGadgetFont(#lvg1,FontID(#font1))
SetGadgetColor(#lvg1, #PB_Gadget_BackColor, #Yellow)
HideGadget(#lvg1, 1)
For i = 0 To 196
AddGadgetItem(#lvg1, -1, RSet(Str(i),3) + #LF$ + Demodaten())
Next
HideGadget(#lvg1, 0)
;Tooltip Create + dem ListIconGadget zuweisen
ttlvg1 = ToolTipCreate(#win1, #lvg1, "", "")
SendMessage_(lvid1, #LVM_SETTOOLTIPS, ttlvg1, 0)
;MSDN spinnt
;http://msdn.microsoft.com/en-us/library/ee501405.aspx
;=====================================================
Repeat
event = WaitWindowEvent()
If Event = #PB_Event_Gadget Or Event = #PB_Event_Menu
welcherButton = EventGadget()
Select welcherButton
Case #but1:
EndSelect
EndIf
Until event = #PB_Event_CloseWindow
End
;=====================================================
Procedure ToolTipCreate(mainwindow, gadget, text$, title$)
mainid = WindowID(mainwindow)
flags = #WS_POPUP |#TTS_BALLOON
tthWnd = CreateWindowEx_(0, "ToolTips_Class32", "", flags, 0, 0, 0, 0, mainid, 0, GetModuleHandle_(0), 0)
ti.TOOLINFO\cbSize = SizeOf(TOOLINFO)
ti\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
ti\hWnd = GadgetID(gadget)
ti\uId = GadgetID(gadget)
ti\lpszText = @text$
SendMessage_(tthWnd, #TTM_ADDTOOL, 0, ti)
ProcedureReturn tthWnd
EndProcedure
Procedure.s ToolTipTextlvg1daten(item, subitem)
Static readflag
Static Dim x$(4,4)
If Not readflag
readflag = 1
Restore DemoDaten
For j = 0 To 4
For k = 0 To 4
Read.s x$(j,k)
Next
Next
EndIf
inh$ = GetGadgetItemText(#lvg1, item, subitem)
name$ = ""
Select subitem
Case 1: For k = 0 To 4
If FindString(inh$, x$(1,k), 0)
name$ = x$(1,k): Break
EndIf
Next
Select name$
Case x$(1,0): text$ = "nette Menschen"
Case x$(1,1): text$ = "arme Leute"
Case x$(1,2): text$ = "ganz viele Kinder"
Case x$(1,3): text$ = "haben Geld wie Heu"
Default: text$ = "kenne ich nicht"
EndSelect
Case 2: For k = 0 To 4
If FindString(inh$, x$(2,k), 0)
name$ = x$(2,k): Break
EndIf
Next
Select name$
Case x$(2,0): text$ = "viele Schlaglöcher"
Case x$(2,1): text$ = "keine Parkplätze"
Case x$(2,2): text$ = "schöne Wohngegend"
Case x$(2,3): text$ = "im Dunkeln sehr gefährlich"
Default: text$ = "wo ist das ?"
EndSelect
Case 3: For k = 0 To 4
If FindString(inh$, x$(4,k), 0)
name$ = x$(4,k): Break
EndIf
Next
Select name$
Case x$(4,0): text$ = "liegt glaube ich im Gebirge"
Case x$(4,1): text$ = "schönste Stadt Deutschlands"
Case x$(4,2): text$ = "da regnet es immer"
Case x$(4,3): text$ = "hat viele Kirchen"
Default: text$ = "irgendwo in Europa"
EndSelect
Default: text$ = "Zeile: " + Str(item) + " "
text$ + "Spalte: " + Str(subitem)
If subitem = 0 And item = -1
text$ + #CR$ + #CR$
text$ + "Spalte 0 und kein Text ergibt -1"
text$ + #CR$
text$ + "Bitte bei Microsoft beschweren !"
EndIf
EndSelect
ProcedureReturn text$
EndProcedure
Procedure ToolTipTextlvg1(item, subitem)
Static olditem, oldsubitem
If item <> olditem Or subitem <> oldsubitem
olditem = item
oldsubitem = subitem
text$ = ToolTipTextlvg1daten(item, subitem)
Else
ProcedureReturn
EndIf
ti.TOOLINFO\cbSize = SizeOf(TOOLINFO)
ti\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
ti\hWnd = GadgetID(#lvg1)
ti\uId = GadgetID(#lvg1)
ti\lpszText = @text$
SendMessage_(ttlvg1, #TTM_UPDATETIPTEXT, 0, ti)
titel$ = "Info"
SendMessage_(ttlvg1, #TTM_SETTITLE, 0, titel$)
EndProcedure
Procedure WindowCallback(hWnd, message, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select message
Case #WM_NOTIFY
;diese Struktur sagt von welchem Gadget und was ist wo passiert
*nmhdr.NMHDR = lParam
;wo ist die Maus
If *nmhdr\idFrom = #lvg1
*nmlv.NM_LISTVIEW = lParam
If *nmlv\hdr\code = #LVN_HOTTRACK ;erst ab XP
ToolTipTextlvg1(*nmlv\iitem, *nmlv\isubitem)
EndIf
EndIf
;Headerabfrage von #lvg1 als Beispiel
If *nmhdr\hwndFrom = hdid1
Select *nmhdr\code
Case #NM_RCLICK
Case #HDN_ITEMCLICK
*nmhd.NMHEADER = lParam
Debug "klick auf col " + Str(*nmhd\iItem)
Case #HDN_ITEMCHANGING
;Headerbreite ändern verbieten solange hdflag 0 ist
If hdflag = 0
result = #True
EndIf
EndSelect
EndIf
EndSelect
ProcedureReturn result
EndProcedure
Procedure.s Demodaten()
Dim x$(4,4)
Restore DemoDaten
For j = 0 To 4
For k = 0 To 4
Read.s x$(j,k)
Next
text$ + x$(j,Random(4))
If j = 1: text$ + #LF$: EndIf
If j = 2: text$ + Str(Random(199)+1) + #LF$: EndIf
Next
ProcedureReturn text$
DataSection
DemoDaten:
Data.s "Otto ", "Mike ", "Hans-Jürgen ", "Ulrike ", "Familie "
Data.s "Meier", "Bremer", "Müller", "Holzfäller", "Rappel"
Data.s "Dorfstr. ", "Hauptstr. ", "Malerstr. ", "Neustr. ", "Baumweg "
Data.s "12345 ", "35793 ", "48265 ", "72561 ", "55127 "
Data.s "Wieda", "Bremen", "Kuhdorf", "Neustadt", "Bonn"
EndDataSection
EndProcedure