Für Toolsbars oder Menüs benötigt man des Öfteren grau eingefärbte Icons. Mit diesem Code lassen sich Icons leicht entsprechend umwandeln.
Code
' (C) Paules PC-Forum
'
Def GetSysColor(1) !"user32","GetSysColor"
Def ExtractIconEx(5) !"shell32.dll","ExtractIconExA"
Def CreateCompatibleDC(1) !"gdi32","CreateCompatibleDC"
Def CreateCompatibleBitmap(3) !"gdi32","CreateCompatibleBitmap"
Def SelectObject(2) !"gdi32","SelectObject"
Def CreateSolidBrush(1) !"gdi32","CreateSolidBrush"
Def FillRect(3) !"user32","FillRect"
Def ImageList_Add(3) !"comctl32.dll","ImageList_Add"
Def DeleteDC(1) !"gdi32","DeleteDC"
Def GetColorAdjustment(2) !"gdi32","GetColorAdjustment"
Def SetStretchBltMode(2) !"gdi32","SetStretchBltMode"
Def SetColorAdjustment(2) !"gdi32","SetColorAdjustment"
Def ImageList_Draw(6) !"comctl32.dll","ImageList_Draw"
Def StretchBlt(11) !"gdi32","StretchBlt"
Struct COLORADJUSTMENT=caSize%,caFlags%,caIlluminantIndex%,caRedGamma%,caGreenGamma%,caBlueGamma%,caReferenceBlack%,caReferenceWhite%,caContrast%,caBrightness%,caColorfulness%,caRedGreenTint%
Declare largeicon&,rect#,ilist&,ilist2&,dc&,bitmap&,oldbitmap&,brush&
Declare wert&,x%,y%,z%,z&,xx&,ca#
CA# = New(COLORADJUSTMENT)
Dim rect#,16
Window 0,0-%maxx,%maxy
Cls GetSysColor(15)
WhileLoop %maxx/32-1
ilist&= Create("ImageList", 32, 32)
ExtractIconEx("shell32.dll",xx&,Addr(largeicon&),0,1)
ImageList("AddIcon", ilist&, largeicon&)
DeleteObject largeicon&
ilist2&= Create("ImageList", 32, 32)
dc&= CreateCompatibleDC(%hdc)
bitmap&= CreateCompatibleBitmap(%hdc, 32, 32)
oldbitmap&= SelectObject(dc&,bitmap&)
Long rect#,0= 0,0,32,32
brush&= CreateSolidbrush(GetSysColor(15))
FillRect(dc&, rect#, brush&)
DeleteObject brush&
' Grau färben
'
GetColorAdjustment(dc&,CA#)
SetStretchBltMode(dc&,4)
CA#.caColorfulness% = -100
SetColorAdjustment(dc&,CA#)
ImageList_Draw(ilist&,0,dc&,0,0,$0)
StretchBlt(dc&,0,0,32,32,dc&,0,0,32,32,$CC0020)
SelectObject(dc&,oldbitmap&)
ImageList_Add(ilist2&, bitmap&, 0)
' Icons testweise darstellen
'
ImageList_Draw(ilist&,0,%hdc2,xx&*32,8,$0)
ImageList_Draw(ilist2&,0,%hdc2,xx&*32,48,$0)
DeleteObject ilist&
DeleteObject ilist2&
DeleteObject bitmap&
DeleteDC(dc&)
Inc xx&
EndWhile
Repaint
WaitInput
Alles anzeigen