Imageliste in Listbox

[Andreas Miethe]

Vielleicht kann es ja jemand gebrauchen

'######################
'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

[Frabbing]

Läuft leider sehr stockend bei mir und hat arge Neuzeichnen-Probleme, wenn ich den Scroller hin und her bewege. Win7, 32 Bit.

[Andreas Miethe]

Zitat von Frabbing

Läuft leider sehr stockend bei mir und hat arge Neuzeichnen-Probleme, wenn ich den Scroller hin und her bewege. Win7, 32 Bit.

Bei mir nicht, läuft so wie es sollte. Win7 - 32-Bit.
Vielleicht hängt es an der Grafikkarte ?

[Frabbing]

Eine ältere NVidia GeForce, kann schon sein. Macht aber sonst nirgendwo Probleme.

[ts-soft]

Solange ich nicht gescrollt habe, ist alles in Ordnung, danach ist das Fenster leer oder fast leer. Auch zurückscrollen bringt die Icons nicht zurück.

Sieht insgesamt sehr merkwürdig aus.

Win 7-64 SP1 Ultimate, GeForce GTS 250, 4 GB RAM, AERO

[Andreas Miethe]

Zitat von ts-soft

Solange ich nicht gescrollt habe, ist alles in Ordnung, danach ist das Fenster leer oder fast leer. Auch zurückscrollen bringt die Icons nicht zurück.

Sieht insgesamt sehr merkwürdig aus.

Win 7-64 SP1 Ultimate, GeForce GTS 250, 4 GB RAM, AERO

Hab's gerade nochmal laufen lassen unter :

Win7-64Bit, NVIDIA GeForce 9500M GS, 4GB Ram, Aero.
Läuft bei mir ohne Probleme.

Nicht nur da sondern auch auf emulierten Systemen von Win98 - Win7

[Frabbing]

Zieh den Scroller mal hin und her. Zeichnet dann nicht mehr richtig neu.

[Manfred Barei]

Solange ich nicht gescrollt habe, ist alles in Ordnung, danach ist das Fenster leer oder fast leer. Auch zurückscrollen bringt die Icons nicht zurück.

ist bei mir genau so.

Win7-32 Ultimate,GeForce 9100M

Gruß Manfred

[horsthorn]

Bei mir läuft der Code ohne Probleme. Klappt einwandfrei
Grafikkarte: NVIDIA Geforce 9400 GT

[Andreas Miethe]

Zitat von Frabbing

Zieh den Scroller mal hin und her. Zeichnet dann nicht mehr richtig neu.

so oft ich den Scroller ziehe und wie schnell, es wird neu gezeichnet.

[_Joerg_]

Ich dachte erst: "welcher Scroller?", bis ich im Code gesehen habe, daß die Listboxgröße vom Monitor abhängt.
Dann gab's bei mir leider auch die Probleme beim Scrollen. Sieht sonst sehr interessant aus!
Edit: Ach ja - ich habe eine NVIDIA Geforce 9600 GT. Das es daran liegt, kann nicht sein.

[ts-soft]

Also GraKa scheidet aus. OS wohl auch.

Ich habe mit dem XProfan Final X2 Interpreter getested.

[Andreas Miethe]

Zitat von ts-soft

Also GraKa scheidet aus. OS wohl auch.

Ich habe mit dem XProfan Final X2 Interpreter getested.

Ich auch, und mit Xprofan11

Möglicherweise liegt es an einem vergessenen Set("WinProc",0).
Ich hab's korrigiert.

[Bangkok]

Die neue Version läuft etwas besser, aber es verschwinden immer noch Icons beim scrollen.

[horsthorn]

Keine Probleme
XProfan-12
Auch, wenn ich das Fenster auf meine Monitor-Auflösung stelle, funktioniert das Scrollen.
Hab schon alles versucht, schnell scrollen oder nur zum Teil rüber und zurück.
Es klappt immer !

Nachtrag:
Ach, so auch die Icon-Anzeige mit Doppelklick funktioniert einwandfrei !
Hab die Listbox-Maße jetzt verändert und eine andere DLL eingeladen (moricons.dll)
Die Anzeige klappt.
Wenn ich aber die Höhe der Listbox (280) verkleinere, erscheint kein senkrechter Scrollbalken.
Da musst du noch dran "schrauben", Andreas