Voting
Category
real language
Bookmarking
Support Us
Language XBLite
(A WIN32 version of the xbasic compiler.)
| Date: | 10/06/06 |
| Author: | Guy Lonne |
| URL: | n/a |
| Comments: | 1 |
| 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
an XBRegular or XBDark version would be!!