A command line interface (CLI), fixed pitch (mono-spaced) messagebox to display numeric information. Proportional fonts are not good for columns of numbers because the characters have different widths. This makes a column "wiggle". Used with TXT.WINDOW, GRAPHIC WINDOW or console the CLI would be consistant. It can be compiled in PBCC 6 or PBWin 10. It is named TxtMessagebox because it uses a TXT.WINDOW instead of a DIALOG.
The project started when a user on the PowerBASIC forum requested an output that needed right justification and fixed pitch font. Another user then requested a messagebox that to use with PBCC. The API Messagebox function can be called with PBCC code but is not designed to easily change fonts. In (at: post 20 (new tab or window) I posted a crude messagebox for PBCC. This replaces that and has improvements.
PB user Stuart McLachlan created a GUI messagebox (new tab or window) in response to the same forum thread. For users having only PBCC (or another language) he compiled it to DLL (new tab or window). It has selectable font so columns of numbers will line up. Being GUI, its IO style is not consistant with console, TXT.WINDOW or GRAPHIC WINDOW.
Download compiled TxtMessagebox.zip. Contains TxtMessageBox function compiled in both a DLL and a SLL, and an #INCLUDE file with sample DECLAREs and #LINK.
The caption string, message string and position of window called from are not optional. The Message string is not "wrapped" by TxtMessageBox function, you must embed $$CRLFs for reasonable box width and multiple lines. The function does put a blank line between last message line and first exit choice line.
If %Demo = 0 the source code may be used as a #INCLUDE "filename"
#compile sll "TxtMessagebox.sll" ' . . . function TxtMessageBox (TxtCaption as wstring, _ TMBMessage as wstring, _ byval ParentPosX as long, _ byval ParentPosY as long, _ opt Opt1Str as wstring, _ opt Opt2Str as wstring, _ opt Opt3Str as wstring) COMMON as long
#compile dll "TxtMessagebox.dll" ' . . . function TxtMessageBox ALIAS "TxtMessageBox" _ (TMBCaption as wstring, _ TMBMessage as wstring, _ byval ParentPosX as long, _ byval ParentPosY as long, _ opt Opt1Str as wstring, _ opt Opt2Str as wstring, _ opt Opt3Str as wstring) EXPORT as long
Full copyleft (ɔ), 2023 by Dale Yarker in source or compiled form. Complete license in new tab or window.
When the constant %Demo is undefined, or set to "0", the whole file may be used as a #INCLUDE. The PBMAIN function will have no effect on operation or size of the compiled code. If %Demo is set to "1" the file compiles to a console executable that tests with no optional exit key, one, two and three optional exit keys. It also uses different numbers of lines in the message boxes.
With changes discussed above the TXTMessageBox can be compiled to SLL or DLL (with %Demo undefined or "0"). Or, just copy and paste the function where you need it.
' File TxtMessagebox.bas 'Full copyleft chr$$("(",&h0254,")"), 2023 Dale Yarker. ' (lower case open "o" with not display in either PB editor) '########################### mono-spaced messagebox ############################ #compile exe #dim all %UNICODE = 1 %Demo = 0 'Non-zero to also compile for demonstration in PBCC 6. declare function SetForegroundWindow lib "User32.dll" _ alias "SetForegroundWindow" (byval hWnd as dword) as long declare function GetParent lib "User32.dll" alias "GetParent" _ (byval hWnd as dword) as dword function TMBMessageBox (TMBCaption as wstring, _ TMBMessage as wstring, _ byval ParentPosX as long, _ byval ParentPosY as long, _ opt Opt1Str as wstring, _ opt Opt2Str as wstring, _ opt Opt3Str as wstring) as long local hTWin as dword local NumOfLines, Counter, TmpLen, MaxOpt as long local A_Key, TmpStr(), Item1, Item2, Item3, MatchStr as wstring ' NumOfLines = parsecount(TMBMessage, $$crlf) dim TmpStr(1 to NumOfLines) TmpLen = len(TMBCaption) + 2 for Counter = 1 to NumOfLines TmpStr(Counter) = $$spc + parse$(TMBMessage, $$crlf, Counter) if len(TmpStr(Counter)) > TmpLen then TmpLen = len(TmpStr(Counter)) end if next if varptr(Opt1Str) = 0 then '· · · · · · · · · · · · · · No optional items · · Item1 = " Press" if len(Item1) > TmpLen then TmpLen = len(Item1) + 1 end if MaxOpt = 2 'set 1 greater than number of optionals used so ... else if varptr(Opt2Str) = 0 then '· · · · · · · · · · · · · · 1 optional item · · Item1 = " " + Opt1Str if len(Item1) > TmpLen then TmpLen = len(Item1) + 1 end if MaxOpt = 2 'that it can be added to NumOfLines in ... else ' · · · · · · · · · · · · · · · · · · · · · · · · 2 optional items · · Item1 = " Press 1 for " + Opt1Str if len(Item1) > TmpLen then TmpLen = len(Item1) + 1 end if Item2 = " Press 2 for " + Opt2Str if len(Item2) > TmpLen then TmpLen = len(Item2) + 1 end if MaxOpt = 3 'TXT.WINDOW without a "+ 1" for the height. if varptr(Opt3Str) then '· · · · · · · · · · · · · · 3 optional items · · Item3 = " Press 3 for " + Opt3Str if len(Item3) > TmpLen then TmpLen = len(Item3) + 1 end if MaxOpt = 4 end if end if end if ' 'Create the TXT.WINDOW txt.window (TMBCaption, ParentPosX + 30, ParentPosY + 80, _ NumOfLines + MaxOpt, TmpLen + 1) to hTWin SetForegroundWindow(GetParent(hTWin)) 'Thanx Borje and Dave 'Show the message in the TXT.WINDOW. for Counter = 1 to NumOfLines txt.print TmpStr(Counter) next 'Show exit choices. txt.print txt.print Item1; if MaxOpt > 2 then txt.print : txt.print Item2; end if if MaxOpt > 3 then txt.print : txt.print Item3; end if 'Process exit choice. if MaxOpt = 2 then '(replaces larger amount of code inside the DO/LOOP) MatchStr = chr$$(13) elseif MaxOpt = 3 then MatchStr = "12" elseif MaxOpt = 4 then MatchStr = "123" end if do A_Key = txt.waitkey$ if instr(A_Key, any MatchStr) then function = val(A_Key) exit do end if loop txt.end end function '======= brute force to demo the messagebox with right justified numbers ======= #if %Demo function pbmain () as long local MyNumber as ext local MyMessage, dummy as wstring local LenLbl, X as long con.print "Right justification in messagebox with default exit key." con.print "(needs mono-spaced (fixed pitch) font to ""line-up"" columns.)" con.print "Press any key to show messagebox:" con.waitkey$ MyMessage = "Formatted number entry: " LenLbl = len(MyMessage) MyNumber = 160000.65## MyMessage += rset$(format$(myNumber,"$ #,#0.00"), 18) + $$crlf MyNumber = 16000.65## MyMessage += rset$(format$(myNumber,"$ #,#0.00"), lenLbl + 18) + $$crlf MyNumber = 9876543210.21## MyMessage += rset$(format$(myNumber,"$ #,#0.00"), lenLbl + 18) ' X = TMBMessageBox("Show right justified in a messagebox.", MyMessage, _ con.loc.x, con.loc.y) con.print "Returned value is: " + dec$(X) ' con.print con.print "Single choice nondefault exit." con.print "(note auto-size.) con.print "Press any key to show messagebox:" con.waitkey$ ' MyMessage = "Five line message, line 1." + $$crlf + "Line 2." + $$crlf + _ "Line 3." + $$crlf + "Line 4." + $$crlf + "Line 5." X = TMBMessageBox( "Show one optional menu item.", MyMessage, _ con.loc.x, con.loc.y, "OK") con.print "Returned value is: " + dec$(X) ' con.print con.print "Two choices to exit, choice number returned." con.print "Press any key to show messagebox:" con.waitkey$ MyMessage = "The water is cold." + $$crlf + "Do you want to swim?" X = TMBMessageBox("Swim Decision", MyMessage, con.loc.x, con.loc.y, _ "Yes, cold or not.", "No, I'm sick.") select case as long X case 1 con.print "Get your suit. No skinny dipping here." case 2 con.print "Go home, you're contagious!" end select con.print con.print "Three exit choices after a long line." con.print "Press any key to show messagebox:" con.waitkey$ MyMessage = "A Llooonnnnggggg line, abc defg hijkl mnopqrs tuvwxyz 0123456789" X = TMBMessageBox("Set your own menu items.", MyMessage, con.loc.x, _ con.loc.y, "ABORT", "RETRY", "IGNORE") if X = 1 then con.print "Oops!" elseif X = 2 then con.print "Wheee!" else 'can only be 3, invalid responses blocked in TMBMessageBox con.print "Don't do that." end if con.print con.print "Any key to exit demo." con.waitkey$ end function #endif '
For PBWin 10 use of the SLL (Static Link Library) TxtMessagebox. The TxtMessagebox function does have any PBWin 10 or PBCC 06 specific code so the SLL maybe compiled by either and used in the other. The #LINK line will be the same for either. #COMPILE SLL and #LINK were new in PBWin 10 and PBCC 6, so the SLL is not usable in older PB versions (see DLL demonstration below).
#compile exe #dim all %UNICODE = 1 %IsPixels = 0 '<=== set to 1 if DIALOG NEW PIXELS (UNITS is default so 0 then) #link "TxtMessagebox.sll" %ID_Test_1st_TMB_Btn = 1001 %ID_Test_2nd_TMB_Btn = 1002 %ID_ExitBtn = 1000 ' callback function DlgCB() as long local MessageStr as wstring local PosX, PosY as long if (cb.msg = %wm_command) and cb.ctlmsg = %bn_clicked then select case as long cb.ctl case %ID_ExitBtn dialog end cb.hndl case %ID_Test_1st_TMB_Btn MessageStr = "This messagebox was compiled to an SLL in PBCC 6 and " + _ $$crlf + _ "works here in PBWin 10." + $$crlf + $$crlf MessageStr +="After closing this messagebox move the dialog before " + _ "pressing button for 2nd messagebox. gosub X_and_Y TxtMessageBox ("Messagebox test 1.", MessageStr, PosX, PosY) case %ID_Test_2nd_TMB_Btn MessageStr = "Should be in same place ON THE DIALOG as it was in test 1." gosub X_and_Y TxtMessageBox ("Messagebox test 2.", MessageStr, PosX, PosY) end select end if exit function X_and_Y: 'GOSUB because needed in multiple places. dialog get loc cb.hndl to PosX, PosY 'may be units or pixels if %def(%IsPixels) and (%IsPixels = 1) then 'DIALOG NEW PIXELS, do nothing return else 'DIALOG NEW or DIALOG NEW UNITS, units to pixels #if %pb_revision = &h1004 'version has known error dialog units cb.hndl, PosX, PosY to pixels PosY, PosX #else 'other versions are correct dialog units cb.hndl, PosX, PosY to pixels PosX, PosY #endif end if return end function ' function pbmain () as long local hDlg as dword dialog new 0, "Dialog to test TxtMessagebox.", 50, 50, 200, 100 to hDlg control add button, hDlg, %ID_Test_1st_TMB_Btn, "Show &1st Messagebox", _ 5, 5, 80, 12 control add button, hDlg, %ID_Test_2nd_TMB_Btn, "Show &2nd Messagebox", _ 5, 22, 80, 12 control add button, hDlg, 1000, "E&xit", 5, 54, 25, 12 dialog show modal hDlg call DlgCB end function
For PBWin 9 and PBCC 5, or older, and other languages, use the API functions LoadLibrary, GetProcAddress and FreeLibrary. PBWin 10 and PBCC 6 added IMPORT ADDR and IMPORT CLOSE for the purpose. This demo uses IMPORT, but the choice is yours for the more recent ("newer" didn't seem appropriate anymore ☹) compilers.
There is no demo for Implicite loading, i.e.:
DECLARE FUNCTION function_name LIB "library_name.dll" ALIAS "alias_name"
(parameters) AS type
Use IMPORT instead of LIB in PBWin 10 and PBCC 6 (LIB is still allowed). An
advantage of implicite is "normal" calling in source code (no CALL DWORD
USING). A disadvantage is program failure at startup without any notification of
why if there is a problem loading.
' Fle name "demoExplicitLoadTMB.bas" #compile exe #dim all %UNICODE = 1 declare function TxtMessageBox (TMBCaption as wstring, _ TMBMessage as wstring, _ byval ParentPosX as long, _ byval ParentPosY as long, _ opt Opt1Str as wstring, _ opt Opt2Str as wstring, _ opt Opt3Str as wstring) as long function pbmain () as long local hLib, pTMB as dword local X as long import addr "TxtMessagebox", "TxtMessagebox.dll" to pTMB, hLib con.color 10, 0 con.print "Any key to show messagebox." con.waitkey$ call dword pTMB using TxtMessageBox ("B Title", "Some message", 200, 100, _ "1 to return 1 on exit.", "2 to return 2 on exit.") to X con.print "TxtMessagebox returned " + dec$(X) con.color 14, 0 con.print "CALL DWORD USING isn't that difficult, is it?" con.color 7, 0 con.print con.print "Any key to exit." con.waitkey$ end function
Created on 21 May 2023, last edit 12 Jun 2023.
To
Domain Home. | To Dale's Notebook index. | To Programs index. |