This program required Win32 API calls, so it will only run on a Windows system.
Custom window in that the code generates a small borderless window text window and adds a custom menu plus drag to move and drag to resize features. It does NOT use the QB64 RESIZE commands but does make use of the mouse cursor appearance changes. Thanks a ton to the dev who provided that neat QB64 mouse feature.
The top pseudo-title bar is functional. The three horizontal lines represent a pop-open menu. Click to open. The menu options are mostly for demo only, but close and quit do work. The symbols from top left to right are "-" Minimize, [] Fullscreen, and "X" Close.
Code: (Select All)
DIM SHARED WinMse AS POINTAPI
TYPE POINTAPI
X_Pos AS LONG
Y_Pos AS LONG
END TYPE
DECLARE DYNAMIC LIBRARY "User32"
FUNCTION GetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG)
FUNCTION SetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG)
FUNCTION SetWindowPos& (BYVAL hwnd AS LONG, BYVAL hWndInsertAfter AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL wFlags AS LONG)
FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG)
FUNCTION GetAsyncKeyState% (BYVAL vkey AS LONG)
FUNCTION GetCursorPos (lpPoint AS POINTAPI)
FUNCTION SetCursorPos% (BYVAL x AS INTEGER, BYVAL y AS INTEGER)
END DECLARE
TYPE Win_Control
X_IN AS INTEGER
Y_IN AS INTEGER
oldxIN AS INTEGER
oldyIN AS INTEGER
my AS INTEGER
mx AS INTEGER
lb AS INTEGER
tbicon AS INTEGER
wintp AS INTEGER
winrt AS INTEGER
winbt AS INTEGER
winlt AS INTEGER
setxy AS INTEGER
sizeit AS INTEGER
x AS INTEGER
y AS INTEGER
fw AS INTEGER
fh AS INTEGER
w AS INTEGER
h AS INTEGER
dragx AS INTEGER
dragy AS INTEGER
S_orig AS LONG
tmp AS STRING
END TYPE
DIM WinCon AS Win_Control
DIM SHARED hWnd AS LONG
WinCon.S_orig = _NEWIMAGE(50, 25, 0) ' SCREEN 0 with _NEWIMAGE.
SCREEN WinCon.S_orig
DO: LOOP UNTIL _SCREENEXISTS
CALL borderless_window
CALL sam_titlebar
CALL borderless_variables(WinCon)
DO ' Main Loop ====================================================================================
_LIMIT 60
CALL mouse_borderless(1, WinCon)
CALL mouse_borderless(2, WinCon)
CALL titlebar_icons(WinCon)
CALL size_n_drag(WinCon, side$)
CALL mouse_borderless(3, WinCon)
IF LEN(INKEY$) THEN SYSTEM
LOOP '=============================================================================================
SUB sam_menu ' Self-contained subroutine.
y = CSRLIN: x = POS(0)
LOCATE , , 0 ' Hide cursor
DIM atmp AS STRING
noi = 6 ' Number of menu items
REDIM menu$(noi)
menu$(1) = "Open"
menu$(2) = "Settings"
menu$(3) = "Recycled"
menu$(4) = "Help"
menu$(5) = "Close"
menu$(6) = "Quit"
h = 5 ' Variable to determine margin spaces from the right of menu.
FOR i = 1 TO noi
j = LEN(menu$(i))
IF j > k THEN k = j
NEXT
mwidth = k + h
mheight = noi * 2 + 1 ' Add one for the separate border element.
MenuT = 1: MenuL = 1: MenuR = MenuL + mwidth: MenuB = MenuT + mheight
DO
_LIMIT 30
z = GetCursorPos(WinMse)
SELECT CASE menu.var
CASE -1
WHILE _MOUSEINPUT: WEND
my = _MOUSEY
mx = _MOUSEX
IF my > MenuT AND my < MenuB AND mx > MenuL AND mx < MenuR THEN
IF my \ 2 = my / 2 AND my AND my <> oldmy THEN
IF MenuHL THEN
atmp = SPACE$(mwidth - 2)
LOCATE MenuHL, MenuL + 2 - 1
COLOR 0, 7
MID$(atmp, 2, LEN(menu$((MenuHL - MenuT) \ 2 + 1))) = menu$((MenuHL - MenuT) \ 2 + 1)
PRINT atmp;
END IF
atmp = SPACE$(mwidth - 2)
LOCATE my, MenuL + 2 - 1
COLOR 7, 0
MID$(atmp, 2, LEN(menu$((my - MenuT) \ 2 + 1))) = menu$((my - MenuT) \ 2 + 1)
PRINT atmp;
COLOR 0, 7
MenuHL = my
END IF
IF _MOUSEBUTTON(1) THEN
menu.var = (my - MenuT) \ 2 + 1
EXIT DO
END IF
ELSE
' Toggle close menu.
IF GetAsyncKeyState(1) < 0 THEN
IF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + 24 AND WinMse.X_Pos >= _SCREENX + 36 AND WinMse.X_Pos <= _SCREENX + 48 THEN
menu.var = 0: EXIT DO ' Close menu.
ELSE
IF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + _FONTHEIGHT * (_HEIGHT + 1) AND WinMse.X_Pos >= _SCREENX AND WinMse.X_Pos <= _SCREENX + _FONTWIDTH * _WIDTH THEN
ELSE ' Outside of app window.
menu.var = 0: EXIT DO ' Close menu.
END IF
END IF
END IF
IF _MOUSEBUTTON(1) THEN ' Outside of menu closes menu.
menu.var = 0 ' Close.
EXIT DO
END IF
END IF
oldmy = WinCon.my
CASE 0
menu.var = -1 ' Menu open.
PCOPY 0, 1
PALETTE 7, 63 ' Bright white.
PALETTE 3, 56 ' Grey shadow.
PALETTE 0, 8 ' Dark blue highlight on hover.
COLOR 0, 7
LOCATE MenuT, MenuL
PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
FOR i = 1 TO mheight - 2
COLOR 0, 7
PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179);
COLOR 7, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1)): COLOR 1, 7
NEXT
COLOR 0, 7
PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217);: COLOR 7, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
LOCATE , MenuL + 2
FOR i = 1 TO mheight ' Bottom shadow.
PRINT CHR$(SCREEN(CSRLIN, POS(0)));
NEXT
COLOR 0, 7
LOCATE MenuT + 2, MenuL + 2
FOR i = 0 TO noi - 1
LOCATE MenuT + 1 + i * 2, 3
PRINT menu$(i + 1)
LOCATE , MenuL
IF i + 1 < noi THEN PRINT "Ã" + STRING$(mwidth - 2, CHR$(196)) + "´";
NEXT
DO: _LIMIT 10: LOOP UNTIL GetAsyncKeyState(1) = 0 ' Wait for button release to avoid continuous toggle event.
END SELECT
LOOP
PCOPY 1, 0
LOCATE y, x
_KEYCLEAR
IF menu.var = 6 THEN SYSTEM
DO: _LIMIT 10: LOOP UNTIL GetAsyncKeyState(1) = 0
PALETTE 7, 7 ' Re-establish color 7.
END SUB
SUB borderless_window
GWL_STYLE = -16
ws_border = &H800000
WS_VISIBLE = &H10000000
_TITLE "No Border"
hWnd& = _WINDOWHANDLE
DO
winstyle& = GetWindowLongA&(hWnd&, GWL_STYLE)
LOOP UNTIL winstyle&
DO
a& = SetWindowLongA&(hWnd&, GWL_STYLE, winstyle& AND WS_VISIBLE)
LOOP UNTIL a&
END SUB
SUB mouse_borderless (mouse_switch AS INTEGER, WinCon AS Win_Control)
SELECT CASE mouse_switch
CASE 1
WHILE _MOUSEINPUT: WEND
WinCon.mx = _MOUSEX
WinCon.my = _MOUSEY
z& = GetCursorPos(WinMse)
REM setcurx = WinMse.X_Pos: setcury = WinMse.Y_Pos
WinCon.X_IN = WinMse.X_Pos \ WinCon.fw
WinCon.Y_IN = WinMse.Y_Pos \ WinCon.fh
CASE 2
IF GetAsyncKeyState(1) < 0 THEN
IF WinCon.lb = 0 THEN WinCon.lb = 1
ELSE
IF WinCon.lb THEN WinCon.lb = 0: WinCon.dragx = 0: WinCon.dragy = 0
END IF
CASE 3
WinCon.oldyIN = WinCon.Y_IN: WinCon.oldxIN = WinCon.X_IN
END SELECT
END SUB
SUB titlebar_icons (WinCon AS Win_Control)
IF WinCon.lb THEN
IF WinCon.tbicon THEN
COLOR 8, 5: LOCATE WinCon.my, WinCon.tbicon - 1: PRINT WinCon.tmp;: WinCon.tbicon = 0
DO: LOOP UNTIL GetAsyncKeyState(1) = 0: WinCon.lb = 0
_DELAY .1
SELECT CASE MID$(WinCon.tmp, 2, 1)
CASE "X"
SYSTEM
CASE "þ"
IF _FULLSCREEN THEN
_FULLSCREEN OFF
_SCREENMOVE _MIDDLE
_DELAY .5
REM DO: LOOP UNTIL _SCREENEXISTS is not sufficient here. It registers the window as upper right corner. WinCon.winlt and WinCon.winrt = 0 but window appears in middle.
CALL borderless_variables(WinCon)
CALL mouse_borderless(1, WinCon) ' Renew variables
CALL mouse_borderless(3, WinCon)
ELSE
SCREEN WinCon.S_orig&
DO: LOOP UNTIL _SCREENEXISTS
_FULLSCREEN
END IF
CASE "Ä"
x& = ShowWindow&(hWnd&, 2)
DO: _LIMIT 1: LOOP UNTIL _SCREENICON = 0
CALL sam_titlebar
CASE "ð"
CALL sam_menu
CALL borderless_variables(WinCon)
CALL mouse_borderless(1, WinCon) ' Renew variables
CALL mouse_borderless(3, WinCon)
END SELECT
WinCon.tmp = ""
END IF
ELSE
IF WinCon.my = 1 THEN
IF WinCon.lb = 0 AND WinCon.dragx = 0 AND side$ = "" THEN
' ID by screen character.
IF WinCon.mx <> WinCon.tbicon THEN
SELECT CASE CHR$(SCREEN(WinCon.my, WinCon.mx))
CASE "X", "þ", "Ä"
IF WinCon.tbicon THEN COLOR 8, 5: LOCATE WinCon.my, WinCon.tbicon - 1: PRINT WinCon.tmp;
WinCon.tmp = SPACE$(3): MID$(WinCon.tmp, 2, 1) = CHR$(SCREEN(WinCon.my, WinCon.mx))
IF MID$(WinCon.tmp, 2, 1) = "X" THEN: COLOR 15, 12 ELSE COLOR 15, 7
WinCon.tbicon = WinCon.mx: LOCATE WinCon.my, WinCon.mx - 1: PRINT WinCon.tmp;
CASE "ð", "M", "e", "n", "u" ' Menu.
IF WinCon.tbicon THEN COLOR 8, 5: LOCATE WinCon.my, WinCon.tbicon - 1: PRINT WinCon.tmp;
' Exception.
WinCon.tmp = SPACE$(3): MID$(WinCon.tmp, 2, 1) = "ð"
WinCon.tbicon = 2: COLOR 15, 7: LOCATE WinCon.my, 1: PRINT WinCon.tmp;
CASE ELSE
IF WinCon.tbicon THEN COLOR 8, 5: LOCATE WinCon.my, WinCon.tbicon - 1: PRINT WinCon.tmp;
WinCon.tbicon = 0
END SELECT
END IF
END IF
ELSE
IF WinCon.tbicon THEN CALL sam_titlebar: WinCon.tbicon = 0
END IF
END IF
END SUB
SUB size_n_drag (WinCon AS Win_Control, side$)
IF WinCon.lb THEN
IF LEN(side$) THEN
DO
_LIMIT 45
z& = GetCursorPos(WinMse)
WinCon.X_IN = WinMse.X_Pos \ WinCon.fw
WinCon.Y_IN = WinMse.Y_Pos \ WinCon.fh
IF WinCon.oldxIN <> WinCon.X_IN OR WinCon.oldyIN <> WinCon.Y_IN THEN
REM setcurx = WinMse.X_Pos: setcury = WinMse.Y_Pos
SELECT CASE side$
CASE "left-top"
WinCon.sizeit = -SGN(WinCon.oldyIN - WinCon.Y_IN) * ABS(WinCon.wintp - WinCon.Y_IN)
IF WinCon.sizeit THEN GOSUB topsize
WinCon.sizeit = SGN(WinCon.oldxIN - WinCon.X_IN) * ABS(WinCon.winlt - WinCon.X_IN)
IF WinCon.sizeit THEN GOSUB leftsize
CASE "right-top"
WinCon.sizeit = -SGN(WinCon.oldyIN - WinCon.Y_IN) * ABS(WinCon.wintp - WinCon.Y_IN)
IF WinCon.sizeit THEN GOSUB topsize
WinCon.sizeit = -SGN(WinCon.oldxIN - WinCon.X_IN) * ABS(WinCon.winrt - WinCon.X_IN)
IF WinCon.sizeit THEN GOSUB rightsize
CASE "left-bottom"
WinCon.sizeit = SGN(WinCon.oldxIN - WinCon.X_IN) * ABS(WinCon.winlt - WinCon.X_IN)
IF WinCon.sizeit THEN GOSUB leftsize
WinCon.sizeit = SGN(WinCon.oldyIN - WinCon.Y_IN) * ABS(WinCon.winbt - WinCon.Y_IN)
IF WinCon.sizeit THEN GOSUB bottomsize
CASE "right-bottom"
WinCon.sizeit = -SGN(WinCon.oldxIN - WinCon.X_IN) * ABS(WinCon.winrt - WinCon.X_IN)
IF WinCon.sizeit THEN GOSUB rightsize
WinCon.sizeit = SGN(WinCon.oldyIN - WinCon.Y_IN) * ABS(WinCon.winbt - WinCon.Y_IN)
IF WinCon.sizeit THEN GOSUB bottomsize
CASE "top" ' up/down
WinCon.sizeit = -SGN(WinCon.oldyIN - WinCon.Y_IN) * ABS(WinCon.wintp - WinCon.Y_IN)
IF WinCon.sizeit THEN GOSUB topsize
CASE "bottom"
WinCon.sizeit = SGN(WinCon.oldyIN - WinCon.Y_IN) * ABS(WinCon.winbt - WinCon.Y_IN)
IF WinCon.sizeit THEN GOSUB bottomsize
CASE "left"
WinCon.sizeit = SGN(WinCon.oldxIN - WinCon.X_IN) * ABS(WinCon.winlt - WinCon.X_IN)
IF WinCon.sizeit THEN GOSUB leftsize
CASE "right"
WinCon.sizeit = -SGN(WinCon.oldxIN - WinCon.X_IN) * ABS(WinCon.winrt - WinCon.X_IN)
IF WinCon.sizeit THEN GOSUB rightsize
END SELECT
WinCon.wintp = WinCon.y \ WinCon.fh: WinCon.winbt = WinCon.y \ WinCon.fh + _HEIGHT: WinCon.winlt = WinCon.x \ WinCon.fw: WinCon.winrt = WinCon.x \ WinCon.fw + _WIDTH
END IF
WinCon.oldyIN = WinCon.Y_IN: WinCon.oldxIN = WinCon.X_IN
LOOP UNTIL GetAsyncKeyState(1) = 0
ELSE
IF WinCon.dragx THEN
DO
_SCREENMOVE WinMse.X_Pos - WinCon.dragx, WinMse.Y_Pos - WinCon.dragy
z& = GetCursorPos(WinMse)
WinCon.setxy = SetCursorPos(WinMse.X_Pos, WinMse.Y_Pos)
LOOP UNTIL GetAsyncKeyState(1) = 0
WinCon.x = _SCREENX: WinCon.y = _SCREENY
WinCon.wintp = _SCREENY \ WinCon.fh: WinCon.winbt = _SCREENY \ WinCon.fh + _HEIGHT: WinCon.winlt = _SCREENX \ WinCon.fw: WinCon.winrt = _SCREENX \ WinCon.fw + _WIDTH
EXIT SUB
ELSEIF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + WinCon.fh AND side$ = "" AND WinCon.lb THEN
WinCon.x = _SCREENX: WinCon.y = _SCREENY
WinCon.dragx = WinMse.X_Pos - WinCon.x
WinCon.dragy = WinMse.Y_Pos - WinCon.y
EXIT SUB
END IF
END IF
ELSE
IF WinCon.X_IN = WinCon.winlt AND WinCon.Y_IN = WinCon.wintp THEN
_MOUSESHOW "TOPLEFT_BOTTOMRIGHT": side$ = "left-top"
ELSEIF WinCon.X_IN = WinCon.winlt AND WinCon.Y_IN = WinCon.winbt THEN _MOUSESHOW "TOPRIGHT_BOTTOMLEFT": side$ = "left-bottom"
ELSEIF WinCon.X_IN = WinCon.winrt AND WinCon.Y_IN = WinCon.wintp THEN _MOUSESHOW "TOPRIGHT_BOTTOMLEFT": side$ = "right-top"
ELSEIF WinCon.X_IN = WinCon.winrt AND WinCon.Y_IN = WinCon.winbt THEN _MOUSESHOW "TOPleft_BOTTOMRIGHT": side$ = "right-bottom"
ELSEIF WinCon.X_IN = WinCon.winlt THEN _MOUSESHOW "HORIZONTAL": side$ = "left"
ELSEIF WinCon.X_IN = WinCon.winrt THEN _MOUSESHOW "HORIZONTAL": side$ = "right"
ELSEIF WinMse.Y_Pos = _SCREENY THEN _MOUSESHOW "VERTICAL": side$ = "top"
ELSEIF WinCon.Y_IN = WinCon.winbt THEN _MOUSESHOW "VERTICAL": side$ = "bottom"
ELSE
IF LEN(side$) THEN side$ = "": _MOUSESHOW "default"
END IF
END IF
EXIT SUB
topsize:
IF LEN(side_suspend$) THEN IF WinCon.wintp < WinCon.Y_IN THEN RETURN
IF WinCon.h - WinCon.sizeit < 15 THEN side_suspend$ = side$: RETURN
side_suspend$ = ""
WinCon.h = WinCon.h - WinCon.sizeit
WinCon.x = _SCREENX
WinCon.y = _SCREENY + WinCon.sizeit * WinCon.fh
S& = _NEWIMAGE(WinCon.w, WinCon.h, 0)
SCREEN S&
CALL sam_titlebar
_SCREENMOVE WinCon.x, WinCon.y
REM z% = SetCursorPos%(setcurx, setcury)
RETURN
leftsize:
IF LEN(side_suspend$) THEN IF WinCon.winlt < WinCon.X_IN THEN RETURN
IF WinCon.w + WinCon.sizeit < 15 THEN side_suspend$ = side$: RETURN
side_suspend$ = ""
WinCon.w = WinCon.w + WinCon.sizeit
WinCon.x = _SCREENX - WinCon.sizeit * WinCon.fw
WinCon.y = _SCREENY
S& = _NEWIMAGE(WinCon.w, WinCon.h, 0)
SCREEN S&
CALL sam_titlebar
_SCREENMOVE WinCon.x, WinCon.y
REM z% = SetCursorPos%(WinCon.x, setcury)
RETURN
rightsize:
IF LEN(side_suspend$) THEN IF WinCon.winrt > WinCon.X_IN THEN RETURN
IF WinCon.w + WinCon.sizeit < 15 THEN side_suspend$ = side$: RETURN
side_suspend$ = ""
WinCon.w = WinCon.w + WinCon.sizeit
WinCon.x = _SCREENX - WinCon.sizeit * WinCon.fw
WinCon.y = _SCREENY
S& = _NEWIMAGE(WinCon.w, WinCon.h, 0)
SCREEN S&
CALL sam_titlebar
WinCon.x = _SCREENX: WinCon.y = _SCREENY
REM z% = SetCursorPos%(WinCon.x + _WIDTH * WinCon.fw, setcury)
RETURN
bottomsize:
IF LEN(side_suspend$) THEN IF WinCon.winbt > WinCon.Y_IN THEN RETURN
IF WinCon.h - WinCon.sizeit < 15 THEN side_suspend$ = side$: RETURN
side_suspend$ = ""
WinCon.h = WinCon.h - WinCon.sizeit
S& = _NEWIMAGE(WinCon.w, WinCon.h, 0)
SCREEN S&
CALL sam_titlebar
WinCon.x = _SCREENX: WinCon.y = _SCREENY
REM z% = SetCursorPos%(setcurx, WinCon. + _HEIGHT * WinCon.fh)
RETURN
END SUB
Installed in this package is Qb64shell.bas which is the source..
The file contents are as follows:
Code: (Select All)
Information file for:
QB64SHELL - command line prompt shell windows program for QB64
Purpose:
Provides a low level DOS-like command shell program similar to the one
used by Windows CMD.EXE prompt. Tries to improve on most DOS functions,
such as: DIR, COPY, DELETE, MKDIR, etc. Also supports standard I/O
between commands and a full screen editor.
Installation:
Copy the QB64shell archive to C:\QB64 and extract contents there.
Load/Start or make .EXE then enter the shell at the command line.
Since QB64shell starts with user profiles activated, enter SYSOP
and PASSWORD to logon.
Files used:
QB64shell attempts to create the folder QB64shell in the \program files
group. The files in the folder are:
filemenu.cfg - config data for the file menu box
profiles.dat - user profiles data file
qb64shell.cfg - current state of QB64shell after exit
filename.cfg is written the first time QB64shell starts.
profiles.dat is written with SYSOP the first time QB64shell starts.
qb64shell.cfg is written every time the QB64shell exits and contains
such variables as the windows coordinates, statusbar setting, etc.
Any of these files may be safely deleted.
Compiling QB64shell:
The following files are required to make the QB64shell.exe program:
QB64shell.bas -- main QB64shell code
QB64shell.inc -- the QB64shell include file
QB64shell.ico -- the QB64shell icon file
QB64shell.new -- new version list file
QB64shell.txt -- readme file
Mem.h -- memory and cpu usage include file
THX_Sound_Effect.mp3 - intro sound
(only plays the first time QB64shell starts)
Author notes:
Program is published 11/30/2022 and is public domain BASIC source code.
Written and maintained by Erik Jon Oredson who can be reached at:
eoredson@gmail.com
-end-
The QBshell commands are:
Code: (Select All)
QB64shell commands:
Basic commands:
CLS CPU KEY MEM VER TOGGLE
CLOCK DATE TIME MENU HELP EDIT
DEBUG COLOR PROMPT STATUS SYSTEM QUIT
ASCII HEXCHART HEXCALC REDRAW WHATIS COUNT
MONITOR PROFILES SCREENSAVER
QB64shell - command line prompt shell windows program for QB64
First release:
Version v.0001 Release r.001
Build 11-21-2017.01
New release:
Build 11-24-2017.01
Edits TREE to reflect TREEDIR
New release:
Build 11-29-2017.01
Copyit v9.0a r4.0a updates:
Adds quit option to disk full error.
Now copies ambiguated unicode filenames.
Fixes switches in moreprompt.
New release:
Build 12-02-2017.01
Copyit v9.0a r5.0a updates:
Now preserves unicode filenames.
Now also preserves unicode directories.
Adds break option to break trap.
New release:
Build 12-05-2017.01
Adds Unicode to rename.
New release:
Build 12-15-2017.01
Fixes recursive loop in Stree.
Adds more Unicode to recursive searches.
Repairs Stdout in Getattr.
New release:
Build 12-16-2017.01
Fixes missing toolbar.
Adds features to ScrnEdit:
Adds Control-Break during fileload,
Adds percent file loaded in title.
Forces alternate filename in redirection.
New release:
Build 12-30-2017.01
Adds switches to detect compressed/encrypted files.
New release:
Build 01-01-2018.01
Modifies attribute to _unsigned long.
New release:
Build 04-20-2022.01
Fixes syntax errors in GetDateTime and FormatX$
New release:
Build 12-10-2022.01
Adds dialog box to file menu.
Removes file menu box.
New release:
Build 12-17-2022.01
Edits SendMessage for screensaver.
Removes LocateF, PrintF, ColorF, ColorF2.
Adds (C)ount to Sub Menu.
Fixes problem with displaytoolbar in dropdown file menu.
New release:
Build 12-20-2022.01
Write critical error to error log file.
Adds some userprofile reserved values.
Add help copy stats.
Fixes recursive clock$ function.
New release:
Build 12-24-2022.01
Removes 150 lines of unused code.
Edits prompt $W[<exp$>] parsing.
New release:
Build 02-20-2023.01
Adds parameter to GetOpenFileName$
Adds keypad-5 trap.
New release: (qbshell8.zip)
Build 03-20-2023.01
Adds Serial and Fattype displays to volume commands.
Fixes setting/displaying volume in Sub Label.
Adds /A, /B, /1:d to Sub Label.
Wrote documentation files:
QB64shell.doc and QB64shell.cmd
New release: (qbshell9.zip)
Build 03-28-2023.01
Modifies titlebar icon.
-end-
Code: (Select All)
(QbshellA.zip);
New release:
Build 04-28-2023.01
Fixes Inkeyx$ function.
Updates ReadConfig and WriteConfig removing GetConfigFilename$
Replaces CreateFile and CreateFileA library function calls with
custom Sub CreateFileA function.
Removes call to GrabURL.
Moves _Limit calls to Function Inkeyx$
Adds Inkeyz$ and Keypad-5 centering to all boxes.
New release:
Build 05-04-2023.01
Removes _DirExists when directory semantics flag could be used
with Sub CreateFileA instead.
Removes all f$=keyboardline$ and g$=keyboardline$ when using
dialog box instead.
Adds more keyboard scancodes to Sub HexCalc.
New release:
Build 05-05-2023.01
Adds chdir to Sub NewDir to store in DriveTable.
Fixes SwitchDrive with C: declared without path.
New release:
Build 05-15-2023.01
Edits critical error trap.
Adds "debug errorlog" to display error log file.
Fixes blank line when <down> is at end of history array.
New release:
Build 05-20-2023.01
Fixes history array when up/down selected.
New release: (qbshellb)
Build 05-23-2023.01
Adds up/down scancodes to some message boxes.
New release: (qbshellc)
Build 05-26-2023.01
Adds WhatisBox to enter equations.
Adds CheckAlarms timer trap and AlarmMenu.
Adds KeyboardLine$ function support for AlarmMenu.
New release: (qbshelld)
Build 06-03-2023.01
Adds Table command to list drivetable/netpathtable.
Adds search string option to Table command.
(may contain ? and * characters).
Adjusts NetPathHistory in KeyboardLine$
New release: (qbshelle)
Build 06-20-2023.01
Fixes problem when started from netpath/cdrom.
Adds filename entry to GrabURL in debug.
Fixes problem when started from netpath.
New release: (qbshellf)
Build 07-01-2023.01
Fixes retracting multidots in CD/RD/MD.
Fixes possible cascade in error.routine trap.
New release: (qbshellg)
Build 07-07-2023.01
Remove Cls from GetOpenFilename$
Adds percent display in VerifyFiles2.
Adds /F"file" and /G"file" to compfile.
Adds /F"path" and /G"path" to compdir.
Fixes some display in compdir.
New release: (qbshellh)
Build 07-15-2023.01
Adds more titlebar display in Compfile and Conpdir.
Adds MouseWheel and WheelReverse to all 16 boxes.
Adds <test> <function> to DebugFunc:
Adds $X and $Z and $A[<n>] to DisplayPrompt.
Adds "debug mouse" to test mouse functions.
Adds ViewFile function to simple array.
Fixes attribute assignment in ListFiles.
New release: (qbshellh)
Build 07-20-2023.01
Converts sound effect file to 8-bit stored as 88KB.
Compresses qbshellh.zip from 880K to 330K.
Fixes Strip.Blanks in More function.
New release: (qbshelli)
Build 08-03-2023.01
Fixes display in Sub FindY during streaming.
Fixes [Removable] drive in Sub ListDrives.
Adds MediaExists in Sub FreeSpace and Sub TotalSpace.
Improves drive display in Volume in Sub Menu.
Now allws multiple filenames in ListFile.
A simple gui example to demonstrate a scheme for button handling and menu selection.
This makes use of a couple of the new dialog controls in version 3.4
Menu selections return input from the selection, there's a little but of button manipulation shown, you cna quit from a menu or the big red quit button. Menu2 uses the new dialog controls, the hello menu selection wlil have a different message if the user has enters a username.
This is fairly barebones and hopefully straightforward enough someone may find this useful.
Code: (Select All)
'a relatively simple gui example by James D. Jarvis
'QB64 PE 3.4 or later needed to compile
'text screen mode 0 program that uses the mouse button to track gui input
'the scheme in this program allows for up to 255 buttons to be used in a program
'
'a mouse is used to click on button and menu selections that are shown in a text screen
'the position of buttons that are active is recorded in a button image
'$dynamic
Dim Shared ts&
Dim Shared bt&
Dim Shared forek, backk
ts& = _NewImage(80, 25, 0) 'the main text screen for the program
Screen ts&
bt& = _NewImage(_Width + 1, _Height + 1, 256) 'the button tracking image needed for the gui
Type button_type
txt As String 'the button label
style As String 'what type of button to use : TEXTONLY,BTEXT,MENU,LBAR,CBAR,BBOX1,BBOX2
bxx As Integer 'button x coordinate
byy As Integer 'button y coordinate
bwid As Integer 'button width in pixels. button height is determined by style and text size
tklr As Integer 'text color
bklr As Integer 'background color
fklr As Integer 'foreground color
state As String 'is button on or off
container As String 'doesn't do anything in the demo but I like to plan ahead
End Type
Dim Shared btn(0) As button_type
Dim tempb As button_type
Dim Shared button_count
button_count = 0
Print "Building GUI";
forek = 15: backk = 0
menu_on = 0
'creating buttosn for the demo code
tempb.bxx = 3: tempb.byy = 3: tempb.bwid = 8: tempb.style = "TEXTONLY"
tempb.txt = "Button 1": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 3: tempb.byy = 5: tempb.bwid = 8: tempb.style = "BTEXT"
tempb.txt = "Button 2": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 3: tempb.byy = 7: tempb.bwid = 12: tempb.style = "BBOX2"
tempb.txt = "Button 3": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 3: tempb.byy = 15: tempb.bwid = 52: tempb.style = "BBOX1"
tempb.txt = "QUIT": tempb.tklr = 0: tempb.bklr = 12: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
'creating the menus for the demo code.
'note: menu selections are just buttons that are only active when the menu is selected
tempb.bxx = 1: tempb.byy = 1: tempb.bwid = 8: tempb.style = "MENU"
tempb.txt = "MENU": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 2: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Select1": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 3: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Select2": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 4: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "--------": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 5: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "QUIT": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
Cls
draw_allbuttons 'have to draw them if you want the user to see them
Locate 3, 16: Print "Will Show Button 3 if it is hiding"
Locate 5, 16: Print "Changes Text Color of this button"
Locate 8, 16: Print "Will hide itself"
Do ' main program loop
_Limit 1000
bkk = 0
Do While _MouseInput
pbx = _MouseX
pby = _MouseY
If _MouseButton(1) Then
_Source bt& 'checking the button tracking image
bkk = Point(pbx, pby) 'get the button clicked if there is one at those coordinates
_Source ts&
'uncomment following lines if you wish to see the demo echoing the button click
' If bkk > 0 Then
' Locate 1, 1: Print "Clicked "; bkk
' Else
' Locate 1, 1: Print " "
' End If
End If
Loop
Select Case bkk 'a handler for each button
Case 1
Beep
flash_button 1
If btn(3).state = "HIDE" Then show_button 3
draw_button 1
Case 2
flash_button 2
btn(2).tklr = Int(Rnd * 32)
draw_button 2
Case 3
flash_button 3
hide_button 3
Case 4
flash_button 4
draw_button 4
Exit Do
Case 5 'menu1
menu1 mchoice$
Locate 12, 16
If mchoice$ <> "" Then Print "Selected "; mchoice$
If mchoice$ = "QUIT" Then Exit Do
Case 6 'this is a menu selection and tracked in the sub menu1
Case 7 'this is a menu selection and tracked in the sub menu1
Case 8 'this is a menu selection and tracked in the sub menu1
Case 9 'this is a menu selection and tracked in the sub menu1
Case 10 'menu2
mchoice$ = ""
menu2 mchoice$
If mchoice$ = "hello" Then
If username$ = "" Then
_MessageBox "Hello", "Hello stranger.", "info"
Else
un$ = "HELLO THERE " + username$ + "!"
_MessageBox "HELLO", un$, "info"
End If
End If
If mchoice$ = "name?" Then
username$ = _InputBox$("Name?", "Enter your name:", "anonymous")
End If
Case 11 'this is a menu selection and tracked in the sub menu2
Case 12 'this is a menu selection and tracked in the sub menu2
End Select
Loop Until InKey$ = Chr$(27)
_FreeImage bt&
System
'=========================================================================
' button routines for gui
'=========================================================================
Sub menu1 (mchoice$)
'menu handling has to be hardcoded as is, this needs to change.
show_button 6
show_button 7
show_button 8
show_button 9
menu_on = 1
mchoice$ = ""
Do 'menu takes over mouse handling only recognizing clicks in the menu or pressing the escape key
_Limit 60
Do While _MouseInput
pbx = _MouseX
pby = _MouseY
If _MouseButton(1) Then
_Source bt& 'checking the button tracking image
bkk = Point(pbx, pby) 'get the button clicked if there is one at those coordinates
_Source ts&
End If
Loop
Select Case bkk 'a handler for each button
Case 6
flash_button 6
mchoice$ = "m1a"
menu_on = 0
Case 7
flash_button 7
mchoice$ = "m1b"
menu_on = 0
'case 8
'there is no entry for button 8. it's just a line separator
Case 9
flash_button 9
mchoice$ = "QUIT"
menu_on = 0
End Select
mk$ = InKey$
Loop Until menu_on = 0 Or mk$ = Chr$(27)
'hide all the menu entries
hide_button 6
hide_button 7
hide_button 8
hide_button 9
'draw all the buttons now that the menu entries are hidden
draw_allbuttons
End Sub
Sub menu2 (mchoice$)
'menu handling has to be hardcoded as is
show_button 11
show_button 12
menu_on = 1
mchoice$ = ""
Do 'menu takes over mouse handling only recognizing clicks in the menu or pressing the escape key
_Limit 60
Do While _MouseInput
pbx = _MouseX
pby = _MouseY
If _MouseButton(1) Then
_Source bt& 'checking the button tracking image
bkk = Point(pbx, pby) 'get the button clicked if there is one at those coordinates
_Source ts&
End If
Loop
Select Case bkk 'a handler for each button
Case 11
flash_button 11
mchoice$ = "hello"
menu_on = 0
Case 12
flash_button 7
mchoice$ = "name?"
menu_on = 0
End Select
mk$ = InKey$
Loop Until menu_on = 0 Or mk$ = Chr$(27)
'hide the menu entries
hide_button 11
hide_button 12
'draw all the buttons now that the menu entries are hidden
draw_allbuttons
End Sub
Sub addbutton (newbtn As button_type)
If button_count < 255 Then
button_count = button_count + 1
ReDim _Preserve btn(button_count) As button_type
Swap btn(button_count), newbtn
Select Case btn(button_count).style
Case "TEXTONLY", "BTEXT"
'correct bwid to be equal to text length for these styles
btn(button_count).bwid = Len(btn(button_count).txt)
End Select
End If
End Sub
Sub draw_button (bnum)
'draw alll the buttons on the mainscreen and on the button tracking image
If bnum < 1 Or bnum > button_count GoTo enddrawb
ds& = _Dest
If btn(bnum).state = "ON" Then
_Dest bt&
Select Case btn(bnum).style
Case "TEXTONLY"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
_Dest ds&
Color btn(bnum).tklr, backk
_PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
Color forek
Case "BTEXT", "MENU"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
_Dest ds&
Color btn(bnum).tklr, btn(bnum).bklr
_PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
Color forek, backk
Case "LBAR"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
_Dest ds&
Color btn(bnum).tklr, btn(bnum).bklr
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
Color forek, backk
Case "CBAR"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
_Dest ds&
Color btn(bnum).tklr, btn(bnum).bklr
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
_PrintString (tpx, btn(bnum).byy), btn(bnum).txt
Color forek, backk
Case "BBOX1"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), bnum, BF
_Dest ds&
Color btn(bnum).fklr, btn(bnum).bklr
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(196))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(196))
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(218))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(179))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(192))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(191))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(179))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(217))
Color btn(bnum).tklr, btn(bnum).bklr
tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
_PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
Color forek, backk
Case "BBOX2"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), bnum, BF
_Dest ds&
Color btn(bnum).fklr, btn(bnum).bklr
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(205))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(205))
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(201))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(186))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(200))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(187))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(186))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(188))
Color btn(bnum).tklr, btn(bnum).bklr
tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
_PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
Color forek, backk
End Select
End If
enddrawb:
End Sub
Sub hide_button (bnum)
'blacks out a button on the mainscreen and the button tracking image
If bnum < 1 Or bnum > button_count Then GoTo endhide
ds& = _Dest
If btn(bnum).state = "ON" Then
btn(bnum).state = "HIDE"
_Dest bt&
Select Case btn(bnum).style
Case "TEXTONLY"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
_Dest ds&
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(Len(btn(bnum).txt), " ")
Case "BTEXT", "MENU"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
_Dest ds&
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(Len(btn(bnum).txt), " ")
Color forek, backk
Case "LBAR"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
_Dest ds&
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
Case "CBAR"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
_Dest ds&
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
Case "BBOX1", "BBOX2"
Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), 0, BF
_Dest ds&
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, " ")
End Select
End If
endhide:
End Sub
Sub show_button (bnum)
'chnage a buttons state and draw it on the main screen and button tracking image
If bnum > 0 And bnum <= button_count Then
btn(bnum).state = "ON"
draw_button bnum
End If
End Sub
Sub draw_allbuttons
'draw all the buttons
For b = 1 To button_count
draw_button b
Next b
End Sub
Sub flash_button (bnum)
'have the button flash to show it has been selected
If bnum < 1 Or bnum > button_count GoTo endflashb
If btn(bnum).state = "ON" Then
Select Case btn(bnum).style
Case "TEXTONLY"
Color backk, btn(bnum).tklr \ 2
_PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
_Delay 0.3
Color forek
Case "BTEXT", "MENU"
Color backk, btn(bnum).tklr \ 2
_PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
_Delay 0.3
Color forek, backk
Case "LBAR"
Color backk, btn(bnum).tklr, btn(bnum).bklr
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
_Delay 0.3
Color forek, backk
Case "CBAR"
Color backk, btn(bnum).tklr \ 2
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
_PrintString (tpx, btn(bnum).byy), btn(bnum).txt
_Delay 0.3
Color forek, backk
Case "BBOX1"
Color backk, btn(bnum).fklr \ 2
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(196))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(196))
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(218))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(179))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(192))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(191))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(179))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(217))
Color backk, btn(bnum).tklr
tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
_PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
_Delay 0.3
Color forek, backk
Case "BBOX2"
Color backk, btn(bnum).fklr \ 2
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(205))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(205))
_PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(201))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(186))
_PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(200))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(187))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(186))
_PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(188))
Color backk, btn(bnum).tklr
tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
_PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
_Delay 0.3
Color forek, backk
End Select
End If
endflashb:
End Sub
A quick little routine to tell you if a string is a number, or not.
Code: (Select All)
Function IsNum%% (PassedText As String)
text$ = PassedText
special$ = UCase$(Left$(text$, 2))
Select Case special$
Case "&H", "&B", "&O"
'check for symbols on right side of value
r3$ = Right$(text$, 3)
Select Case r3$
Case "~&&", "~%%", "~%&" 'unsigned int64, unsigned byte, unsigned offset
text$ = Left$(text$, Len(text$) - 3)
Case Else
r2$ = Right$(text$, 2)
Select Case r2$
Case "~&", "##", "%&", "%%", "~%", "&&" 'unsigned long, float, offset, byte, unsigned integer, int64
text$ = Left$(text$, Len(text$) - 2)
Case Else
r$ = Right$(text$, 1)
Select Case r$
Case "&", "#", "%", "!" 'long, double, integer, single
text$ = Left$(text$, Len(text$) - 1)
End Select
End Select
End Select
check$ = "0123456789ABCDEF"
If special$ = "&O" Then check$ = "01234567"
If special$ = "&B" Then check$ = "01"
temp$ = Mid$(UCase$(text$), 2)
For i = 1 To Len(temp$)
If InStr(check$, Mid$(temp$, i, 1)) = 0 Then Exit For
Next
If i <= Len(temp$) Then IsNum = -1
Case Else
If _Trim$(Str$(Val(text$))) = text$ Then IsNum = -1
End Select
End Function
Note that this may fail if you're dealing with values that are so large they translate into scientific notation on you. "1234567890123456788901234567890" is NOT going to be counted as a number, as QB64 would expect to see this written as "1.234567E30", and your string definitely isn't going to compare to that string. (And the values probably won't match either, as you lost multiple digits to rounding when it became a scientific notation value.)
If you look close, you'll see that this function is basically one line of code, unless you happen to be passing it &H, &B, &O values -- in which case it has to work much harder to see if the string you passed it is a valid number, or not.
BTW: at the end of the song, or after you stop the song, you'll have the option to play the song again. Choose "Y", and then you can alter the tempo of the song and the waveform applied to the sounds.
Hey if you like borderless windows but want a way to resize them forget about using $RESIZE. It has no border to grab on to. Oh, if you don't mind ugly, or want an all black window, you can add a WS_THICKBORDER element to your API call, which Steve discovered, but it's ugly. (It leaves a thin black row just below the top white border in any window that has a colored background.) Anyway, if you don't mind that, you can use it with QB64 $RESIZE. If you want an alternative to $RESIZE, try something like this...
Try a mouse drag at any side or any corner to enlarge or shrink the borderless window. Esc to quit.
Code: (Select All)
DIM SHARED WinMse AS POINTAPI
TYPE POINTAPI
X_Pos AS LONG
Y_Pos AS LONG
END TYPE
DECLARE DYNAMIC LIBRARY "user32"
FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG)
FUNCTION GetAsyncKeyState% (BYVAL vkey AS LONG)
FUNCTION GetCursorPos (lpPoint AS POINTAPI)
FUNCTION FindWindowA& (BYVAL ClassName AS _OFFSET, WindowName$) 'handle by title
REM FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG) 'maximize process
FUNCTION GetForegroundWindow& 'Find currently focused process handle
FUNCTION SetWindowPos& (BYVAL hWnd AS LONG, BYVAL hWndInsertAfter AS _OFFSET, BYVAL X AS INTEGER, BYVAL Y AS INTEGER, BYVAL cx AS INTEGER, BYVAL cy AS INTEGER, BYVAL uFlags AS _OFFSET)
FUNCTION GetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG)
FUNCTION SetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG)
FUNCTION SetLayeredWindowAttributes& (BYVAL hwnd AS LONG, BYVAL crKey AS LONG, BYVAL bAlpha AS _UNSIGNED _BYTE, BYVAL dwFlags AS LONG)
FUNCTION SetCursorPos% (BYVAL cx AS INTEGER, BYVAL cy AS INTEGER)
SUB SENDKEYS ALIAS keybd_event (BYVAL bVk AS LONG, BYVAL bScan AS LONG, BYVAL dwFlags AS LONG, BYVAL dwExtraInfo AS LONG)
END DECLARE
DIM AS INTEGER setcurx, setcury, sizeit, oldmx, oldmy, x, y, fw, fh
x = _SCREENX
y = _SCREENY
w = _WIDTH
h = _HEIGHT
fw = _FONTWIDTH
fh = _FONTHEIGHT
DIM hWnd AS LONG
hWnd = _WINDOWHANDLE
_DELAY .1
GWL_STYLE = -16
WS_POPUP = &H4800000 ' Can be used to make a razor thin border but is not resizable.
ws_border = &H800000
WS_VISIBLE = &H10000000
DO
winstyle& = GetWindowLongA&(hWnd, GWL_STYLE)
LOOP UNTIL winstyle&
DO
a& = SetWindowLongA&(hWnd, GWL_STYLE, winstyle& AND WS_VISIBLE)
LOOP UNTIL a&
a& = SetWindowPos&(hWnd&, 0, 0, 0, 0, 0, 39) ' Required to allow printing where title bar used to be.
_DELAY .1
wintp = _SCREENY \ fh: winbt = _SCREENY \ fh + _HEIGHT: winlt = _SCREENX \ fw: winrt = _SCREENX \ fw + _WIDTH
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN lb = 1 ELSE IF lb = 1 AND _MOUSEBUTTON(1) = 0 THEN lb = 0: side$ = "": enl = 0
z& = GetCursorPos(WinMse)
setcurx = WinMse.X_Pos: setcury = WinMse.Y_Pos
WinMse.X_Pos = WinMse.X_Pos \ fw
WinMse.Y_Pos = WinMse.Y_Pos \ fh
IF lb THEN
IF LEN(side$) THEN
IF oldmx <> WinMse.X_Pos OR oldmy <> WinMse.Y_Pos THEN
DO ' Falx loop.
SELECT CASE side$
CASE "left-top"
sizeit = -SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
IF sizeit THEN GOSUB topsize
sizeit = SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
IF sizeit THEN GOSUB leftsize
CASE "right-top"
sizeit = -SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
IF sizeit THEN GOSUB topsize
sizeit = -SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
IF sizeit THEN GOSUB rightsize
CASE "left-bottom"
sizeit = SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
IF sizeit THEN GOSUB leftsize
sizeit = SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
IF sizeit THEN GOSUB bottomsize
CASE "right-bottom"
sizeit = -SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
IF sizeit THEN GOSUB rightsize
sizeit = SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
IF sizeit THEN GOSUB bottomsize
CASE "top" ' up/down
sizeit = -SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
IF sizeit THEN GOSUB topsize
CASE "bottom"
sizeit = SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
IF sizeit THEN GOSUB bottomsize
CASE "left"
sizeit = SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
IF sizeit THEN GOSUB leftsize
CASE "right"
sizeit = -SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
IF sizeit THEN GOSUB rightsize
END SELECT
wintp = y \ fh: winbt = y \ fh + _HEIGHT: winlt = x \ fw: winrt = x \ fw + _WIDTH
EXIT DO
LOOP
END IF
END IF
ELSE
IF WinMse.X_Pos = winlt AND WinMse.Y_Pos = wintp THEN
_MOUSESHOW "TOPLEFT_BOTTOMRIGHT": side$ = "left-top"
ELSEIF WinMse.X_Pos = winlt AND WinMse.Y_Pos = winbt THEN _MOUSESHOW "TOPRIGHT_BOTTOMLEFT": side$ = "left-bottom"
ELSEIF WinMse.X_Pos = winrt AND WinMse.Y_Pos = wintp THEN _MOUSESHOW "TOPRIGHT_BOTTOMLEFT": side$ = "right-top"
ELSEIF WinMse.X_Pos = winrt AND WinMse.Y_Pos = winbt THEN _MOUSESHOW "TOPleft_BOTTOMRIGHT": side$ = "right-bottom"
ELSEIF WinMse.X_Pos = winlt THEN _MOUSESHOW "HORIZONTAL": side$ = "left"
ELSEIF WinMse.X_Pos = winrt THEN _MOUSESHOW "HORIZONTAL": side$ = "right"
ELSEIF WinMse.Y_Pos = wintp THEN _MOUSESHOW "VERTICAL": side$ = "top"
ELSEIF WinMse.Y_Pos = winbt THEN _MOUSESHOW "VERTICAL": side$ = "bottom"
ELSE
IF LEN(side$) THEN side$ = "": _MOUSESHOW "default"
END IF
END IF
oldmx = WinMse.X_Pos: oldmy = WinMse.Y_Pos
IF INKEY$ = CHR$(27) THEN SYSTEM
LOOP
topsize:
IF h - sizeit < 5 THEN RETURN
h = h - sizeit
x = _SCREENX
y = _SCREENY + sizeit * fh
WIDTH w, h
_FONT 16
_SCREENMOVE x, y
z% = SetCursorPos%(setcurx, setcury)
RETURN
leftsize:
IF w + sizeit < 15 THEN RETURN
w = w + sizeit
x = _SCREENX - sizeit * fw
y = _SCREENY
WIDTH w, h
_FONT 16
_SCREENMOVE x, y
z% = SetCursorPos%(x, setcury)
RETURN
rightsize:
IF w + sizeit < 15 THEN RETURN
w = w + sizeit
x = _SCREENX - sizeit * fw
y = _SCREENY
WIDTH w, h
_FONT 16
x = _SCREENX: y = _SCREENY
z% = SetCursorPos%(x + _WIDTH * fw, setcury)
RETURN
bottomsize:
IF h - sizeit < 5 THEN RETURN
h = h - sizeit
WIDTH w, h
_FONT 16
x = _SCREENX: y = _SCREENY
z% = SetCursorPos%(setcurx, y + _HEIGHT * fh)
RETURN
Something I may try later is using the _NEWIMAGE equivalent of SCREEN 0. I'd like to see if that would eliminate the need to load QB64 default 16 size font. One problem with window sizing in SCREEN 0 is that 16 size font gets traded out at different sizes with what I think is the 8 size square font. Anyway, that causes irregular resizing results. Specifying _FONT 16 prevents that occurrence.
As always, if anyone has any improvement suggestions, go ahead and post them. A nice perk to sharing code is more minds often results in more performance.
Finally everything works properly. A system that can be easily extended from non-source code. I created a structure that allows us to parameterize everything with a simple notepad. Add new maps, terrain, and textures quickly.
I want to make a game that I haven't made before. I deleted the shooting part. There is already such a game. An adventure game with missions and characters would be nice. If you have any ideas, I'd love to read them. even if it seems funny at first. I'm interested in any ideas! moreover, if we could collectively build a game in some form, where more people could take part, that would be wonderful.
It can be tried for now. there is no task, but you can walk around the huge space. There is a lot of garbage among the files, that's why it was 240 Mb, so sorry!