Code: Select all
#include once "windows.bi"
declare function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
byval szCmdLine as zstring ptr, _
byval iCmdShow as integer ) as integer
end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )
FUNCTION DlgProc (BYVAL hDlg AS HWND, BYVAL wMsg AS Uint, BYVAL wParam AS wParam, BYVAL lParam AS lParam) AS Integer
SELECT CASE wMsg
CASE WM_INITDIALOG
CASE WM_COMMAND
IF HIWORD(wParam) = BN_CLICKED THEN
SELECT CASE LOWORD(wParam)
CASE IDOK
END SELECT
END IF
CASE WM_CLOSE
EndDialog hDlg, 0
END SELECT
function = 0 ' DefWindowProc( hDlg, wMsg, wParam, lParam )
END FUNCTION
function NewDialog( byval hParent as HWND, byval lpDialogProc as DLGPROC) as HWND
dim as HWND rval
dim dt as DLGTEMPLATE
dim strTitle as string
dim lpdt as LPDLGTEMPLATE
dt.style = WS_OVERLAPPEDWINDOW 'DS_MODALFRAME OR DS_CENTER OR WS_VISIBLE OR WS_OVERLAPPEDWINDOW
dt.dwExtendedStyle = 0
dt.cx = 170
dt.cy = 200
dt.cdit = 0
dt.x = 50
dt.y = 50
lpdt = cast(LPDLGTEMPLATE,@dt)
rval = DialogBoxIndirect(GetModuleHandle(null),lpdt,hParent,lpDialogProc)
return rval
end function
function WndProc ( byval hWnd as HWND, _
byval wMsg as UINT, _
byval wParam as WPARAM, _
byval lParam as LPARAM ) as LRESULT
function = 0
select case( wMsg )
case WM_CREATE
exit function
case WM_SIZE
exit function
case WM_COMMAND
exit function
case WM_PAINT
dim rct as RECT
dim pnt as PAINTSTRUCT
dim hDC as HDC
hDC = BeginPaint( hWnd, @pnt )
EndPaint( hWnd, @pnt )
exit function
case WM_KEYDOWN
case WM_DESTROY
PostQuitMessage( 0 )
exit function
end select
function = DefWindowProc( hWnd, wMsg, wParam, lParam )
end function
'':::::
function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
byval szCmdLine as zstring ptr, _
byval iCmdShow as integer ) as integer
dim wMsg as MSG
dim wcls as WNDCLASS
dim hWnd as HWND
function = 0
with wcls
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon( NULL, IDI_APPLICATION )
.hCursor = LoadCursor( NULL, IDC_ARROW )
.hbrBackground = GetStockObject( WHITE_BRUSH )
.lpszMenuName = NULL
.lpszClassName = @"Test"
end with
if( RegisterClass( @wcls ) = FALSE ) then
MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
exit function
end if
hWnd = CreateWindowEx( 0, _
@"Test", _
"The GRD Simple Demo", _
WS_OVERLAPPEDWINDOW, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
NULL, _
NULL, _
hInstance, _
NULL )
ShowWindow( hWnd, iCmdShow )
UpdateWindow( hWnd )
NewDialog(HWND,cast(DLGPROC,ProcPtr(DlgProc)))
while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )
TranslateMessage( @wMsg )
DispatchMessage( @wMsg )
wend
function = wMsg.wParam
end function