Exe-Icons hochauflösend(!) anzeigen

[Frabbing]

Testcode zeigt alle Exe-Icons (des Systemordners) hochauflösend an (ab XProfan 8):

Declare ilist&,reg&,x&,y&,z&,text$,bereich#,button&,static&,a&
Dim bereich#,356

Def ImageList_Create(5) !"comctl32.dll","ImageList_Create"
Def ImageList_AddIcon(2) !"comctl32.dll","ImageList_AddIcon"
Def ImageList_Draw(6) !"comctl32.dll","ImageList_Draw"
Def SHGetFileInfo(5) !"shell32.dll","SHGetFileInfo"
Def GetSystemMetrics(1) !"user32","GetSystemMetrics"

Proc GetExeIcon
  If text$<>""
    z&=SHGetFileInfo(addr(text$),0,bereich#,352,$101)
    If z&
      ImageList_AddIcon(ilist&,Long(bereich#,0))
      ImageList_Draw(ilist&,a&,%hdc,x&,y&,0)
      ImageList_Draw(ilist&,a&,%hdc2,x&,y&,0)  'Falls die Anzeige auf dem Haupt-Fenster permanent sein soll!
      a&=a&+1
    EndIf
  EndIf
EndProc

WindowTitle "Alle Exe-Icons (des Systemordners) hochauflösend anzeigen."
Window 0,0-%maxx,%maxy

Usefont "MS Sans Serif",10,0,0,0,0
SetDialogFont 1

ilist&=ImageList_Create(GetSystemMetrics(49),GetSystemMetrics(50),33,0,0)

ChDir $Syspath

x&=20
y&=0
text$=FindFirst$("*.EXE")
DrawText x&+GetSystemMetrics(49)+4,y&,text$
GetExeIcon
y&=y&+18
WhileNot %IOResult
  text$=FindNext$()
  If (y&>=(%maxy-20))
    y&=0
    x&=x&+120
  Endif
  DrawText x&+GetSystemMetrics(49)+4,y&,text$
  GetExeIcon
  y&=y&+18
EndWhile

WaitInput

Dispose bereich#
End