PureBoard

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