I was assuming "image" meant a static image.
Code: Select all
''=============================================================================
#include "windows.bi"
''=============================================================================
''---------------------------------------------------------------------
'' This procedure sizes the specified window so the client area is the
'' specified width and height and optionally centers the window on the
'' the screen. Unlike AdjustWindowRect and AdjustWindowRectEx, this
'' procedure can handle a window with the WS_OVERLAPPED style.
''---------------------------------------------------------------------
sub SetClientSize( hwnd as HWND, pixelWidth as integer, _
pixelHeight as integer, bCenter as BOOL )
dim as integer x, y, w, h
dim as RECT rcc, rcw
GetClientRect( hwnd, @rcc )
GetWindowRect( hwnd, @rcw )
w = (rcw.right - rcw.left) - (rcc.right - pixelWidth) - 1
h = (rcw.bottom - rcw.top) - (rcc.bottom - pixelHeight) - 1
if bCenter then
x = (GetSystemMetrics( SM_CXSCREEN ) / 2) - w / 2
y = (GetSystemMetrics( SM_CYSCREEN ) / 2) - h / 2
else
x = rcw.left
y = rcw.top
end if
MoveWindow( hwnd, x, y, w, h, TRUE )
end sub
''=============================================================================
function WindowProc( hwnd as HWND, uMsg as UINT, _
wParam as WPARAM, lParam as LPARAM) as LRESULT
static as HBRUSH hBrushBmp
select case uMsg
case WM_CREATE
''-----------------------------------------
'' Fblogo.bmp is in ...\FreeBASIC\examples
'' Size derived from the file properties.
''-----------------------------------------
SetClientSize( hwnd, 320, 240, TRUE )
dim as HANDLE hBmp = LoadImage( NULL, _
"fblogo.bmp", _
IMAGE_BITMAP, _
0, _
0, _
LR_LOADFROMFILE )
hBrushBmp = CreatePatternBrush( hBmp )
SetClassLongPtr( hwnd, _
GCLP_HBRBACKGROUND, _
CAST(LONG_PTR, hBrushBmp) )
case WM_COMMAND
if wParam = IDCANCEL then
DestroyWindow(hwnd)
end if
case WM_CLOSE
DestroyWindow( hwnd )
case WM_DESTROY
PostQuitMessage( 0 )
case else
return DefWindowProc( hwnd, uMsg, wParam, lParam )
end select
end function
''=============================================================================
dim as HWND hwnd
dim as MSG msg
dim as WNDCLASSEX wcx
wcx.cbSize = sizeof(WNDCLASSEX)
wcx.style = 0
wcx.lpfnWndProc = @WindowProc
wcx.cbClsExtra = 0
wcx.cbWndExtra = 0
wcx.hInstance = GetModuleHandle( NULL )
wcx.hIcon = LoadIcon( NULL, IDI_APPLICATION )
wcx.hCursor = LoadCursor( NULL, IDC_ARROW )
wcx.hbrBackground = GetStockObject( WHITE_BRUSH )
wcx.lpszMenuName = NULL
wcx.lpszClassName = strptr("test")
wcx.hIconSm = 0
RegisterClassEx( @wcx )
hwnd = CreateWindowEx( 0, "test", "Test", WS_OVERLAPPED or WS_SYSMENU, _
0, 0, 0, 0, NULL, NULL, NULL, NULL )
ShowWindow( hwnd, SW_SHOWNORMAL )
UpdateWindow( hwnd )
do while GetMessage( @msg, NULL, 0, 0 ) > 0
if IsDialogMessage(hwnd, @msg ) = 0 then
TranslateMessage( @msg )
DispatchMessage( @msg )
end if
loop