Da es auch für Version PB 4.4 laufen mußte, habe ich ein statisches Array in der Structure benutzt
IncludeDatei:
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()