XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Listview mit Icons erzeugen
(C) Uwe Pascal Niemeier
window 30,30-550,300
usefont MS Sans Serif,15,7,0,0,0
setdialogfont 1
settruecolor 1
----------------------------------------------------------------ImageList
declare IcoList&
def ImageList_Create(5) !COMCTL32,ImageList_Create
def ImageList_AddIcon(2) !COMCTL32,ImageList_AddIcon
def ImageList_Destroy(1) !COMCTL32,ImageList_Destroy
def LoadIcon(2) !USER32,LoadIconA
IcoList&=ImageList_Create(16,16,1,1,0)---Parameter 1+2: Grösse der Icons
ImageList_AddIcon(IcoList&,LoadIcon(0,32512))---SystemIcons laden
ImageList_AddIcon(IcoList&,LoadIcon(0,32513))
ImageList_AddIcon(IcoList&,LoadIcon(0,32514))
--------------------------------------------Diesen Pfad bitte anpassen!!
 $H X:Experimente 7.0ListViewListView.ph
 $H ListView.ph
---------------------------------------------------------------------------------Funktionen
------Spalte einfügen
def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
------Kombination aus LVM_SETITEMTEXT und LVM_INSERTITEM, weil zum Anlegen des Items
------und zum Setzen der SubItem-Texte verschiedene Messages nötig sind
def LvInsertItem(1) if(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
------Suche nach Item mit State LVIS_SELECTED = $02
def LvGetSelect(1) sendmessage( &(1),~LVM_GETNEXTITEM,-1,~LVIS_SELECTED )
------Text eines Items/SubItems abfragen
def LvGetItemText(2) sendmessage( &(1),~LVM_GETITEMTEXT,&(2),Lv# )
------Eigenschaften eines Items setzen (z.B. SubItem-Icon)
def LvSetItem(1) sendmessage( &(1),~LVM_SETITEM,0,Lv# )
declare Lvc#,Lv#,Lv1&
Lv1&=control(SysListView32,,$54010009,20,20,400,200,%hwnd,1,%hinstance,$200)
sendmessage(Lv1&,~LVM_SETIMAGELIST,1,IcoList&)--------ListView mit ImageList verbinden
sendmessage(Lv1&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_GRIDLINES | ~LVS_EX_SUBITEMIMAGES)
-----------------Font des Headers ändern
declare Font&,Header&
Font&=Create(Font,Arial,15,15,0,0,0)
Header&=sendmessage(Lv1&,~LVM_GETHEADER,0,0)
setfont Header&,Font&
struct Lvc=Mask&,Fmt&,Cx&,Text&,TextMax&,SubItem&,Image&,Order&,Text$(200)
dim Lvc#,Lvc
clear Lvc#
Lvc#.Mask&    =~LVCF_TEXT | ~LVCF_IMAGE | ~LVCF_WIDTH
Lvc#.Text&    =Lvc#+32
Lvc#.TextMax& =200
Lvc#.Cx&   =200
Lvc#.Image&=1
Lvc#.Text$ =Text 1
LvInsertColumn(Lv1&,0)
Lvc#.Cx&   =150
Lvc#.Image&=0
Lvc#.Text$ =Text 2
LvInsertColumn(Lv1&,1)
dispose Lvc#
struct Lvi=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&,Param&,Text$(200)
dim Lv#,Lvi
clear Lv#
Lv#.Text&   =(Lv#+36)
Lv#.TextMax&=200----Maximal zu erwartende Textlänge entspricht Länge von Lv#.Text$
-------------------------------------------------Item 1
Lv#.Mask&   =~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE
Lv#.Image&   =1
Lv#.Item&    =0
Lv#.SubItem& =0
Lv#.Text$    =Eintrag 1
LvInsertItem(Lv1&)
Lv#.SubItem& =1
Lv#.Text$    =Eintrag 2
LvInsertItem(Lv1&)
Lv#.Mask&   =~LVIF_IMAGE
Lv#.Image&  =2
LvSetItem(Lv1&)
-------------------------------------------------Item 2
Lv#.Mask&   =~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE
Lv#.Image&   =2
Lv#.Item&    =1
Lv#.SubItem& =0
Lv#.Text$    =Eintrag 3
LvInsertItem(Lv1&)
Lv#.SubItem& =1
Lv#.Text$    =Eintrag 4
LvInsertItem(Lv1&)
Lv#.Mask&   =~LVIF_IMAGE
Lv#.Image&  =1
LvSetItem(Lv1&)

while 1----------------------------------Abfrage

    waitinput
    settext %hwnd,str$(LvGetSelect(Lv1&))

endwhile

-----dies sollte beim praktischen Einsatz spätestens bei Programm-Ende erreicht werden!
destroywindow(Lv1&)
ImageList_Destroy(IcoList&)
DeleteObject Font&
dispose Lv#