Проблема с прозрачностью фона компоненты

[IljaO]

Помогите! У меня форма с фоновой картинкой, а компоненты типа RadioButton и Frame имеют стандартный серый фон (подбор цветов невозможен) под надписями, что смотрится отвратительно!
В Делфи, например, у компонент есть св-во Transparent background, что делает такой фон прозрачным. Как сделать фон компонент прозрачным?

[tyomitch]

Думаю, что никак - рисовать свои им на замену...

[GSerg]

В Делфи, например, у компонент есть св-во Transparent background, что делает такой фон прозрачным.

Вот как раз у этих компонентов и нет этого свойства

[Mleha]

Option Explicit
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_OR = 2




Public Function lGetRegion(lBackColor As Long, frmM As Object) As Long
Dim lRgn As Long
Dim lSkinRgn As Long
Dim lStart As Long
Dim lX As Long
Dim lY As Long
Dim lHeight As Long
Dim lWidth As Long
Dim ms As Long
lSkinRgn = CreateRectRgn(0, 0, 0, 0)
With frmM
lHeight = .Height / Screen.TwipsPerPixelY
lWidth = .Width / Screen.TwipsPerPixelX
For lX = 0 To lHeight - 1
lY = 0
Do While lY < lWidth
Do While lY < lWidth And GetPixel(.hdc, lY, lX) = lBackColor
lY = lY + 1
Loop

If lY < lWidth Then
lStart = lY
Do While lY < lWidth And GetPixel(.hdc, lY, lX) <> lBackColor
lY = lY + 1
Loop
If lY > lWidth Then lY = lWidth
lRgn = CreateRectRgn(lStart, lX, lY, lX + 1)
CombineRgn lSkinRgn, lSkinRgn, lRgn, RGN_OR
DeleteObject lRgn
End If
Loop
Next
End With
lGetRegion = lSkinRgn
End Function

Public Function ApplySk(ByVal Color As OLE_COLOR, frmM As Object)
Dim lRgn As Long
Screen.MousePointer = 13
lRgn = lGetRegion(Color, frmM)
frmM.BorderStyle = 0
frmM.AutoRedraw = True
SetWindowRgn frmM.hWnd, lRgn, True
DeleteObject lRgn
Screen.MousePointer = vbDefault
End Function
ставь свой цвет и все будет хорошо!

[kif]

Убери картинку.

Продукт должен быть работающим, а не красивым. Никогда не понимал этого.

[A.A.Z.]

Может, у человека давно все работает, и он хочет чтобы еще и красиво было
Помню, как-то спрашивал про прозрачный текстбокс - все свелось к BS_OWNERDRAW...

[GSerg]

Между прочим, эта BS очень даже