I'm trying to find a way to put a pixmap on a button without losing the text. I've got part way there, but it's not quite right. Firstly, the image doesn't cover the whole button and secondly, the button doesn't show text as well.
According to the MSDN, it should do if I only SendMessage BM_BITMAP and don't SetWindowLong BS_BITMAP but if I do that, I'm back to just text and no image.
Here's what I got ( feel free to use and abuse if you want this half-finished piece of not-entirely-working junk built around half-understood information from the MSDN and stolen snippets of code from around here. )
Extern "Win32"
Function SetWindowLong:Int(HWND:Int,nIndex:Int,dwNewLong:Int) = "SetWindowLongA@12"
Function GetWindowLong:Int(HWND:Int,nIndex:Int) = "GetWindowLongA@8"
Function DrawMenuBar:Int(hMenu:Int)
'Function SetWindowLongPtr(hWnd:Int,nIndex:Int,lNewLong:Int)= "SetWindowLongA@12"
'Function GetWindowLongPtr:Int(hWnd:Int,nIndex:Int)= "GetWindowLongA@8"
Function GetDesktopWindow:Int()"win32"
Function GetWindowRect:Int(hWindow:Int,r:Int Ptr)"win32"
Function TextOutA(HDC:Int,nXStart:Int,nYStart:Int,lpString$z,cbString:Int)
Function ReleaseDC(hWND:Int,hDC:Int)
Function CreateBitmap(nWidth:Int,nHeight:Int,cPlanes:Int,cBitsPerPixel:Int,lpvBits:Byte Ptr)
Function SetFocus:Int(hWND:Int) = "SetFocus@4"
Function SendMessage:Int(hWnd:Int,Msg:Int,wParam:Int,lParam:Int) = "SendMessageA"
End Extern
Const GWL_STYLE:Int=-16
Const BM_SETIMAGE:Int=247
Const BS_BITMAP:Int=128
Const BS_ICON:Int=64
Const IMAGE_BITMAP:Int=0
Function SetButtonPixmap(Button:TGadget,Pixmap:TPixmap)
Local ButtonhWND:Int=QueryGadget(Button,QUERY_HWND)
Local Flags:Int=GetWindowLong(ButtonhWND,GWL_STYLE)
Local Img:Int
If Pixmap
If Pixmap.format<>PF_RGBA8888
Pixmap=Pixmap.Convert(PF_RGBA8888)
End If
If ~ (BS_BITMAP & flags)
SetWindowLong(ButtonhWND,GWL_STYLE,flags+BS_BITMAP)
Else
If (BS_BITMAP & flags)
SetWindowLong(ButtonhWND,GWL_STYLE,flags-BS_BITMAP)
Return
End If
End If
Img:Int=CreateBitmap(Pixmap.width,Pixmap.height,1,32,Pixmap.pixels)
DebugLog "IMG "+Img
Local oldimage:Int=SendMessage(ButtonhWND,BM_SETIMAGE,IMAGE_BITMAP,Img)
DebugLog "OLDIMAGE "+OldImage
If OldImage<>Null
DeleteObject(oldimage)
End If
End If
End Function
Some of the Constants and Externs aren't needed, but I don't want to piddle about removing the ones I use for other things because I'm tired and I'll probably remove one you need by mistake.
|