$OPTIMIZE ON
$APPTYPE CONSOLE
$TYPECHECK ON
$ESCAPECHARS ON
Application.Minimize
Application.Title="Console.BAS"
CONST FOREGROUND_BLUE=1
CONST FOREGROUND_GREEN=2
CONST FOREGROUND_RED=4
CONST FOREGROUND_INTENSITY=8
CONST BACKGROUND_BLUE=16
CONST BACKGROUND_GREEN=32
CONST BACKGROUND_RED=64
CONST BACKGROUND_INTENSITY=128
CONST INK_RED=FOREGROUND_INTENSITY OR FOREGROUND_RED
CONST INK_GREEN=FOREGROUND_INTENSITY OR FOREGROUND_GREEN
CONST INK_BLUE=FOREGROUND_INTENSITY OR FOREGROUND_BLUE
CONST INK_YELLOW=FOREGROUND_INTENSITY OR FOREGROUND_RED OR FOREGROUND_GREEN
CONST INK_MAGENTA=FOREGROUND_INTENSITY OR FOREGROUND_RED OR FOREGROUND_BLUE
CONST INK_CYAN=FOREGROUND_INTENSITY OR FOREGROUND_GREEN OR FOREGROUND_BLUE
CONST INK_WHITE=FOREGROUND_INTENSITY OR FOREGROUND_RED OR FOREGROUND_GREEN OR FOREGROUND_BLUE
CONST PAPER_RED=BACKGROUND_INTENSITY OR BACKGROUND_RED
CONST PAPER_GREEN=BACKGROUND_INTENSITY OR BACKGROUND_GREEN
CONST PAPER_BLUE=BACKGROUND_INTENSITY OR BACKGROUND_BLUE
CONST PAPER_YELLOW=BACKGROUND_INTENSITY OR BACKGROUND_RED OR BACKGROUND_GREEN
CONST PAPER_MAGENTA=BACKGROUND_INTENSITY OR BACKGROUND_RED OR BACKGROUND_BLUE
CONST PAPER_CYAN=BACKGROUND_INTENSITY OR BACKGROUND_GREEN OR BACKGROUND_BLUE
CONST PAPER_WHITE=BACKGROUND_INTENSITY OR BACKGROUND_RED OR BACKGROUND_GREEN OR BACKGROUND_BLUE
CONST ARGS_ALLOWED=50
CONST CREATE_INPUT_HANDLE=0
CONST CREATE_OUTPUT_HANDLE=1
CONST RESTORE_CTRLC=0
CONST IGNORE_CTRLC=1
CONST GMEM_FIXED=0
CONST GMEM_MOVEABLE=2
CONST GMEM_ZEROINIT=64
CONST GMEM_INVALID_HANDLE=&H8000
CONST STD_INPUT_HANDLE = -10&
CONST STD_OUTPUT_HANDLE = -11&
CONST STD_ERROR_HANDLE = -12&
CONST INVALID_HANDLE_VALUE=-1
CONST ENABLE_PROCESSED_INPUT=1
CONST ENABLE_LINE_INPUT=2
CONST ENABLE_ECHO_INPUT=4
CONST ENABLE_WINDOW_INPUT=8
CONST ENABLE_MOUSE_INPUT=16
CONST ENABLE_PROCESSED_OUTPUT=1
CONST ENABLE_WRAP_AT_EOL_OUTPUT=2
CONST GENERIC_READ=&H80000000
CONST GENERIC_WRITE=&H40000000
CONST FILE_SHARE_READ=1
CONST FILE_SHARE_WRITE=2
CONST CONSOLE_TEXTMODE_BUFFER=1
CONST KEY_EVENT=1
CONST MOUSE_EVENT=2
CONST WINDOW_BUFFER_SIZE_EVENT=4
CONST MENU_EVENT=8
CONST FOCUS_EVENT=16
CONST RIGHT_ALT_PRESSED=1
CONST LEFT_ALT_PRESSED=2
CONST RIGHT_CTRL_PRESSED=4
CONST LEFT_CTRL_PRESSED=8
CONST SHIFT_PRESSED=16
CONST NUMLOCK_ON=32
CONST SCROLLLOCK_ON=64
CONST CAPSLOCK_ON=128
CONST ENHANCED_KEY=256
CONST FROM_LEFT_1ST_BUTTON_PRESSED=1
CONST RIGHTMOST_BUTTON_PRESSED=2
CONST FROM_LEFT_2ND_BUTTON_PRESSED=4
CONST FROM_LEFT_3RD_BUTTON_PRESSED=8
CONST FROM_LEFT_4TH_BUTTON_PRESSED=16
CONST MOUSE_MOVED=1
CONST DOUBLE_CLICK=2
CONST CREATE_NEW=1
CONST CREATE_ALWAYS=2
CONST OPEN_EXISTING=3
CONST OPEN_ALWAYS=4
CONST TRUNCATE_EXISTING=5
CONST HWND_BROADCAST = &HFFFF&
CONST WM_COMMAND=&H111
CONST FILE_ATTRIBUTE_NORMAL=&H80
CONST CTRL_C_EVENT=0
CONST CTRL_BREAK_EVENT=1
CONST CTRL_CLOSE_EVENT=2
CONST CTRL_LOGOFF_EVENT=5
CONST CTRL_SHUTDOWN_EVENT=6
DECLARE FUNCTION AllocConsole LIB "kernel32.dll" ALIAS "AllocConsole" () AS LONG
DECLARE FUNCTION CloseHandle LIB "kernel32.dll" ALIAS "CloseHandle" (handle AS LONG) AS LONG
DECLARE SUB CopyMemory LIB "kernel32.dll" ALIAS "RtlMoveMemory" (BYVAL dest AS LONG, BYVAL source AS LONG, BYVAL numBytes AS LONG)
DECLARE FUNCTION CreateConsoleScreenBuffer LIB "kernel32.dll" ALIAS "CreateConsoleScreenBuffer" (access AS LONG, shareMode AS LONG, security AS LONG, flags AS LONG, buffer AS LONG) AS LONG
DECLARE FUNCTION CreateFile LIB "kernel32.dll" ALIAS "CreateFileA" (fileName AS STRING, access AS LONG, shareMode AS LONG, security AS LONG, creation AS LONG, attrs AS LONG, template AS LONG) AS LONG
DECLARE FUNCTION FillConsoleOutputAttribute LIB "kernel32.dll" ALIAS "FillConsoleOutputAttribute" (hOutput AS LONG, colors AS WORD, length AS LONG, coords AS WORD, written AS LONG) AS LONG
DECLARE FUNCTION FillConsoleOutputCharacter LIB "kernel32.dll" ALIAS "FillConsoleOutputCharacterA" (hOutput AS LONG, character AS BYTE, length AS LONG, coords AS WORD, written AS LONG) AS LONG
DECLARE FUNCTION FindWindow LIB "user32.dll" ALIAS "FindWindowA" (className AS STRING, windowName AS STRING) AS INTEGER
DECLARE FUNCTION FlushConsoleInputBuffer LIB "kernel32.dll" ALIAS "FlushConsoleInputBuffer" (hInput AS LONG) AS LONG
DECLARE FUNCTION FreeConsole LIB "kernel32.dll" ALIAS "FreeConsole" () AS LONG
DECLARE FUNCTION GetCommandLine LIB "kernel32.dll" ALIAS "GetCommandLineA" () AS STRING
DECLARE FUNCTION GetConsoleCP LIB "kernel32.dll" ALIAS "GetConsoleCP" () AS LONG
DECLARE FUNCTION GetConsoleOutputCP LIB "kernel32.dll" ALIAS "GetConsoleOutputCP" () AS LONG
DECLARE FUNCTION GetConsoleCursorInfo LIB "kernel32.dll" ALIAS "GetConsoleCursorInfo" (hOutput AS LONG, cursorInfo AS LONG) AS LONG
DECLARE FUNCTION GetConsoleMode LIB "kernel32.dll" ALIAS "GetConsoleMode" (hConsole AS LONG, mode AS LONG) AS LONG
DECLARE FUNCTION GetConsoleScreenBufferInfo LIB "kernel32.dll" ALIAS "GetConsoleScreenBufferInfo" (hOutput AS LONG, screenBufInfo AS WORD) AS LONG
DECLARE FUNCTION GetConsoleTitle LIB "kernel32.dll" ALIAS "GetConsoleTitleA" (buffer AS LONG, buflen AS LONG) AS LONG
DECLARE FUNCTION GetLargestConsoleWindowSize LIB "kernel32.dll" ALIAS "GetLargestConsoleWindowSize" (hOutput AS LONG) AS LONG
DECLARE FUNCTION GetLastError LIB "kernel32.dll" ALIAS "GetLastError" () AS LONG
DECLARE FUNCTION GetNumberOfConsoleInputEvents LIB "kernel32.dll" ALIAS "GetNumberOfConsoleInputEvents" (hInput AS LONG, numEvents AS LONG) AS LONG
DECLARE FUNCTION GetNumberOfConsoleMouseButtons LIB "kernel32.dll" ALIAS "GetNumberOfConsoleMouseButtons" (numButtons AS LONG) AS LONG
DECLARE FUNCTION GetStdHandle LIB "kernel32.dll" ALIAS "GetStdHandle" (handleType AS LONG) AS LONG
DECLARE FUNCTION GlobalAlloc LIB "kernel32.dll" ALIAS "GlobalAlloc" (flags AS LONG, numBytes AS LONG) AS LONG
DECLARE FUNCTION GlobalFree LIB "kernel32.dll" ALIAS "GlobalFree" (hMem AS LONG) AS LONG
DECLARE FUNCTION GlobalLock LIB "kernel32.dll" ALIAS "GlobalLock" (hMem AS LONG) AS LONG
DECLARE FUNCTION GlobalUnlock LIB "kernel32.dll" ALIAS "GlobalUnlock" (hMem AS LONG) AS LONG
DECLARE FUNCTION PeekConsoleInput LIB "kernel32.dll" ALIAS "PeekConsoleInputA" (hInput AS LONG, recordsBuf AS LONG, numRecords AS LONG, readRecords AS LONG) AS LONG
DECLARE FUNCTION ReadConsole LIB "kernel32.dll" ALIAS "ReadConsoleA" (hInput AS LONG, buffer AS LONG, buflen AS LONG, charsRead AS LONG, reserved AS LONG) AS LONG
DECLARE FUNCTION ReadConsoleInput LIB "kernel32.dll" ALIAS "ReadConsoleInputA" (hInput AS LONG, recordsBuf AS LONG, numRecords AS LONG, readRecords AS LONG) AS LONG
DECLARE FUNCTION ReadConsoleOutput LIB "kernel32.dll" ALIAS "ReadConsoleOutputA" (hOutput AS LONG, charinfo AS LONG, ciSize AS LONG, ciXY AS LONG, destRect AS WORD) AS LONG
DECLARE FUNCTION ReadConsoleOutputAttribute LIB "kernel32.dll" ALIAS "ReadConsoleOutputAttribute" (hOutput AS LONG, colors AS WORD, buflen AS LONG, coords AS LONG, numRead AS LONG) AS LONG
DECLARE FUNCTION ReadConsoleOutputCharacter LIB "kernel32.dll" ALIAS "ReadConsoleOutputCharacterA" (hOutput AS LONG, buffer AS LONG, buflen AS LONG, coords AS LONG, numRead AS LONG) AS LONG
DECLARE FUNCTION ReadFile LIB "kernel32.dll" ALIAS "ReadFile" (hFile AS LONG, buffer AS LONG, bufsize AS LONG, numRead AS LONG, overlapped AS LONG) AS LONG
DECLARE FUNCTION ScrollConsoleScreenBuffer LIB "kernel32.dll" ALIAS "ScrollConsoleScreenBufferA" (hOutput AS LONG, sourceRect AS WORD, clipRect AS WORD, destXY AS LONG, charInfo AS LONG) AS LONG
DECLARE FUNCTION SendMsg LIB "user32.dll" ALIAS "SendMessageA" (hwnd AS LONG, wMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
DECLARE FUNCTION SetConsoleActiveScreenBuffer LIB "kernel32.dll" ALIAS "SetConsoleActiveScreenBuffer" (hOutput AS LONG) AS LONG
DECLARE FUNCTION SetConsoleCP LIB "kernel32.dll" ALIAS "SetConsoleCP" (codePageID AS LONG) AS LONG
DECLARE FUNCTION SetConsoleOutputCP LIB "kernel32.dll" ALIAS "SetConsoleOutputCP" (codePageID AS LONG) AS LONG
DECLARE FUNCTION SetConsoleCtrlHandler LIB "kernel32.dll" ALIAS "SetConsoleCtrlHandler" (routine AS LONG, flag AS LONG) AS LONG
DECLARE FUNCTION SetConsoleCursorInfo LIB "kernel32.dll" ALIAS "SetConsoleCursorInfo" (hOutput AS LONG, cursorInfo AS LONG) AS LONG
DECLARE FUNCTION SetConsoleCursorPosition LIB "kernel32.dll" ALIAS "SetConsoleCursorPosition" (hOutput AS LONG, curPos AS LONG) AS LONG
DECLARE FUNCTION SetConsoleMode LIB "kernel32.dll" ALIAS "SetConsoleMode" (hConsole AS LONG, mode AS LONG) AS LONG
DECLARE FUNCTION SetConsoleScreenBufferSize LIB "kernel32.dll" ALIAS "SetConsoleScreenBufferSize" (hOutput AS LONG, coords AS WORD) AS LONG
DECLARE FUNCTION SetConsoleTextAttribute LIB "kernel32.dll" ALIAS "SetConsoleTextAttribute" (hOutput AS LONG, colors AS LONG) AS LONG
DECLARE FUNCTION SetConsoleWindowInfo LIB "kernel32.dll" ALIAS "SetConsoleWindowInfo" (hOutput AS LONG, absolute AS LONG, rectangle AS WORD) AS LONG
DECLARE FUNCTION SetStdHandle LIB "kernel32.dll" ALIAS "SetStdHandle" (handleType AS LONG, handle AS LONG) AS LONG
DECLARE FUNCTION SetTitle LIB "kernel32.dll" ALIAS "SetConsoleTitleA" (title AS STRING) AS LONG
DECLARE FUNCTION ShutDown_Handler (CtrlEvent AS LONG) AS LONG
DECLARE SUB SLEEP LIB "kernel32.dll" ALIAS "Sleep" (milliSeconds AS LONG)
DECLARE FUNCTION WriteConsole LIB "kernel32.dll" ALIAS "WriteConsoleA" (output AS LONG, buffer AS LONG, buflen AS LONG, charsWrote AS LONG, reserved AS LONG) AS LONG
DECLARE FUNCTION WriteConsoleInput LIB "kernel32.dll" ALIAS "WriteConsoleInputA" (hInput AS LONG, recordsBuf AS LONG, numRecords AS LONG, writtenRecords AS LONG) AS LONG
DECLARE FUNCTION WriteConsoleOutput LIB "kernel32.dll" ALIAS "WriteConsoleOutputA" (hOutput AS LONG, buffer AS LONG, buflen AS LONG, bufcoords AS LONG, region AS WORD) AS LONG
DECLARE FUNCTION WriteConsoleOutputAttribute LIB "kernel32.dll" ALIAS "WriteConsoleOutputAttribute" (hOutput AS LONG, colorsbuf AS WORD, buflen AS LONG, coords AS LONG, written AS LONG) AS LONG
DECLARE FUNCTION WriteConsoleOutputCharacter LIB "kernel32.dll" ALIAS "WriteConsoleOutputCharacterA" (hOutput AS LONG, buffer AS LONG, buflen AS LONG, coords AS LONG, written AS LONG) AS LONG
DECLARE FUNCTION WriteFile LIB "kernel32.dll" ALIAS "WriteFile" (hFile AS LONG, buffer AS LONG, bufsize AS LONG, numWritten AS LONG, overlapped AS LONG) AS LONG
DIM con_Handle AS LONG, inout_Handle AS LONG
DIM handle(0 TO 23) AS LONG
DIM oldIMode AS LONG, oldOMode AS LONG, oldColours AS LONG
DIM counter AS LONG, position AS LONG, argNum AS BYTE, numRecs AS LONG
DIM mem_Lock AS LONG, mem_Memory AS LONG, mem_Default AS LONG
DIM mem_Offset AS LONG, quit AS BYTE, con_Window AS LONG
DIM input_CP AS LONG, output_CP AS LONG, numMB AS LONG, curScr AS BYTE
DIM wrect0(0 TO 3) AS WORD, wrect1(0 TO 3) AS WORD
DIM scrInfo(0 TO 10) AS WORD
DIM largestX AS LONG, largestY AS LONG, cursor(0 TO 1) AS LONG
DIM colors(0 TO 2000) AS WORD
DIM char_info(0 TO 500) AS LONG
DIM stgbuf$ AS STRING, arg$ AS STRING
DIM parse$(0 TO ARGS_ALLOWED-1) AS STRING
stgbuf$=STRING$(256,0)
DIM rtn AS LONG, rtnval AS LONG, stg$ AS STRING, slen AS LONG
DIM count AS LONG, FLong AS LONG, FWord AS WORD, FByte AS BYTE
DIM FFour AS LONG
SUB UnLock_DefaultMemory
IF mem_Lock<>0 THEN
rtn=GlobalUnlock(mem_Lock)
IF ((rtn=0) AND (GetLastError()=0)) THEN
ELSE
END IF
END IF
END SUB
SUB Free_DefaultMemory
IF mem_Memory<>0 THEN
rtn=GlobalFree(mem_Memory)
IF rtn=0 THEN
ELSE
END IF
END IF
END SUB
SUB Alloc_DefaultMemory(bufsize AS LONG)
mem_Lock=0
mem_Memory=0
mem_Default=0
mem_Memory=GlobalAlloc(GMEM_MOVEABLE OR GMEM_ZEROINIT, bufsize)
IF mem_Memory<>0 THEN
mem_Lock=GlobalLock(mem_Memory)
IF mem_Lock<>0 THEN
mem_Default=mem_Lock
END IF
END IF
END SUB
SUB Set_ConsoleSize(number AS BYTE,x AS WORD,y AS WORD)
FWord=x
CopyMemory mem_Default, VARPTR(FWord), 2
FWord=y
CopyMemory mem_Default+2, VARPTR(FWord), 2
rtn=SetConsoleScreenBufferSize(handle(number),mem_Default)
IF rtn<>0 THEN
ELSE
END IF
END SUB
SUB Set_Handle(hType AS LONG,number AS BYTE)
rtn=SetStdHandle(hType,handle(number))
IF rtn<>0 THEN
ELSE
END IF
END SUB
SUB Write_ScreenChars(number AS BYTE,buffer AS LONG,buflen AS LONG)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=WriteConsole(handle(number),buffer,buflen,VARPTR(rtnval),0)
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Get_ScreenInfo(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=GetConsoleScreenBufferInfo(handle(number),@scrInfo(0))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Write_NewLine(number AS BYTE)
Get_ScreenInfo(number)
count=scrInfo(2)
WHILE ((scrInfo(3)<=scrInfo(10)) AND (count<scrInfo(9)))
stg$=" "
Write_ScreenChars(number,VARPTR(stg$),1)
INC count
WEND
END SUB
SUB Write_ScreenRect(number AS BYTE,w AS WORD,h AS WORD,x AS WORD,y AS WORD,left AS WORD,top AS WORD,right AS WORD,bottom AS WORD)
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
FFour=h
FFour=FFour SHL 16
FFour=FFour OR w
wrect1(0)=left
wrect1(1)=top
wrect1(2)=right
wrect1(3)=bottom
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=WriteConsoleOutput(handle(number),@char_info(0),FFour,FLong,@wrect1(0))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Read_ScreenRect(number AS BYTE,w AS WORD,h AS WORD,x AS WORD,y AS WORD,left AS WORD,top AS WORD,right AS WORD,bottom AS WORD)
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
FFour=h
FFour=FFour SHL 16
FFour=FFour OR w
wrect1(0)=left
wrect1(1)=top
wrect1(2)=right
wrect1(3)=bottom
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=ReadConsoleOutput(handle(number),@char_info(0),FFour,FLong,@wrect1(0))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Write_ScreenCharsXY(number AS BYTE,x AS WORD,y AS WORD,buffer AS LONG,buflen AS LONG)
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=WriteConsoleOutputCharacter(handle(number),buffer,buflen,FLong,VARPTR(rtnval))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Get_Input(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=ReadConsole(handle(number),VARPTR(stgbuf$),LEN(stgbuf$),VARPTR(rtnval),0)
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Read_ScreenCharsXY(number AS BYTE,x AS WORD,y AS WORD,buffer AS LONG,buflen AS LONG)
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=ReadConsoleOutputCharacter(handle(number),buffer,buflen,FLong,VARPTR(rtnval))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Set_ScreenColoursXY(number AS BYTE,numColours AS LONG,x AS WORD,y AS WORD)
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=WriteConsoleOutputAttribute(handle(number),@colors(0),numColours,FLong,VARPTR(rtnval))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Get_ScreenColoursXY(number AS BYTE,numColours AS LONG,x AS WORD,y AS WORD)
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=ReadConsoleOutputAttribute(handle(number),@colors(0),numColours,FLong,VARPTR(rtnval))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Flush_Input(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=FlushConsoleInputBuffer(handle(number))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Write_Records(number AS BYTE,numRecords AS LONG)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=WriteConsoleInput(handle(number),mem_Default,numRecords,VARPTR(rtnval))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Peek_Records(number AS BYTE,numRecords AS LONG)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=PeekConsoleInput(handle(number),mem_Default,numRecords,VARPTR(rtnval))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Get_Records(number AS BYTE,numRecords AS LONG)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=ReadConsoleInput(handle(number),mem_Default,numRecords,VARPTR(numRecs))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Get_NumberOfRecords(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=GetNumberOfConsoleInputEvents(handle(number),VARPTR(rtnval))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Set_CursorPosition(number AS BYTE,x AS WORD,y AS WORD)
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=SetConsoleCursorPosition(handle(number),FLong)
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Set_TextColours(number AS BYTE,colours AS WORD)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=SetConsoleTextAttribute(handle(number),colours)
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Colour_WholeScreen(number AS BYTE,Colour AS WORD)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=FillConsoleOutputAttribute(handle(number),Colour,0,1,0)
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Clear_WholeScreen(number AS BYTE,Character AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=FillConsoleOutputCharacter(handle(number),Character,0,1,0)
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Clear_ScreenXY(number AS BYTE,x AS WORD,y AS WORD,colours AS WORD,numCharsToClear AS LONG,clearCharacter AS BYTE)
Set_CursorPosition(number,x,y)
IF colours>-1 THEN
Set_TextColours(number,colours)
END IF
FOR count=0 TO numCharsToClear-1
stg$=CHR$(clearCharacter)
Write_ScreenChars(number,VARPTR(stg$),1)
NEXT
END SUB
SUB Set_Cursor(number AS BYTE,visibility AS LONG,visible AS LONG)
cursor(0)=visibility
cursor(1)=visible
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=SetConsoleCursorInfo(handle(number),@cursor(0))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Scroll_Screen(number AS BYTE,left AS WORD,top AS WORD,right AS WORD,bottom AS WORD,x AS WORD,y AS WORD,cleft AS WORD,ctop AS WORD,cright AS WORD,cbottom AS WORD,useClip AS BYTE)
wrect0(0)=left
wrect0(1)=top
wrect0(2)=right
wrect0(3)=bottom
FLong=y
FLong=FLong SHL 16
FLong=FLong OR x
wrect1(0)=cleft
wrect1(1)=ctop
wrect1(2)=cright
wrect1(3)=cbottom
IF handle(number)<>INVALID_HANDLE_VALUE THEN
IF useClip=0 THEN
rtn=ScrollConsoleScreenBuffer(handle(number), @wrect0(0), 0, FLong, @char_info(0))
ELSE
rtn=ScrollConsoleScreenBuffer(handle(number),@wrect0(0),@wrect1(0),FLong,@char_info(0))
END IF
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Get_InputMode(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=GetConsoleMode(handle(number),VARPTR(oldIMode))
IF rtn<>0 THEN
END IF
END IF
END SUB
SUB Get_OutputMode(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=GetConsoleMode(handle(number),VARPTR(oldOMode))
IF rtn<>0 THEN
END IF
END IF
END SUB
SUB Set_InputMode(number AS BYTE,mode AS LONG)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=SetConsoleMode(handle(number),mode)
IF rtn<>0 THEN
END IF
END IF
END SUB
SUB Set_OutputMode(number AS BYTE,mode AS LONG)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=SetConsoleMode(handle(number), mode)
IF rtn<>0 THEN
END IF
END IF
END SUB
SUB Get_LargestWindowSize(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtnval=GetLargestConsoleWindowSize(handle(number))
IF rtnval<>0 THEN
FLong=rtnval
FLong=FLong AND &HFFFF0000
FLong=FLong SHR 16
FFour=rtnval
FFour=FFour AND &H0000FFFF
largestX=FLong
largestY=FFour
stg$="Max Y: "+STR$(largestY)+" Max. X: "+STR$(largestX)
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
ELSE
END IF
END IF
END SUB
SUB Get_MouseButtons
rtn=GetNumberOfConsoleMouseButtons(VARPTR(numMB))
IF rtn<>0 THEN
ELSE
END IF
END SUB
SUB Show_ScreenInfo(number AS BYTE)
Set_TextColours(number,INK_RED)
stg$="Screen Character Width: "+STR$(scrInfo(0))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
stg$="Screen Character Height: "+STR$(scrInfo(1))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
Set_TextColours(number,INK_GREEN)
stg$="Cursor Position X: "+STR$(scrInfo(2))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
stg$="Cursor Position Y: "+STR$(scrInfo(3))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
Set_TextColours(number,INK_BLUE)
stg$="Colour Attributes: "+STR$(scrInfo(4))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
Set_TextColours(number,INK_MAGENTA)
stg$="Display Left: "+STR$(scrInfo(5))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
stg$="Display Top: "+STR$(scrInfo(6))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
stg$="Display Right: "+STR$(scrInfo(7))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
stg$="Display Bottom: "+STR$(scrInfo(8))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
Set_TextColours(number,INK_WHITE)
stg$="Maximum Screen (Character) Width: "+STR$(scrInfo(9))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
stg$="Maximum Screen (Character) Height: "+STR$(scrInfo(10))
Write_ScreenChars(number,VARPTR(stg$),LEN(stg$))
Write_NewLine(number)
END SUB
SUB Free_CreatedConsoleHandle(number AS BYTE)
IF handle(number)<>0 THEN
rtn=CloseHandle(handle(number))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Create_ConsoleHandle(inout AS BYTE,access AS LONG,shareMode AS LONG)
IF inout=CREATE_INPUT_HANDLE THEN
inout_Handle=CreateFile("CONIN$",access,shareMode,0,OPEN_EXISTING,0,0)
ELSE
inout_Handle=CreateFile("CONOUT$",access,shareMode,0,OPEN_EXISTING,0,0)
END IF
IF inout_Handle<>0 THEN
ELSE
END IF
END SUB
SUB Set_OutputCodePage(code AS LONG)
rtn=SetConsoleOutputCP(code)
IF rtn<>0 THEN
ELSE
END IF
END SUB
SUB Set_InputCodePage(code AS LONG)
rtn=SetConsoleCP(code)
IF rtn<>0 THEN
ELSE
END IF
END SUB
SUB Get_OutputCodePage
output_CP=GetConsoleOutputCP()
IF output_CP<>0 THEN
ELSE
END IF
END SUB
SUB Get_InputCodePage
input_CP=GetConsoleCP()
IF input_CP<>0 THEN
ELSE
END IF
END SUB
SUB Get_InputHandle(number AS BYTE)
handle(number)=GetStdHandle(STD_INPUT_HANDLE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
ELSE
END IF
END SUB
SUB Get_OutputHandle(number AS BYTE)
handle(number)=GetStdHandle(STD_OUTPUT_HANDLE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
ELSE
END IF
END SUB
SUB Get_ErrorHandle(number AS BYTE)
handle(number)=GetStdHandle(STD_ERROR_HANDLE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
ELSE
END IF
END SUB
SUB Set_Title(title$ AS STRING)
rtn=SetTitle(title$)
IF rtn<>0 THEN
ELSE
END IF
END SUB
SUB Get_Title(buffer AS LONG,buflen AS LONG)
rtn=GetConsoleTitle(buffer,buflen)
IF rtn<>0 THEN
ELSE
END IF
END SUB
SUB Set_WindowSize(number AS BYTE,left AS WORD,top AS WORD,right AS WORD,bottom AS WORD,flag AS LONG)
IF left<0 THEN left=0
IF top<0 THEN top=0
IF right=>scrInfo(9) THEN right=scrInfo(9)-1
IF bottom=>scrInfo(10) THEN bottom=scrInfo(10)-1
IF left=right THEN
left=0
right=scrInfo(9)-1
END IF
IF top=bottom THEN
top=0
bottom=scrInfo(10)-1
END IF
wrect0(0)=left
wrect0(1)=top
wrect0(2)=right
wrect0(3)=bottom
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=SetConsoleWindowInfo(handle(number),flag,@wrect0(0))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Set_ActiveScreen(number AS BYTE)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
rtn=SetConsoleActiveScreenBuffer(handle(number))
IF rtn<>0 THEN
ELSE
END IF
END IF
END SUB
SUB Create_Screen(access AS LONG,shareMode AS LONG,number AS BYTE)
IF ((number>2) AND (number<23)) THEN
handle(number)=CreateConsoleScreenBuffer(access,shareMode,0,CONSOLE_TEXTMODE_BUFFER,0)
IF handle(number)<>INVALID_HANDLE_VALUE THEN
ELSE
END IF
END IF
END SUB
SUB Show_Arguments(number AS BYTE)
counter=0
WHILE (parse$(counter)<>"END OF ARGUMENTS" AND parse$(counter)<>"LAST ARGUMENT OVERWRITTEN" AND parse$(counter)<>"")
Write_ScreenChars(number,VARPTR(parse$(counter)),LEN(parse$(counter)))
Write_NewLine(number)
INC counter
WEND
END SUB
SUB Parse_Arguments
counter=0
FByte=0
argNum=0
WHILE ((counter<LEN(arg$)) AND (FByte=0) AND (argNum<ARGS_ALLOWED))
position=INSTR(counter, arg$, " ")
IF position<>0 THEN
stg$=MID$(arg$,counter,position-1)
parse$(argNum)=LEFT$(stg$,position-counter)
counter=position+1
INC argNum
ELSE
FByte=1
parse$(argNum)=MID$(arg$,counter,LEN(arg$))
INC argNum
IF argNum<ARGS_ALLOWED THEN
parse$(argNum)="END OF ARGUMENTS"
ELSE
parse$(argNum-1)="LAST ARGUMENT OVERWRITTEN"
END IF
END IF
WEND
END SUB
SUB Set_CtrlC(flag AS LONG)
rtn=SetConsoleCtrlHandler(0,flag)
IF rtn<>0 THEN
ELSE
END IF
END SUB
rtn=FreeConsole()
IF rtn<>0 THEN
con_Handle=AllocConsole()
IF con_Handle<>0 THEN
Get_ErrorHandle(0)
Get_InputHandle(1)
Get_OutputHandle(2)
Set_InputMode(1,ENABLE_LINE_INPUT OR ENABLE_ECHO_INPUT OR ENABLE_PROCESSED_INPUT OR ENABLE_MOUSE_INPUT)
Set_OutputMode(2,ENABLE_PROCESSED_OUTPUT OR ENABLE_WRAP_AT_EOL_OUTPUT)
Alloc_DefaultMemory(3000)
curScr=0
Set_CtrlC(IGNORE_CTRLC)
Set_Title("Console Window - Example")
Set_WindowSize(2,0,0,60,25,1)
Set_TextColours(2,INK_YELLOW)
Set_Cursor(2,60,1)
Get_ScreenInfo(2)
Show_ScreenInfo(2)
Write_NewLine(2)
stg$="I am Screen One (The Default Output Screen)"
Write_ScreenChars(2,VARPTR(stg$),LEN(stg$))
SLEEP(6000)
Create_Screen(GENERIC_READ OR GENERIC_WRITE,FILE_SHARE_READ OR FILE_SHARE_WRITE,3)
curScr=1
Set_Handle(STD_OUTPUT_HANDLE,3)
Set_OutputMode(3,ENABLE_PROCESSED_OUTPUT OR ENABLE_WRAP_AT_EOL_OUTPUT)
Set_ActiveScreen(3)
stg$="I am Screen Two"
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
SLEEP(2500)
curScr=0
Set_Handle(STD_OUTPUT_HANDLE,2)
Write_NewLine(2)
Write_NewLine(2)
stg$="I am on Screen One again."
Write_ScreenChars(2,VARPTR(stg$),LEN(stg$))
Set_ActiveScreen(2)
SLEEP(2500)
curScr=1
Set_Handle(STD_OUTPUT_HANDLE,3)
Write_NewLine(3)
Write_NewLine(3)
stg$="I am on Screen Two again."
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Set_ActiveScreen(3)
SLEEP(2500)
Clear_ScreenXY(3,0,0,INK_RED OR PAPER_YELLOW,240,32)
colors(0)=INK_RED
colors(1)=INK_GREEN
colors(2)=INK_BLUE
colors(3)=INK_RED OR PAPER_WHITE
colors(4)=INK_BLUE OR PAPER_MAGENTA
colors(5)=INK_GREEN OR PAPER_WHITE
colors(6)=INK_YELLOW
colors(7)=INK_WHITE OR PAPER_BLUE
colors(8)=INK_YELLOW OR PAPER_CYAN
Set_ScreenColoursXY(3,9,10,6)
stg$="Very Colourful Text!"
Write_ScreenCharsXY(3,5,6,VARPTR(stg$),LEN(stg$))
Read_ScreenCharsXY(3,10,6,mem_Default,10)
Write_ScreenCharsXY(3,5,10,mem_Default,10)
Get_ScreenColoursXY(3,9,10,6)
Set_ScreenColoursXY(3,9,5,10)
Set_ScreenColoursXY(3,9,45,10)
SLEEP(2500)
stg$="Type Something: "
Write_ScreenCharsXY(3,0,12,VARPTR(stg$),LEN(stg$))
Set_CursorPosition(3,18,12)
Set_TextColours(3,INK_RED OR PAPER_WHITE)
Flush_Input(1)
Get_Input(1)
stg$="You typed: "+LEFT$(stgbuf$,rtnval-2)
Write_ScreenCharsXY(3,0,14,VARPTR(stg$),LEN(stg$))
Read_ScreenRect(3,80,5,0,0,0,6,79,10)
Write_ScreenRect(3,80,5,0,0,0,17,79,21)
SLEEP(2500)
Clear_ScreenXY(3,0,0,INK_RED,scrInfo(9)*scrInfo(10),32)
Set_CursorPosition(3,0,0)
stg$="Command Line: "
Write_ScreenCharsXY(3,0,0,VARPTR(stg$),LEN(stg$))
arg$=GetCommandLine()
Write_ScreenCharsXY(3,20,0,VARPTR(arg$),LEN(arg$))
stg$="Parsed (Split-Up): "
Write_ScreenCharsXY(3,0,2,VARPTR(stg$),LEN(stg$))
Set_CursorPosition(3,0,4)
Parse_Arguments
Show_Arguments(3)
Get_Title(mem_Default,256)
stg$=VARPTR$(mem_Default)
Write_ScreenCharsXY(3,0,8,VARPTR(stg$),LEN(stg$))
Get_MouseButtons
stg$="Total Mouse Buttons: "+STR$(numMB)
Write_ScreenCharsXY(3,0,10,VARPTR(stg$),LEN(stg$))
SLEEP(2500)
Clear_WholeScreen(3,65)
Colour_WholeScreen(3,INK_YELLOW OR PAPER_BLUE)
SLEEP(2500)
Clear_ScreenXY(3,0,0,INK_RED,scrInfo(9)*scrInfo(10),32)
Set_CursorPosition(3,0,0)
stg$="Move the Mouse and/or Press a Key -- Mouse to right edge=finish"
Write_ScreenCharsXY(3,0,10,VARPTR(stg$),LEN(stg$))
Flush_Input(1)
quit=0
DO
Get_NumberOfRecords(1)
counter=0
WHILE counter<rtnval
Get_Records(1,1)
CopyMemory VARPTR(FWord), mem_Default, 2
IF FWord=KEY_EVENT THEN
CopyMemory VARPTR(FByte), mem_Default+4, 1
IF FByte=0 THEN
stg$="Key is UP"
ELSE
stg$="Key is DOWN"
END IF
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FWord), mem_Default+8, 2
stg$="Repeat Count: "+STR$(FWord)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FWord), mem_Default+10, 2
stg$="Key Code: "+STR$(FWord)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FWord), mem_Default+12, 2
stg$="Scan Code: "+STR$(FWord)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FWord), mem_Default+14, 2
stg$="Uni/ASCII Code: "+STR$(FWord)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FWord), mem_Default+16, 2
stg$="Control Keys: "+STR$(FWord)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
ELSEIF FWord=MOUSE_EVENT THEN
CopyMemory VARPTR(FWord), mem_Default+4, 2
stg$="Mouse X (Character) Position: "+STR$(FWord)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
IF FWord>70 THEN quit=1
CopyMemory VARPTR(FWord), mem_Default+6, 2
stg$="Mouse Y (Character) Position: "+STR$(FWord)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FLong), mem_Default+8, 4
stg$="Button/s Pressed: "+STR$(FLong)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FLong), mem_Default+12, 4
stg$="Control-Key/s Pressed: "+STR$(FLong)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
CopyMemory VARPTR(FLong), mem_Default+16, 4
stg$="Mouse Event Flag: "+STR$(FLong)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
Write_NewLine(3)
ELSEIF FWord=WINDOW_BUFFER_SIZE_EVENT THEN
ELSEIF FWord=MENU_EVENT THEN
ELSEIF FWord=FOCUS_EVENT THEN
FOR slen=0 TO 14
CopyMemory VARPTR(FByte), mem_Default+slen, 1
stg$="Debug Byte: "+HEX$(FByte)+" "+STR$(FByte)
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Write_NewLine(3)
NEXT
Write_NewLine(3)
END IF
INC counter
WEND
LOOP UNTIL quit=1
Write_NewLine(3)
Write_NewLine(3)
stg$="Largest Possible Window: "
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
Get_LargestWindowSize(3)
SLEEP(2500)
char_info(0)=0
Scroll_Screen(3,0,0,19,19,10,15,10,15,29,34,1)
SLEEP(2500)
Clear_WholeScreen(3,32)
Colour_WholeScreen(3,INK_YELLOW OR PAPER_MAGENTA)
SLEEP(1500)
Clear_WholeScreen(3,32)
Colour_WholeScreen(3,INK_YELLOW OR PAPER_WHITE)
SLEEP(1500)
Clear_WholeScreen(3,32)
Colour_WholeScreen(3,INK_YELLOW OR PAPER_BLUE)
SLEEP(1500)
Clear_WholeScreen(3,32)
Colour_WholeScreen(3,INK_YELLOW OR PAPER_GREEN)
SLEEP(1500)
Clear_WholeScreen(3,32)
Colour_WholeScreen(3,INK_YELLOW OR PAPER_RED)
SLEEP(1500)
stg$="Type Something (6 characters): "
Write_ScreenCharsXY(3,0,12,VARPTR(stg$),LEN(stg$))
Set_CursorPosition(3,31,12)
Create_ConsoleHandle(CREATE_INPUT_HANDLE,GENERIC_READ OR GENERIC_WRITE,FILE_SHARE_READ OR FILE_SHARE_WRITE)
IF inout_Handle<>0 THEN
Flush_Input(1)
ReadFile(inout_Handle,mem_Default,6,VARPTR(rtnval),0)
stg$="You typed: "
Write_ScreenCharsXY(3,0,14,VARPTR(stg$),LEN(stg$))
Set_CursorPosition(3,11,14)
WriteFile(handle(3),mem_Default,6,VARPTR(rtnval),0)
Free_CreatedConsoleHandle()
END IF
SLEEP(2500)
Set_CursorPosition(3,0,0)
Get_InputCodePage()
Get_OutputCodePage()
Set_InputCodePage(850)
Set_OutputCodePage(850)
stg$="Ú Ä ¿ À Ù"
Write_ScreenChars(3,VARPTR(stg$),LEN(stg$))
SLEEP(2500)
Set_InputCodePage(input_CP)
Set_OutputCodePage(output_CP)
Set_ConsoleSize(3,largestX,largestY)
SLEEP(2500)
UnLock_DefaultMemory
Free_DefaultMemory
rtn=FreeConsole()
IF rtn<>0 THEN
ELSE
END IF
ELSE
END IF
ELSE
Application.Terminate
END IF
|
|