XProfan

 $H commctrl.ph
DEf LockWindowUpdate(1) ! "USER32","LockWindowUpdate"
Def InitCommonControls(0) !"COMCTL32","InitCommonControls"
InitCommonControls()
DEF ExtractIcon(3) !"SHELL32","ExtractIconA"
window 30,30-550,300
usefont "MS Sans Serif",15,7,0,0,0
setdialogfont 1
settruecolor 1
----------------------------------------------------------------ImageList
declare IcoList&
Def SetWindowlong(3) ! "USER32.DLL","SetWindowLongA" zum Ändern des Fensterstils
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"
Def ImageList_Add(3) !"COMCTL32","ImageList_Add"
declare himagelist&,e%,datei#,imagehandle&
DECLARE PictureObject&
IcoList&=ImageList_Create(18,18,1,1,0)---Parameter 1+2: Grösse der Icons
ImageList_AddIcon(IcoList&,PictureObject&)---SystemIcons laden
ImageList_AddIcon(IcoList&,LoadIcon(0,32512))---SystemIcons laden
ImageList_AddIcon(IcoList&,LoadIcon(0,32513))
ImageList_AddIcon(IcoList&,LoadIcon(0,32514))
Declare LVColumntext#,LVCOLUMN#
Dim LVColumntext#,255
Dim LVCOLUMN#,300

PROC LVINSERTCOLUMN --------------------HEADER-für ReportStil--------------------------

    string LVColumnText#,0 = @$(5)      Der Übergebene Text in @$(4)        ok
    long LVCOLUMN#,0 = $000F            MAsk,Text|Format|Width|Subitem      ok
    long LVCOLUMN#,4 = @&(3)            Ausrichtung                In @&(2) ok
    long LVCOlumn#,8 = @&(4)            Width of Column in Pixeln. In @&(3) ok
    Long LVColumn#,12= LVColumnText#    die Adresse aus LVColumntext#       ok
    sendmessage(@&(1),$101B,@&(2),LVColumn#) Insertcolumn. in @&(1)        ok
    ENDPROC -------------------------------------------------------------------------
    def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
    def LvInsertItem(1) if(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
    def LvGetSelect(2) sendmessage( &(1),~LVM_GETNEXTITEM,&(2),~LVIS_SELECTED )
    def LvGetItemText(2) sendmessage( &(1),~LVM_GETITEMTEXT,&(2),Lv# )
    def LvSetItem(1) sendmessage( &(1),~LVM_SETITEM,0,Lv# )
    Declare LV_Handle&    Handle des Aktuellen listviews
    ---------------------------------------------------------------------------------Funktionen

    proc InsertColumn

        Parameters LV_Handle&,mask&,Fmt&,Cx&,Text$,Textmax&,Subitem&,Image&,Order&
        LvInsertColumn(@&(1),0)

    Endproc

    >>> Setzt die Eigenschaften für das Listview...

    Proc SetItem

        Parameters LV_Handle&,mask&,state&,statemask&,image&,item&,subitem&,text$
        Lv#.Mask&   = @&(2)
        Lv#.state&  = @&(3)
        Lv#.statemask&  = @&(4)
        Lv#.Image&   = @&(5)
        Lv#.Item&    = @&(6)
        Lv#.SubItem& = @&(7)
        Lv#.Text$    = @$(8)
        LvInsertItem(Lv1&)
        Lv#.Mask&   =~LVIF_IMAGE
        LvSetItem(Lv1&)

    endproc

    declare Lvc#,Lv#,Lv1&
    Lv1&=control("SysListView32","",$54010009,0,0,550,300,%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 | ~LVS_EX_CHECKBOXES | ~LVS_EX_FULLROWSELECT | ~LVS_EX_HEADERDRAGDROP | ~LVS_EX_FLATSB | ~LVS_EX_INFOTIP)
    sendmessage(lv1&,$1001,0,$00AAAAAA)     Hintergrund-Farbe ok |
    sendmessage(lv1&,$1024,0,$000000FF)     Text-Farbe        ok |
    sendmessage(lv1&,$1026,0,$FFFFFFFF)     TextHintergrund-Farbe transparent? -1
    -----------------Font des Headers ändern
    declare Font&,Header&
    Font&=Create("Font","Arial",18,0,1,0,0)
    Header&=sendmessage(Lv1&,~LVM_GETHEADER,0,0)
    setfont Header&,Font&
    struct Lvc=Mask&,Fmt&,Cx&,Text&,TextMax&,SubItem&,Image&,Order&,Text$(20)
    dim Lvc#,Lvc
    clear Lvc#
    Lvc#.Mask&    =~LVCF_TEXT | ~LVCF_IMAGE | ~LVCF_WIDTH
    Lvc#.Text&    =Lvc#+32
    Lvc#.TextMax& =200
    Lvc#.Cx&   =180   Breite
    Lvc#.Image&=1
    Lvc#.Text$ ="Spalte 1"
    LvInsertColumn(Lv1&,0)
    Lvc#.Cx&   =120
    Lvc#.Image&=0
    Lvc#.Text$ ="Spalte 2"
    LvInsertColumn(Lv1&,1)
    Lvc#.Cx&   =120
    Lvc#.Image&=1
    Lvc#.Text$ ="Spalte 3"
    LvInsertColumn(Lv1&,2)
    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&   =2
    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&)
    Lv#.Mask&   =~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE
    Lv#.Image&   =1
    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&  =7
    LvSetItem(Lv1&)
    Lv#.Mask&   =~LVIF_STATE
    Lv#.Image&   =1
    Lv#.Item&    =0
    Lv#.SubItem& =0
    Lv#.state&  = 12092
    Lv#.statemask&  = $F000
    sendmessage(lv1&,~LVM_SETITEM,0,lv#)  Neue Attribute setzen
    setitem lv1&,~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE | ~LVIF_IMAGE,0,0,0,2,0,"Text1"
    setitem lv1&,~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE | ~LVIF_IMAGE,0,0,0,2,1,"Text2"
    setitem lv1&,~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE,0,0,0,2,2,"Text3"

    while 1

        waitinput

    wend

    destroywindow(Lv1&)
    ImageList_Destroy(IcoList&)
    DeleteObject Font&
    dispose Lv#

Struct LV_COLUMN = Maske&,Formate&,SpaltenBreite&,pointerText&,TextLen&,Spalte&
Struct LV_Item   = Maske&,Zeile&,Spalte&,Status&,StatusMaske&,pointerText&,TextLen&,ImgIndex&,lParam&

Proc IsItemChecked

    Parameters lvHndl&,Row&
    Declare Item#,erg&
    Dim Item#,LV_Item

    With Item#

        .Maske&       = $0008
        .Zeile&       = Row&
        .Spalte&      = 0  (Col&)
        .Status&      = 2
        .StatusMaske& = $F000

    EndWith

    SendMessage(lvHndl&,$1005,Row&,Item#)
    erg& = Equ(Item#.Status&,8192)
    Dispose Item#
    Return erg&

EndProc