BCX Console Demonstration Program s85.bas
|
PRINT "This will not compile or run correctly on Windows 7 thru 10"
PRINT "It is being left here for historical continuity only."
PRINT "MrBcx -- Dec 01, 2019"
$COMMENT
'-----------------------------------------------------
' This program demonstrates toggling full screen mode
' This version only works in Win95/98/ME/NT
'-----------------------------------------------------
REM '$HEADER
REM typedef void (CALLBACK *ULPRET1)(DWORD*);
REM typedef void (CALLBACK *ULPRET2)(HANDLE,DWORD,int);
REM '$HEADER
ToggleFullScreen()
Sleep(1000) 'delay 1 second each iteration
SUB ToggleFullScreen()
DIM SetConsoleDisplayMode AS ULPRET2
DIM GetConsoleDisplayMode AS ULPRET1
DIM hKernel32 AS HMODULE
DIM hOut AS HANDLE
DIM dwOldMode AS DWORD
DIM hConWnd AS HWND
DIM ConTxt$
CONST ID_SWITCH_CONSOLEMODE = 0xE00F
IF IsNT() THEN
' ------------------------------------------------
' taken from http://www.codepile.com/tric16.shtml
' ------------------------------------------------
hKernel32 = GetModuleHandle("kernel32.dll")
SetConsoleDisplayMode = (ULPRET2)GetProcAddress(hKernel32, "SetConsoleDisplayMode")
GetConsoleDisplayMode = (ULPRET1)GetProcAddress(hKernel32, "GetConsoleDisplayMode")
hOut = GetStdHandle(STD_OUTPUT_HANDLE)
GetConsoleDisplayMode(&dwOldMode)
SetConsoleDisplayMode(hOut, 1 XOR dwOldMode, 0)
ELSE
GetConsoleTitle(ConTxt$, SIZEOF(ConTxt$))
hConWnd = FindWindow("tty", ConTxt$)
SendMessage(hConWnd, WM_COMMAND, ID_SWITCH_CONSOLEMODE, 0)
END IF
END SUB
FUNCTION IsNT()
DIM dwVersion AS DWORD
dwVersion = GetVersion()
IF (dwVersion < 0x80000000) THEN
FUNCTION = TRUE
ELSE
FUNCTION = FALSE
END IF
END FUNCTION
$COMMENT