XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Listbox mit Bildern erstellen
Lauffähig ab Profan-Version 5.0
Eine Listbox mit Bildchen erstellen
(c) by Rolf Koch - Rokosoft - Koblenz - März 2002
Seterrorlevel 0  SEHR WICHTIG WEGEN NEGATIVER FENSTERGRÖSSE!!!
Def GetSysColor(1) !USER32,GetSysColor
Def @LoadImage(6) !USER32,LoadImageA
DEF ExtractIcon(3) ! SHELL32,ExtractIconA
SETTRUECOLOR 1
DECLARE ENDE%,i%,Button2%,Top%,last%,now%
DECLARE LISTBOX1%,font%,STATIC&
DECLARE BUTTON1%,ZEILE$,ausgabeliste%
Declare bild%[1000]
DECLARE rkb#,bmp#,ctrl&
DECLARE rkh&,rkc&,rkbild&

PROC INSERTPIC

    PARAMETERS LBILD$,rhwnd&,rkx%,rky%,rkx2%,rky2%
    Dim rkb#,Add(Len(LBILD$),1)
    String rkb#,0=LBILD$
    Let rkh&=LoadImage(%HInstance,rkb#,0,sub(rkx2%,1),sub(rky2%,1),$0050)
    LET rkc&=@Control(STATIC,,$05000010E,rkx%,rky%,rkx2%,rky2%,rhwnd&,1001,%Hinstance)
    Sendmessage(rkc&,$172,0,rkh&)
    Dispose rkb#
    Return rkc&

ENDPROC

PROC LISTREFRESH

    Top%=@SendMessage(Listbox1%,398,0,0)
    Top%= Top%*13
    Top%= Top%-Top%*2
    setwindowpos static&=0,Top%-15,5000;0 Sonst isser im Hintergrund ;)
    showwindow(static&,1)

ENDPROC

PROC LESEN

    addstring(ausgabeliste%,@Trim$(@GetString$(listbox1%,@GetCursel(Listbox1%))))
    setfocus(%HWND)

ENDPROC

WINDOWSTYLE 63
WINDOWTITLE PICTURELISTBOX (c) by Rolf Koch 2003
WINDOW 214,134-429,418
CLS GETSYSCOLOR(15)
USEFONT MS Sans Serif,8,0,0,0,0
SETDIALOGFONT 1
LISTBOX1% = CREATE(LISTBOX,%HWND,,0012,0013,0190,0267)
STATIC&= Control(STATIC,,$5400010E,0,0,15,5000,LISTBOX1%,2000,%hinstance)
AUSGABELISTE% = CREATE(LISTBOX,%HWND,,0210,0013,0190,0267)
BUTTON1% = CREATE(BUTTON,%HWND,Good by,0091,0340,0228,0033)
BUTTON2% = CREATE(BUTTON,%HWND,Auslesen,0091,0300,0228,0033)
clearlist
addstring(listbox1%,     Eintrag 1)
addstring(listbox1%,     Eintrag 2)
addstring(listbox1%,     Eintrag 3)
addstring(listbox1%,     Eintrag 4)
addstring(listbox1%,     Eintrag 5)
addstring(listbox1%,     Eintrag 6)
addstring(listbox1%,     Eintrag 7)
addstring(listbox1%,     Eintrag 8)
addstring(listbox1%,     Eintrag 9)
addstring(listbox1%,     Eintrag 10)
addstring(listbox1%,     Eintrag 11)
addstring(listbox1%,     Eintrag 12)
addstring(listbox1%,     Eintrag 13)
addstring(listbox1%,     Eintrag 14)
addstring(listbox1%,     Eintrag 15)
addstring(listbox1%,     Eintrag 16)
addstring(listbox1%,     Eintrag 17)
addstring(listbox1%,     Eintrag 18)
addstring(listbox1%,     Eintrag 19)
addstring(listbox1%,     Eintrag 20)
Bei Neuerstellung Clear Bild%[] nicht vergessen:
Man kann die einzelnen Bilder wieder per
Destroywindow(bild%[x]) entfernen und an die
selbe Stelle ein neues setzen u.s.w.........
INSERTPIC _1.bmp,STATIC&,0,mul(0,13),13,13
bild%[1]=@&(0)
INSERTPIC _2.bmp,STATIC&,0,mul(1,13),13,13
bild%[2]=@&(0)
INSERTPIC _3.bmp,STATIC&,0,mul(2,13),13,13
bild%[3]=@&(0)
INSERTPIC _4.bmp,STATIC&,0,mul(3,13),13,13
bild%[4]=@&(0)
INSERTPIC _5.bmp,STATIC&,0,mul(4,13),13,13
bild%[5]=@&(0)
INSERTPIC _3.bmp,STATIC&,0,mul(5,13),13,13
bild%[6]=@&(0)
INSERTPIC _1.bmp,STATIC&,0,mul(6,13),13,13
bild%[7]=@&(0)
INSERTPIC _2.bmp,STATIC&,0,mul(7,13),13,13
bild%[8]=@&(0)
INSERTPIC _4.bmp,STATIC&,0,mul(8,13),13,13
bild%[9]=@&(0)
INSERTPIC _1.bmp,STATIC&,0,mul(9,13),13,13
bild%[10]=@&(0)
INSERTPIC _2.bmp,STATIC&,0,mul(10,13),13,13
bild%[11]=@&(0)
INSERTPIC _5.bmp,STATIC&,0,mul(11,13),13,13
bild%[12]=@&(0)
INSERTPIC _1.bmp,STATIC&,0,mul(12,13),13,13
bild%[13]=@&(0)
INSERTPIC _2.bmp,STATIC&,0,mul(13,13),13,13
bild%[14]=@&(0)
INSERTPIC _3.bmp,STATIC&,0,mul(14,13),13,13
bild%[15]=@&(0)
INSERTPIC _5.bmp,STATIC&,0,mul(15,13),13,13
bild%[16]=@&(0)
INSERTPIC _2.bmp,STATIC&,0,mul(16,13),13,13
bild%[17]=@&(0)
INSERTPIC _3.bmp,STATIC&,0,mul(17,13),13,13
bild%[18]=@&(0)
INSERTPIC _1.bmp,STATIC&,0,mul(18,13),13,13
bild%[19]=@&(0)
INSERTPIC _2.bmp,STATIC&,0,mul(19,13),13,13
bild%[20]=@&(0)

WHILENOT ENDE%

    LISTREFRESH MUSS VOR WAITINPUT (Wegen Focus)
    Waitinput

    If @EQU(%KEY,2)

        LET ENDE%= 1

    ELSEIF GETFOCUS(BUTTON1%)  BUTTON

        LET ENDE%=1

    ENDIF

    IF GETFOCUS(BUTTON2%)

        LESEN

    ELSEIF GETFOCUS(LISTBOX1%)

        Top%=@SendMessage(Listbox1%,398,0,0)
        Top%= Top%*13
        Top%= Top%-Top%*2
        setwindowpos static&=0,Top%-0,0;0 Sonst isser im Hintergrund ;)
        showwindow(static&,1)
        setfocus(%HWND)

    ELSEIF GETFOCUS(AUSGABELISTE%)

        getmessage

    ENDIF

WEND