File "DosPrint+.inc"

Path: /DosPrint+/DosPrint+.inc
File size: 2.13 KB
MIME-type:
Charset: utf-8

'--------------------------------------------------------------------------------
' This is "DosPrint+.inc"
' It allows to print formatted output to Windows console (CMD).
' Formats supported:
'   [fc,bc] set foreground and background colors (fc/bc are the 0-15 DOS colors)
'--------------------------------------------------------------------------------
' In order to work, the produced .exe needs to have its byte #221 changed to
' CHR$(3), in order to enable console mode. See http://mougino.free.fr/code/
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
#INCLUDE ONCE "Win32Api.inc"
#INCLUDE ONCE "WinBase.inc"
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION DosPrint(BYVAL sText AS STRING) AS LONG
    STATIC iTxtDone  AS LONG
    STATIC noConsole AS LONG
    STATIC hCon      AS DWORD
    LOCAL  e, sChar  AS STRING
    LOCAL  i, j      AS LONG
    LOCAL  fc, bc    AS WORD

    IF hCon = 0 THEN hCon = GetStdHandle(BYVAL %STD_OUTPUT_HANDLE)

    IF hCon = %INVALID_HANDLE_VALUE THEN
        noConsole = %TRUE
        CALL FreeConsole()
        IF AllocConsole() THEN hCon = GetStdHandle(BYVAL %STD_OUTPUT_HANDLE)

    ELSE
        noConsole = %FALSE
        sText += $CRLF
        FOR i = 1 TO LEN(sText)

            sChar = MID$(sText, i, 1)

            IF sChar = "[" THEN
                INCR i
                j = INSTR(i, sText, "]")
                e = MID$(sText, i, j-i)
                IF INSTR(e,",") > 0 THEN
                    fc = VAL(PARSE$(e,",",1))
                    bc = VAL(PARSE$(e,",",2)) : SHIFT LEFT bc, 4
                    CALL SetConsoleTextAttribute(hCon, fc+bc)
                END IF
                i += LEN(e)
                IF e <> "" THEN ITERATE FOR
            END IF

            CALL WriteConsole(hCon, BYCOPY sChar, LEN(sChar), iTxtDone, BYVAL 0)
        NEXT
    END IF

    FUNCTION = noConsole
END FUNCTION
'--------------------------------------------------------------------------------