Windows Button Image
Windows Button Image
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...
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...
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Windows Button Image
albert wrote: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)
Re: Windows Button Image
@Tourist Trap
Yeah , i need the MS Windows API, "BUTTON" call , with an image on it.
Yeah , i need the MS Windows API, "BUTTON" call , with an image on it.
-
- Posts: 516
- Joined: Sep 27, 2016 18:20
- Location: Valencia, Spain
Re: Windows Button Image
Create a button with the BS_BITMAP style and then send a BM_SETIMAGE message with the handle of your bitmap.
Re: Windows Button Image
@Josep Roca
Can ou modify the following to put a bitmap on the button??
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
-
- Posts: 516
- Joined: Sep 27, 2016 18:20
- Location: Valencia, Spain
Re: Windows Button Image
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
Re: Windows Button Image
@Josep Roca
It errors on "hImage" , you forgot to assign hImage ??
It says , variable hImage not declared..
It errors on "hImage" , you forgot to assign hImage ??
It says , variable hImage not declared..
-
- Posts: 516
- Joined: Sep 27, 2016 18:20
- Location: Valencia, Spain
Re: Windows Button Image
Change hImage to hBitmap or change hBitmap to hImage.
Re: Windows Button Image
I tweaked the code a little.
(My bitmap is 350 by 150)
(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
Re: Windows Button Image
@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..
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..
Re: Windows Button Image
@Dodicat
How would you create an "image" , draw on the image and then stick the image on the button?
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
Re: Windows Button Image
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
Re: Windows Button Image
albert wrote: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
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Windows Button Image
UEZ wrote:albert wrote: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?
Re: Windows Button Image
Tourist Trap wrote:UEZ wrote:albert wrote: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
Who is online
Users browsing this forum: No registered users and 3 guests