Windows Button Image

[albert]

Hello;

How do you set a Windows "Button" control to hold a bitmap image?

And , how do you create and array of images?


I need an array of buttons , holding an array of images...

[Tourist Trap]

Hello;

How do you set a Windows "Button" control to hold a bitmap image?

And , how do you create and array of images?


I need an array of buttons , holding an array of images...

Hi Albert,

I don't really know if you are asking for something related to the windows API. In any case I grabbed some button object from the tips and tricks section and adapted it to hold images that should be displayed on click, but there is no specifical call to the windows stuff. It's done quick and a little dirty but it's my modest contrib to an answer. Hope it can help a little.

Have a good day.

Code: Select all

'a simple button that triggers a click on button released
'with image container

'WARNING:
'in this example the button object will be fed in images from a directory in the disk that has the following characteristics:
'you put the directory in the directory of the program's executable file ( this place will be retrieved by a call to curdir() )
'you name it as you wish but you tell the program right below in the define ( put just the name, the parent path will be curdir() )
'you put normal BMP files in it and it should go for it
'thanks
#define _myimagesdirectoryname    "imagecontainer"

dim shared as string   imagesPathfullName 
sub main() constructor
   'this is the module initializer
   'if one wants, he can test the __FB_PCOS__ intrinsic to decide to add back or forward slash in path names, I don't know...
   'here on windows it works well with those slashes:
   imagesPathfullName => curDir() & "\" & _myimagesdirectoryname & "\"
end sub

#include "fbgfx.bi"
'__________________________________here stand the definitions
#macro _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(w, v)
    screenSet (w), (v)
#endMacro
#macro _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(w, v)
    screenCopy (w), (v)
#endMacro

namespace CreditFBDoc
   'it came from ... not the desert, the fb documentation instead!
   Const NULL As Any Ptr = 0
   Function BMPlOAD( ByRef filename As Const String ) As Any Ptr
       Dim As Long filenum, bmpwidth, bmpheight
       Dim As Any Ptr img
       '' open BMP file
       filenum = FreeFile()
       If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL
           '' retrieve BMP dimensions
           Get #filenum, 19, bmpwidth
           Get #filenum, 23, bmpheight
       Close #filenum
       '' create image with BMP dimensions
       img = ImageCreate( bmpwidth, Abs(bmpheight) )
       If img = NULL Then Return NULL
       '' load BMP file into image buffer
       If BLoad( filename, img )<>0 Then ImageDestroy( img ): Return NULL
       Return img
   End Function
end namespace

type BUTTON
    declare constructor()
    declare destructor()
    declare sub FeedInWithImages()
    declare sub TriggerMouseTest()
    declare sub DrawButton()
        as integer  _left
        as integer  _top
        as integer  _width
        as integer  _height
        as string   _text
        as boolean  _hasMouseOver
        as boolean  _hasMouseClick
        as boolean  _hasMouseButtonReleased
    'image container
      as fb.IMAGE ptr   _arrayOfImagesPtr(any)
      as integer        _arrayOfImagesWidth(any)
      as integer        _arrayOfImagesHeight(any)
      as integer        _currentImageIndex
end type
constructor BUTTON
    dim as integer scrW, scrH
    screenInfo scrW, scrH
    with THIS
        ._left                      => scrW\4 - 2
        ._top                       => scrH\4 - 2
        ._width                     => scrW\4
        ._height                    => scrH\7
        ._text                      => "default"
        ._hasMouseOver              => FALSE
        ._hasMouseClick             => FALSE
        ._hasMouseButtonReleased    => FALSE
    end with
    '
    THIS.FeedInWithImages()
    THIS._currentImageIndex   => uBound(THIS._arrayOfImagesPtr)
end constructor
destructor BUTTON
   for index as integer = lBound(THIS._arrayOfImagesPtr) to uBound(THIS._arrayOfImagesPtr)
      imageDestroy THIS._arrayOfImagesPtr(index)
   next index
end destructor
sub BUTTON.FeedInWithImages()
   'list all stuff in the image repo, then try to grab it if looks like a bitmap file
   dim as string  filename => dir(imagesPathfullName & "*.*") 'init the dir process
   do while len(filename)>0
      dim as any ptr tryImage => CreditFBDoc.BMPlOAD(imagesPathfullName & filename)
      if tryImage>0 then
         redim preserve THIS._arrayOfImagesPtr(lBound(THIS._arrayOfImagesPtr) to uBound(THIS._arrayOfImagesPtr) + 1)
         redim preserve THIS._arrayOfImagesWidth(lBound(THIS._arrayOfImagesWidth) to uBound(THIS._arrayOfImagesWidth) + 1)
         redim preserve THIS._arrayOfImagesHeight(lBound(THIS._arrayOfImagesHeight) to uBound(THIS._arrayOfImagesHeight) + 1)
         THIS._arrayOfImagesPtr(uBound(THIS._arrayOfImagesPtr)) => tryImage
         imageInfo   tryImage, _
                     THIS._arrayOfImagesWidth(uBound(THIS._arrayOfImagesWidth)), _
                     THIS._arrayOfImagesHeight(uBound(THIS._arrayOfImagesHeight))
      end if
      filename = dir() 'increment the dir process
   loop
end sub
sub BUTTON.TriggerMouseTest()
    dim as integer  whereMouseX, _
                    whereMouseY, _
                    whatMouseButtonClicked
    GetMouse whereMouseX, whereMouseY, , whatMouseButtonClicked
    with THIS
        if whereMouseX>=._left andAlso _
            whereMouseX<(._left+ ._width) andAlso _
            whereMouseY>=._top andAlso _
            whereMouseY<(._top + ._height) then
            if not ._hasMouseOver then
                ._hasMouseOver = TRUE
            end if
        else
            if ._hasMouseOver then
                ._hasMouseOver = FALSE
            end if
        end if
        '
        if ._hasMouseOver andAlso cBool(whatMouseButtonClicked>0) then
            if not ._hasMouseClick then
                ._hasMouseClick = TRUE
            end if
        else
            if ._hasMouseClick then
                ._hasMouseClick             = FALSE
                if ._hasMouseOver then
                    if not ._hasMouseButtonReleased then
                        ._hasMouseButtonReleased    = TRUE
                    else
                        ._hasMouseButtonReleased    = FALSE
                    end if
                end if
            else
                ._hasMouseButtonReleased    = FALSE
            end if
        end if
    end with
end sub
sub BUTTON.DrawButton()
    THIS.TriggerMouseTest()
    '
    dim as long btnColor
    with THIS
        if ._hasMouseButtonReleased then
                btnColor = rgb(100,200,100)
                if THIS._currentImageIndex<>-1 then
                   if THIS._currentImageIndex=uBound(THIS._arrayOfImagesPtr) then
                      THIS._currentImageIndex = lBound(THIS._arrayOfImagesPtr)
                   else
                      THIS._currentImageIndex += 1
                   end if
                  put (THIS._left, THIS._top), THIS._arrayOfImagesPtr(THIS._currentImageIndex)
                end if
        elseIf ._hasMouseClick then
                btnColor = rgb(100,100,200)
        else
                btnColor = rgb(100,100,100)
        end if
        '
        line (._left,._top)- _
                (._left + ._width - 1,._top + ._height - 1), _
                btnColor, _
                b
        draw string (._left + 8, ._top + 8), str(THIS._currentImageIndex)
    end with
end sub




'_______________________________________here starts the execution
screenres 800, 600, 32, 2
dim as BUTTON   btn

'______________________________________________________main loop
do
    _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(1, 0)
   
    btn.DrawButton()
   
    _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(1, 0)
    '
    sleep 15
loop until inkey()=chr(27)

'_______________________here we pause before end, we'll be back!
getKey()

'(eof)

[albert]

@Tourist Trap

Yeah , i need the MS Windows API, "BUTTON" call , with an image on it.

[Josep Roca]

Create a button with the BS_BITMAP style and then send a BM_SETIMAGE message with the handle of your bitmap.

[albert]

@Josep Roca

Can ou modify the following to put a bitmap on the button??

Code: Select all


#define WIN_INCLUDEALL

#include once "windows.bi"
#include once "win\commctrl.bi"

Dim As MSG msg
Dim Shared As HWND hWnd, edit

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 200, 100, 0, 0, 0, 0 )

edit = CreateWindowEx( 0, "BUTTON", "Button" , WS_BORDER Or WS_VISIBLE Or WS_CHILD or ANSI_CHARSET , 10 , 10 , 50 , 20 , hWnd, 0, 0, 0 )

While GetMessage( @msg, 0, 0, 0 )
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273 : PostQuitMessage(0)
            End Select
    End Select
   
Wend
PostQuitMessage(0)
End



[Josep Roca]

Something like this:

Code: Select all


#define WIN_INCLUDEALL

#include once "windows.bi"
#include once "win\commctrl.bi"

Dim As MSG msg
Dim Shared As HWND hWnd, edit

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 200, 100, 0, 0, 0, 0 )

edit = CreateWindowEx( 0, "BUTTON", "Button" , WS_BORDER Or WS_VISIBLE Or WS_CHILD or ANSI_CHARSET OR BS_PUSHBUTTON OR BS_BITMAP, 10 , 10 , 50 , 20 , hWnd, 0, 0, 0 )

' // Load the bitmap and set its handle
DIM szBitmap AS ZSTRING * MAX_PATH = <path and name of your bitmap>
DIM hBitmap AS HANDLE = LoadImage(NULL, szBitmap, IMAGE_BITMAP, 0, 0, LR_DEFAULTCOLOR)
IF hImage THEN SendMessage(edit, BM_SETIMAGE, IMAGE_BITMAP, CAST(LPARAM, hImage))

While GetMessage( @msg, 0, 0, 0 )
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273 : PostQuitMessage(0)
            End Select
    End Select
   
Wend
PostQuitMessage(0)
End


[albert]

@Josep Roca

It errors on "hImage" , you forgot to assign hImage ??

It says , variable hImage not declared..

[Josep Roca]

Change hImage to hBitmap or change hBitmap to hImage.

[dodicat]

I tweaked the code a little.
(My bitmap is 350 by 150)

Code: Select all

 

#include once "windows.bi"


sub getsize(picture as string,byref dimensionx as long,byref dimensiony as long)
     Open picture For Binary access read As #1
    Get #1, 19, dimensionx
    Get #1, 23, dimensiony
    Close #1
end sub

DIM szBitmap AS STRING  = "C:\Users\User\Desktop\dodi.bmp"  '' path to a bitmap

dim as long w,h
getsize(szbitmap,w,h)
if w*h then print "OK" else print "Loading error":sleep:end

Dim As MSG msg
Dim Shared As HWND hWnd, edit
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )

edit = CreateWindowEx( 0, "BUTTON", "Button" , WS_BORDER Or WS_VISIBLE Or WS_CHILD or ANSI_CHARSET OR BS_PUSHBUTTON OR BS_BITMAP, 10 , 10 , w ,h , hWnd, 0, 0, 0 )

' // Load the bitmap and set its handle

DIM hBitmap AS HANDLE = LoadImage(0, szBitmap, IMAGE_BITMAP, w, h,  LR_LOADFROMFILE )

IF hbitmap THEN SendMessage(edit, BM_SETIMAGE, IMAGE_BITMAP, CAST(LPARAM, hbitmap))

While GetMessage( @msg, 0, 0, 0 )
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273 : PostQuitMessage(0)
            End Select
    End Select
   
Wend
PostQuitMessage(0)
End

[albert]

@Dodicat

It worked!! Thanks!!
You always come through , with the fix.

I'm working on my language "Huh-Yuh" and need to load images on the buttons.

I came out with a new version of Picto-Font_V9. It's on the Projects section of the forum..
I'm using it to create the font chars for my Huh-Yuh language..

[albert]

@Dodicat

How would you create an "image" , draw on the image and then stick the image on the button?

Code: Select all

 

#include once "windows.bi"

sub getsize(picture as string,byref dimensionx as long,byref dimensiony as long)
    Open picture For Binary access read As #1
    Get #1, 19, dimensionx
    Get #1, 23, dimensiony
    Close #1
end sub

DIM szBitmap AS STRING  = ".\Font\Huh.bmp"  '' path to a bitmap

dim as long w,h
getsize(szbitmap,w,h)
if w*h then print "OK" else print "Loading error":sleep:end

Dim As MSG msg
Dim Shared As HWND hWnd, edit
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )

edit = CreateWindowEx( 0, "BUTTON", "Button" , WS_BORDER Or WS_VISIBLE Or WS_CHILD or ANSI_CHARSET OR BS_PUSHBUTTON OR BS_BITMAP, 10 , 10 , 50 , 25 , hWnd, 0, 0, 0 )

' // Load the bitmap and set its handle

DIM hBitmap AS HANDLE = LoadImage(0, szBitmap, IMAGE_BITMAP, w, h,  LR_LOADFROMFILE )

IF hbitmap THEN SendMessage(edit, BM_SETIMAGE, IMAGE_BITMAP, CAST(LPARAM, hbitmap))

While GetMessage( @msg, 0, 0, 0 )
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273 : PostQuitMessage(0)
            End Select
    End Select
   
Wend
PostQuitMessage(0)
End



[dodicat]

Maybe something like

Code: Select all

 

 

#include once "windows.bi"

sub getsize(picture as string,byref dimensionx as long,byref dimensiony as long)
    Open picture For Binary access read As #1
    Get #1, 19, dimensionx
    Get #1, 23, dimensiony
    Close #1
end sub

DIM szBitmap AS STRING ' = "C:\Users\User\Desktop\dodi.bmp"   '' path to a bitmap

dim as long w,h
w=50 'to  suit your given size
h=25
'getsize(szbitmap,w,h)
'if w*h then print "OK" else print "Loading error":sleep:end
'=======================================
screenres w,h,32,,-1 'create a temp [hidden] screen
dim as any ptr i=imagecreate(w,h,rgb(0,100,255))
draw string i,(5,10),"Click",rgb(255,255,255)
bsave("small.bmp",i)
szbitmap="small.bmp"
screen 0  'return to console
'=========================================

Dim As MSG msg
Dim Shared As HWND hWnd, edit
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )

edit = CreateWindowEx( 0, "BUTTON", "Button" , WS_BORDER Or WS_VISIBLE Or WS_CHILD or ANSI_CHARSET OR BS_PUSHBUTTON OR BS_BITMAP, 10 , 10 , w , h , hWnd, 0, 0, 0 )

' // Load the bitmap and set its handle

DIM hBitmap AS HANDLE = LoadImage(0, szBitmap, IMAGE_BITMAP, w, h,  LR_LOADFROMFILE )

IF hbitmap THEN SendMessage(edit, BM_SETIMAGE, IMAGE_BITMAP, CAST(LPARAM, hbitmap))

While GetMessage( @msg, 0, 0, 0 )
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273 : PostQuitMessage(0):kill "small.bmp"
            End Select
    End Select
   
Wend
PostQuitMessage(0)
End
 

[UEZ]

How would you create an "image" , draw on the image and then stick the image on the button?

I would use GDIPlus to create and draw to image:

Code: Select all

#include once "windows.bi"

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include "win/gdiplus-c.bi"
#Else
    #Include "win/gdiplus.bi"
    Using gdiplus
#Endif

'init GDIPlus
Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End

'create an empty GDIPlus bitmap
Dim As Any Ptr hBitmap, hGfx, hPen, hGDIBitmap
GdipCreateBitmapFromScan0(50, 25, 0, PixelFormat32bppARGB, 0, @hBitmap)
'create graphic handle which is needed to draw to bitmap
GdipGetImageGraphicsContext(hBitmap, @hGfx)
'enable anti aliasing for canvas
GdipSetSmoothingMode(hGfx, SmoothingModeAntiAlias)
'clear canvas with white color
GdipGraphicsClear(hGfx, &hFFFFFFFF) 'ARGB
'create a green pen handle with 4px width
GdipCreatePen1(&hFF00FF00, 4, 2, @hPen) 'ARGB
'draw X and a circle
GdipDrawEllipse(hGfx, hPen, 4, 4, 43, 18)
'change pen color to blue and semi transparent alpha channel and draw X
GdipSetPenColor(hPen, &h800000FF)
GdipDrawLine(hGfx, hPen, 0, 0, 50, 25)
GdipDrawLine(hGfx, hPen, 0, 25, 50, 0)
'now convert the GDIPlus bitmap to GDI format which is needed to display bitmap in button control
GdipCreateHBITMAPFromBitmap(hBitmap, @hGDIBitmap, &hFF000000)
'release GDIPlus resources as they are not needed anymore
GdipDeletePen(hPen)     
GdipDeleteGraphics(hGfx)
GdipDisposeImage(hBitmap)
GdiplusShutdown(gdipToken)

Dim As MSG msg
Dim Shared As HWND hWnd, edit
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 10, 200, 100, 0, 0, 0, 0 )

edit = CreateWindowEx( 0, "BUTTON", "Button" , WS_BORDER Or WS_VISIBLE Or WS_CHILD or ANSI_CHARSET OR BS_PUSHBUTTON OR BS_BITMAP, 10 , 10 , 50 , 25 , hWnd, 0, 0, 0 )


IF hGDIBitmap THEN SendMessage(edit, BM_SETIMAGE, IMAGE_BITMAP, CAST(LPARAM, hGDIBitmap))

While GetMessage( @msg, 0, 0, 0 )
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273 : PostQuitMessage(0)
            End Select
    End Select
   
Wend
PostQuitMessage(0)
'release GDI bitmap
DeleteObject(hGDIBitmap)

End


[Tourist Trap]

How would you create an "image" , draw on the image and then stick the image on the button?

I would use GDIPlus to create and draw

By luck, would gdi+ be dpi aware or not?

[UEZ]

How would you create an "image" , draw on the image and then stick the image on the button?

I would use GDIPlus to create and draw

By luck, would gdi+ be dpi aware or not?

Sure.

Code: Select all

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include "win/gdiplus-c.bi"
#Else
    #Include "win/gdiplus.bi"
    Using gdiplus
#Endif

Function _GDIPlus_GraphicsGetDPIRatio(iDPIDef As Single = 96) As Single
   Dim As Any Ptr hGfx
   GdipCreateFromHWND(0, @hGfx)
   Dim As Single fDPI
   GdipGetDpiX(hGfx, @fDPI)
   GdipDeleteGraphics(hGfx)
   Return fDPI / iDPIDef
End Function

'init GDIPlus
Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then End

? "DPI ratio: " & _GDIPlus_GraphicsGetDPIRatio()

GdiplusShutdown(gdipToken)

Sleep