Vielleicht kann es ja jemand gebrauchen:-)
Code
'######################
'Header-Dateien
'######################
$H Windows.ph
$H Messages.ph
$H Commctrl.ph
'######################
'######################
'Structuren
'######################
STRUCT RECT = Left&,Top&,Right&,Bottom&
STRUCT MEASUREITEMSTRUCT = CtlType&,CtlID&,itemID&,itemWidth&,itemHeight&,itemData&
STRUCT DRAWITEMSTRUCT = CtlType&,CtlID&,itemID&,itemAction&,itemState&,hwndItem&,hDC&,rcItem!RECT,itemData&
Var OldCB& = 0
Var WindowWidth& = 800
Var WindowHeight& = 600
'Einstellungen für die Listbox
Var Itemwidth& = 32
Var Itemheight& = 32
Var ItemBorder& = 6
Var ItemBackColor& = ~GetSysColor(~COLOR_BTNFACE)
Var ItemForeColor& = $FFFFFF
Var DllFile$ = "Shell32.dll"
'Itemborder muss mindestens 2 Pixel haben
ItemBorder& = If(Itemborder& < 2,2,Itemborder&)
Var LB_Brush& = ~CreateSolidBrush(ItemForeColor&)
'Erstmal ein unsichtbares Fenster anlegen
windowStyle $250
WINDOW 0,0-0,0
CLS ~GetSysColor(~COLOR_BTNFACE)
SubClass %HWnd, 1
'Die Fenster-Prozedur muss für die erste Anzeige umgeleitet werden
Set("FastMode",1)
OldCB& = ~SetWindowlong(%hwnd,~GWL_WNDPROC,ProcAddr("CB",4))
'Fensterstil für die Bildliste
Var flags& = ~WS_CHILD | ~WS_HSCROLL | ~WS_VISIBLE | ~WS_CLIPCHILDREN | ~LBS_OWNERDRAWFIXED | ~LBS_NOINTEGRALHEIGHT | ~LBS_MULTICOLUMN | ~LBS_NOTIFY
'Liste für die Bilder
Var hlist& = ~CreateWindowEx($200,"ListBox","",flags&,10,100,WindowWidth&-30,280,%hwnd,4000,0,0)
Create("Tooltip",%hwnd,hList&,"Doppelklick auf ein icon zeichnet das Icon")
'Itemgrösse setzen
~SendMessage(hlist&,~LB_SETCOLUMNWIDTH,Itemwidth&+Itemborder&,0)
~SendMessage(hlist&,~LB_SETITEMHEIGHT,0,Itemheight&+ItemBorder&)
'Imageliste anlegen
Var il& = Create("ImageList", Itemwidth&,Itemheight&,0,0)
'und die Icons der Shell32.dll in die Imageliste
Var SH& = Usedll(DllFile$)
Var SH_Count& = IconCount(DllFile$)
Var Ico& = 0
WhileLoop 0,SH_Count&
Ico& = ~LoadImage(SH&,&Loop,~IMAGE_ICON,Itemwidth&,Itemheight&,0)
ImageList("AddIcon",il&,Ico&)
~DestroyIcon(Ico&)
EndWhile
FreeDll SH&
'Icons der Imageliste in die Listbox
Var Il_Count& = GetCount(il&)
SendMessage(hList&,~LB_INITSTORAGE,IL_COUNT&,0)
WhileLoop 0,IL_Count&
~SendMessage(hlist&,~LB_ADDSTRING,0,~Imagelist_GetIcon(IL&,&loop,0))
EndWhile
'die Imageliste brauchen wir nicht mehr
~ImageList_Destroy(IL&)
'Fenster positionieren und anzeigen
SetStyle %hwnd,0,$14CF2000
~SetClassLong(%hwnd,~GCL_STYLE,(~GetClassLong(%hwnd,~GCL_STYLE)- ~CS_HREDRAW - ~CS_VREDRAW))
~Movewindow(%hwnd,Int(%maxx/2-WindowWidth&/2),Int(%maxy/2-WindowHeight&/2),WindowWidth&,WindowHeight&,1)
Repaint
'Fenster-Prozedur zurücksetzen
~SetWindowlong(%hwnd,~GWL_WNDPROC,OldCB&)
Set("FastMode",0)
~SelectObject(%hdc,~GetStockObject(~ANSI_VAR_FONT))
~SelectObject(%hdc2,~GetStockObject(~ANSI_VAR_FONT))
Var Ende& = 0
Var Oldsel& = 0
WhileNot Ende&
Waitinput
If %key = 2
Ende& = 1
EndIf
EndWhile
DeleteObJect LB_Brush&
End
Subclassproc
If SubClassMessage(%hWnd, ~WM_DRAWITEM)
Var DW# = New(DRAWITEMSTRUCT)
DW# = &slParam
If DW#.CtlType& = ~ODT_LISTBOX
If DW#.itemState& & ~ODS_SELECTED 'wenn selektiert
Var brush& = ~CreateSolidBrush(ItemBackColor&)
Else
Var brush& = ~CreateSolidBrush(ItemForeColor&)
EndIf
~FillRect(DW#.hdc&,DW#.rcItem,brush&)
~DeleteObject(Brush&)
~SetBkMode(DW#.hdc&,~TRANSPARENT)
~DrawIcon(DW#.hdc&,Int(DW#.RCItem!Left&+ItemBorder&/2),Int(DW#.RCItem!Top&+ItemBorder&/2),DW#.itemData&)
EndIf
Set("WinProc",0)
Return 1
ElseIf SubClassMessage(%hWnd, ~WM_COMMAND) and (HiWord(&swParam) = ~LBN_DBLCLK)
Set("WinProc",0)
If Oldsel& = Getcursel(hlist&)
Return 0
Else
If GetCursel(hList&) > -1
Usepen 5,0,0
Rectangle 0,0 - Width(%hwnd),100
DrawIcon sendmessage(hList&,~LB_GETITEMDATA,GetCursel(hList&),0),0,0
DrawText 0,40,"Icon "+Str$(GetCursel(hList&))+" aus "+DllFile$
EndIf
Oldsel& = GetCursel(hList&)
EndIf
ElseIf SubClassMessage(%hWnd, ~WM_CTLCOLORLISTBOX)
Set("WinProc",0)
Return LB_Brush&
EndIf
EndProc
Proc CB
'------------------------
'WindowCallback fürs Hauptfenster
'------------------------
PARAMETERS hWnd&, hMsg&, wParam&, lParam&
If hMsg& = ~WM_CTLCOLORLISTBOX
Return LB_Brush&
EndIf
If hMsg& = ~WM_DRAWITEM
Var DW# = New(DRAWITEMSTRUCT)
DW# = lParam&
If DW#.CtlType& = ~ODT_LISTBOX
If DW#.itemState& & ~ODS_SELECTED 'wenn selektiert
Var brush& = ~CreateSolidBrush(ItemBackColor&)
Else
Var brush& = ~CreateSolidBrush(ItemForeColor&)
EndIf
~FillRect(DW#.hdc&,DW#.rcItem,brush&)
~DeleteObject(Brush&)
~SetBkMode(DW#.hdc&,~TRANSPARENT)
~DrawIcon(DW#.hdc&,Int(DW#.RCItem!Left&+ItemBorder&/2),Int(DW#.RCItem!Top&+ItemBorder&/2),DW#.itemData&)
EndIf
Return 1
EndIf
Return ~CallWindowProc(Oldcb&,hWnd&, hMsg&, wParam&, lParam&)
EndProc
Alles anzeigen