Anregungen und Tips und Codes willkommen
Code: Alles auswählen
#LVS_EX_LABELTIP = $4000
Structure myLVGadget
idstrg.s{10} ;nur für Testinfo
flags.i ;nur im Quellcode ändern, ListIconflags
pb.i ;intern PB Nr
id.i ;intern GadgetID()
hwnd.i ;intern WindowID() Parentwindow = hwnd vom Hauptfenster
header.i ;intern HeaderID
hdtheme.i ; -> kann verändert werden, Header Theme abschalten
bkcolor.i ; -> kann verändert werden, Hintergrundfarbe
fontid1.i ; -> kann verändert werden, Font
fontid2.i ; -> kann verändert werden, Font
fonthh1.i ;nur im Quellcode ändern
fonthh2.i ;nur im Quellcode ändern
lvhh.i ;nur im Quellcode ändern
lvimglist.i ;intern
lvlabeltip.i ; -> kann verändert werden, 0 oder 1
cbhh.i ;nur im Quellcode ändern
cbimglist.i ;intern
cbhh1.i ;nur im Quellcode ändern
cbhh2.i ;nur im Quellcode ändern
cbimg1.i ; -> kann verändert werden, Image
cbimg2.i ; -> kann verändert werden, Image
cbimgID.i ;intern
cbframe.i ; -> kann verändert werden, 1 = Rahmen, 0 = kein Rahmen
cbcolor1.i ; -> kann verändert werden, Buttonfarbe
cbcolor2.i ; -> kann verändert werden, Buttonfarbe
cbnormal.i
lvoldproc.i ;intern
hdoldproc.i ;intern
hdhh.i ;nur im Quellcode ändern
hdflag.i ; -> kann verändert werden, Headerbreite ändern ja/nein
hdsort.i ; -> kann verändert werden, Sortieren
hdCDraw.i ; -> kann verändert werden, Header farbig
hdbrush1.i
hdbrush2.i
hdbkclr1.i
hdbkclr2.i
hdtxtclr1.i
hdtxtclr2.i
hdicons.i[22] ;für 0 - 21 Spalten nur Icons, keine BMPs
EndStructure
Procedure LV_WinProc(hWnd, Msg, wParam, lParam)
;aus dem englischen Forum, etwas abgeändert
;hwnd ist hier die ListIconGadget idnr
*this.myLVGadget = GetWindowLong_(hWnd,#GWL_USERDATA)
oldproc = *this\lvoldproc
result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
If Msg = #WM_NOTIFY
*pnmh.NMHDR = lparam
; --> Get handle to ListIcon header control
If *pnmh\code = #NM_CUSTOMDRAW
*pnmcd.NMCUSTOMDRAW = lparam
; --> Determine drawing stage
Select *pnmcd\dwDrawStage
Case #CDDS_PREPAINT: result = #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
;Get header text.
;text$=GetGadgetItemText(GetDlgCtrlID_(hWnd),-1,*pnmcd\dwItemSpec)
text$=GetGadgetItemText(*this\pb,-1,*pnmcd\dwItemSpec)
;Check button state.
If *pnmcd\uItemState & #CDIS_SELECTED
DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH|#DFCS_PUSHED)
;Offset text because of the selected button.
InflateRect_(*pnmcd\rc,-1,-1) ;Text bewegt sich, wenn Button gedrückt
Else
DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH)
EndIf
;Draw background.
*pnmcd\rc\bottom-2 : *pnmcd\rc\right-2
SetBkMode_(*pnmcd\hdc,#TRANSPARENT)
If *pnmcd\dwItemSpec & 1
FillRect_(*pnmcd\hdc, *pnmcd\rc, *this\hdbrush1)
SetTextColor_(*pnmcd\hdc, *this\hdtxtclr1)
Else
FillRect_(*pnmcd\hdc, *pnmcd\rc, *this\hdbrush2)
SetTextColor_(*pnmcd\hdc, *this\hdtxtclr2)
EndIf
;Icon links
x = *pnmcd\rc\left+2
y = *pnmcd\rc\top+3
hh = *pnmcd\rc\bottom - *pnmcd\rc\top - 6
col = *pnmcd\dwItemSpec
DrawIconEx_(*pnmcd\hdc,x,y,*this\hdicons[col],hh,hh,0,0,#DI_NORMAL)
;anstatt Text vielleicht Icon in die Mitte oder was weiß ich
;Text in die Mitte, wenn Text neben dem Icon = *pnmcd\rc\left-hh+1 und #DT_CENTER weg
*pnmcd\rc\top+2
InflateRect_(*pnmcd\rc,-5,0)
If *pnmcd\rc\right > *pnmcd\rc\left
DrawText_(*pnmcd\hdc, @text$, -1, *pnmcd\rc, #DT_CENTER|#DT_VCENTER|#DT_END_ELLIPSIS)
EndIf
result = #CDRF_SKIPDEFAULT
EndSelect
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure LV_HeaderWinProc(hWnd, Msg, wParam, lParam)
;hwnd ist hier die header idnr
;result muß hier in jeder Funktion/Abfrage gesetzt werden, sonst geht nix richtig
*this.myLVGadget = GetWindowLong_(hWnd,#GWL_USERDATA)
;in *this\hdhh steht die Headerhöhe
oldproc = *this\hdoldproc
result = 0
Select Msg
Case #HDM_LAYOUT
result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
If *this\hdhh
*hdlayout.HD_LAYOUT = lParam
If *hdlayout\prc <> 0
*rect.RECT = *hdlayout\prc
*rect\top = *this\hdhh
EndIf
If *hdlayout\pwpos <> 0
*windowpos.WINDOWPOS = *hdlayout\pwpos
*windowpos\cy = *this\hdhh
EndIf
EndIf
Case #WM_LBUTTONDOWN ;513 ; linke Maustaste
;wo wurde im Header geklickt
hit.HD_HITTESTINFO
hit\pt\x = lParam & $FFFF : Debug hit\pt\x
hit\pt\y = (lParam >> 16) & $FFFF : Debug hit\pt\y
SendMessage_(hwnd,#HDM_HITTEST,0,hit) : Debug hit\flags
: Debug "----"
;wenn Trennbalken = Divider zum verschieben angeklickt
If (hit\flags & #HHT_ONDIVIDER ) = #HHT_ONDIVIDER
;wenn hdflag = 0 verschieben verboten
;wenn 1 verschieben erlaubt, z.B. wegen Autobreite
If *this\hdflag
Debug "verschieben erlaubt"
result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
Else
Debug "verboten"
result = 0 ;dann tue nix = verschieben nicht möglich
EndIf
;wenn im Header geklickt wurde
ElseIf (hit\flags & #HHT_ONHEADER ) = #HHT_ONHEADER
If *this\hdsort
;ListView_Sort(*this\pb, hit\iitem)
Debug "Jetzt wird sortiert nach Spalte "+Str(hit\iitem)+" in "+*this\idstrg
Else
Debug "Sortieren verboten in "+*this\idstrg
EndIf
result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
;normal weiter
Else
result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndIf
Default: result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndSelect
ProcedureReturn result
EndProcedure
Procedure NewCheckboxes(*lv.myLVGadget)
; --> in einem Bild werden beide Checkboxen gemalt
;Angaben für Höhe sollten durch 2 ohne Rest teilbar sein
;Höhe ist auch gleichzeitig Breite
;cbhh = höhe = breite, dies ist der gleiche Wert wie bei ImageList_Create_
;cbhh1 = höhe imgage 1, gleicher Wert wie cbhh oder kleiner
;cbhh2 = höhe imgage 2,
;cbimg1 = unchecked
;cbimg2 = checked
;cbframe= Rahmen malen
With *lv
img = CreateImage(#PB_Any, \cbhh*2, \cbhh)
dc = StartDrawing(ImageOutput(img))
;für beide CBs
Box(0, 0, 2 * \cbhh, \cbhh, \bkcolor)
;unchecked zentriert
If \cbhh1 > \cbhh: \cbhh1 = \cbhh: EndIf
x =(\cbhh - \cbhh1) / 2: y = (\cbhh - \cbhh1) / 2: z = \cbhh1
If \cbframe
Box(x, y, z, z, #Gray) ;Rahmenfarbe
x+1: y+1: z-2 ;x+1 dann z-2, x+2 dann z-4 usw.
EndIf
If \cbimg1
Box(x, y, z, z, \bkcolor)
x+1: y+1:z-2
DrawImage(\cbimg1,x,y,z,z)
Else
color = \cbcolor1
Repeat
Box(x, y, z, z, color)
x+1: y+1: z-2
If color < $eeeeee: color + $111100: EndIf
Until z < 0
EndIf
;checked zentriert
If \cbhh2 > \cbhh: \cbhh2 = \cbhh: EndIf
x = \cbhh + ((\cbhh - \cbhh2) / 2): y = (\cbhh - \cbhh2) / 2: z = \cbhh2
If \cbframe
Box(x, y, z, z, #Gray) ;Rahmenfarbe
x+1: y+1: z-2
EndIf
If \cbimg2
Box(x, y, z, z, \bkcolor)
x+1: y+1: z-2
DrawImage(\cbimg2,x,y,z,z)
Else
color = \cbcolor2
Repeat
Box(x, y, z, z, color)
x+1: y+1: z-2
If color < $eeeeee: color + $111100: EndIf
Until z < 0
EndIf
StopDrawing()
\cbimgID = ImageID(img)
EndWith
ProcedureReturn img
EndProcedure
Procedure myListIconGadget(*lv.myLVGadget, x, y, br, hh, col$, colbr, flags=0)
;#LVS_EX_LABELTIP = $4000
With *lv
;bei Bedarf Vorgaben festlegen
;\hdsort = 1 ;Sortieren
;\hdflag = 1 ;Col-Breite ändern
;\hdCDraw = 1
;\cbframe = 1 ;
;\lvlabeltip = 1 ;
\flags = #PB_ListIcon_GridLines|#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection
If flags
\flags | flags ;in der Regel kommt #PB_ListIcon_CheckBoxes dazu
EndIf
\pb = ListIconGadget(#PB_Any, x, y, br, hh, col$, colbr, \flags)
\id = GadgetID(\pb)
\hwnd = GetParent_(\id)
\header = SendMessage_(\id, #LVM_GETHEADER, 0, 0)
;classname.s{255}
;Debug GetClassName_(\header,@classname,255): Debug classname
If \lvlabeltip
exstyle = SendMessage_(\id, #LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
SendMessage_(\id, #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, exstyle | #LVS_EX_LABELTIP)
EndIf
;das Einfärben des Headers bedeutet Ownerdraw, und dann muß man alles selbst machen
;bei Bedarf Theme nur für den Header einfach abschalten und dann ist Header grau
If \hdtheme
SetWindowTheme_(\header, @null.w, @null.w)
EndIf
If \bkcolor = 0: \bkcolor = $FaFDFD: EndIf ;#White
SetGadgetColor(\pb, #PB_Gadget_BackColor, \bkcolor)
;Font für Liste
If \fontid2 = 0
\fontid2 = FontID(LoadFont(#PB_Any, "Courier", 10))
EndIf
dc = GetDC_(hwnd)
SelectObject_(dc,\fontID2)
GetTextMetrics_(dc,TM.textmetric)
\fonthh2 = TM\tmHeight ;dies ist die wirkliche Höhe
SetGadgetFont(\pb, \fontID2)
;Font für Header
If \fontid1 = 0
\fontid1 = FontID(LoadFont(#PB_Any, "Ariel", 14))
EndIf
SelectObject_(dc,\fontID1)
GetTextMetrics_(dc,TM.textmetric)
\fonthh1 = TM\tmHeight ;dies ist die wirkliche Höhe
SendMessage_(\header, #WM_SETFONT, \FontID1, 1)
;div Vorgaben
\hdhh = \fonthh1 + \fonthh1/4
\lvhh = \fonthh2 + \fonthh2/2 ;wenn Checkbox, sollte lvhh = cbhh sein, muß aber nicht
\cbhh = \lvhh ;max Höhe der Checkbox
\cbhh1 = \fonthh2 + 2 ;wirkliche Höhe der Checkboxen
\cbhh2 = \fonthh2 + 4
\cbcolor1 = #Gray ;wenn kein Image = Buttonfarbe
\cbcolor2 = #Red ;wenn kein Image = Buttonfarbe
; --> Create imagelist für Icon in Zeile vom ListIconGadget
;bestimmt indirekt die Zeilenhöhe
;wenn man auf diese Imagelist verzichtet, wird die Höhe der Zeilen
;durch den Font bzw. die Checkbox bestimmt, die erste Null steht für
;die Breite der nicht vorhandenen Icons. Wird bei AddGadgetItem ein
;Image angegeben ist alles für die Katz und PB macht seinen eigenen Mist
\lvimglist = ImageList_Create_(0, \lvhh, #ILC_COLORDDB, 0, 0)
SendMessage_(\id, #LVM_SETIMAGELIST, #LVSIL_SMALL, \lvimglist)
; --> Create imagelist für Checkbox ListIconGadget
If \flags & #PB_ListIcon_CheckBoxes
If \cbnormal ;Originale laden
\cbimglist = SendMessage_(\id, #LVM_GETIMAGELIST, #LVSIL_STATE, 0)
If \cbimg1 = 0
\cbimg1 = ImageList_GetIcon_(\cbimglist,0,#ILD_NORMAL)
EndIf
If \cbimg2 = 0
\cbimg2 = ImageList_GetIcon_(\cbimglist,1,#ILD_NORMAL)
EndIf
\cbframe = 1
EndIf
NewCheckboxes(*lv) ;erstellt Image \cbimgID
\cbimglist = ImageList_Create_(\cbhh, \cbhh, #ILC_MASK|#ILC_COLORDDB, 0, 2)
ImageList_Add_(\cbimglist, \cbimgID, 0)
SendMessage_(\id, #LVM_SETIMAGELIST, #LVSIL_STATE, \cbimglist)
EndIf
;HeaderFarben
If \hdbrush1 And \hdbrush2 ; zwei BMP wurden angegeben
\hdbrush1 = CreatePatternBrush_(\hdbrush1)
\hdbrush2 = CreatePatternBrush_(\hdbrush2)
ElseIf \hdbrush1
\hdbrush1 = CreatePatternBrush_(\hdbrush1)
\hdbrush2 = \hdbrush1
ElseIf \hdbrush2
\hdbrush2 = CreatePatternBrush_(\hdbrush2)
\hdbrush1 = \hdbrush2
Else
If \hdbkclr1 = 0: \hdbkclr1 = #Yellow: EndIf
If \hdbkclr2 = 0: \hdbkclr2 = #Red: EndIf
\hdbrush1 = CreateSolidBrush_(\hdbkclr1)
\hdbrush2 = CreateSolidBrush_(\hdbkclr2)
EndIf
If \hdtxtclr1 = 0: \hdtxtclr1 = #Black: EndIf
If \hdtxtclr2 = 0: \hdtxtclr2 = #Blue: EndIf
;SubClassing Header
\hdoldproc = SetWindowLong_(\header, #GWL_WNDPROC, @LV_HeaderWinProc())
SetWindowLong_(\header, #GWL_USERDATA, *lv)
;SubClassing ListIconGadget für Header farbig
If \hdCDraw
\lvoldproc = SetWindowLong_(\id, #GWL_WNDPROC, @LV_WinProc())
SetWindowLong_(\id, #GWL_USERDATA, *lv)
EndIf
EndWith
EndProcedure
;==========================================================
icon1 = ImageID(CatchImage(#PB_Any, ?Logo1))
icon2 = ExtractIcon_(0,"Shell32.dll", 23)
icon3 = ExtractIcon_(0,"Shell32.dll", 160)
icon4 = LoadIcon_(0,#IDI_ASTERISK)
icon5 = LoadIcon_(0,#IDI_EXCLAMATION)
icon6 = LoadIcon_(0,#IDI_HAND)
icon7 = LoadIcon_(0,#IDI_QUESTION)
UseJPEGImageDecoder()
bmpID1 = ImageID(CatchImage(#PB_Any, ?Logo2))
bmpID2 = ImageID(CatchImage(#PB_Any, ?Logo3))
;==========================================================
nr = OpenWindow(#PB_Any, 0, 0, 800, 600, "",#PB_Window_SystemMenu | 1)
CreateGadgetList(WindowID(nr))
lv1.myLVGadget
lv1\idstrg = "LV 1" ;nur für Testzwecke
myListIconGadget(lv1, 10, 10, 350, 350, "Tage", 150, #PB_ListIcon_CheckBoxes)
For a = 1 To 2
addtext$ = "Col" + Str(a)
AddGadgetColumn(lv1\pb, a, addtext$,90)
Next
;vergrößert die letzte Column
SendMessage_(lv1\id, #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE_USEHEADER)
For a = 0 To 12
addtext$ = "LV 1 Item " + Str(a) + #LF$ + #LF$ + "Dies ist ein Text"
AddGadgetItem(lv1\pb, -1, addtext$)
Next
; ---------------------------------------------------
lv2.myLVGadget
lv2\idstrg = "LV 2"
lv2\cbimg1 = icon6
lv2\cbimg2 = icon3
lv2\fontid1 = FontID(LoadFont(#PB_Any, "Times", 18))
lv2\fontid2 = FontID(LoadFont(#PB_Any, "Courier", 12))
lv2\cbframe = 1
lv2\hdflag = 1
lv2\hdsort = 1
lv2\hdCDraw = 1
lv2\hdbrush1 = bmpId1
lv2\hdbrush2 = bmpId2
lv2\lvlabeltip = 1
lv2\hdicons[0] = icon1
lv2\hdicons[1] = icon2
lv2\hdicons[2] = icon4
myListIconGadget(lv2, 400, 10, 350, 350, "Tage", 122, #PB_ListIcon_CheckBoxes)
For a = 1 To 2
addtext$ = "Col" + Str(a)
AddGadgetColumn(lv2\pb, a, addtext$,142)
Next
For a = 0 To 12
addtext$ = "Item " + Str(a)
If a = 5: addtext$ + " dies ist ein Test": EndIf
AddGadgetItem(lv2\pb, -1, addtext$)
Next
SetGadgetItemText(lv2\pb,3,"Hallo du bist hier",1)
; ---------------------------------------------------
lv3.myLVGadget
lv3\idstrg = "LV 3" ;nur für Testzwecke
lv3\hdcdraw = 1
lv3\lvlabeltip = 1
lv3\cbnormal = 1
lv3\cbimg2 = icon3
myListIconGadget(lv3, 10, 380, 350, 200, "Tage", 150, #PB_ListIcon_CheckBoxes)
For a = 1 To 2
addtext$ = "Col" + Str(a)
AddGadgetColumn(lv3\pb, a, addtext$,90)
Next
;vergrößert die letzte Column
SendMessage_(lv3\id, #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE_USEHEADER)
For a = 0 To 12
addtext$ = "LV 1 Item " + Str(a) + #LF$ + #LF$ + "Dies ist ein Text"
AddGadgetItem(lv3\pb, -1, addtext$)
Next
;Testbilder
ImageGadget(#PB_Any,400,400,0,0,lv1\cbimgID)
ImageGadget(#PB_Any,400,440,0,0,lv2\cbimgID)
ImageGadget(#PB_Any,400,480,0,0,lv3\cbimgID)
;==========================================================
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case lv1\pb
x$ = ""
For j = 0 To 12
state = GetGadgetItemState(lv1\pb,j)
x$ + Str(state)
Next
Debug x$
EndSelect
EndSelect
Until event = #PB_Event_CloseWindow
End
IncludePath #PB_Compiler_Home + "Examples\Sources\Data\"
Logo1: IncludeBinary "cdplayer.ico"
Logo2: IncludeBinary "clouds.jpg"
Logo3: IncludeBinary "terrain_detail.jpg"