Form Background as a bitmap

[Roger Garstang]

I don't know if I'm just not seeing how to do it or what, but I know there is a way when setting a background of a form as a bitmap for it to show through the label/option/radiobutton/frame controls as though they have it is their background too, but every option I try still gives them a background of a solid color and the bitmap isn't showing through it???

http://www.tibed.net/images/screenshots/ts_specialweapons.png

This image reminds me it would be nice to have tooltip options for controls as well...

[Ed Turner]

I'm sure there are cleaner ways to do this, but here is what I use:

Add the following subroutine to a module in your project:

Code Select Expand


SUB TileTheBackground(BYVAL hDC AS LONG, BYVAL hBkgndBmp AS LONG, BYVAL wWidth AS LONG, BYVAL wHeight AS LONG, xOff AS LONG, yOff AS LONG)
LOCAL bm AS BITMAP, bmW AS LONG, bmH AS LONG, hMemDC AS LONG, hOldBmp AS LONG
LOCAL nRows AS LONG, nCols AS LONG, x AS LONG, y AS LONG, i AS LONG, ii AS LONG
LOCAL yOffset AS LONG, xOffset AS LONG
LOCAL xOff1 AS LONG, bmW1 AS LONG, bmW2 AS LONG, bmWidth AS LONG
LOCAL yOff1 AS LONG, bmH1 AS LONG, bmH2 AS LONG, bmHeight AS LONG
IF hBkgndBmp THEN
GetObject hBkgndBmp, SIZEOF(bm), bm
bmW = bm.bmWidth
bmH = bm.bmHeight

hMemDC = CreateCompatibleDC(hDC)
hOldBmp = SelectObject(hMemDC, hBkgndBmp)

IF bmW And bmH THEN
If xOff > 0 Then
If xOff >= bmW Then
xOff1 = xOff Mod bmW + 1
bmW1 = bmW - xOff1
Else
xOff1 = xOff + 1
bmW1 = bmW - xOff1
End If
If wWidth - bmW1 > 0  Then
nCols = (wWidth - bmW1) \ bmW
Else
bmW1 = wWidth
nCols = 0
End If
If nCols * bmW + bmW1 <= wWidth Then
bmW2 = wWidth - (bmW1 + nCols * bmW)
nCols = nCols + 1
Else
bmW2 = 0
End If
nCols = nCols + 1
Else
xOff1 = 0
bmW1 = bmW
nCols = wWidth \ bmW
If nCols * bmW < wWidth Then
bmW2 = wWidth - (nCols * bmW)
nCols = nCols + 1
Else
bmW2 = 0
End If
End If
If yOff > 0 Then
If yOff >= bmh Then
yOff1 = yOff Mod bmH + 1
bmH1 = bmH - yOff1
Else
yOff1 = yOff + 1
bmH1 = bmH - yOff1
End If
If wHeight - bmH1 > 0  Then
nRows = (wHeight - bmH1) \ bmH
Else
bmH1 = wHeight
nRows = 0
End If
If (nRows * bmH + bmH1) <= wHeight Then
bmH2 = wHeight - (bmH1 + nRows * bmH)
nRows = nRows + 1
Else
bmH2 = 0
End If
nRows = nRows + 1
Else
yOff1 = 0
bmH1 = bmH
nRows = wHeight \ bmH
If nRows * bmH < wHeight Then
bmH2 = wHeight - (nRows * bmH)
nRows = nRows + 1
Else
bmH2 = 0
End If
End If
y = 0
FOR i = 1 TO nRows
If i = 1 Then
yOffset = yOff1
bmHeight = bmH1
ElseIf i = nRows Then
yOffset = 0
bmHeight = bmH2
Else
yOffset = 0
bmHeight = bmH
End If
x = 0
FOR ii = 1 TO nCols
If ii = 1 Then
xOffset = xOff1
bmWidth = bmW1
ElseIf ii = nCols Then
xOffset = 0
bmWidth = bmW2
Else
xOffset = 0
bmWidth = bmW
End If
BitBlt hDC, x, y, bmWidth, bmHeight, hMemDC, 0 + xOffset, 0 + yOffset, %SRCCOPY
x = x + bmWidth
NEXT ii
y = y + bmHeight
NEXT I
End If
SelectObject hMemDC, hOldBmp
DeleteDC hMemDC
END IF
END SUB  ' TileTheBackground


In the WM_PAINT function of the form add the following:

Code Select Expand


Function TESTBMP_WM_PAINT (hWndForm As Dword) As Long
Local ps AS PAINTSTRUCT, hdc AS LONG, hbackbmp AS LONG, bitmapf AS ASCIIZ * 32
Local hInstance AS LONG, rct AS RECT
hdc = BeginPaint(hwndForm, ps)
bitmapf = "\basic32a\bees.bmp"
hInstance = GetClassLong(hWndForm, %GCL_HMODULE)
GetClientRect hWndForm, rct
hbackbmp = LoadImage(hInstance, bitmapf, %IMAGE_BITMAP, 0, 0, %LR_LOADFROMFILE)
TileTheBackground hdc, hbackbmp, rct.nRight, rct.nBottom, 0, 0
   EndPaint hwndForm, ps
   Function = 0
End Function


And in the WM_PAINT section of your label, add the following:

Code Select Expand


Function TESTBMP_LABEL1_WM_PAINT (ControlIndex As Long, hWndForm As Dword, hWndControl As Dword) As Long
Local ps AS PAINTSTRUCT, hdc AS LONG, hbackbmp AS LONG, bitmapf AS ASCIIZ * 32
Local hInstance AS LONG, rctp AS RECT,rctc AS RECT, xoffset AS LONG, yoffset AS LONG
hdc = BeginPaint(hwndControl, ps)
bitmapf = "\basic32a\bees.bmp"
hInstance = GetClassLong(hWndForm, %GCL_HMODULE)
GetWindowRect hWndForm, rctp
GetWindowRect hWndControl, rctc
xoffset = rctc.nLeft - rctp.nLeft - 2
yoffset = rctc.nTop - rctp.nTop - 20
GetClientRect hWndControl, rctc
hbackbmp = LoadImage(hInstance, bitmapf, %IMAGE_BITMAP, 0, 0, %LR_LOADFROMFILE)
TileTheBackground hdc, hbackbmp, rctc.nRight, rctc.nBottom, xoffset, yoffset

   EndPaint hwndForm, ps
   Function = 0

End Function


I threw this together fairly quickly so notice that in the WM_PAINT section for the label I just hardcoded the border and caption thicknesses (2 and 20).  It would naturally be best to use something like GetSystemMetrics to obtain the correct values.  Also, you will have to use something like GetFontData or GetTextMetrics to get the font information for the label and then display it.

[Roger Garstang]

Wow, that's a lot of work just to get the effect.  Aren't labels themselves windows? Why can't their background brush be a bitmap?  Or have a transparent background or something.  There has to be some way to accomplish it easier...

[Ed Turner]

Roger,
Yep, I know what you mean.  and yep, labels are just another window.  I don't know what is going on behind the scenes with labels as that is the only control I have to jump through hoops for just to make the damn background appear transparent.  No such problems with check boxes, radio buttons, etc.  Just the labels.  There is probably a very simple explaination and a very simple work-around, but I have yet to come across it.  Meanwhile, I just go with what works.

[Roger Garstang]

I found the solution, but FF can't currently do it, so I added it to the WishList.  The Brush for the background needs to be created like so:

lBrush.lbStyle= %BS_HOLLOW
@ff.hBackBrush      = CreateBrushIndirect(lBrush)

This is how all controls with a background type of transparent should be created.

GetStockObject can also be used with a NULL/HOLLOW brush to accomplish this.