Christmas 2025 Coding Challenge – Secret Santa Gift Raffle
16 views
Skip to first unread message
Guy Lonne
Dec 12, 2025, 1:05:48 PM (7 days ago) Dec 12
to xbl...@googlegroups.com
Dear fellow XBLiters,
As the holiday season approaches, I thought it would be fun to combine our love for programming with the joy of giving!
I’m proposing a small but creative challenge: Build a Windows GUI application that draws gifts for participants in the "Secret Santa" tradition.
The Challenge
The application:
1. Loads from a text file a list of participants (name, email)
2. Draws Randomly the Gifts:
◦ Randomly assigns each participant a "Secret Santa" recipient
◦ Ensures no one is assigned to themselves
◦ Ensures fairness and avoids duplicates (e.g., no two people
draw the same recipient)
3. Displays the Results:
◦ Shows the resulting list “Who Gives to Whom”
◦ Drafts an email text to inform each participant and saves it
in participant_email.txt
Bonus Feature(s) (If your coffee is still lukewarm)
◦ Charm us with a festive theme (e.g., Christmas colors,
animations, or sound effects)
◦ Present the results in a visually appealing way (e.g., a
[Santa tick] list, a [Christmas] tree with participant's emails
hanging, a [festive] animation of the drawing process)
◦ Allow saving/manual update/loading participant list(s) with
their emails in text file(s) (-->Much appreciated for next
year's raffle)
◦ Send the emails directly from within your application
(-->Look up vxbl.x or xsed.x to see how it's done in XBLite)
Technical Requirements
-
Language: XBLite for the core logic
-
GUI: WinX (or your preferred GUI) for the user interface
-
Platform: Windows XP or later (-->XBLite's magic!)
Why Participate?
-
Sharpen your XBLite skills in GUI programming and random assignment logic from a random Guy!
-
Share your creation with the community and inspire other Xbliters.
-
Spread some holiday cheer through code!
- Run your application out-of-the-box every Christmas, and liven up all future holiday celebrations!
Submission
Post your the XBLite source of your solution here in the XBLite Google group by December 20, 2025.
I’ll share my own version using XBLite for the logic and WinX for the UI if I am not too rusty...
Modus operandis
Let’s make this a fun and collaborative project!
Hugo, Geoffrey, try to make it simple so it just does the job, and it does it good; if you have any questions or new ideas, feel free to reply to this thread.
Happy coding, and may your Secret Santa be bug-free!
-- Bye! Guy
Guy LONNE
Dec 12, 2025, 1:12:20 PM (7 days ago) Dec 12
to xblite
As you might guess, I meant:
1.Load the participant list into a list Box
2.Add/Change/Delete to your heart content
3.Overwrite the original text file with you updates
Makes more sense, doesn't it?
Bye! Guy
Guy LONNE
Dec 12, 2025, 6:43:15 PM (7 days ago) Dec 12
to xblite
Hi Xbliters!
Since I'll be AFK, here's my submission.
This is a minimum version, but it does the job!
Feel free to review it after submitting your own: all your comments are welcome (really, all of them).
' (e.g., no two people draw the same recipient)
' (e.g., Christmas colors, animations, or sound effects)
Since I'll be AFK, here's my submission.
This is a minimum version, but it does the job!
Feel free to review it after submitting your own: all your comments are welcome (really, all of them).
Bye! Guy
'
'
' ####################
' ##### PROLOG #####
' ####################
'
' Secret_Santa.x
' Copyright (c) GPL 2025 Guy Lonne.
' Purpose: Secret Santa Gift Raffle
' ======= with a Graphical User Interface using Callum Lowcay's WinX.
'
PROGRAM "Secret_Santa"
VERSION "1.00"
'CONSOLE
'
' ------------------------------------------------------------------------------
' The following source code is generated by viXen v1.99u
' from viXen Project C:\xblite\MyProgs\Secret_Santa\gen\Secret_Santa.vxn
' and is released under GPL.
' ------------------------------------------------------------------------------
' Programs contain: 1: Prolog - no executable code - see below
' 2: Entry function - start execution at 1st declared function
' * = optional 3: Other functions - everything else - all other functions
'
' The prolog contains (in this order):
' * 1. Program name statement PROGRAM "Secret_Santa"
' * 2. Version number statement VERSION "1.00"
' * 3. Import library statements IMPORT "libName"
' * 4. Composite type definitions TYPE <typename> ... END TYPE
' 5. Internal FUNCTION DECLAREs DECLARE/INTERNAL FUNCTION FuncName(args)
' * 6. External FUNCTION DECLAREs EXTERNAL FUNCTION FuncName(args)
' * 7. Shared constant definitions $$constantName = literal or constant
' * 8. Shared variable declarations SHARED variableName
' ------------------------------------------------------------------------------
'
' ***** Description *****
'
' Application that draws gifts for participants
' in the "Secret Santa" tradition:
' 1. Manages Participants
' - Allow to load from a text file a list of participants (name, email)
' 2. Draws Gifts Randomly
' - Randomly assign each participant a "Secret Santa" recipient
' - Ensure no one is assigned to themselves
' - Ensure fairness and avoids duplicates
'
' ####################
' ##### PROLOG #####
' ####################
'
' Secret_Santa.x
' Copyright (c) GPL 2025 Guy Lonne.
' Purpose: Secret Santa Gift Raffle
' ======= with a Graphical User Interface using Callum Lowcay's WinX.
'
PROGRAM "Secret_Santa"
VERSION "1.00"
'CONSOLE
'
' ------------------------------------------------------------------------------
' The following source code is generated by viXen v1.99u
' from viXen Project C:\xblite\MyProgs\Secret_Santa\gen\Secret_Santa.vxn
' and is released under GPL.
' ------------------------------------------------------------------------------
' Programs contain: 1: Prolog - no executable code - see below
' 2: Entry function - start execution at 1st declared function
' * = optional 3: Other functions - everything else - all other functions
'
' The prolog contains (in this order):
' * 1. Program name statement PROGRAM "Secret_Santa"
' * 2. Version number statement VERSION "1.00"
' * 3. Import library statements IMPORT "libName"
' * 4. Composite type definitions TYPE <typename> ... END TYPE
' 5. Internal FUNCTION DECLAREs DECLARE/INTERNAL FUNCTION FuncName(args)
' * 6. External FUNCTION DECLAREs EXTERNAL FUNCTION FuncName(args)
' * 7. Shared constant definitions $$constantName = literal or constant
' * 8. Shared variable declarations SHARED variableName
' ------------------------------------------------------------------------------
'
' ***** Description *****
'
' Application that draws gifts for participants
' in the "Secret Santa" tradition:
' 1. Manages Participants
' - Allow to load from a text file a list of participants (name, email)
' 2. Draws Gifts Randomly
' - Randomly assign each participant a "Secret Santa" recipient
' - Ensure no one is assigned to themselves
' - Ensure fairness and avoids duplicates
' (e.g., no two people draw the same recipient)
' 3. Displays Results
' - Show the results “Who Gives to Whom”.
' - Using the list of participant’s emails, write the text of the email.
'
' Bonus Features (If the coffee is still lukewarm)
' - Charm us with a festive theme
' - Show the results “Who Gives to Whom”.
' - Using the list of participant’s emails, write the text of the email.
'
' Bonus Features (If the coffee is still lukewarm)
' - Charm us with a festive theme
' (e.g., Christmas colors, animations, or sound effects)
' - Present the results in a visually appealing way
' (e.g., [Santa tick] list, [Christmas] tree, [festive] animation)
' - Allow saving/loading participant list(s) with their emails in text
' file(s)
' - Send the emails from within your application
'
' ***** Notes *****
'
' WinX.dll
' ========
'
' WinX.dll is Callum Lowcay's Windowing library for XBLite;
' it makes easy Windows GUI programming through a set of wrappers
' for the ANSI Win32 APIs. WinX is perfect to experiment GUI coding
' by means of quick prototypes.
'
' Information about the XP Style
' ==============================
'
' viXen's "XP Style" is what Microsoft calls:
' Common Controls' Visual Styles.
'
' To benefit from the XP Style, the program's executable
' must invoke at run-time ComCtl32.dll version 6 or later.
'
' Because version 6 is not redistributable,
' it is available only when the executable is running
' on a version of Windows that contains it.
'
' Windows XP and later ships with both version 5 and version 6.
'
' ComCtl32.dll version 6 contains both the user controls and the common
' controls. By default, programs use the user controls defined in
' User32.dll and the common controls defined in ComCtl32.dll version 5.
'
' It was customary to call the manifest file "program.exe.manifest"
' however, when attached to an e-mail, ".exe" in the file name can cause
' the recipient's antivirus to reject the e-mail.
' To prevent this rejection, viXen names the manifest file: "program.manifest".
'
' For Vista or above, the generated program is made User Account Control-aware
' by adding a UAC section; 'asInvoker' is used by default, but 'highestAvailable'
' or 'asAdministrator' could also be used instead.
'
' Naming Conventions
' ==================
'
' No handle prefix.
' Control Ids are Mixed-Case.
' Handle names are Mixed-Case.
'
' - GDI Naming ("my OBJect_name")
' . Control Id : $$myOBJectName
' . Handle : #myOBJectName
'
' - Window
' . Main window
' handle : #winMain
' . Dialog : #dlg...
'
' - Control
' . menu bar : Control Id: $$mnuMain Handle: #mnuMain
' . sub-menu : Control Id: $$mnuSubMenu Handle: #mnuSubMenu
' . menu option : Control Id: $$mnuMenuOption Handle: #mnuMenuOption
' . group box : Control Id: $$grpGroupBox Handle: #grpGroupBox
' . push button : Control Id: $$btnPushButton Handle: #btnPushButton
' . static : Control Id: $$lblStaticControl Handle: #lblStaticControl
' . multiline editor : Control Id: $$mleMultilineEditor Handle: #mleMultilineEditor
' . list box : Control Id: $$lstListBox Handle: #lstListBox
'
'
' ***** Versions *****
'
' 1.00-GL-12dec25-Generated GUI prototype using viXen v1.99u.
' Operating System: Windows 7
' Generation switches that are on:
' - Use Callum Lowcay's WinX
' - Use Windows XP Style
' - Use Debugging Functions
' - Source Verbose Mode
' - Meticulous Clean-Up
'
'
' ##############################
' ##### Import Libraries #####
' ##############################
'
' XBLite headers
'
IMPORT "xst" ' XBLite Standard Library
IMPORT "xsx" ' XBLite Standard eXtended Library
' IMPORT "xio" ' console library
'
IMPORT "WinX" ' Callum Lowcay's Windows GUI library
'
' Win32 DLL Headers
'
IMPORT "kernel32" ' Operating System
' ---Note: import kernel32 BEFORE gdi32
IMPORT "gdi32" ' Graphic Device Interface
' ---Note: import gdi32 BEFORE shell32 and user32
IMPORT "shell32" ' interface to Operating System
IMPORT "user32" ' Windows management
'
' ---Note: import gdi32 BEFORE comctl32
IMPORT "comctl32" ' Common controls; ==> initialize w/ InitCommonControlsEx ()
' ---Note: import comctl32 BEFORE comdlg32
' IMPORT "comdlg32" ' Standard dialog boxes (opening and saving files ...)
'
'
' ********************************************
' ***** INTERNAL FUNCTION DECLARATIONS *****
' ********************************************
'
' User Interface Functions
'
DECLARE FUNCTION Entry () ' program entry point
DECLARE FUNCTION CleanStart () ' program setup
DECLARE FUNCTION CleanUp () ' program clean-up
DECLARE FUNCTION CreateWindows () ' create the windows of the program
DECLARE FUNCTION InitWindows () ' initializations after CreateWindows()
'
' Debugging Functions
'
DECLARE FUNCTION GuiTellApiError (msg$) ' display a Win32 API Error message
DECLARE FUNCTION GuiTellRunError (msg$) ' display a run-time error message
'
'
' ============================================
' ===== Callback Function Declarations =====
' ============================================
'
' Some WinX callback functions:
'
' Message $$WM_CLOSE Handler
' - windowX_Close (SLONG hWnd)
' - registered with WinXRegOnClose
'
' Note: return zero to confirm closing the window.
'
' Message $$WM_COMMAND Handler
' - windowX_onCommand (SLONG idCtr, SLONG notifyCode, SLONG hWnd)
' - registered with WinXRegOnCommand
'
' If you return 0 in this $$WM_CLOSE handler,
' WinX will emit a $$WM_DESTROY signal. Returning 1 means
' you don't want the window to be destroyed.
' This is specially useful for the main window
' for popping up dialog 'Exit Program'.
'
' Message $$WM_PAINT Handler
' - windowX_onPaint (SLONG hWnd, SLONG hDC)
' - registered with WinXRegOnPaint
'
' Messages GotFocus/Selected Handler
' - windowX_onItem (SLONG idCtr, SLONG notifyCode, SLONG virtualKey)
' - registered with WinXRegOnItem
'
'
' Main Window Callbacks
'
DECLARE FUNCTION winMain_Close (hWnd) ' handles message $$WM_CLOSE
DECLARE FUNCTION winMain_onCommand (idCtr, notifyCode, hCtr) ' handles message $$WM_COMMAND
DECLARE FUNCTION winMain_SetTitleBar ()
'
' About Dialog Callbacks
'
DECLARE FUNCTION dlgAbout_Close (hWnd) ' handles message $$WM_CLOSE
DECLARE FUNCTION dlgAbout_onCommand (idCtr, notifyCode, hCtr) ' handles message $$WM_COMMAND
DECLARE FUNCTION QuiLoadGifted ()
DECLARE FUNCTION QuiLoadNames () ' load names from file Participants.txt
DECLARE FUNCTION btnDraw_Click () ' on click on push button $$btnDraw
DECLARE FUNCTION btnSave_Click () ' on click on push button $$btnSave
DECLARE FUNCTION WinXDir_AppendSlash (@dir$) ' end directory path dir$ with $$PathSlash$
DECLARE FUNCTION WinXListBox_Clear (hListBox) ' delete all items of list box
DECLARE FUNCTION WinXPath_Trim$ (path$) ' trim/correct a file path
DECLARE FUNCTION DteGetMonthName (language, month, @month$) ' get month's name
'
'
' *****************************************
' ***** SHARED CONSTANT DEFINITIONS *****
' *****************************************
'
' Shared constants which represent the Control Ids.
' (the prefix '$$' declares implicitly a SHARED constant)
'
'
' ***** Constants used as control identificators for the main window *****
'
' control identificators for the main window
'
$$grpFrom = 101 ' group box 'Givers'
$$grpTo = 102 ' group box 'Lucky Ones'
$$lstFrom = 103 ' list box
$$lstTo = 104 ' list box
$$btnDraw = 105 ' push button 'Draw'
$$btnSave = 106 ' push button '&Save'
$$btnExit = 107 ' push button 'E&xit'
'
' menu identificators for Window #winMain
'
$$mnuMain = 8000 ' menu bar
'
$$mnuFile = 8001 ' sub-menu "&File"
$$mnuHelp = 8002 ' sub-menu "&Help"
'
$$mnuFileSave = 8003 ' menu option "&Save...\tCtrl+S"
$$mnuFileExit = 8004 ' menu option "E&xit"
'
$$mnuHelpAbout = 8009 ' menu option "&About\tCtrl+F1"
'
'
' ***** Constants used as control identificators for dialog #dlgAbout *****
'
$$dlgAbout = 300 ' dialog 'About " + PROGRAM$ (0) + "'
'
' control identificators for dialog #dlgAbout
'
$$dlgAbout_lblTitle = 301 ' static '" + PROGRAM$ (0) + ".exe\" - Secret Santa Gift Raffle'
$$dlgAbout_lblVer = 302 ' static 'Version " + VERSION$ (0) + ".'
$$dlgAbout_lblDisclaimer = 303 ' static 'Copyright (c) GPL 2025 Guy Lonne.'
$$dlgAbout_mleDesc = 304 ' multiline editor 'Application that draws gifts for participants in the \"Secret Santa\" tradition.'
$$dlgAbout_btnClose = 305 ' push button '&Close'
'
'
' ***** Shared Program Constants *****
'
' initial width and height of the main window
$$winMain_initW = 512
$$winMain_initH = 520
'
' initial width and height of dialog #dlgAbout
$$dlgAbout_initW = 720
$$dlgAbout_initH = 420
'
'
'
' ******************************************
' ***** SHARED VARIABLE DECLARATIONS *****
' ******************************************
'
' Keyword SHARED declares explicitly shared variables;
' e.g., "SHARED myGlobalXlong" declares a SHARED (global) XLONG: myGlobalXlong.
' In a FUNCTION Body, a variable prefixed by '#'
' is also a shared variable, but implicitly declared.
'
' WINDOWS GUI SHARED VARIABLES
'
SHARED hInst ' global instance handle
SHARED #winMain ' Main Window
SHARED #dlgAbout ' About Box
'
' ###################
' ##### Entry #####
' ###################
'
' Program Entry Point.
' The entry FUNCTION Entry is invoked at run-time on program start-up,
' NOT because of its name, but because it is the very first declared.
'
FUNCTION Entry ()
STATIC entry ' ensure Entry() is entered only one time
XLONG bErr ' $$TRUE for error
IF entry THEN RETURN ' enter once...
entry = $$TRUE ' ...and then no more
' XioCreateConsole ("", 50) ' create console
' The WinX() initialization call should go in the entry FUNCTION.
' This is because WinX could crash if a WinX API is called before
' the library is initialized.
IF WinX () THEN XstAbend (@"Can't initialize library WinX")
PRINT "CleanStart-DEBUG: initialize the program"
' CleanStart(), InitGui() and CreateWindows() return bErr on fail
bErr = CleanStart () ' initialize program and libraries
IF bErr THEN XstAlert (@"CleanStart: Can't initialize the program")
PRINT "CreateWindows-DEBUG: create the windows of the program"
bErr = CreateWindows () ' create the windows of the program
IF bErr THEN XstAlert (@"CreateWindows: Can't create the windows of the program")
PRINT "InitWindows-DEBUG: initializations after CreateWindows()"
InitWindows () ' initializations after CreateWindows()
'
' A Windows GUI program operates in a loop that receives and handles
' messages sent to it from the OS in reaction to user interactions and
' system events. These messages are handled by a specific "message loop":
' WinXDoEvents() for library WinX, which returns bErr
' ($$FALSE on receiving a QUIT event, $$TRUE for error).
'
PRINT "WinXDoEvents-DEBUG: the main event loop"
WinXDoEvents () ' the main event loop
CleanUp () ' program clean-up
' a$ = INLINE$ ("Press ENTER to exit >")
' XioFreeConsole () ' free console
QUIT (0)
END FUNCTION
'
' ########################
' ##### CleanStart #####
' ########################
'
' Program Setup on First Entry.
' Initialization code goes here,
' e.g., initializing global data structures,
' reading registry settings, loading files...
' returns bErr: $$TRUE for error
'
FUNCTION CleanStart ()
SHARED hInst ' global instance handle
SetLastError (0)
hInst = GetModuleHandleA (0) ' get the handle of current module
IFZ hInst THEN
msg$ = "GetModuleHandleA: Can't get the handle of current module"
bErr = GuiTellApiError (@msg$)
RETURN $$TRUE ' fail
ENDIF
' (Now is the right time to call the each library's initialization routine.)
bErr = QuiLoadNames () ' load names from file Participants.txt
RETURN bErr
END FUNCTION
'
' #####################
' ##### CleanUp #####
' #####################
'
' Program Clean-Up on Exit.
' This is where you clean up any resources that need to be deallocated.
'
FUNCTION CleanUp ()
XLONG ret ' Win32 API return value (0 for error)
' 1.Destroy the accelerator table(s)
IF #hAccel THEN DestroyAcceleratorTable (#hAccel)
#hAccel = 0
WinXCleanUp () ' optional clean-up
END FUNCTION
'
' ###########################
' ##### CreateWindows #####
' ###########################
'
' Creates the windows of the program.
' This function generates all the windows that you've created
' and makes the main window visible.
'
' An application's icon should come in two versions:
' - 16x16 pixels for the window itself; it is also used except
' for the Large View.
'
' - 32x32 pixels for the Large View of certain windows such as
' My Documents or Windows Explorer.
'
' This icon is not refered by its name, but as icon$ = "00app_icon".
'
FUNCTION CreateWindows ()
SHARED hInst ' must be valid to ensure ressource loading
ACCEL accel[] ' accelerator table
' ***************** Begin the main window setup *****************
' *********** Begin Menu setup ***********
' build the menu bar #mnuMain
menuList$ = "&File,&Help"
#mnuMain = WinXNewMenu (menuList$, $$mnuFile, $$FALSE) ' generate menu #mnuMain
IFZ #mnuMain THEN
msg$ = "WinXNewMenu: Can't generate menu #mnuMain"
GuiTellApiError (@msg$)
ENDIF
' build the sub-menu mnuFile
menuList$ = "&Save...\tCtrl+S,E&xit"
mnuFile = WinXNewMenu (menuList$, $$mnuFileSave, $$FALSE) ' generate menu mnuFile
IFZ mnuFile THEN
msg$ = "WinXNewMenu: Can't generate menu mnuFile"
GuiTellApiError (@msg$)
ENDIF
bOK = WinXMenu_Attach (#mnuFile, #mnuMain, $$mnuFile) ' attach sub-menu #mnuFile to its parent menu #mnuMain
IFF bOK THEN
msg$ = "WinXMenu_Attach: Can't attach sub-menu #mnuFile to its parent menu #mnuMain"
GuiTellApiError (@msg$)
ENDIF
' build the sub-menu mnuHelp
menuList$ = "&About\tCtrl+F1"
#mnuHelp = WinXNewMenu (menuList$, $$mnuHelpAbout, $$FALSE) ' generate menu mnuHelp
IFZ #mnuHelp THEN
msg$ = "WinXNewMenu: Can't generate menu #mnuHelp"
GuiTellApiError (@msg$)
ENDIF
bOK = WinXMenu_Attach (#mnuHelp, #mnuMain, $$mnuHelp) ' attach sub-menu #mnuHelp to its parent menu #mnuMain
IFF bOK THEN
msg$ = "WinXMenu_Attach: Can't attach sub-menu #mnuHelp to its parent menu #mnuMain"
GuiTellApiError (@msg$)
ENDIF
DIM accel[] ' reset the accelerator table
WinXAddAccelerator (@accel[], $$mnuFileSave, 'S', $$TRUE, $$FALSE, $$FALSE)
WinXAddAccelerator (@accel[], $$mnuHelpAbout, $$VK_F1, $$TRUE, $$FALSE, $$FALSE)
#hAccel = WinXAddAcceleratorTable (@accel[]) ' create accelerator table
IFZ #hAccel THEN
msg$ = "WinXAddAcceleratorTable: Can't create accelerator table"
GuiTellApiError (@msg$)
ENDIF
' *********** End Menu setup ***********
icon$ = "00app_icon"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon santa.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon santa.ico"
GuiTellApiError (@msg$)
ENDIF
' ---- creating the main window -----
titleBar$ = "Secret Santa Gift Raffle"
#winMain = WinXNewWindow (0, @titleBar$, -1, -1, $$winMain_initW, $$winMain_initH, $$XWSS_APP, 0, hIcon, #mnuMain) ' create window #winMain
IFZ #winMain THEN
msg$ = "WinXNewWindow: Can't create window #winMain"
bErr = GuiTellApiError (@msg$)
RETURN $$TRUE ' fail
ENDIF
' keep the initial width and height as minimum size
WinXSetMinSize (#winMain, $$winMain_initW, $$winMain_initH)
bOK = WinXAttachAccelerators (#winMain, #hAccel) ' attach the accelerator table to the main window
IFF bOK THEN
msg$ = "WinXAttachAccelerators: Can't attach the accelerator table to the main window"
GuiTellApiError (@msg$)
ENDIF
' register the callback functions
addrProc = &winMain_Close () ' handles message $$WM_CLOSE
WinXRegOnClose (#winMain, addrProc)
addrProc = &winMain_onCommand () ' handles message $$WM_COMMAND
WinXRegOnCommand (#winMain, addrProc)
' *********** Begin Controls setup ***********
' creating group box $$grpFrom
' style
' $$BS_GROUPBOX : Group box
' extended style
' $$WS_EX_TRANSPARENT : See-Thru Window
#grpFrom = WinXAddGroupBox (#winMain, @"Givers", $$grpFrom) ' create group box $$grpFrom
IFZ #grpFrom THEN
msg$ = "WinXAddGroupBox: Can't create group box $$grpFrom"
GuiTellApiError (@msg$)
ENDIF
' creating group box $$grpTo
' style
' $$BS_GROUPBOX : Group box
' extended style
' $$WS_EX_TRANSPARENT : See-Thru Window
#grpTo = WinXAddGroupBox (#winMain, @"Lucky Ones", $$grpTo) ' create group box $$grpTo
IFZ #grpTo THEN
msg$ = "WinXAddGroupBox: Can't create group box $$grpTo"
GuiTellApiError (@msg$)
ENDIF
' creating list box $$lstFrom
sort = $$FALSE ' unsorted list
multiSelect = $$FALSE ' mono-selection
' style
' $$WS_BORDER : Thin-line Border
#lstFrom = WinXAddListBox (#winMain, sort, multiSelect, $$lstFrom) ' create list box $$lstFrom
IFZ #lstFrom THEN
msg$ = "WinXAddListBox: Can't create list box $$lstFrom"
GuiTellApiError (@msg$)
ENDIF
' creating list box $$lstTo
sort = $$FALSE ' unsorted list
multiSelect = $$FALSE ' mono-selection
' style
' $$WS_BORDER : Thin-line Border
#lstTo = WinXAddListBox (#winMain, sort, multiSelect, $$lstTo) ' create list box $$lstTo
IFZ #lstTo THEN
msg$ = "WinXAddListBox: Can't create list box $$lstTo"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$btnDraw
icon$ = "do_right"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon do_right.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon do_right.ico"
GuiTellApiError (@msg$)
ENDIF
#btnDraw = WinXAddButton (#winMain, @"icon", hIcon, $$btnDraw) ' create push button $$btnDraw
IFZ #btnDraw THEN
msg$ = "WinXAddButton: Can't create push button $$btnDraw"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$btnSave
icon$ = "save"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon save.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon save.ico"
GuiTellApiError (@msg$)
ENDIF
#btnSave = WinXAddButton (#winMain, @"icon", hIcon, $$btnSave) ' create push button $$btnSave
IFZ #btnSave THEN
msg$ = "WinXAddButton: Can't create push button $$btnSave"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$btnExit
icon$ = "exit"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon exit.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon exit.ico"
GuiTellApiError (@msg$)
ENDIF
btnExit = WinXAddButton (#winMain, @"icon", hIcon, $$btnExit) ' create push button $$btnExit
IFZ btnExit THEN
msg$ = "WinXAddButton: Can't create push button $$btnExit"
GuiTellApiError (@msg$)
ENDIF
' *********** End Controls setup ***********
MoveWindow (#grpFrom, 8, 8, 188, 396, 1)
MoveWindow (#grpTo, 300, 8, 188, 396, 1)
MoveWindow (#lstFrom, 20, 26, 166, 368, 1)
MoveWindow (#lstTo, 308, 26, 166, 368, 1)
MoveWindow (#btnDraw, 210, 104, 76, 36, 1)
MoveWindow (#btnSave, 12, 420, 76, 36, 1)
MoveWindow (btnExit, 100, 420, 76, 36, 1)
' ***************** End the main window setup *****************
' ***************** Begin dialog #dlgAbout setup *****************
icon$ = "00app_icon"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon santa.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon santa.ico"
GuiTellApiError (@msg$)
ENDIF
' ---- creating dialog #dlgAbout -----
titleBar$ = "About " + PROGRAM$ (0)
#dlgAbout = WinXNewWindow (0, @titleBar$, -1, -1, $$dlgAbout_initW, $$dlgAbout_initH, $$XWSS_APPNORESIZE, 0, hIcon, 0) ' create dialog #dlgAbout
IFZ #dlgAbout THEN
msg$ = "WinXNewWindow: Can't create dialog #dlgAbout"
GuiTellApiError (@msg$)
ENDIF
WinXEnableDialogInterface (#dlgAbout, $$TRUE) ' enable a dialog-type interface
' register the callback functions
addrProc = &dlgAbout_Close () ' handles message $$WM_CLOSE
WinXRegOnClose (#dlgAbout, addrProc)
addrProc = &dlgAbout_onCommand () ' handles message $$WM_COMMAND
WinXRegOnCommand (#dlgAbout, addrProc)
' *********** Begin Controls setup ***********
' creating static $$dlgAbout_lblTitle
text$ = "\"" + PROGRAM$ (0) + ".exe\" - Secret Santa Gift Raffle"
dlgAbout_lblTitle = WinXAddStatic (#dlgAbout, @text$, 0, 0, $$dlgAbout_lblTitle) ' create static $$dlgAbout_lblTitle
IFZ dlgAbout_lblTitle THEN
msg$ = "WinXAddStatic: Can't create static $$dlgAbout_lblTitle"
GuiTellApiError (@msg$)
ENDIF
' creating static $$dlgAbout_lblVer
text$ = "Version " + VERSION$ (0) + "."
dlgAbout_lblVer = WinXAddStatic (#dlgAbout, @text$, 0, 0, $$dlgAbout_lblVer) ' create static $$dlgAbout_lblVer
IFZ dlgAbout_lblVer THEN
msg$ = "WinXAddStatic: Can't create static $$dlgAbout_lblVer"
GuiTellApiError (@msg$)
ENDIF
' creating static $$dlgAbout_lblDisclaimer
text$ = "Copyright (c) GPL 2025 Guy Lonne."
dlgAbout_lblDisclaimer = WinXAddStatic (#dlgAbout, @text$, 0, 0, $$dlgAbout_lblDisclaimer) ' create static $$dlgAbout_lblDisclaimer
IFZ dlgAbout_lblDisclaimer THEN
msg$ = "WinXAddStatic: Can't create static $$dlgAbout_lblDisclaimer"
GuiTellApiError (@msg$)
ENDIF
' creating multiline editor $$dlgAbout_mleDesc
text$ = "Application that draws gifts for participants in the \"Secret Santa\" tradition."
text$ = text$ + "\r\n\r\n1. Manages Participants"
text$ = text$ + "\r\n - Allow to load from a text file a list of participants"
text$ = text$ + "\r\n\r\n2. Draws Gifts Randomly"
text$ = text$ + "\r\n - Randomly assign each participant a \"Secret Santa\" recipient"
text$ = text$ + "\r\n - Ensure no one is assigned to themselves"
text$ = text$ + "\r\n - Ensure fairness and avoids duplicates"
text$ = text$ + "\r\n (e.g., no two people draw the same recipient)"
text$ = text$ + "\r\n\r\n3. Displays Results"
text$ = text$ + "\r\n - Show the results \"Who Gives to Whom\"."
text$ = text$ + "\r\n - Using the list of participant’s emails, write the text of the email."
style = $$ES_MULTILINE OR $$ES_AUTOHSCROLL OR $$ES_READONLY OR $$WS_HSCROLL OR $$WS_VSCROLL
' extended style
' $$WS_EX_CLIENTEDGE : Sunken Edged Border
#dlgAbout_mleDesc = WinXAddEdit (#dlgAbout, @text$, style, $$dlgAbout_mleDesc) ' create multiline editor $$dlgAbout_mleDesc
IFZ #dlgAbout_mleDesc THEN
msg$ = "WinXAddEdit: Can't create multiline editor $$dlgAbout_mleDesc"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$dlgAbout_btnClose
icon$ = "close"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon close.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon close.ico"
GuiTellApiError (@msg$)
ENDIF
dlgAbout_btnClose = WinXAddButton (#dlgAbout, @"icon", hIcon, $$dlgAbout_btnClose) ' create push button $$dlgAbout_btnClose
IFZ dlgAbout_btnClose THEN
msg$ = "WinXAddButton: Can't create push button $$dlgAbout_btnClose"
GuiTellApiError (@msg$)
ENDIF
' *********** End Controls setup ***********
MoveWindow (dlgAbout_lblTitle, 12, 12, 250, 20, 1)
MoveWindow (dlgAbout_lblVer, 12, 32, 250, 20, 1)
MoveWindow (dlgAbout_lblDisclaimer, 12, 52, 250, 56, 1)
MoveWindow (#dlgAbout_mleDesc, 270, 12, 428, 364, 1)
MoveWindow (dlgAbout_btnClose, 100, 340, 76, 36, 1)
' ***************** End dialog #dlgAbout setup *****************
WinXDisplay (#winMain)
END FUNCTION ' CreateWindows
'
' #############################
' ##### DteGetMonthName #####
' #############################
'
' Gets the month's name.
'
FUNCTION DteGetMonthName (language, month, @r_month$)
bErr = $$FALSE
' language = 0: English (by default)
SELECT CASE language
CASE 0, 1, 2, 3 ' English, French, Spanish, German
CASE ELSE : language = 0
END SELECT
SELECT CASE language
CASE 0 ' English
SELECT CASE month
CASE 1 : r_month$ = "January"
CASE 2 : r_month$ = "February"
CASE 3 : r_month$ = "March"
CASE 4 : r_month$ = "April"
CASE 5 : r_month$ = "May"
CASE 6 : r_month$ = "June"
CASE 7 : r_month$ = "July"
CASE 8 : r_month$ = "August"
CASE 9 : r_month$ = "September"
CASE 10 : r_month$ = "October"
CASE 11 : r_month$ = "November"
CASE 12 : r_month$ = "December"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
CASE 1 ' French
SELECT CASE month
CASE 1 : r_month$ = "janvier"
' CASE 2 : r_month$ = "février"
CASE 2 : r_month$ = "f" + CHR$ (233) + "vrier"
CASE 3 : r_month$ = "mars"
CASE 4 : r_month$ = "avril"
CASE 5 : r_month$ = "mai"
CASE 6 : r_month$ = "juin"
CASE 7 : r_month$ = "juillet"
' CASE 8 : r_month$ = "août"
CASE 8 : r_month$ = "ao" + CHR$ (251) + "t"
CASE 9 : r_month$ = "septembre"
CASE 10 : r_month$ = "octobre"
CASE 11 : r_month$ = "novembre"
' CASE 12 : r_month$ = "décembre"
CASE 12 : r_month$ = "d" + CHR$ (233) + "cembre"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
CASE 2 ' Spanish
SELECT CASE month
CASE 1 : r_month$ = "enero"
CASE 2 : r_month$ = "febrero"
CASE 3 : r_month$ = "marzo"
CASE 4 : r_month$ = "abril"
CASE 5 : r_month$ = "mayo"
CASE 6 : r_month$ = "junio"
CASE 7 : r_month$ = "julio"
CASE 8 : r_month$ = "agosto"
CASE 9 : r_month$ = "setiembre"
CASE 10 : r_month$ = "octubre"
CASE 11 : r_month$ = "noviembre"
CASE 12 : r_month$ = "diciembre"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
CASE 3 ' German
SELECT CASE month
CASE 1 : r_month$ = "Januar"
CASE 2 : r_month$ = "Februar"
' CASE 3 : r_month$ = "März"
CASE 3 : r_month$ = "M" + CHR$ (228) + "rz"
CASE 4 : r_month$ = "April"
CASE 5 : r_month$ = "Mai"
CASE 6 : r_month$ = "Juni"
CASE 7 : r_month$ = "Juli"
CASE 8 : r_month$ = "August"
CASE 9 : r_month$ = "September"
CASE 10 : r_month$ = "Oktober"
CASE 11 : r_month$ = "November"
CASE 12 : r_month$ = "Dezember"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
END SELECT
RETURN bErr
END FUNCTION
'
' #############################
' ##### GuiTellApiError #####
' #############################
'
' Displays a win32 api error message.
' returns bErr: $$TRUE only if an error REALLY occurred
'
' Usage:
' SetLastError (0)
' hImage = LoadImageA (0, &file$, $$IMAGE_BITMAP, 0, 0, $$LR_LOADFROMFILE)
' IFZ hImage THEN
' msg$ = "LoadImageA: Can't load Image File\r\n"
' msg$ = msg$ + file$
' bErr = GuiTellApiError (@msg$)
' IF bErr THEN RETURN $$TRUE ' fail
' ENDIF
'
FUNCTION GuiTellApiError (msg$)
XLONG char_count ' character count
XLONG dwFlags ' FormatMessageA()'s flags
'
' Arguments of XstGetOSVersion ()
'
XLONG major ' returned major version number
XLONG minor ' returned minor version number
XLONG platformId ' returned platform identification
STRING version$ ' returned string form of version number: "4.10"
STRING platform$ ' returned platform string: "Win32s", "Windows", or "NT"
XLONG hwnd ' = GetActiveWindow ()
XLONG ret ' win32 api return value (0 for fail)
XLONG errNum ' the last error code
XLONG bErr ' $$TRUE for error
' get the last error code, then clear it
errNum = GetLastError ()
SetLastError (0)
IFZ errNum THEN RETURN ' was OK!
fmtMsg$ = "Last error code " + STRING$ (errNum) + ": "
' set up FormatMessageA arguments
dwFlags = $$FORMAT_MESSAGE_FROM_SYSTEM OR $$FORMAT_MESSAGE_IGNORE_INSERTS
char_count = 1020
szBuf$ = NULL$ (char_count) ' note: NULL$() appends a nul-terminator
ret = FormatMessageA (dwFlags, 0, errNum, 0, &szBuf$, char_count, 0)
IFZ ret THEN
fmtMsg$ = fmtMsg$ + "(unknown)"
ELSE
fmtMsg$ = fmtMsg$ + CSTRING$ (&szBuf$) ' works the best with FormatMessageA()
ENDIF
IFZ msg$ THEN msg$ = "Windows API error"
fmtMsg$ = fmtMsg$ + "\r\n\r\n" + msg$
' get the running OS's name and version
bErr = XstGetOSName (@osName$)
IF bErr THEN
st$ = "(unknown)"
ELSE
IFZ osName$ THEN osName$ = "(unknown)"
st$ = osName$ + " ver "
bErr = XstGetOSVersion (@major, @minor, @platformId, @version$, @platform$)
IF bErr THEN
st$ = st$ + " (unknown)"
ELSE
st$ = st$ + STR$ (major) + "." + STRING$ (minor) + "-" + platform$
ENDIF
ENDIF
fmtMsg$ = fmtMsg$ + "\r\n\r\nOS: " + st$
title$ = PROGRAM$ (0) + ".exe-API Error"
hwnd = GetActiveWindow ()
MessageBoxA (hwnd, &fmtMsg$, &title$, $$MB_ICONSTOP)
PRINT "GuiTellApiError: "; fmtMsg$ ' output message to an active console
RETURN $$TRUE ' an error really occurred!
END FUNCTION
'
' #############################
' ##### GuiTellRunError #####
' #############################
'
' Displays a run-time error message.
' returns $$TRUE only if an error really occurred
'
' Usage:
' errNum = ERROR (0) ' reset any prior run-time error
' fileNumber = OPEN (fileName$, $$WRNEW)
' IF fileNumber < 1 THEN
' msg$ = "OPEN: Can't open file\r\n"
' msg$ = msg$ + fileName$
' GuiTellRunError (@msg$)
' ENDIF
'
FUNCTION GuiTellRunError (msg$)
XLONG bErr ' $$TRUE for error
XLONG errNum ' the last error code
errNum = ERROR (0) ' reset any prior run-time error on entry
IFZ errNum THEN
bErr = $$FALSE ' was OK!
ELSE
bErr = $$TRUE ' an error really occurred!
'
fmtMsg$ = "Error code " + STRING$ (errNum) + ", " + ERROR$ (errNum)
'
IFZ msg$ THEN msg$ = "XBLite Library Error"
fmtMsg$ = fmtMsg$ + "\r\n\r\n" + msg$
XstAlert (@fmtMsg$)
PRINT fmtMsg$ ' output message to an active console
ENDIF
RETURN bErr
END FUNCTION
'
' #########################
' ##### InitWindows #####
' #########################
'
' Initializations after CreateWindows().
' Add code to this function to perform any initialization needed
' after CreateWindows() created your program's windows.
' Note: For initialization before CreateWindows(), add code to CleanStart().
'
FUNCTION InitWindows ()
upp = UBOUND (#qui$[])
FOR i = 0 TO upp
item$ = STRING$ (i + 1) + ". " + #qui$[i]
SetLastError (0)
index = WinXListBox_AddItem (#lstFrom, -1, item$)
IF index < 0 THEN ' error
msg$ = "Can't add item with 'index = WinXListBox_AddItem (#lstFrom, -1, item$)'"
GuiTellApiError (@msg$)
ENDIF
NEXT i
IFZ #qui$[] THEN WinXHide (#btnDraw)
winMain_SetTitleBar ()
WinXHide (#btnSave)
EnableMenuItem (#mnuFile, $$mnuFileSave, $$MF_DISABLED | $$MF_GRAYED | $$MF_BYCOMMAND) ' disable menu item $$mnuFileSave
WinXShow (#winMain) ' show window #winMain
END FUNCTION
'
'
' ##############################
' ##### QuiLoadGifted () #####
' ##############################
'
' Loads names from file Gifted.txt.
'
FUNCTION QuiLoadGifted ()
WinXListBox_Clear (#lstTo)
file$ = #dataDir$ + "Lucky_Ones.txt"
bErr = XstFileExists (file$)
IF bErr THEN RETURN $$TRUE ' error
errNum = ERROR (0)
bErr = XstLoadStringArray (file$, @arr$[])
IF bErr THEN
msg$ = "QuiLoadGifted: Can't load file " + file$
GuiTellRunError (msg$)
RETURN $$TRUE ' error
ENDIF
IFZ arr$[] THEN RETURN $$TRUE
upp = UBOUND (arr$[])
FOR i = 0 TO upp
SetLastError (0)
index = WinXListBox_AddItem (#lstTo, -1, arr$[i])
IF index < 0 THEN ' fail
msg$ = "QuiLoadGifted: Can't add item " + arr$[i]
GuiTellApiError (@msg$)
ENDIF
NEXT i
END FUNCTION
'
'
' #############################
' ##### QuiLoadNames () #####
' #############################
'
' Loads names from file Giver.txt.
'
FUNCTION QuiLoadNames ()
' compute execution directory
runPath$ = XstGetProgramFileName$ ()
XstDecomposePathname (runPath$, @runDir$, "", "", "", "")
WinXDir_AppendSlash (@runDir$) ' end directory path with $$PathSlash$
#dataDir$ = runDir$
XstGetDateAndTime (@year, @month, @day, @weekDay, @hour, @minute, @second, @nanos)
#dataDir$ = #dataDir$ + STRING$ (year) + $$PathSlash$
file$ = #dataDir$ + "Participants.txt"
errNum = ERROR (0)
bErr = XstFileExists (file$)
IF bErr THEN
msg$ = "QuiLoadNames: Can't find file " + file$
GuiTellRunError (msg$)
RETURN $$TRUE ' error
ENDIF
errNum = ERROR (0)
bErr = XstLoadStringArray (file$, @arr$[])
IF bErr THEN
msg$ = "QuiLoadNames: Can't load file " + file$
GuiTellRunError (msg$)
RETURN $$TRUE ' error
ENDIF
upp = UBOUND (arr$[])
DIM #qui$[upp]
iSup = -1
FOR i = 0 TO upp
text$ = TRIM$ (arr$[i])
IF text$ THEN
INC iSup
#qui$[iSup] = text$
ENDIF
NEXT i
IF iSup < 1 THEN
msg$ = "QuiLoadNames: Not enough names loaded from file " + file$
XstAlert (msg$)
RETURN $$TRUE ' error
ENDIF
REDIM #qui$[iSup]
WinXShow (#winMain) ' show window #winMain
END FUNCTION
'
' #################################
' ##### WinXDir_AppendSlash #####
' #################################
'
' Ends a directory path with Windows' path-slash.
'
' Usage:
' dir$ = " c:/Lonne' "
' WinXDir_AppendSlash (@dir$) ' end directory path with $$PathSlash$
' --> correct result: " c:/Lonne'" ==> "c:\\Lonne'\\"
'
FUNCTION WinXDir_AppendSlash (@r_dir$)
r_dir$ = WinXPath_Trim$ (r_dir$)
IF r_dir$ THEN
IF RIGHT$ (r_dir$) <> $$PathSlash$ THEN
r_dir$ = r_dir$ + $$PathSlash$
ENDIF
ENDIF
END FUNCTION
'
' ###############################
' ##### WinXListBox_Clear #####
' ###############################
'
' Clears out the list box's contents.
' hListBox = the handle of the list box
'
' Usage:
' WinXListBox_Clear (hListBox) ' delete all items in list box
'
FUNCTION WinXListBox_Clear (hListBox)
SetLastError (0)
IF hListBox THEN
SendMessageA (hListBox, $$LB_RESETCONTENT, 0, 0)
RETURN $$TRUE ' success
ENDIF
END FUNCTION
'
' ############################
' ##### WinXPath_Trim$ #####
' ############################
'
' Trims a directory path or a file path
' and corrects the path-slashes to Windows' style.
' (dedicated TRIM$() function for file or directory paths)
'
' Note
' ====
' This function:
' 1. Removes white-spaces and all invalid characters;
' 2. Corrects to Windows path-slashes.
'
FUNCTION WinXPath_Trim$ (path$)
upp = UBOUND (path$)
SELECT CASE upp
CASE -1
r_trimmed$ = ""
'
CASE ELSE
' 1. Removes white-spaces and all invalid characters;
'
' Find the last non-space character, its index is iLastChar.
iLastChar = -1
FOR i = upp TO 0 STEP -1
SELECT CASE path${i}
CASE ' ', '\t', '\n', ':', '*', '?', '\"', '<', '>', '|' ' invalid character
CASE ELSE
' No more trailing white-spaces => Exit loop!
iLastChar = i
EXIT FOR
'
END SELECT
NEXT i
IF (iLastChar < 0) THEN
' empty path => return a null STRING
r_trimmed$ = ""
EXIT SELECT
ENDIF
'
' 2. Corrects to Windows path-slashes.
'
' Find the first non-space character, its index is iFirstChar.
FOR i = 0 TO iLastChar
SELECT CASE path${i}
CASE ' ', '\t', '\n', ':', '*', '?', '\"', '<', '>', '|' ' invalid character
CASE ELSE
' No more leading white-spaces => Exit loop!
iFirstChar = i
EXIT FOR
'
END SELECT
NEXT i
'
' Trim off leading and trailing white-spaces.
'
length = iLastChar - iFirstChar + 1
IF (length <= 0) THEN
' empty path => return a null STRING
r_trimmed$ = ""
EXIT SELECT
ENDIF
'
r_trimmed$ = MID$ (path$, iFirstChar + 1, length)
'
' Ensure only Windows path slashes.
pos = INSTR (r_trimmed$, "/") ' find the first wrong path slash
DO WHILE (pos > 0)
r_trimmed${pos - 1} = $$PathSlash ' replace it with the Windows path slash
pos = INSTR (r_trimmed$, "/", pos + 1) ' find the next wrong path slash
LOOP
'
' Replace any double Windows path slashes by a single one.
two_sl$ = $$PathSlash$ + $$PathSlash$
pos = INSTR (r_trimmed$, two_sl$)
DO WHILE (pos > 0)
' get rid of the 2nd Windows path slash
r_trimmed$ = LEFT$ (r_trimmed$, pos) + LCLIP$ (r_trimmed$, pos + 1)
'
' (Note that INSTR() restarts from the current position
' to account for: \\\... changed to \\...)
pos = INSTR (r_trimmed$, two_sl$, pos)
LOOP
'
END SELECT
RETURN r_trimmed$
END FUNCTION
FUNCTION btnDraw_Click () ' on click on push button $$btnDraw
WinXHide (#lstTo) ' hide the ListBox #lstTo
WinXListBox_Clear (#lstTo) ' clear the ListBox #lstTo
upp = UBOUND (#qui$[])
DIM #recoit[upp]
DIM taken[upp]
' scramble the first (upp - 1) elements #recoit[i]
FOR i = 0 TO upp - 1
' compute a random iNew not = i
DO
DO
iNew = XstRandomRange (0, upp)
LOOP WHILE iNew = i ' not the same person
'
bAssigned = $$FALSE
IF i THEN
' check if iNew is not already assigned
FOR z = 0 TO i - 1
IF #recoit[z] = iNew THEN
bAssigned = $$TRUE
EXIT FOR
ENDIF
NEXT z
ENDIF
LOOP WHILE bAssigned
'
#recoit[i] = iNew
taken[iNew] = $$TRUE
NEXT i
' the last element #recoit[upp] takes the last iNew not taken
FOR iNew = 0 TO upp
IFF taken[iNew] THEN
#recoit[upp] = iNew
EXIT FOR
ENDIF
NEXT iNew
FOR i = 0 TO upp
item$ = STRING$ (i + 1) + ". " + #qui$[#recoit[i]] + " (" + STRING$ (#recoit[i] + 1) + ")"
SetLastError (0)
index = WinXListBox_AddItem (#lstTo, -1, item$)
IF index < 0 THEN ' error
msg$ = "Can't add item with 'index = WinXListBox_AddItem (#lstTo, -1, item$)'"
GuiTellApiError (@msg$)
ENDIF
NEXT i
WinXShow (#lstTo) ' show the ListBox #lstTo
WinXShow (#btnSave)
EnableMenuItem (#mnuFile, $$mnuFileSave, $$MF_ENABLED | $$MF_BYCOMMAND) ' enable menu item $$mnuFileSave
winMain_SetTitleBar ()
END FUNCTION
FUNCTION btnSave_Click () ' on click on push button $$btnSave
XstGetDateAndTimeFormatted (1, 14, @today$, 0, @time$)
upp = UBOUND (#qui$[])
DIM recoit$[upp]
FOR i = 0 TO upp
item$ = STRING$ (i + 1) + ". " + #qui$[#recoit[i]] + " (" + STRING$ (#recoit[i] + 1) + ")"
text$ = "Le " + today$ + $$CRLF$ + $$CRLF$
text$ = text$ + "Greetings " + #qui$[i] + $$CRLF$ + $$CRLF$
text$ = text$ + "I've secretly drawn the names for Christmas." + $$CRLF$
text$ = text$ + "Even myself'll be surprised to find out who's giving and who's receiving..." + $$CRLF$
text$ = text$ + "Actually, I generated this text programmatically in a file that I attached" + $$CRLF$
text$ = text$ + "to my email without even opening it first." + $$CRLF$ + $$CRLF$
text$ = text$ + "So, I'm pleased to announce to you, in complete confidence, " + $$CRLF$
text$ = text$ + "that you, " + #qui$[i] + ", are giving a gift to " + #qui$[#recoit[i]] + "." + $$CRLF$ + $$CRLF$
text$ = text$ + "Good luck scooting out and finding your so perfectly chosen gift," + $$CRLF$
text$ = text$ + "which, without the shadow of a doubt, " + #qui$[#recoit[i]] + " won't soon forget." + $$CRLF$ + $$CRLF$
text$ = text$ + "Best regards," + $$CRLF$
text$ = text$ + "Guy" + $$CRLF$
'
recoit$[i] = STRING$ (i + 1) + ". " + #qui$[#recoit[i]] + " (" + STRING$ (#recoit[i] + 1) + ")"
'
file$ = #dataDir$ + #qui$[i] + ".txt"
'
' Replace all spaces by underscores.
IF INSTR (file$, " ") THEN
XstReplace (@file$, " ", "_", 0)
ENDIF
'
XstSaveString (file$, text$)
NEXT i
file$ = #dataDir$ + "Lucky_Ones.txt"
XstSaveStringArrayCRLF (file$, @recoit$[])
file$ = #dataDir$ + "Raffle.txt"
text$ = "Raffle of " + today$
XstSaveString (file$, text$)
WinXHide (#btnDraw)
'display a message box
msg$ = "Messages ready to be sent!"
msg$ = msg$ + $$CRLF$ + $$CRLF$ + "The text of the messages is saved in a text file"
msg$ = msg$ + $$CRLF$ + "that you should attach to your email to the Giver_s_Name."
msg$ = msg$ + $$CRLF$ + $$CRLF$ + "The text file is named: \"Giver_s_Name.txt\"."
msg$ = msg$ + $$CRLF$ + "(See the About Box for additional information)"
title$ = "Drafting Emails"
MessageBoxA (#winMain, &msg$, &title$, $$MB_ICONINFORMATION)
END FUNCTION
FUNCTION dlgAbout_Close (hWnd)
WinXHide (hWnd) ' hide current dialog
WinXShow (#winMain) ' show the main window
RETURN 1 ' message $$WM_CLOSE is handled
END FUNCTION
FUNCTION dlgAbout_onCommand (idCtr, notifyCode, hCtr)
handled = 0 ' not handled
SELECT CASE idCtr
CASE 0 ' identifies the window
IF notifyCode = $$WM_CLOSE THEN
dlgAbout_Close (#dlgAbout) ' closed by user
handled = 1 ' message handled
ENDIF
'
CASE $$dlgAbout_btnClose, $$IDCANCEL
IF notifyCode = $$BN_CLICKED THEN
dlgAbout_Close (#dlgAbout)
handled = 1 ' message handled
ENDIF
'
END SELECT ' CASE idCtr
RETURN handled
END FUNCTION
FUNCTION winMain_Close (hWnd)
' exit program silently
WinXHide (hWnd) ' hide current window
PostQuitMessage ($$WM_QUIT) ' end program
RETURN 0
END FUNCTION
FUNCTION winMain_SetTitleBar ()
text$ = ""
XstLoadString (#dataDir$ + "Tirage.txt", @text$)
IFZ text$ THEN
' get today's date
XstGetDateAndTimeFormatted (0, 13, @date$, 0, "") ' dateFormat = 1 : 2009-10-31
'
dd = XLONG (RIGHT$ (date$, 2))
mm = XLONG (MID$ (date$, 6, 2))
DteGetMonthName (0, mm, @month$) ' get month's name
today$ = STRING$ (dd) + " " + month$ + " " + LEFT$ (date$, 4)
'
text$ = "Secret Santa Gift Raffle - " + today$
ENDIF
WinXSetText (#winMain, text$)
END FUNCTION
FUNCTION winMain_onCommand (idCtr, notifyCode, hCtr)
handled = 0 ' not handled
SELECT CASE idCtr
CASE 0 ' identifies the window
IF notifyCode = $$WM_CLOSE THEN
winMain_Close (#winMain) ' closed by user
handled = 1 ' message handled
ENDIF
'
CASE $$mnuFileSave
btnSave_Click ()
'
CASE $$mnuFileExit
winMain_Close (#winMain)
handled = 1 ' message handled
'
CASE $$mnuHelpAbout
WinXHide (#winMain) ' hide the main window
XstCenterWindow (#dlgAbout)
WinXShow (#dlgAbout) ' show the About Box
handled = 1 ' message handled
'
CASE $$btnDraw
IF notifyCode = $$BN_CLICKED THEN
btnDraw_Click () ' tirage au sort
handled = 1 ' message handled
ENDIF
'
CASE $$btnSave
IF notifyCode = $$BN_CLICKED THEN
btnSave_Click ()
handled = 1 ' message handled
ENDIF
'
CASE $$btnExit
IF notifyCode = $$BN_CLICKED THEN
winMain_Close (#winMain)
handled = 1 ' message handled
ENDIF
'
END SELECT ' CASE idCtr
RETURN handled
END FUNCTION
END PROGRAM
' (e.g., [Santa tick] list, [Christmas] tree, [festive] animation)
' - Allow saving/loading participant list(s) with their emails in text
' file(s)
' - Send the emails from within your application
'
' ***** Notes *****
'
' WinX.dll
' ========
'
' WinX.dll is Callum Lowcay's Windowing library for XBLite;
' it makes easy Windows GUI programming through a set of wrappers
' for the ANSI Win32 APIs. WinX is perfect to experiment GUI coding
' by means of quick prototypes.
'
' Information about the XP Style
' ==============================
'
' viXen's "XP Style" is what Microsoft calls:
' Common Controls' Visual Styles.
'
' To benefit from the XP Style, the program's executable
' must invoke at run-time ComCtl32.dll version 6 or later.
'
' Because version 6 is not redistributable,
' it is available only when the executable is running
' on a version of Windows that contains it.
'
' Windows XP and later ships with both version 5 and version 6.
'
' ComCtl32.dll version 6 contains both the user controls and the common
' controls. By default, programs use the user controls defined in
' User32.dll and the common controls defined in ComCtl32.dll version 5.
'
' It was customary to call the manifest file "program.exe.manifest"
' however, when attached to an e-mail, ".exe" in the file name can cause
' the recipient's antivirus to reject the e-mail.
' To prevent this rejection, viXen names the manifest file: "program.manifest".
'
' For Vista or above, the generated program is made User Account Control-aware
' by adding a UAC section; 'asInvoker' is used by default, but 'highestAvailable'
' or 'asAdministrator' could also be used instead.
'
' Naming Conventions
' ==================
'
' No handle prefix.
' Control Ids are Mixed-Case.
' Handle names are Mixed-Case.
'
' - GDI Naming ("my OBJect_name")
' . Control Id : $$myOBJectName
' . Handle : #myOBJectName
'
' - Window
' . Main window
' handle : #winMain
' . Dialog : #dlg...
'
' - Control
' . menu bar : Control Id: $$mnuMain Handle: #mnuMain
' . sub-menu : Control Id: $$mnuSubMenu Handle: #mnuSubMenu
' . menu option : Control Id: $$mnuMenuOption Handle: #mnuMenuOption
' . group box : Control Id: $$grpGroupBox Handle: #grpGroupBox
' . push button : Control Id: $$btnPushButton Handle: #btnPushButton
' . static : Control Id: $$lblStaticControl Handle: #lblStaticControl
' . multiline editor : Control Id: $$mleMultilineEditor Handle: #mleMultilineEditor
' . list box : Control Id: $$lstListBox Handle: #lstListBox
'
'
' ***** Versions *****
'
' 1.00-GL-12dec25-Generated GUI prototype using viXen v1.99u.
' Operating System: Windows 7
' Generation switches that are on:
' - Use Callum Lowcay's WinX
' - Use Windows XP Style
' - Use Debugging Functions
' - Source Verbose Mode
' - Meticulous Clean-Up
'
'
' ##############################
' ##### Import Libraries #####
' ##############################
'
' XBLite headers
'
IMPORT "xst" ' XBLite Standard Library
IMPORT "xsx" ' XBLite Standard eXtended Library
' IMPORT "xio" ' console library
'
IMPORT "WinX" ' Callum Lowcay's Windows GUI library
'
' Win32 DLL Headers
'
IMPORT "kernel32" ' Operating System
' ---Note: import kernel32 BEFORE gdi32
IMPORT "gdi32" ' Graphic Device Interface
' ---Note: import gdi32 BEFORE shell32 and user32
IMPORT "shell32" ' interface to Operating System
IMPORT "user32" ' Windows management
'
' ---Note: import gdi32 BEFORE comctl32
IMPORT "comctl32" ' Common controls; ==> initialize w/ InitCommonControlsEx ()
' ---Note: import comctl32 BEFORE comdlg32
' IMPORT "comdlg32" ' Standard dialog boxes (opening and saving files ...)
'
'
' ********************************************
' ***** INTERNAL FUNCTION DECLARATIONS *****
' ********************************************
'
' User Interface Functions
'
DECLARE FUNCTION Entry () ' program entry point
DECLARE FUNCTION CleanStart () ' program setup
DECLARE FUNCTION CleanUp () ' program clean-up
DECLARE FUNCTION CreateWindows () ' create the windows of the program
DECLARE FUNCTION InitWindows () ' initializations after CreateWindows()
'
' Debugging Functions
'
DECLARE FUNCTION GuiTellApiError (msg$) ' display a Win32 API Error message
DECLARE FUNCTION GuiTellRunError (msg$) ' display a run-time error message
'
'
' ============================================
' ===== Callback Function Declarations =====
' ============================================
'
' Some WinX callback functions:
'
' Message $$WM_CLOSE Handler
' - windowX_Close (SLONG hWnd)
' - registered with WinXRegOnClose
'
' Note: return zero to confirm closing the window.
'
' Message $$WM_COMMAND Handler
' - windowX_onCommand (SLONG idCtr, SLONG notifyCode, SLONG hWnd)
' - registered with WinXRegOnCommand
'
' If you return 0 in this $$WM_CLOSE handler,
' WinX will emit a $$WM_DESTROY signal. Returning 1 means
' you don't want the window to be destroyed.
' This is specially useful for the main window
' for popping up dialog 'Exit Program'.
'
' Message $$WM_PAINT Handler
' - windowX_onPaint (SLONG hWnd, SLONG hDC)
' - registered with WinXRegOnPaint
'
' Messages GotFocus/Selected Handler
' - windowX_onItem (SLONG idCtr, SLONG notifyCode, SLONG virtualKey)
' - registered with WinXRegOnItem
'
'
' Main Window Callbacks
'
DECLARE FUNCTION winMain_Close (hWnd) ' handles message $$WM_CLOSE
DECLARE FUNCTION winMain_onCommand (idCtr, notifyCode, hCtr) ' handles message $$WM_COMMAND
DECLARE FUNCTION winMain_SetTitleBar ()
'
' About Dialog Callbacks
'
DECLARE FUNCTION dlgAbout_Close (hWnd) ' handles message $$WM_CLOSE
DECLARE FUNCTION dlgAbout_onCommand (idCtr, notifyCode, hCtr) ' handles message $$WM_COMMAND
DECLARE FUNCTION QuiLoadGifted ()
DECLARE FUNCTION QuiLoadNames () ' load names from file Participants.txt
DECLARE FUNCTION btnDraw_Click () ' on click on push button $$btnDraw
DECLARE FUNCTION btnSave_Click () ' on click on push button $$btnSave
DECLARE FUNCTION WinXDir_AppendSlash (@dir$) ' end directory path dir$ with $$PathSlash$
DECLARE FUNCTION WinXListBox_Clear (hListBox) ' delete all items of list box
DECLARE FUNCTION WinXPath_Trim$ (path$) ' trim/correct a file path
DECLARE FUNCTION DteGetMonthName (language, month, @month$) ' get month's name
'
'
' *****************************************
' ***** SHARED CONSTANT DEFINITIONS *****
' *****************************************
'
' Shared constants which represent the Control Ids.
' (the prefix '$$' declares implicitly a SHARED constant)
'
'
' ***** Constants used as control identificators for the main window *****
'
' control identificators for the main window
'
$$grpFrom = 101 ' group box 'Givers'
$$grpTo = 102 ' group box 'Lucky Ones'
$$lstFrom = 103 ' list box
$$lstTo = 104 ' list box
$$btnDraw = 105 ' push button 'Draw'
$$btnSave = 106 ' push button '&Save'
$$btnExit = 107 ' push button 'E&xit'
'
' menu identificators for Window #winMain
'
$$mnuMain = 8000 ' menu bar
'
$$mnuFile = 8001 ' sub-menu "&File"
$$mnuHelp = 8002 ' sub-menu "&Help"
'
$$mnuFileSave = 8003 ' menu option "&Save...\tCtrl+S"
$$mnuFileExit = 8004 ' menu option "E&xit"
'
$$mnuHelpAbout = 8009 ' menu option "&About\tCtrl+F1"
'
'
' ***** Constants used as control identificators for dialog #dlgAbout *****
'
$$dlgAbout = 300 ' dialog 'About " + PROGRAM$ (0) + "'
'
' control identificators for dialog #dlgAbout
'
$$dlgAbout_lblTitle = 301 ' static '" + PROGRAM$ (0) + ".exe\" - Secret Santa Gift Raffle'
$$dlgAbout_lblVer = 302 ' static 'Version " + VERSION$ (0) + ".'
$$dlgAbout_lblDisclaimer = 303 ' static 'Copyright (c) GPL 2025 Guy Lonne.'
$$dlgAbout_mleDesc = 304 ' multiline editor 'Application that draws gifts for participants in the \"Secret Santa\" tradition.'
$$dlgAbout_btnClose = 305 ' push button '&Close'
'
'
' ***** Shared Program Constants *****
'
' initial width and height of the main window
$$winMain_initW = 512
$$winMain_initH = 520
'
' initial width and height of dialog #dlgAbout
$$dlgAbout_initW = 720
$$dlgAbout_initH = 420
'
'
'
' ******************************************
' ***** SHARED VARIABLE DECLARATIONS *****
' ******************************************
'
' Keyword SHARED declares explicitly shared variables;
' e.g., "SHARED myGlobalXlong" declares a SHARED (global) XLONG: myGlobalXlong.
' In a FUNCTION Body, a variable prefixed by '#'
' is also a shared variable, but implicitly declared.
'
' WINDOWS GUI SHARED VARIABLES
'
SHARED hInst ' global instance handle
SHARED #winMain ' Main Window
SHARED #dlgAbout ' About Box
'
' ###################
' ##### Entry #####
' ###################
'
' Program Entry Point.
' The entry FUNCTION Entry is invoked at run-time on program start-up,
' NOT because of its name, but because it is the very first declared.
'
FUNCTION Entry ()
STATIC entry ' ensure Entry() is entered only one time
XLONG bErr ' $$TRUE for error
IF entry THEN RETURN ' enter once...
entry = $$TRUE ' ...and then no more
' XioCreateConsole ("", 50) ' create console
' The WinX() initialization call should go in the entry FUNCTION.
' This is because WinX could crash if a WinX API is called before
' the library is initialized.
IF WinX () THEN XstAbend (@"Can't initialize library WinX")
PRINT "CleanStart-DEBUG: initialize the program"
' CleanStart(), InitGui() and CreateWindows() return bErr on fail
bErr = CleanStart () ' initialize program and libraries
IF bErr THEN XstAlert (@"CleanStart: Can't initialize the program")
PRINT "CreateWindows-DEBUG: create the windows of the program"
bErr = CreateWindows () ' create the windows of the program
IF bErr THEN XstAlert (@"CreateWindows: Can't create the windows of the program")
PRINT "InitWindows-DEBUG: initializations after CreateWindows()"
InitWindows () ' initializations after CreateWindows()
'
' A Windows GUI program operates in a loop that receives and handles
' messages sent to it from the OS in reaction to user interactions and
' system events. These messages are handled by a specific "message loop":
' WinXDoEvents() for library WinX, which returns bErr
' ($$FALSE on receiving a QUIT event, $$TRUE for error).
'
PRINT "WinXDoEvents-DEBUG: the main event loop"
WinXDoEvents () ' the main event loop
CleanUp () ' program clean-up
' a$ = INLINE$ ("Press ENTER to exit >")
' XioFreeConsole () ' free console
QUIT (0)
END FUNCTION
'
' ########################
' ##### CleanStart #####
' ########################
'
' Program Setup on First Entry.
' Initialization code goes here,
' e.g., initializing global data structures,
' reading registry settings, loading files...
' returns bErr: $$TRUE for error
'
FUNCTION CleanStart ()
SHARED hInst ' global instance handle
SetLastError (0)
hInst = GetModuleHandleA (0) ' get the handle of current module
IFZ hInst THEN
msg$ = "GetModuleHandleA: Can't get the handle of current module"
bErr = GuiTellApiError (@msg$)
RETURN $$TRUE ' fail
ENDIF
' (Now is the right time to call the each library's initialization routine.)
bErr = QuiLoadNames () ' load names from file Participants.txt
RETURN bErr
END FUNCTION
'
' #####################
' ##### CleanUp #####
' #####################
'
' Program Clean-Up on Exit.
' This is where you clean up any resources that need to be deallocated.
'
FUNCTION CleanUp ()
XLONG ret ' Win32 API return value (0 for error)
' 1.Destroy the accelerator table(s)
IF #hAccel THEN DestroyAcceleratorTable (#hAccel)
#hAccel = 0
WinXCleanUp () ' optional clean-up
END FUNCTION
'
' ###########################
' ##### CreateWindows #####
' ###########################
'
' Creates the windows of the program.
' This function generates all the windows that you've created
' and makes the main window visible.
'
' An application's icon should come in two versions:
' - 16x16 pixels for the window itself; it is also used except
' for the Large View.
'
' - 32x32 pixels for the Large View of certain windows such as
' My Documents or Windows Explorer.
'
' This icon is not refered by its name, but as icon$ = "00app_icon".
'
FUNCTION CreateWindows ()
SHARED hInst ' must be valid to ensure ressource loading
ACCEL accel[] ' accelerator table
' ***************** Begin the main window setup *****************
' *********** Begin Menu setup ***********
' build the menu bar #mnuMain
menuList$ = "&File,&Help"
#mnuMain = WinXNewMenu (menuList$, $$mnuFile, $$FALSE) ' generate menu #mnuMain
IFZ #mnuMain THEN
msg$ = "WinXNewMenu: Can't generate menu #mnuMain"
GuiTellApiError (@msg$)
ENDIF
' build the sub-menu mnuFile
menuList$ = "&Save...\tCtrl+S,E&xit"
mnuFile = WinXNewMenu (menuList$, $$mnuFileSave, $$FALSE) ' generate menu mnuFile
IFZ mnuFile THEN
msg$ = "WinXNewMenu: Can't generate menu mnuFile"
GuiTellApiError (@msg$)
ENDIF
bOK = WinXMenu_Attach (#mnuFile, #mnuMain, $$mnuFile) ' attach sub-menu #mnuFile to its parent menu #mnuMain
IFF bOK THEN
msg$ = "WinXMenu_Attach: Can't attach sub-menu #mnuFile to its parent menu #mnuMain"
GuiTellApiError (@msg$)
ENDIF
' build the sub-menu mnuHelp
menuList$ = "&About\tCtrl+F1"
#mnuHelp = WinXNewMenu (menuList$, $$mnuHelpAbout, $$FALSE) ' generate menu mnuHelp
IFZ #mnuHelp THEN
msg$ = "WinXNewMenu: Can't generate menu #mnuHelp"
GuiTellApiError (@msg$)
ENDIF
bOK = WinXMenu_Attach (#mnuHelp, #mnuMain, $$mnuHelp) ' attach sub-menu #mnuHelp to its parent menu #mnuMain
IFF bOK THEN
msg$ = "WinXMenu_Attach: Can't attach sub-menu #mnuHelp to its parent menu #mnuMain"
GuiTellApiError (@msg$)
ENDIF
DIM accel[] ' reset the accelerator table
WinXAddAccelerator (@accel[], $$mnuFileSave, 'S', $$TRUE, $$FALSE, $$FALSE)
WinXAddAccelerator (@accel[], $$mnuHelpAbout, $$VK_F1, $$TRUE, $$FALSE, $$FALSE)
#hAccel = WinXAddAcceleratorTable (@accel[]) ' create accelerator table
IFZ #hAccel THEN
msg$ = "WinXAddAcceleratorTable: Can't create accelerator table"
GuiTellApiError (@msg$)
ENDIF
' *********** End Menu setup ***********
icon$ = "00app_icon"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon santa.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon santa.ico"
GuiTellApiError (@msg$)
ENDIF
' ---- creating the main window -----
titleBar$ = "Secret Santa Gift Raffle"
#winMain = WinXNewWindow (0, @titleBar$, -1, -1, $$winMain_initW, $$winMain_initH, $$XWSS_APP, 0, hIcon, #mnuMain) ' create window #winMain
IFZ #winMain THEN
msg$ = "WinXNewWindow: Can't create window #winMain"
bErr = GuiTellApiError (@msg$)
RETURN $$TRUE ' fail
ENDIF
' keep the initial width and height as minimum size
WinXSetMinSize (#winMain, $$winMain_initW, $$winMain_initH)
bOK = WinXAttachAccelerators (#winMain, #hAccel) ' attach the accelerator table to the main window
IFF bOK THEN
msg$ = "WinXAttachAccelerators: Can't attach the accelerator table to the main window"
GuiTellApiError (@msg$)
ENDIF
' register the callback functions
addrProc = &winMain_Close () ' handles message $$WM_CLOSE
WinXRegOnClose (#winMain, addrProc)
addrProc = &winMain_onCommand () ' handles message $$WM_COMMAND
WinXRegOnCommand (#winMain, addrProc)
' *********** Begin Controls setup ***********
' creating group box $$grpFrom
' style
' $$BS_GROUPBOX : Group box
' extended style
' $$WS_EX_TRANSPARENT : See-Thru Window
#grpFrom = WinXAddGroupBox (#winMain, @"Givers", $$grpFrom) ' create group box $$grpFrom
IFZ #grpFrom THEN
msg$ = "WinXAddGroupBox: Can't create group box $$grpFrom"
GuiTellApiError (@msg$)
ENDIF
' creating group box $$grpTo
' style
' $$BS_GROUPBOX : Group box
' extended style
' $$WS_EX_TRANSPARENT : See-Thru Window
#grpTo = WinXAddGroupBox (#winMain, @"Lucky Ones", $$grpTo) ' create group box $$grpTo
IFZ #grpTo THEN
msg$ = "WinXAddGroupBox: Can't create group box $$grpTo"
GuiTellApiError (@msg$)
ENDIF
' creating list box $$lstFrom
sort = $$FALSE ' unsorted list
multiSelect = $$FALSE ' mono-selection
' style
' $$WS_BORDER : Thin-line Border
#lstFrom = WinXAddListBox (#winMain, sort, multiSelect, $$lstFrom) ' create list box $$lstFrom
IFZ #lstFrom THEN
msg$ = "WinXAddListBox: Can't create list box $$lstFrom"
GuiTellApiError (@msg$)
ENDIF
' creating list box $$lstTo
sort = $$FALSE ' unsorted list
multiSelect = $$FALSE ' mono-selection
' style
' $$WS_BORDER : Thin-line Border
#lstTo = WinXAddListBox (#winMain, sort, multiSelect, $$lstTo) ' create list box $$lstTo
IFZ #lstTo THEN
msg$ = "WinXAddListBox: Can't create list box $$lstTo"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$btnDraw
icon$ = "do_right"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon do_right.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon do_right.ico"
GuiTellApiError (@msg$)
ENDIF
#btnDraw = WinXAddButton (#winMain, @"icon", hIcon, $$btnDraw) ' create push button $$btnDraw
IFZ #btnDraw THEN
msg$ = "WinXAddButton: Can't create push button $$btnDraw"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$btnSave
icon$ = "save"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon save.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon save.ico"
GuiTellApiError (@msg$)
ENDIF
#btnSave = WinXAddButton (#winMain, @"icon", hIcon, $$btnSave) ' create push button $$btnSave
IFZ #btnSave THEN
msg$ = "WinXAddButton: Can't create push button $$btnSave"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$btnExit
icon$ = "exit"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon exit.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon exit.ico"
GuiTellApiError (@msg$)
ENDIF
btnExit = WinXAddButton (#winMain, @"icon", hIcon, $$btnExit) ' create push button $$btnExit
IFZ btnExit THEN
msg$ = "WinXAddButton: Can't create push button $$btnExit"
GuiTellApiError (@msg$)
ENDIF
' *********** End Controls setup ***********
MoveWindow (#grpFrom, 8, 8, 188, 396, 1)
MoveWindow (#grpTo, 300, 8, 188, 396, 1)
MoveWindow (#lstFrom, 20, 26, 166, 368, 1)
MoveWindow (#lstTo, 308, 26, 166, 368, 1)
MoveWindow (#btnDraw, 210, 104, 76, 36, 1)
MoveWindow (#btnSave, 12, 420, 76, 36, 1)
MoveWindow (btnExit, 100, 420, 76, 36, 1)
' ***************** End the main window setup *****************
' ***************** Begin dialog #dlgAbout setup *****************
icon$ = "00app_icon"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon santa.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon santa.ico"
GuiTellApiError (@msg$)
ENDIF
' ---- creating dialog #dlgAbout -----
titleBar$ = "About " + PROGRAM$ (0)
#dlgAbout = WinXNewWindow (0, @titleBar$, -1, -1, $$dlgAbout_initW, $$dlgAbout_initH, $$XWSS_APPNORESIZE, 0, hIcon, 0) ' create dialog #dlgAbout
IFZ #dlgAbout THEN
msg$ = "WinXNewWindow: Can't create dialog #dlgAbout"
GuiTellApiError (@msg$)
ENDIF
WinXEnableDialogInterface (#dlgAbout, $$TRUE) ' enable a dialog-type interface
' register the callback functions
addrProc = &dlgAbout_Close () ' handles message $$WM_CLOSE
WinXRegOnClose (#dlgAbout, addrProc)
addrProc = &dlgAbout_onCommand () ' handles message $$WM_COMMAND
WinXRegOnCommand (#dlgAbout, addrProc)
' *********** Begin Controls setup ***********
' creating static $$dlgAbout_lblTitle
text$ = "\"" + PROGRAM$ (0) + ".exe\" - Secret Santa Gift Raffle"
dlgAbout_lblTitle = WinXAddStatic (#dlgAbout, @text$, 0, 0, $$dlgAbout_lblTitle) ' create static $$dlgAbout_lblTitle
IFZ dlgAbout_lblTitle THEN
msg$ = "WinXAddStatic: Can't create static $$dlgAbout_lblTitle"
GuiTellApiError (@msg$)
ENDIF
' creating static $$dlgAbout_lblVer
text$ = "Version " + VERSION$ (0) + "."
dlgAbout_lblVer = WinXAddStatic (#dlgAbout, @text$, 0, 0, $$dlgAbout_lblVer) ' create static $$dlgAbout_lblVer
IFZ dlgAbout_lblVer THEN
msg$ = "WinXAddStatic: Can't create static $$dlgAbout_lblVer"
GuiTellApiError (@msg$)
ENDIF
' creating static $$dlgAbout_lblDisclaimer
text$ = "Copyright (c) GPL 2025 Guy Lonne."
dlgAbout_lblDisclaimer = WinXAddStatic (#dlgAbout, @text$, 0, 0, $$dlgAbout_lblDisclaimer) ' create static $$dlgAbout_lblDisclaimer
IFZ dlgAbout_lblDisclaimer THEN
msg$ = "WinXAddStatic: Can't create static $$dlgAbout_lblDisclaimer"
GuiTellApiError (@msg$)
ENDIF
' creating multiline editor $$dlgAbout_mleDesc
text$ = "Application that draws gifts for participants in the \"Secret Santa\" tradition."
text$ = text$ + "\r\n\r\n1. Manages Participants"
text$ = text$ + "\r\n - Allow to load from a text file a list of participants"
text$ = text$ + "\r\n\r\n2. Draws Gifts Randomly"
text$ = text$ + "\r\n - Randomly assign each participant a \"Secret Santa\" recipient"
text$ = text$ + "\r\n - Ensure no one is assigned to themselves"
text$ = text$ + "\r\n - Ensure fairness and avoids duplicates"
text$ = text$ + "\r\n (e.g., no two people draw the same recipient)"
text$ = text$ + "\r\n\r\n3. Displays Results"
text$ = text$ + "\r\n - Show the results \"Who Gives to Whom\"."
text$ = text$ + "\r\n - Using the list of participant’s emails, write the text of the email."
style = $$ES_MULTILINE OR $$ES_AUTOHSCROLL OR $$ES_READONLY OR $$WS_HSCROLL OR $$WS_VSCROLL
' extended style
' $$WS_EX_CLIENTEDGE : Sunken Edged Border
#dlgAbout_mleDesc = WinXAddEdit (#dlgAbout, @text$, style, $$dlgAbout_mleDesc) ' create multiline editor $$dlgAbout_mleDesc
IFZ #dlgAbout_mleDesc THEN
msg$ = "WinXAddEdit: Can't create multiline editor $$dlgAbout_mleDesc"
GuiTellApiError (@msg$)
ENDIF
' creating push button $$dlgAbout_btnClose
icon$ = "close"
SetLastError (0)
hIcon = LoadIconA (hInst, &icon$) ' load icon close.ico
IFZ hIcon THEN
msg$ = "LoadIconA: Can't load icon close.ico"
GuiTellApiError (@msg$)
ENDIF
dlgAbout_btnClose = WinXAddButton (#dlgAbout, @"icon", hIcon, $$dlgAbout_btnClose) ' create push button $$dlgAbout_btnClose
IFZ dlgAbout_btnClose THEN
msg$ = "WinXAddButton: Can't create push button $$dlgAbout_btnClose"
GuiTellApiError (@msg$)
ENDIF
' *********** End Controls setup ***********
MoveWindow (dlgAbout_lblTitle, 12, 12, 250, 20, 1)
MoveWindow (dlgAbout_lblVer, 12, 32, 250, 20, 1)
MoveWindow (dlgAbout_lblDisclaimer, 12, 52, 250, 56, 1)
MoveWindow (#dlgAbout_mleDesc, 270, 12, 428, 364, 1)
MoveWindow (dlgAbout_btnClose, 100, 340, 76, 36, 1)
' ***************** End dialog #dlgAbout setup *****************
WinXDisplay (#winMain)
END FUNCTION ' CreateWindows
'
' #############################
' ##### DteGetMonthName #####
' #############################
'
' Gets the month's name.
'
FUNCTION DteGetMonthName (language, month, @r_month$)
bErr = $$FALSE
' language = 0: English (by default)
SELECT CASE language
CASE 0, 1, 2, 3 ' English, French, Spanish, German
CASE ELSE : language = 0
END SELECT
SELECT CASE language
CASE 0 ' English
SELECT CASE month
CASE 1 : r_month$ = "January"
CASE 2 : r_month$ = "February"
CASE 3 : r_month$ = "March"
CASE 4 : r_month$ = "April"
CASE 5 : r_month$ = "May"
CASE 6 : r_month$ = "June"
CASE 7 : r_month$ = "July"
CASE 8 : r_month$ = "August"
CASE 9 : r_month$ = "September"
CASE 10 : r_month$ = "October"
CASE 11 : r_month$ = "November"
CASE 12 : r_month$ = "December"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
CASE 1 ' French
SELECT CASE month
CASE 1 : r_month$ = "janvier"
' CASE 2 : r_month$ = "février"
CASE 2 : r_month$ = "f" + CHR$ (233) + "vrier"
CASE 3 : r_month$ = "mars"
CASE 4 : r_month$ = "avril"
CASE 5 : r_month$ = "mai"
CASE 6 : r_month$ = "juin"
CASE 7 : r_month$ = "juillet"
' CASE 8 : r_month$ = "août"
CASE 8 : r_month$ = "ao" + CHR$ (251) + "t"
CASE 9 : r_month$ = "septembre"
CASE 10 : r_month$ = "octobre"
CASE 11 : r_month$ = "novembre"
' CASE 12 : r_month$ = "décembre"
CASE 12 : r_month$ = "d" + CHR$ (233) + "cembre"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
CASE 2 ' Spanish
SELECT CASE month
CASE 1 : r_month$ = "enero"
CASE 2 : r_month$ = "febrero"
CASE 3 : r_month$ = "marzo"
CASE 4 : r_month$ = "abril"
CASE 5 : r_month$ = "mayo"
CASE 6 : r_month$ = "junio"
CASE 7 : r_month$ = "julio"
CASE 8 : r_month$ = "agosto"
CASE 9 : r_month$ = "setiembre"
CASE 10 : r_month$ = "octubre"
CASE 11 : r_month$ = "noviembre"
CASE 12 : r_month$ = "diciembre"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
CASE 3 ' German
SELECT CASE month
CASE 1 : r_month$ = "Januar"
CASE 2 : r_month$ = "Februar"
' CASE 3 : r_month$ = "März"
CASE 3 : r_month$ = "M" + CHR$ (228) + "rz"
CASE 4 : r_month$ = "April"
CASE 5 : r_month$ = "Mai"
CASE 6 : r_month$ = "Juni"
CASE 7 : r_month$ = "Juli"
CASE 8 : r_month$ = "August"
CASE 9 : r_month$ = "September"
CASE 10 : r_month$ = "Oktober"
CASE 11 : r_month$ = "November"
CASE 12 : r_month$ = "Dezember"
CASE ELSE
r_month$ = ""
bErr = $$TRUE ' fail
'
END SELECT
'
END SELECT
RETURN bErr
END FUNCTION
'
' #############################
' ##### GuiTellApiError #####
' #############################
'
' Displays a win32 api error message.
' returns bErr: $$TRUE only if an error REALLY occurred
'
' Usage:
' SetLastError (0)
' hImage = LoadImageA (0, &file$, $$IMAGE_BITMAP, 0, 0, $$LR_LOADFROMFILE)
' IFZ hImage THEN
' msg$ = "LoadImageA: Can't load Image File\r\n"
' msg$ = msg$ + file$
' bErr = GuiTellApiError (@msg$)
' IF bErr THEN RETURN $$TRUE ' fail
' ENDIF
'
FUNCTION GuiTellApiError (msg$)
XLONG char_count ' character count
XLONG dwFlags ' FormatMessageA()'s flags
'
' Arguments of XstGetOSVersion ()
'
XLONG major ' returned major version number
XLONG minor ' returned minor version number
XLONG platformId ' returned platform identification
STRING version$ ' returned string form of version number: "4.10"
STRING platform$ ' returned platform string: "Win32s", "Windows", or "NT"
XLONG hwnd ' = GetActiveWindow ()
XLONG ret ' win32 api return value (0 for fail)
XLONG errNum ' the last error code
XLONG bErr ' $$TRUE for error
' get the last error code, then clear it
errNum = GetLastError ()
SetLastError (0)
IFZ errNum THEN RETURN ' was OK!
fmtMsg$ = "Last error code " + STRING$ (errNum) + ": "
' set up FormatMessageA arguments
dwFlags = $$FORMAT_MESSAGE_FROM_SYSTEM OR $$FORMAT_MESSAGE_IGNORE_INSERTS
char_count = 1020
szBuf$ = NULL$ (char_count) ' note: NULL$() appends a nul-terminator
ret = FormatMessageA (dwFlags, 0, errNum, 0, &szBuf$, char_count, 0)
IFZ ret THEN
fmtMsg$ = fmtMsg$ + "(unknown)"
ELSE
fmtMsg$ = fmtMsg$ + CSTRING$ (&szBuf$) ' works the best with FormatMessageA()
ENDIF
IFZ msg$ THEN msg$ = "Windows API error"
fmtMsg$ = fmtMsg$ + "\r\n\r\n" + msg$
' get the running OS's name and version
bErr = XstGetOSName (@osName$)
IF bErr THEN
st$ = "(unknown)"
ELSE
IFZ osName$ THEN osName$ = "(unknown)"
st$ = osName$ + " ver "
bErr = XstGetOSVersion (@major, @minor, @platformId, @version$, @platform$)
IF bErr THEN
st$ = st$ + " (unknown)"
ELSE
st$ = st$ + STR$ (major) + "." + STRING$ (minor) + "-" + platform$
ENDIF
ENDIF
fmtMsg$ = fmtMsg$ + "\r\n\r\nOS: " + st$
title$ = PROGRAM$ (0) + ".exe-API Error"
hwnd = GetActiveWindow ()
MessageBoxA (hwnd, &fmtMsg$, &title$, $$MB_ICONSTOP)
PRINT "GuiTellApiError: "; fmtMsg$ ' output message to an active console
RETURN $$TRUE ' an error really occurred!
END FUNCTION
'
' #############################
' ##### GuiTellRunError #####
' #############################
'
' Displays a run-time error message.
' returns $$TRUE only if an error really occurred
'
' Usage:
' errNum = ERROR (0) ' reset any prior run-time error
' fileNumber = OPEN (fileName$, $$WRNEW)
' IF fileNumber < 1 THEN
' msg$ = "OPEN: Can't open file\r\n"
' msg$ = msg$ + fileName$
' GuiTellRunError (@msg$)
' ENDIF
'
FUNCTION GuiTellRunError (msg$)
XLONG bErr ' $$TRUE for error
XLONG errNum ' the last error code
errNum = ERROR (0) ' reset any prior run-time error on entry
IFZ errNum THEN
bErr = $$FALSE ' was OK!
ELSE
bErr = $$TRUE ' an error really occurred!
'
fmtMsg$ = "Error code " + STRING$ (errNum) + ", " + ERROR$ (errNum)
'
IFZ msg$ THEN msg$ = "XBLite Library Error"
fmtMsg$ = fmtMsg$ + "\r\n\r\n" + msg$
XstAlert (@fmtMsg$)
PRINT fmtMsg$ ' output message to an active console
ENDIF
RETURN bErr
END FUNCTION
'
' #########################
' ##### InitWindows #####
' #########################
'
' Initializations after CreateWindows().
' Add code to this function to perform any initialization needed
' after CreateWindows() created your program's windows.
' Note: For initialization before CreateWindows(), add code to CleanStart().
'
FUNCTION InitWindows ()
upp = UBOUND (#qui$[])
FOR i = 0 TO upp
item$ = STRING$ (i + 1) + ". " + #qui$[i]
SetLastError (0)
index = WinXListBox_AddItem (#lstFrom, -1, item$)
IF index < 0 THEN ' error
msg$ = "Can't add item with 'index = WinXListBox_AddItem (#lstFrom, -1, item$)'"
GuiTellApiError (@msg$)
ENDIF
NEXT i
IFZ #qui$[] THEN WinXHide (#btnDraw)
winMain_SetTitleBar ()
WinXHide (#btnSave)
EnableMenuItem (#mnuFile, $$mnuFileSave, $$MF_DISABLED | $$MF_GRAYED | $$MF_BYCOMMAND) ' disable menu item $$mnuFileSave
WinXShow (#winMain) ' show window #winMain
END FUNCTION
'
'
' ##############################
' ##### QuiLoadGifted () #####
' ##############################
'
' Loads names from file Gifted.txt.
'
FUNCTION QuiLoadGifted ()
WinXListBox_Clear (#lstTo)
file$ = #dataDir$ + "Lucky_Ones.txt"
bErr = XstFileExists (file$)
IF bErr THEN RETURN $$TRUE ' error
errNum = ERROR (0)
bErr = XstLoadStringArray (file$, @arr$[])
IF bErr THEN
msg$ = "QuiLoadGifted: Can't load file " + file$
GuiTellRunError (msg$)
RETURN $$TRUE ' error
ENDIF
IFZ arr$[] THEN RETURN $$TRUE
upp = UBOUND (arr$[])
FOR i = 0 TO upp
SetLastError (0)
index = WinXListBox_AddItem (#lstTo, -1, arr$[i])
IF index < 0 THEN ' fail
msg$ = "QuiLoadGifted: Can't add item " + arr$[i]
GuiTellApiError (@msg$)
ENDIF
NEXT i
END FUNCTION
'
'
' #############################
' ##### QuiLoadNames () #####
' #############################
'
' Loads names from file Giver.txt.
'
FUNCTION QuiLoadNames ()
' compute execution directory
runPath$ = XstGetProgramFileName$ ()
XstDecomposePathname (runPath$, @runDir$, "", "", "", "")
WinXDir_AppendSlash (@runDir$) ' end directory path with $$PathSlash$
#dataDir$ = runDir$
XstGetDateAndTime (@year, @month, @day, @weekDay, @hour, @minute, @second, @nanos)
#dataDir$ = #dataDir$ + STRING$ (year) + $$PathSlash$
file$ = #dataDir$ + "Participants.txt"
errNum = ERROR (0)
bErr = XstFileExists (file$)
IF bErr THEN
msg$ = "QuiLoadNames: Can't find file " + file$
GuiTellRunError (msg$)
RETURN $$TRUE ' error
ENDIF
errNum = ERROR (0)
bErr = XstLoadStringArray (file$, @arr$[])
IF bErr THEN
msg$ = "QuiLoadNames: Can't load file " + file$
GuiTellRunError (msg$)
RETURN $$TRUE ' error
ENDIF
upp = UBOUND (arr$[])
DIM #qui$[upp]
iSup = -1
FOR i = 0 TO upp
text$ = TRIM$ (arr$[i])
IF text$ THEN
INC iSup
#qui$[iSup] = text$
ENDIF
NEXT i
IF iSup < 1 THEN
msg$ = "QuiLoadNames: Not enough names loaded from file " + file$
XstAlert (msg$)
RETURN $$TRUE ' error
ENDIF
REDIM #qui$[iSup]
WinXShow (#winMain) ' show window #winMain
END FUNCTION
'
' #################################
' ##### WinXDir_AppendSlash #####
' #################################
'
' Ends a directory path with Windows' path-slash.
'
' Usage:
' dir$ = " c:/Lonne' "
' WinXDir_AppendSlash (@dir$) ' end directory path with $$PathSlash$
' --> correct result: " c:/Lonne'" ==> "c:\\Lonne'\\"
'
FUNCTION WinXDir_AppendSlash (@r_dir$)
r_dir$ = WinXPath_Trim$ (r_dir$)
IF r_dir$ THEN
IF RIGHT$ (r_dir$) <> $$PathSlash$ THEN
r_dir$ = r_dir$ + $$PathSlash$
ENDIF
ENDIF
END FUNCTION
'
' ###############################
' ##### WinXListBox_Clear #####
' ###############################
'
' Clears out the list box's contents.
' hListBox = the handle of the list box
'
' Usage:
' WinXListBox_Clear (hListBox) ' delete all items in list box
'
FUNCTION WinXListBox_Clear (hListBox)
SetLastError (0)
IF hListBox THEN
SendMessageA (hListBox, $$LB_RESETCONTENT, 0, 0)
RETURN $$TRUE ' success
ENDIF
END FUNCTION
'
' ############################
' ##### WinXPath_Trim$ #####
' ############################
'
' Trims a directory path or a file path
' and corrects the path-slashes to Windows' style.
' (dedicated TRIM$() function for file or directory paths)
'
' Note
' ====
' This function:
' 1. Removes white-spaces and all invalid characters;
' 2. Corrects to Windows path-slashes.
'
FUNCTION WinXPath_Trim$ (path$)
upp = UBOUND (path$)
SELECT CASE upp
CASE -1
r_trimmed$ = ""
'
CASE ELSE
' 1. Removes white-spaces and all invalid characters;
'
' Find the last non-space character, its index is iLastChar.
iLastChar = -1
FOR i = upp TO 0 STEP -1
SELECT CASE path${i}
CASE ' ', '\t', '\n', ':', '*', '?', '\"', '<', '>', '|' ' invalid character
CASE ELSE
' No more trailing white-spaces => Exit loop!
iLastChar = i
EXIT FOR
'
END SELECT
NEXT i
IF (iLastChar < 0) THEN
' empty path => return a null STRING
r_trimmed$ = ""
EXIT SELECT
ENDIF
'
' 2. Corrects to Windows path-slashes.
'
' Find the first non-space character, its index is iFirstChar.
FOR i = 0 TO iLastChar
SELECT CASE path${i}
CASE ' ', '\t', '\n', ':', '*', '?', '\"', '<', '>', '|' ' invalid character
CASE ELSE
' No more leading white-spaces => Exit loop!
iFirstChar = i
EXIT FOR
'
END SELECT
NEXT i
'
' Trim off leading and trailing white-spaces.
'
length = iLastChar - iFirstChar + 1
IF (length <= 0) THEN
' empty path => return a null STRING
r_trimmed$ = ""
EXIT SELECT
ENDIF
'
r_trimmed$ = MID$ (path$, iFirstChar + 1, length)
'
' Ensure only Windows path slashes.
pos = INSTR (r_trimmed$, "/") ' find the first wrong path slash
DO WHILE (pos > 0)
r_trimmed${pos - 1} = $$PathSlash ' replace it with the Windows path slash
pos = INSTR (r_trimmed$, "/", pos + 1) ' find the next wrong path slash
LOOP
'
' Replace any double Windows path slashes by a single one.
two_sl$ = $$PathSlash$ + $$PathSlash$
pos = INSTR (r_trimmed$, two_sl$)
DO WHILE (pos > 0)
' get rid of the 2nd Windows path slash
r_trimmed$ = LEFT$ (r_trimmed$, pos) + LCLIP$ (r_trimmed$, pos + 1)
'
' (Note that INSTR() restarts from the current position
' to account for: \\\... changed to \\...)
pos = INSTR (r_trimmed$, two_sl$, pos)
LOOP
'
END SELECT
RETURN r_trimmed$
END FUNCTION
FUNCTION btnDraw_Click () ' on click on push button $$btnDraw
WinXHide (#lstTo) ' hide the ListBox #lstTo
WinXListBox_Clear (#lstTo) ' clear the ListBox #lstTo
upp = UBOUND (#qui$[])
DIM #recoit[upp]
DIM taken[upp]
' scramble the first (upp - 1) elements #recoit[i]
FOR i = 0 TO upp - 1
' compute a random iNew not = i
DO
DO
iNew = XstRandomRange (0, upp)
LOOP WHILE iNew = i ' not the same person
'
bAssigned = $$FALSE
IF i THEN
' check if iNew is not already assigned
FOR z = 0 TO i - 1
IF #recoit[z] = iNew THEN
bAssigned = $$TRUE
EXIT FOR
ENDIF
NEXT z
ENDIF
LOOP WHILE bAssigned
'
#recoit[i] = iNew
taken[iNew] = $$TRUE
NEXT i
' the last element #recoit[upp] takes the last iNew not taken
FOR iNew = 0 TO upp
IFF taken[iNew] THEN
#recoit[upp] = iNew
EXIT FOR
ENDIF
NEXT iNew
FOR i = 0 TO upp
item$ = STRING$ (i + 1) + ". " + #qui$[#recoit[i]] + " (" + STRING$ (#recoit[i] + 1) + ")"
SetLastError (0)
index = WinXListBox_AddItem (#lstTo, -1, item$)
IF index < 0 THEN ' error
msg$ = "Can't add item with 'index = WinXListBox_AddItem (#lstTo, -1, item$)'"
GuiTellApiError (@msg$)
ENDIF
NEXT i
WinXShow (#lstTo) ' show the ListBox #lstTo
WinXShow (#btnSave)
EnableMenuItem (#mnuFile, $$mnuFileSave, $$MF_ENABLED | $$MF_BYCOMMAND) ' enable menu item $$mnuFileSave
winMain_SetTitleBar ()
END FUNCTION
FUNCTION btnSave_Click () ' on click on push button $$btnSave
XstGetDateAndTimeFormatted (1, 14, @today$, 0, @time$)
upp = UBOUND (#qui$[])
DIM recoit$[upp]
FOR i = 0 TO upp
item$ = STRING$ (i + 1) + ". " + #qui$[#recoit[i]] + " (" + STRING$ (#recoit[i] + 1) + ")"
text$ = "Le " + today$ + $$CRLF$ + $$CRLF$
text$ = text$ + "Greetings " + #qui$[i] + $$CRLF$ + $$CRLF$
text$ = text$ + "I've secretly drawn the names for Christmas." + $$CRLF$
text$ = text$ + "Even myself'll be surprised to find out who's giving and who's receiving..." + $$CRLF$
text$ = text$ + "Actually, I generated this text programmatically in a file that I attached" + $$CRLF$
text$ = text$ + "to my email without even opening it first." + $$CRLF$ + $$CRLF$
text$ = text$ + "So, I'm pleased to announce to you, in complete confidence, " + $$CRLF$
text$ = text$ + "that you, " + #qui$[i] + ", are giving a gift to " + #qui$[#recoit[i]] + "." + $$CRLF$ + $$CRLF$
text$ = text$ + "Good luck scooting out and finding your so perfectly chosen gift," + $$CRLF$
text$ = text$ + "which, without the shadow of a doubt, " + #qui$[#recoit[i]] + " won't soon forget." + $$CRLF$ + $$CRLF$
text$ = text$ + "Best regards," + $$CRLF$
text$ = text$ + "Guy" + $$CRLF$
'
recoit$[i] = STRING$ (i + 1) + ". " + #qui$[#recoit[i]] + " (" + STRING$ (#recoit[i] + 1) + ")"
'
file$ = #dataDir$ + #qui$[i] + ".txt"
'
' Replace all spaces by underscores.
IF INSTR (file$, " ") THEN
XstReplace (@file$, " ", "_", 0)
ENDIF
'
XstSaveString (file$, text$)
NEXT i
file$ = #dataDir$ + "Lucky_Ones.txt"
XstSaveStringArrayCRLF (file$, @recoit$[])
file$ = #dataDir$ + "Raffle.txt"
text$ = "Raffle of " + today$
XstSaveString (file$, text$)
WinXHide (#btnDraw)
'display a message box
msg$ = "Messages ready to be sent!"
msg$ = msg$ + $$CRLF$ + $$CRLF$ + "The text of the messages is saved in a text file"
msg$ = msg$ + $$CRLF$ + "that you should attach to your email to the Giver_s_Name."
msg$ = msg$ + $$CRLF$ + $$CRLF$ + "The text file is named: \"Giver_s_Name.txt\"."
msg$ = msg$ + $$CRLF$ + "(See the About Box for additional information)"
title$ = "Drafting Emails"
MessageBoxA (#winMain, &msg$, &title$, $$MB_ICONINFORMATION)
END FUNCTION
FUNCTION dlgAbout_Close (hWnd)
WinXHide (hWnd) ' hide current dialog
WinXShow (#winMain) ' show the main window
RETURN 1 ' message $$WM_CLOSE is handled
END FUNCTION
FUNCTION dlgAbout_onCommand (idCtr, notifyCode, hCtr)
handled = 0 ' not handled
SELECT CASE idCtr
CASE 0 ' identifies the window
IF notifyCode = $$WM_CLOSE THEN
dlgAbout_Close (#dlgAbout) ' closed by user
handled = 1 ' message handled
ENDIF
'
CASE $$dlgAbout_btnClose, $$IDCANCEL
IF notifyCode = $$BN_CLICKED THEN
dlgAbout_Close (#dlgAbout)
handled = 1 ' message handled
ENDIF
'
END SELECT ' CASE idCtr
RETURN handled
END FUNCTION
FUNCTION winMain_Close (hWnd)
' exit program silently
WinXHide (hWnd) ' hide current window
PostQuitMessage ($$WM_QUIT) ' end program
RETURN 0
END FUNCTION
FUNCTION winMain_SetTitleBar ()
text$ = ""
XstLoadString (#dataDir$ + "Tirage.txt", @text$)
IFZ text$ THEN
' get today's date
XstGetDateAndTimeFormatted (0, 13, @date$, 0, "") ' dateFormat = 1 : 2009-10-31
'
dd = XLONG (RIGHT$ (date$, 2))
mm = XLONG (MID$ (date$, 6, 2))
DteGetMonthName (0, mm, @month$) ' get month's name
today$ = STRING$ (dd) + " " + month$ + " " + LEFT$ (date$, 4)
'
text$ = "Secret Santa Gift Raffle - " + today$
ENDIF
WinXSetText (#winMain, text$)
END FUNCTION
FUNCTION winMain_onCommand (idCtr, notifyCode, hCtr)
handled = 0 ' not handled
SELECT CASE idCtr
CASE 0 ' identifies the window
IF notifyCode = $$WM_CLOSE THEN
winMain_Close (#winMain) ' closed by user
handled = 1 ' message handled
ENDIF
'
CASE $$mnuFileSave
btnSave_Click ()
'
CASE $$mnuFileExit
winMain_Close (#winMain)
handled = 1 ' message handled
'
CASE $$mnuHelpAbout
WinXHide (#winMain) ' hide the main window
XstCenterWindow (#dlgAbout)
WinXShow (#dlgAbout) ' show the About Box
handled = 1 ' message handled
'
CASE $$btnDraw
IF notifyCode = $$BN_CLICKED THEN
btnDraw_Click () ' tirage au sort
handled = 1 ' message handled
ENDIF
'
CASE $$btnSave
IF notifyCode = $$BN_CLICKED THEN
btnSave_Click ()
handled = 1 ' message handled
ENDIF
'
CASE $$btnExit
IF notifyCode = $$BN_CLICKED THEN
winMain_Close (#winMain)
handled = 1 ' message handled
ENDIF
'
END SELECT ' CASE idCtr
RETURN handled
END FUNCTION
END PROGRAM
Reply all
Reply to author
Forward
0 new messages