 |
BCX Console Demonstration Program S79.bas
|
' *************************************************************************
' BCX recognizes WinMain and WndProc as being indicative of GUI programming
' otherwise, BCX defaults to generating code for the console only. This is
' the first Gui program ever successfully translated by BCX. Possibilities?
' *************************************************************************
FUNCTION
WinMain(
)
LOCAL
hWnd AS
HWND
LOCAL
Msg AS
MSG
LOCAL
wc AS
WNDCLASSEX
DIM
AppName$
AppName$ =
"BCX_Demo"
wc.cbSize =
SIZEOF
(
wc)
wc.style =
CS_HREDRAW OR
CS_VREDRAW
wc.lpfnWndProc =
WndProc
wc.cbClsExtra =
0
wc.cbWndExtra =
0
wc.hInstance =
hInst
wc.hIcon =
LoadIcon(
hInst, "BCX_GUI"
)
wc.hCursor =
LoadCursor(
NULL, IDC_ARROW )
wc.hbrBackground =
GetStockObject(
WHITE_BRUSH )
wc.lpszMenuName =
NULL
wc.lpszClassName =
AppName$
wc.hIconSm =
LoadIcon(
hInst, IDI_APPLICATION )
RegisterClassEx (
&
wc)
hWnd =
CreateWindow(
AppName$,"Introducing BCX!"
, _
WS_OVERLAPPEDWINDOW, 0
, 0
, 400
, 200
, NULL, NULL, hInst, NULL )
ShowWindow (
hWnd,CmdShow)
UpdateWindow(
hWnd)
WHILE
(
GetMessage(
&
Msg, NULL, 0
, 0
)
)
TranslateMessage(
&
Msg)
DispatchMessage(
&
Msg)
WEND
FUNCTION
=
Msg.wParam
END
FUNCTION
CALLBACK
FUNCTION
WndProc(
)
LOCAL
hButton AS
HANDLE
LOCAL
hdc AS
HDC
LOCAL
ps AS
PAINTSTRUCT
LOCAL
rect AS
RECT
LOCAL
tm AS
TEXTMETRIC
LOCAL
Tmp$
LOCAL
cx
LOCAL
cy
SELECT
CASE
Msg
CASE
WM_CREATE
hdc =
GetDC(
hWnd)
SelectObject(
hdc, GetStockObject(
SYSTEM_FIXED_FONT)
)
GetTextMetrics(
hdc, &
tm)
cx =
tm.tmAveCharWidth *
10
cy =
(
tm.tmHeight +
tm.tmExternalLeading)
*
2
ReleaseDC(
hWnd, hdc)
hButton =
CreateWindow(
"button"
,"Too Cool!"
, _
WS_CHILD OR
WS_VISIBLE OR
BS_PUSHBUTTON, _
140
, 115
, cx, cy, hWnd, 1
, NULL, NULL)
CenterWindow(
hWnd)
CASE
WM_PAINT
hdc =
BeginPaint(
hWnd, &
ps)
GetClientRect(
hWnd, &
rect)
Tmp$ =
"BCX does Gui Windows too ..."
TextOut(
hdc, 85
, 30
, Tmp$, LEN
(
Tmp$)
)
Tmp$ =
"For Free!"
TextOut(
hdc, 150
, 70
, Tmp$, LEN
(
Tmp$)
)
EndPaint(
hWnd, &
ps)
EXIT
FUNCTION
CASE
WM_COMMAND
IF
LOWORD(
wParam)
=
1
THEN
IF
HIWORD(
wParam)
=
BN_CLICKED THEN
DestroyWindow(
hWnd)
END
IF
END
IF
EXIT
FUNCTION
CASE
WM_DESTROY
PostQuitMessage(
0
)
END
SELECT
FUNCTION
=
DefWindowProc(
hWnd, Msg, wParam, lParam)
END
FUNCTION
SUB
CenterWindow(
hWnd AS
HANDLE)
DIM
wRect AS
RECT
DIM
x AS
DWORD
DIM
y AS
DWORD
GetWindowRect(
hWnd, &
wRect)
x =
(
GetSystemMetrics(
SM_CXSCREEN)
-
(
wRect.right -
wRect.left)
)
/
2
y =
(
GetSystemMetrics(
SM_CYSCREEN)
-
_
(
wRect.bottom -
wRect.top +
GetSystemMetrics(
SM_CYCAPTION)
)
)
/
2
SetWindowPos(
hWnd, NULL, x, y, 0
, 0
, SWP_NOSIZE OR
SWP_NOZORDER)
END
SUB