PureBoard

Code: Alles auswählen

;AuswahlGadget - PB 4.41 (x86) Windows Vista - Dez.2012 - by HJBremer

#awg_maxcols = 100         ;irgendein sinnvoller Wert für Array in der Structure

;flags bei Aufruf          ;z.B. #awg_withspaces | #awg_hidewithesc
#awg_withspaces = 1        ;wenn gesetzt, Auswahl mit Spaces zwischen den Werten
#awg_hidewithesc = 2       ;Gadget verschwindet mit Esc (Hidegadget wird aufgerufen)

Structure AuswahlGadget
   pbnr.i                  ;PB Gadgetnr
   flag.i                  ;für GetText
   cols.i                  ;Anzahl Cols beginnend ab null
   lvptr.i                 ;pointer Rücksprung vom Callback
   mousecolor.i               ;Highlight Mouse
   clickcolor.i               ;Frontcolor für angeclickt
   auswahl.s                  ;Text der angeclickten Spalten für GetText
   colclick.i[#awg_maxcols + 1]  ;enthält angeclicktes item einer Spalte
   StructureUnion                ;um lParam in Hi + Loword zu zerlegen für Mouseposi
      lparam.i                   ; lParam vom Callback
      points.points              ; aufgeteiltes lParam in x + y
   EndStructureUnion   
EndStructure

EnableExplicit

Procedure.s AuswahlGadgetGetText(pbnr)
   
   Protected *awg.AuswahlGadget = GetWindowLongPtr_(GadgetID(pbnr), #GWL_USERDATA)   
   Protected j, item
   
   With *awg
      \auswahl = ""
      For j = 1 To \cols         ;alle Spalten abfragen
         item = \colclick[j]
         If item >= 0
            \auswahl + GetGadgetItemText(pbnr, item, j) 
            If \flag: \auswahl + " ": EndIf
         EndIf   
      Next      
   EndWith
   
   ProcedureReturn *awg\auswahl
   
EndProcedure

Procedure.i AuswahlGadgetAutoSize(pbnr)
   
   Protected *awg.AuswahlGadget = GetWindowLongPtr_(GadgetID(pbnr), #GWL_USERDATA)      
   Protected j, rect.rect
   Protected br = GetSystemMetrics_(#SM_CYEDGE) * 2   ;Rahmenbreite, meistens 2 * 2 = 4
     
   With *awg 
      
      HideGadget(pbnr, 1)
   
      For j = 1 To \cols   
         SendMessage_(GadgetID(pbnr), #LVM_SETCOLUMNWIDTH, j, #LVSCW_AUTOSIZE)
      Next
      
      rect\top = \cols           
      rect\left = #LVIR_LABEL
      SendMessage_(GadgetID(pbnr), #LVM_GETSUBITEMRECT, 0, rect) 
                  
      br + rect\right
      
      ;wenn Scrollbalken vorhanden, Breite addieren
      If GetWindowLongPtr_(GadgetID(pbnr), #GWL_STYLE) & #WS_VSCROLL
         br + GetSystemMetrics_(#SM_CXVSCROLL)
      EndIf
      
      ResizeGadget(pbnr, #PB_Ignore, #PB_Ignore, br, #PB_Ignore)
      
      HideGadget(pbnr, 0)
      
   EndWith
   
EndProcedure

Procedure.i AuswahlGadgetCenterCols(pbnr)
   
   Protected *awg.AuswahlGadget = GetWindowLongPtr_(GadgetID(pbnr), #GWL_USERDATA)   
   Protected j, lv.LV_COLUMN 

   lv\mask = #LVCF_FMT 
   lv\fmt  = #LVCFMT_CENTER 
   
   For j = 1 To *awg\cols
      SendMessage_(GadgetID(pbnr), #LVM_SETCOLUMN, j, lv) 
   Next
   
EndProcedure  

Procedure.i AuswahlGadgetReset(pbnr)
   ;löscht alle Clicks
   
   Protected *awg.AuswahlGadget = GetWindowLongPtr_(GadgetID(pbnr), #GWL_USERDATA)
   Protected j
   
   With *awg      
      For j = 1 To \cols
         SetGadgetItemColor(\pbnr, \colclick[j], #PB_Gadget_FrontColor, -1, j)
         \colclick[j] = -1
      Next            
   EndWith
   
EndProcedure

Procedure.i AuswahlGadgetRelease(pbnr)   
   ;zerstört das Gadget
   
   Protected *awg.AuswahlGadget = GetWindowLongPtr_(GadgetID(pbnr), #GWL_USERDATA)
   
   With *awg      
      SetWindowLongPtr_(GadgetID(pbnr), #GWL_WNDPROC, \lvptr)  ;Callback aufheben
      FreeGadget(pbnr)
      FreeMemory(*awg)            
   EndWith
   
EndProcedure

Procedure.i AuswahlGadgetCallBack(hwnd, msg, wParam, lParam) 
   ;hwnd ist hier gleich der ID vom Gadget
   
   Protected *awg.AuswahlGadget = GetWindowLongPtr_(hwnd, #GWL_USERDATA)   
   Protected j, item, subitem, itemhh, rect.rect   
   Static olditem, oldsubitem
   
   With *awg

      If msg = #WM_MOUSEMOVE
         
         ;nur zur Info. 
         ;#LVN_HOTTRACK gibt es nur im ParentCallback und liefert auch nur dann
         ;den itemwert, wenn der Style #PB_ListIcon_FullRowSelect angegeben wurde
         ;Beides ist hier unerwünscht, darum Berechnung von item und subitem wie folgt.
      
         ;Mouseposi
         \lparam = lparam    ;Hi+Loword stehen in \points\x + y
         
         ;subitem
         For j = 1 To \cols            
            rect\top = j               ;subitem angeben, Col 0 wird nicht benutzt
            rect\left = #LVIR_LABEL
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, 0, rect) 
            If rect\right > \points\x             
               subitem = j: Break
            EndIf                  
         Next
         
         itemhh = rect\bottom - rect\top    ;:Debugr(rect) 
         
         ;item
         item = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) + (\points\y / itemhh)
         
         ;subitem color
         If olditem <> item Or oldsubitem <> subitem
            SetGadgetItemColor(\pbnr, olditem, #PB_Gadget_BackColor, -1, oldsubitem)
            SetGadgetItemColor(\pbnr, item, #PB_Gadget_BackColor, \mousecolor, subitem)
            olditem = item
            oldsubitem = subitem
         EndIf
         
      ElseIf msg = #WM_NCMOUSEMOVE ;msg = #WM_NCMOUSELEAVE
         ;Wenn Maus Gadget verlässt, soll Backcolor wieder hergestellt werden
         ;aber bei schnellen Mausbewegungen geht diese Message verloren.
         SetGadgetItemColor(\pbnr, olditem, #PB_Gadget_BackColor, -1, oldsubitem)

      ElseIf msg = #WM_RBUTTONDOWN
         ;alle Spaltenclicks entfernen, wie AuswahlGadgetReset() 
         For j = 1 To \cols
            SetGadgetItemColor(\pbnr, \colclick[j], #PB_Gadget_FrontColor, -1, j)
            \colclick[j] = -1
         Next   
         
      ElseIf msg = #WM_LBUTTONDOWN
         
         ;olditem ist Static und ist gleich der aktuellen Cursorposition, siehe WM_MOUSEMOVE subitem Color
         
         ;in einer Spalte vorherige Farbe zurücksetzen
         SetGadgetItemColor(\pbnr, \colclick[oldsubitem], #PB_Gadget_FrontColor, -1, oldsubitem)
         
         ;neue Farbe setzen
         SetGadgetItemColor(\pbnr, olditem, #PB_Gadget_FrontColor, \clickcolor, oldsubitem)
         
         ;merken wo neue Farbe gesetzt
         \colclick[oldsubitem] = olditem
         
      ElseIf msg = #WM_CHAR
         If \flag & 2
            If wparam = 27
               HideGadget(\pbnr, 1)
            EndIf
         EndIf

      ElseIf msg = #LVM_INSERTCOLUMN  ;4123
         ;diese Message gibt es nur beim Erstellen der Liste
         ;jeder Aufruf von AddGadgetColumn(pbnr, ... ) erzeugt diese Message
         ;dies ermöglicht das Ermitteln der Spaltenanzahl an dieser Stelle !
         
         ;ermittelt Anzahl Columns und setzt colclick auf -1 
         \cols = SendMessage_(SendMessage_(hwnd, #LVM_GETHEADER, 0, 0), #HDM_GETITEMCOUNT, 0, 0)
         If \cols > #awg_maxcols
            MessageRequester("", "zu viele Spalten, max " + Str(#awg_maxcols))
            End
         EndIf
         \colclick[\cols] = -1 
         
      Else         
         ;debugmsg(msg)
      EndIf      
      
      ProcedureReturn CallWindowProc_(\lvptr, hwnd, msg, wParam, lParam) 
      
   EndWith
EndProcedure 

Procedure.i AuswahlGadget(pbnr, sp, ze, br, hh, flag = 0)
   
   Protected *awg.AuswahlGadget = AllocateMemory(SizeOf(AuswahlGadget))   
   Protected j, id, returnvalue, rect.rect 
   
   Protected flags = #PB_ListIcon_GridLines|#LVS_NOCOLUMNHEADER
      
   With *awg
      
      If pbnr = #PB_Any
         pbnr = ListIconGadget(#PB_Any, sp, ze, br, hh, "", 0, flags)
         returnvalue = pbnr
      Else
         returnvalue = ListIconGadget(pbnr, sp, ze, br, hh, "", 0, flags)
      EndIf
      
      \pbnr = pbnr      
      \flag = flag       
      \mousecolor = #Yellow   ;Backcolor Subitem MouseHighlight
      \clickcolor = $0300D3   ;Frontcolor Subitem angeclickt
      
      ;meine Default Colors
      SetGadgetColor(pbnr, #PB_Gadget_BackColor, $FFF8F9)
      SetGadgetColor(pbnr, #PB_Gadget_FrontColor, $9D0016)
      
      ;Original WindowProcPointer holen
      \lvptr = GetWindowLongPtr_(GadgetID(pbnr), #GWL_WNDPROC)
      
      ;GadgetMemory und eigene WindowProc setzen
      SetWindowLongPtr_(GadgetID(pbnr), #GWL_USERDATA, *awg)
      SetWindowLongPtr_(GadgetID(pbnr), #GWL_WNDPROC, @AuswahlGadgetCallBack())
            
   EndWith
   
   ProcedureReturn returnvalue
   
EndProcedure

DisableExplicit

Code: Alles auswählen

XIncludeFile("AuswahlListe.pbi")   ;Name anpassen

Enumeration
   #window   
   #font0
   #font1
   #ipliste3
   #textgadget
   #buttonrelease
EndEnumeration

Procedure.i FillAuswahlGadget(pbnr)
   
   Protected j, z1
   
   For j = 1 To 7
      AddGadgetColumn(pbnr, j, "", 0)
   Next
   
   For j = 0 To 27      
      AddGadgetItem(pbnr, -1, "")      
   Next
   
   SetGadgetItemText(pbnr, 0, "S.", 1)
   SetGadgetItemText(pbnr, 1, "A.", 1)
   SetGadgetItemText(pbnr, 2, "AO.", 1)
   
   z1 = 135   
   For j = 0 To 16 
      SetGadgetItemText(pbnr, j, Str(z1), 2)
      z1 + 10      
   Next
   
   z1 = 25
   For j = 0 To 11
      SetGadgetItemText(pbnr, j, Str(z1), 3)
      z1 + 5
   Next
   
   z1 = 13
   For j = 0 To 7
      SetGadgetItemText(pbnr, j, Str(z1), 4)
      z1 + 1
   Next
   
   Restore reifenidx
   j = 0
   z1 = 1
   While z1
      Read.i z1
      If z1
         SetGadgetItemText(pbnr, j, " " + Str(z1), 5)
         j + 1
      EndIf
   Wend
   
   z1 = 81
   For j = 0 To 9
      SetGadgetItemText(pbnr, j, Chr(z1), 6)
      z1 + 1
   Next
   
   SetGadgetItemText(pbnr, 0, " MO", 7)
   SetGadgetItemText(pbnr, 1, " NO", 7)
   SetGadgetItemText(pbnr, 2, " RF", 7)
   SetGadgetItemText(pbnr, 3, " 6PR", 7)
   SetGadgetItemText(pbnr, 4, " 8PR", 7)
   
   DataSection
      reifenidx:
      Data.i 71,72,73,75,77,79,80,81,82,83,84,85,86,87,88,89,91,94,95,96,97,98,99
      Data.i 100,102,103,109,112
      Data.i 0
   EndDataSection
   
EndProcedure

Procedure.i Mainwindow()
   
   LoadFont(#font0, "Arial", 9)  
   LoadFont(#font1, "Arial", 12)  
   
   Protected j, event
   
   Protected winbr = 700
   Protected winhh = 550
   Protected flags = #PB_Window_SystemMenu|#PB_Window_MinimizeGadget
   
   OpenWindow(#window, 150, 150, winbr, winhh, "", flags)
   
   AuswahlGadget(#ipliste3, 200, 5, 0, winhh-30)
   SetGadgetFont(#ipliste3, FontID(#font1))
   
   FillAuswahlGadget(#ipliste3)
   
   AuswahlGadgetAutoSize(#ipliste3)
   AuswahlGadgetCenterCols(#ipliste3)
   
   TextGadget(#textgadget, 200, winhh-20, 180, 20, "", #PB_Text_Center)
   
   ;ButtonGadget(#buttonrelease, 10, 10, 80, 20, "Release") 
      
   SetActiveGadget(#ipliste3)
   
   ;Start   
   
   Repeat: event = WaitWindowEvent()
      
      If event = #PB_Event_Gadget   
         
         Select EventGadget()
               
            Case #ipliste3
               ;Eventtype() abfragen vermeidet doppelte Ausführung
               If EventType() = #PB_EventType_LeftClick
                  txt$ = AuswahlGadgetGetText(#ipliste3)                  
                  SetGadgetText(#textgadget, txt$)
               EndIf
               
            Case #buttonrelease
               AuswahlGadgetRelease(#ipliste3)
               
         EndSelect
         
      EndIf
      
   Until event = #PB_Event_CloseWindow 
   
EndProcedure

Mainwindow()