Klappt auch alles, aber warum geht nun GetGadgetItemText nicht mehr ? Das macht zwar nicht viel, kann mir den Text auch über Api holen, aber irgendwie ist das doof.
Hinweis zum Democode: In Column 1 + 2 wird durch anklicken des Image dieses geändert. In Column 3 gibt es keine Änderung. Pfeiltasten werden nicht unterstützt.
Code: Alles auswählen
;ListIconGadget: HJ Bremer PB 4.2 Windows XP
;Bilder/Image in allen Spalten/Columns
;Wie gehabt, Spalte 0 ausgeblendet
;Buffergröße für Text auf 99 gesetzt, sollte meistens reichen
;die Structurvariable lvlr dient dazu das Image nach rechts zu schieben
;Farbbalken mit Pfeiltasten bewegen fehlt noch, brauch ich nicht
;GetGadgetItemText() funktioniert nicht mehr, warum ? keine Ahnung !
Structure myLvGadget
pbnr.i
id.i
font.i
bkcolor.i
lvhh.i
lvbr.i
lvlr.i
lvimglist.i
cbori1.i
cbori2.i
hd.i
hdhh.i
hdoldproc.i
maskcolor.i
clickrow.i
clickcol.i
clickflags.i
clickicon.i
clicktext.s
EndStructure
#LVM_SETEXTENDEDLISTVIEWSTYLE = 4150
#LVS_EX_SUBITEMIMAGES = 2
;====================================================================
Procedure SetGadgetItemIcon(pbnr,row,col,iicon)
buffer.s{99}
lvi.lv_item
lvi\iSubItem = col
lvi\pszText = @buffer
lvi\cchTextMax = 99
SendMessage_(GadgetID(pbnr), #LVM_GETITEMTEXT , row, @lvi)
lvi\mask = #LVIF_IMAGE | #LVIF_TEXT
lvi\iItem = row ; row number for change
lvi\iSubItem = col ; 2nd subitem
lvi\pszText = @buffer ; text to change to
lvi\iImage = iicon ; index of icon in the list
SendMessage_(GadgetID(pbnr), #LVM_SETITEM, 0, @lvi)
EndProcedure
Procedure GetGadgetItemIcon(*lv.myLvGadget)
buffer.s{99}
lvi.lv_item
lvi\mask = #LVIF_IMAGE | #LVIF_TEXT
lvi\iItem = *lv\clickrow
lvi\iSubItem = *lv\clickcol
lvi\cchTextMax = 99
lvi\pszText = @buffer
SendMessage_(*lv\id, #LVM_GETITEM, 0, @lvi)
*lv\clickicon = lvi\iImage
*lv\clicktext = buffer
ProcedureReturn lvi\iImage
EndProcedure
Procedure GetGadgetItemClick(*lv.myLvGadget)
GetCursorPos_(p.POINT)
MapWindowPoints_(0,*lv\id, p, 1)
HitInfo.LVHITTESTINFO
Hitinfo\pt\x = p\x
HitInfo\pt\y = p\y
SendMessage_(*lv\id, #LVM_SUBITEMHITTEST, 0, HitInfo)
*lv\clickrow = hitinfo\iitem
*lv\clickcol = hitinfo\isubitem
*lv\clickflags = hitinfo\flags
EndProcedure
Procedure pbbox(*lv.myLvGadget,farbe)
With *lv
nr = CreateImage(#PB_Any, \lvbr, \lvhh)
StartDrawing(ImageOutput(nr))
;Hintergrundfarbe welche nachher verschwindet
Box(0, 0, \lvbr, \lvhh, \maskcolor)
;sichtbaren Bereich zeichnen, Rahmen, LinkerRand berücksichtigen
x = 3 + \lvlr
y = 4
z = \lvhh - 6
Box(x, y, z, z, #Gray)
;Rahmen ausfüllen
x + 1: y + 1: z - 2
Box(x, y, z, z, farbe)
;nun könnte man ein paar Striche etc, malen
;x + 1: y + 1: z - 2
;Line(x,y,z,z,#Black)
StopDrawing()
EndWith
ProcedureReturn nr
EndProcedure
Procedure pbImage(*lv.myLvGadget,imgid)
With *lv
nr = CreateImage(#PB_Any, \lvbr, \lvhh)
StartDrawing(ImageOutput(nr))
Box(0, 0, \lvbr, \lvhh, \maskcolor)
x = 1 + \lvlr: y = 2: z = \lvhh - 2
;Box(x, y, z, z, #Gray)
;x + 1: y + 1: z - 2
Box(x, y, z, z, \bkcolor)
x + 1: y + 1: z - 2
If imgid
DrawImage(imgid,x,y,z,z)
Else
Box(x, y, z, z, #Magenta)
x + 2: y + 2
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(x, y, "?")
EndIf
StopDrawing()
EndWith
ProcedureReturn nr
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 neue 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
Default: result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndSelect
ProcedureReturn result
EndProcedure
Procedure myListIconGadget(*lv.myLvGadget,x,y,br,hh,flags=0)
With *lv
;flags | #PB_ListIcon_FullRowSelect ;sieht doof aus wenn gesetzt
;flags | #PB_ListIcon_AlwaysShowSelection
flags | #PB_ListIcon_CheckBoxes
flags | #PB_ListIcon_MultiSelect
flags | #PB_ListIcon_GridLines
flags | #PB_ListIcon_HeaderDragDrop
\pbnr = ListIconGadget(#PB_Any,x,y,br,hh,"",0,flags)
\id = GadgetID(\pbnr)
\hd = SendMessage_(\id, #LVM_GETHEADER, 0, 0)
\bkcolor = $FEFEFE
SetGadgetColor(\pbnr, #PB_Gadget_BackColor, \bkcolor)
;Farbe für ImageList_AddMasked_(), diese Farbe verschwindet in den Images
\maskcolor = #White
;Images in anderen Columns aktivieren
exstyle = SendMessage_(\id, #LVM_GETEXTENDEDLISTVIEWSTYLE , 0, 0)
exstyle | #LVS_EX_SUBITEMIMAGES
SendMessage_(\id, #LVM_SETEXTENDEDLISTVIEWSTYLE , 0, exstyle)
;font
If \font = 0
nr = LoadFont(#PB_Any, "ARIAL", 12)
\font = FontID(nr)
EndIf
SetGadgetFont(\pbnr, \font)
SendMessage_(\hd, #WM_SETFONT, \font, 1)
dc = GetDC_(0)
SelectObject_(dc, \font)
GetTextMetrics_(dc,TM.textmetric)
fonthh = TM\tmHeight ;dies ist die wirkliche Höhe
;CheckboxOriginale holen
imglist = SendMessage_(\id, #LVM_GETIMAGELIST, #LVSIL_STATE, 0)
\cbori1 = ImageList_GetIcon_(imglist,0,0)
\cbori2 = ImageList_GetIcon_(imglist,1,0)
;Höhe der Imagelisten festlegen
;ohne Imagelist, wird itemhöhe durch Font bestimmt
;wenn Imagelist höher als Font, bestimmt Imagelist die Höhe eines item
;die höchste der Imagelisten bestimmt die Höhe
;hier wird Imagelist State/Checkbox nicht gebraucht,
;aber da höher als Imagelist Small, bestimmt State die Höhe
hh = fonthh + fonthh / 3
\lvhh = hh - 2 ;für Imagelist Small
\lvlr = 6 ;macht Image breiter,
\lvbr = \lvhh + \lvlr ;dadurch wird es nach rechts gerückt
;create Image List
\lvimglist = ImageList_Create_(\lvbr, \lvhh, #ILC_MASK | #ILC_COLOR32, 0, 0)
SendMessage_(\id, #LVM_SETIMAGELIST, #LVSIL_SMALL, \lvimglist)
;Header
\hdhh = fonthh + fonthh/3 ;headerhöhe
;SubClassing Header
\hdoldproc = SetWindowLong_(\hd, #GWL_WNDPROC, @LV_HeaderWinProc())
SetWindowLong_(\hd, #GWL_USERDATA, *lv)
EndWith
ProcedureReturn 0
EndProcedure
Procedure myListAddIcons(*lv.myLvGadget)
;eigene Images ico oder bmp
; DataSection
; LogoA: IncludeBinary "D:\Bremer\BeispieleV4\ico\birne1.ico"
; LogoB: IncludeBinary "D:\Bremer\BeispieleV4\ico\birne2.ico"
; LogoC: IncludeBinary "D:\Bremer\BeispieleV4\ico\mail1.ico"
; LogoD: IncludeBinary "D:\Bremer\BeispieleV4\ico\irre.bmp"
; EndDataSection
;
; nr1 = ImageID(CatchImage(#PB_Any, ?LogoA))
; nr2 = ImageID(CatchImage(#PB_Any, ?LogoB))
; nr3 = ImageID(CatchImage(#PB_Any, ?LogoC))
; nr4 = ImageID(CatchImage(#PB_Any, ?LogoD))
;System icos zur Demo
nr1 = ExtractIcon_(0,"Shell32.dll", 23)
nr2 = ExtractIcon_(0,"Shell32.dll", 160)
nr3 = LoadIcon_(0,#IDI_ASTERISK)
nr4 = LoadIcon_(0,#IDI_EXCLAMATION)
;pbImage erwartet eine ImageID
;pbImage + pbBox geben eine PB Imagenr zurück und keine ID !!!
;wenn die Reihenfolge hier geändert wird, dann auch in der event Abfrage
max = 20: Dim nr(max)
nr(0) = pbBox(*lv,#Green) ;0 Box grün
nr(1) = pbBox(*lv,#Yellow) ;1 Box gelb
nr(2) = pbBox(*lv,#Red) ;2 Box rot
nr(3) = pbImage(*lv,*lv\cbori1) ;3 Box ohne Haken
nr(4) = pbImage(*lv,*lv\cbori2) ;4 Box mit Haken
nr(5) = pbImage(*lv,nr1) ;5 Birne 1
nr(6) = pbImage(*lv,nr2) ;6 Birne 2
nr(7) = pbImage(*lv,nr3) ;7 Mail
nr(8) = pbImage(*lv,nr4) ;8 Irre
For j = 0 To max
If nr(j)
id = ImageID(nr(j))
ImageList_AddIcon_(*lv\lvimglist, id)
ImageList_AddMasked_(*lv\lvimglist,id,*lv\maskcolor)
FreeImage(nr(j))
EndIf
Next
EndProcedure
Procedure AddGadgetItemEx(pbnr,row,txt$)
#LVS_EX_ImageTrenner = "\\\" ;eigene Konstanten
#LVS_EX_ImageTrennerLg = 3
id = GadgetID(pbnr)
If row = -1: row = CountGadgetItems(pbnr): EndIf
If Left(txt$,1) <> #LF$: txt$ = #LF$ + txt$: EndIf
If Right(txt$,1) <> #LF$: txt$ + #LF$: EndIf
lvi.lv_item
lvi\mask = #LVIF_IMAGE | #LVIF_TEXT
For j = 1 To CountString(txt$,#LF$)
sub$ = StringField(txt$,j,#LF$)
iicon = -1
p = FindString(sub$, #LVS_EX_ImageTrenner, 1)
If p
iicon = Val(Left(sub$,p)) ; Debugl(iicon)
sub$ = Mid(sub$,p+#LVS_EX_ImageTrennerLg)
EndIf
lvi\iItem = row ;
lvi\iSubItem = j-1
lvi\pszText = @sub$
lvi\iImage = iicon ; index of icon in the list
If lvi\iSubItem = 0
SendMessage_(id, #LVM_INSERTITEM , 0, @lvi)
Else
SendMessage_(id, #LVM_SETITEM, 0, @lvi)
EndIf
Next
EndProcedure
Procedure AddGadgetItemData(pbnr, pos)
;kann im Prinzip auch zum Zerlegen einer Datei benutzt werden
;nicht die allerschnellste Routine, aber schnell genug
x = 2 ;x = länge Satzendezeichen # + char null
memorypos = ?LVInhaltA
memorybis = ?LVInhaltB
;zerlege Daten nach # = 1 zeile
Repeat
p = strchr_(memorypos,'#') ;dies ist eine Api Funktion
lg = p - memorypos
If p: satz$ = PeekS(memorypos, lg) ;: Debug satz$
satz$ = ReplaceString(satz$,"|",#LF$)
AddGadgetItemEx(pbnr, pos, satz$)
memorypos + lg + x
Else
Break ;zur Sicherheit, falls p null ist
EndIf
Until memorypos >= memorybis
EndProcedure
;====================================================================
nr = OpenWindow(#PB_Any,100,100,550,500, "Icon", #PB_Window_SystemMenu)
hwnd = WindowID(nr)
CreateGadgetList(hwnd)
infotext = TextGadget(#PB_Any, 11, 11, 333, 33, "Infotext")
lv.myLvGadget
myListIconGadget(lv,10,50,500,350)
myListAddIcons(lv)
AddGadgetColumn(lv\pbnr, 1, "C1",199)
AddGadgetColumn(lv\pbnr, 2, "C2",199)
AddGadgetColumn(lv\pbnr, 3, "C3",199)
AddGadgetItemData(lv\pbnr,-1)
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case lv\pbnr
If EventType() = #PB_EventType_LeftClick
;löscht alte Backgroundfarbe
SetGadgetItemColor(lv\pbnr, lv\clickrow, #PB_Gadget_BackColor, lv\bkcolor, lv\clickcol)
;wo wurde geclickt
GetGadgetItemClick(lv)
icon = GetGadgetItemIcon(lv): SetGadgetText(infotext, lv\clicktext)
Select lv\clickcol
Case 1
If lv\clickflags = #LVHT_ONITEMICON
Select icon
Case 0: i = 1
Case 1: i = 2
Case 2: i = 0
Default:i = 0
EndSelect
SetGadgetItemIcon(lv\pbnr, lv\clickrow, lv\clickcol, i)
EndIf
Case 2
If lv\clickflags = #LVHT_ONITEMICON
Select icon
Case 3: i = 4
Case 4: i = 3
Default:i = 3
EndSelect
SetGadgetItemIcon(lv\pbnr, lv\clickrow, lv\clickcol, i)
EndIf
Case 3 ;keine Imageänderung
EndSelect ;von lv\clickcol
SetGadgetItemColor(lv\pbnr, lv\clickrow, #PB_Gadget_BackColor, #Red, lv\clickcol)
EndIf ;von EventType()
EndSelect ;von EventGadget()
EndSelect ;von event
Until event = #PB_Event_CloseWindow
End
DataSection
LVInhaltA:
Data.s "0\\\Otto Meier|4\\\bezahlt ?|5\\\alles Banane#"
Data.s "2\\\Arto Meier|4\\\bezahlt ?|6\\\24 Kartoffeln#"
Data.s "1\\\Egon Meier|3\\\bezahlt ?|7\\\keine Birnen#"
Data.s "0\\\Rudi Meier|3\\\bezahlt ?|8\\\viele Orangen#"
Data.s "0\\\Otto Geier|3\\\bezahlt ?|6\\\alles in Butter#"
LVInhaltB:
EndDataSection