Voting
Category
real language
Bookmarking
Language XBLite
(A WIN32 version of the xbasic compiler.)
| Date: | 10/06/06 |
| Author: | Guy Lonne |
| URL: | n/a |
| Comments: | 0 |
| Info: | http://perso.wanadoo.fr/xblite/ |
| Score: |  (2.69 in 78 votes) |
'
' ####################
' ##### PROLOG #####
' ####################
'
' Bottles - would sing all the verses of the song "99 bottles of beer"
' if only it could!
' Guy LONNE, using XBLite
'
' Written in XBLite, a WIN32 version of the xbasic compiler,
' which can be found at:
' - http://perso.wanadoo.fr/xblite/
' - http://xblite.xbasic.org/
' Send comments/bug reports to xblite@googlegroups.com
'
' The following source code is auto-generated by XBLite GDE
' and is released without restrictions.
'
PROGRAM "Bottles"
VERSION "0.01"
'
' ###############################
' ##### declare functions #####
' ###############################
'
' XBLite DLL headers
'
IMPORT "xst" ' XBLite Standard Library
'
' Win32API DLL headers
'
' ---Note: import gdi32 BEFORE user32
IMPORT "gdi32" ' Graphic Device Interface
IMPORT "kernel32" ' operating system
IMPORT "user32" ' Windows management
'
' #################################
' ##### Function prototypes #####
' #################################
'
' These are standard functions that belong to all XBLite GUI programs
DECLARE FUNCTION Entry ()
DECLARE FUNCTION InitGui ()
DECLARE FUNCTION RegisterWinClass (className$, addrCallback, icon$, menu$)
DECLARE FUNCTION CreateWindows ()
DECLARE FUNCTION NewWindow (className$, title$, style, x, y, w, h, _
exStyle)
DECLARE FUNCTION NewChild (className$, text$, style, x, y, w, h, parent, _
id, exStyle)
DECLARE FUNCTION MessageLoop ()
DECLARE FUNCTION CleanUp ()
' The next function is the callback function for the main
' window. This is where messages are sent when a user
' interacts with the controls in the window
DECLARE FUNCTION mainWnd_callback (hWnd, msg, wParam, lParam)
'
'
' #################################################
' ##### declare and define global constants #####
' #################################################
'
' Global Constants which represent control ID's for the "edit"
' control used for the song's display
' (prefix "$$" declares implicitly a global constant)
$$textBox_Id = 2421 ' multi-line text edit
'
'
' ######################
' ##### Entry () #####
' ######################
'
' Application start-up entry
' (name imposed: the compiler knows only "Entry ()")
'
FUNCTION Entry ()
STATIC entry
IF entry THEN RETURN ' enter once
entry = $$TRUE ' enter occured
InitGui () ' initialize win32 controls and libraries
CreateWindows () ' create windows and other child controls
MessageLoop () ' the main message loop
CleanUp () ' unregister the window class
END FUNCTION
' start GUI
FUNCTION InitGui ()
SHARED hInst ' global variable: current instance handle
hInst = GetModuleHandleA (0) ' get current instance handle
IFZ hInst THEN QUIT (0) ' error: abend!
END FUNCTION
' register the window class
FUNCTION RegisterWinClass (className$, addrCallback, icon$, _
menu$)
'
' Returns:
' - an error flag: $$TRUE = error, $$FALSE = OK!
SHARED hInst
WNDCLASS wc
wc.style = $$CS_HREDRAW | $$CS_VREDRAW | $$CS_OWNDC
wc.lpfnWndProc = addrCallback
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInst
wc.hIcon = LoadIconA (hInst, &icon$)
wc.hCursor = LoadCursorA (0, $$IDC_ARROW)
wc.hbrBackground = $$COLOR_BTNFACE + 1
wc.lpszMenuName = &menu$
wc.lpszClassName = &className$
IFZ RegisterClassA (&wc) THEN RETURN $$TRUE ' error
END FUNCTION
' create a window
FUNCTION NewWindow (className$, title$, style, x, y, w, h, exStyle)
'
' Arguments:
' - className$: window's class
' - text$ : title
' - style : style
' - x : Left
' - y : Top
' - w : Width
' - h : Height
' - exStyle : extended style
'
' Returns:
' - The window's handle if OK!, 0 = error
SHARED hInst ' current instance handle
RETURN CreateWindowExA (exStyle, &className$, &title$, style, x, y, _
w, h, 0, 0, hInst, 0)
END FUNCTION
' create a child window (i.e. a control)
FUNCTION NewChild (className$, text$, style, x, y, w, h, parent, id, _
exStyle)
'
' Arguments:
' - className$: window's class
' - text$ : title
' - style : style
' - x : Left
' - y : Top
' - w : Width
' - h : Height
' - exStyle : extended style
'
' Returns:
' - The child window's handle if OK!, 0 = error
SHARED hInst ' current instance handle
style = style | $$WS_CHILD | $$WS_VISIBLE
RETURN CreateWindowExA (exStyle, &className$, &text$, style, x, y, w, _
h, parent, id, hInst, 0)
END FUNCTION
' main message loop
FUNCTION MessageLoop ()
'
' Returns:
' - an error flag: $$TRUE = error, $$FALSE = OK!
MSG msg
DO ' the message loop
ret = GetMessageA (&msg, NULL, 0, 0) ' retrieve next message
'
SELECT CASE ret
CASE 0 : RETURN $$FALSE ' WM_QUIT message
CASE -1 : RETURN $$TRUE ' error
CASE ELSE
' deal with window messages
hwnd = GetActiveWindow ()
IF (!IsWindow (hwnd)) || (!IsDialogMessageA (hwnd, &msg)) THEN
' send only non-dialog messages
TranslateMessage (&msg) ' translate virtual-key messages
DispatchMessageA (&msg) ' send message to callback function
END IF
END SELECT
LOOP ' forever
END FUNCTION
' callback function for window mainWnd
FUNCTION mainWnd_callback (hWnd, msg, wParam, lParam)
'
' Message handler: all messages pass thru this function.
' (called by Windows' function DispatchMessage)
'
' Returns:
' - the error code of the default window procedure, 0 = OK!
SELECT CASE msg
CASE $$WM_CLOSE : DestroyWindow (hWnd)
CASE $$WM_DESTROY : PostQuitMessage (0)
CASE ELSE
RETURN DefWindowProcA (hWnd, msg, wParam, lParam)
END SELECT
RETURN 0 'OK!
END FUNCTION
' This function generates the main window and displays it
FUNCTION CreateWindows ()
'
' Returns:
' - an error flag: $$TRUE = error, $$FALSE = OK!
' **************************************************************
' ***************** Begin Window Generation ********************
' **************************************************************
' register the window class for window: mainWnd
' #mainWnd_class$: global variable that holds the window class
' (prefix "#" declares implicitly a global variable)
#mainWnd_class$ = "mainWndClass"
addrCallback = &mainWnd_callback ()
icon$ = ""
menu$ = ""
IF RegisterWinClass (@#mainWnd_class$, addrCallback, @icon$, _
@menu$) THEN RETURN $$TRUE ' error
' create window
title$ = "Song \"99 Bottles of Beer\""
style = $$WS_OVERLAPPEDWINDOW
x = 309
y = 47
w = 508
h = 433
exStyle = 0
' #mainWnd_handle: global variable that holds the window handle
#mainWnd_handle = NewWindow (@#mainWnd_class$, @title$, style, x, _
y, w, h, exStyle)
IFZ #mainWnd_handle THEN RETURN $$TRUE
nl$ = CHR$ (13) + CHR$ (10)
t$ = ""
FOR b = 99 TO 3 STEP -1
'
t$ = t$ + STRING$ (b) + " bottles of beer on the wall,"
t$ = t$ + STR$ (b) + " bottles of beer." + nl$
t$ = t$ + "Take one down and pass it around,"
b_1 = b - 1
t$ = t$ + STR$ (b_1) + " bottles of beer on the wall." + nl$ + nl$
NEXT b
t$ = t$ + "2 bottles of beer on the wall, 2 bottles of beer." + nl$
t$ = t$ + "Take one down and pass it around, "
t$ = t$ + "1 bottle of beer on the wall." + nl$ + nl$
t$ = t$ + "1 bottle of beer on the wall, 1 bottle of beer." + nl$
t$ = t$ + "Take one down and pass it around, "
t$ = t$ + "no more bottles of beer on the wall." + nl$ + nl$
t$ = t$ + "No more bottles of beer on the wall, "
t$ = t$ + "no more bottles of beer." + nl$
t$ = t$ + "Go to the store and buy some more, "
t$ = t$ + "99 bottles of beer on the wall."
' *************** Begin Controls Configuration **************
' Multiline Edit Control with Vertical Scrollbar
style = $$ES_MULTILINE | $$ES_AUTOVSCROLL | $$WS_VSCROLL | $$ES_LEFT | _
$$WS_TABSTOP
#txtSong_handle = NewChild ($$EDIT, t$, style, 16, 24, 483, 365, _
#mainWnd_handle, $$textBox_Id, 0)
' **************** End Controls Configuration ***************
' **************************************************************
' ****************** End Window Generation *********************
' **************************************************************
' auto-center main window
' (standard function from Xst.dll)
XstCenterWindow (#mainWnd_handle)
' display main window
ShowWindow (#mainWnd_handle, $$SW_SHOWNORMAL)
RETURN $$FALSE 'OK!
END FUNCTION
FUNCTION CleanUp ()
' #mainWnd_class$: global variable: window class
SHARED hInst ' global variable: current instance handle
' unregister the main window
UnregisterClassA (&#mainWnd_class$, hInst)
END FUNCTION
'
'
' #########################
' ##### END PROGRAM #####
' #########################
'
END PROGRAM
Download Source | Write Comment
Download Source | Write Comment
Add Comment
Please provide a value for the fields Name,
Comment and Security Code.
This is a gravatar-friendly website.
E-mail addresses will never be shown.
Enter your e-mail address to use your gravatar.
Please don't post large portions of code here! Use the form to submit new examples or updates instead!
Comments