Hello everybody.
I need to put on the systray an icon with text and transparent background.
I have the next code, but it is always drawn in black.
Then choose to paint the background with the color RGB but it is not the optimal.
I am very bad with graphics and even more with GDI XD.
![]()
Sorry for my translation
a greeting
I need to put on the systray an icon with text and transparent background.
I have the next code, but it is always drawn in black.
Then choose to paint the background with the color RGB but it is not the optimal.
I am very bad with graphics and even more with GDI XD.
Code:
Public Function Icon_text(Text As String, hWnd As Long, Optional FontName As String = "Times New Roman", Optional FontSize As Long = 16, Optional Sizeicon As Long = 16, Optional colorfont As ColorConstants = vbWhite, Optional colorbackground As ColorConstants = vbBlack) As Long
Dim Hdc As Long, hdcMem As Long
Dim hBitmap As Long, hOldBitMap As Long, hBitmapMask As Long
Dim iconData As ICONINFO
Dim hBrush As Long
Dim tr As RECT
Dim hFont As Long
Dim hIcon As Long
Hdc = GetDC(hWnd)
hdcMem = CreateCompatibleDC(Hdc)
hBitmap = CreateCompatibleBitmap(Hdc, Sizeicon, Sizeicon)
hBitmapMask = CreateCompatibleBitmap(Hdc, Sizeicon, Sizeicon)
ReleaseDC hWnd, Hdc
hOldBitMap = SelectObject(hdcMem, hBitmap)
hBrush = CreateSolidBrush(colorbackground)
tr.Right = Sizeicon: tr.Bottom = Sizeicon
FillRect hdcMem, tr, hBrush
SetTextColor hdcMem, colorfont
' PatBlt hdcMem, 0, 0, 32, 32, WHITENESS
SetBkMode hdcMem, TRANSPARENT
hFont = CreateFont(FontSize, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, FontName)
hFont = SelectObject(hdcMem, hFont)
TextOut hdcMem, 5, 0, Text, lstrlen(Text)
SelectObject Hdc, hOldBitMap
hOldBitMap = 0
iconData.fIcon = 1
iconData.xHotspot = 0
iconData.yHotspot = 0
iconData.hbmMask = hBitmapMask
iconData.hbmColor = hBitmap
hIcon = CreateIconIndirect(iconData)
DeleteObject SelectObject(hdcMem, hFont)
DeleteDC hdcMem
DeleteDC Hdc
DeleteObject hBitmap
DeleteObject hBitmapMask
Icon_text = hIcon
End Functiona greeting
