Back2BASIC

You are here: Home > Issues > Issue #3 > B2B Code Show

B2B Code Show

This issue we have code for QB64 written by Pete.

 

DIM SHARED winmode AS STRING * 1: winmode = "D": REM DEFAULT
CLS
TITLE$ = "QB64 WINDOW SIZE DEMO"
LOCATE 9, 41 - LEN(TITLE$) \ 2: PRINT TITLE$
TITLE$ = "PRESS [D] TO RETURN TO DEFAUL WINDOW AT ANYTIME"
LOCATE 11, 41 - LEN(TITLE$) \ 2: PRINT TITLE$
LOCATE 25, 1
PRINT " [F] Full Screen  [X] Stretch  [1-9] Size  [Ctrl +-] Enlarge/Shrink  [Esc] End";
DO
    CtrlEnl% = INP(96): REM CASE 12 and 13 are the Right and Legt Ctrl Keys.
    SELECT CASE CtrlEnl%
        CASE 12: CtrlEnl% = -1: CALL WINDOWSCREEN(CtrlEnl%)
        CASE 13: CtrlEnl% = 1: CALL WINDOWSCREEN(CtrlEnl%)
    END SELECT
    mykey$ = INKEY$
    IF mykey$ = CHR$(27) THEN SYSTEM
    REM Limit the key choices.
    IF INSTR("FfDdXx123456789", mykey$) <> 0 AND LEN(mykey$) = 1 THEN
        CtrlEnl% = 0
        winmode = mykey$
        CALL WINDOWSCREEN(CtrlEnl%)
    END IF
    _LIMIT 30
LOOP
SUB WINDOWSCREEN(CtrlEnl%)
row% = CSRLIN: column% = POS(1)
IF CtrlEnl% <> 0 THEN
    DEF SEG = 0
    IF PEEK(1047) MOD 16 <> 4 THEN DEF SEG: EXIT SUB
    DEF SEG
    full = _FULLSCREEN
    IF full = 0 THEN
        IF VAL(winmode) = 0 then winmode = "1"
        SELECT CASE CtrlEnl%
            CASE -1: IF VAL(winmode) > 1 THEN winmode = LTRIM$(STR$(VAL(winmode) - 1)): ELSE winmode = "1"
            CASE 1: IF VAL(winmode) < 9 THEN winmode = LTRIM$(STR$(VAL(winmode) + 1))
        END SELECT
    ELSE
        winmode = "1"
    END IF
END IF
IF VAL(winmode) <> 0 THEN
    fontsize% = VAL(winmode) + 15: REM 16pt Default.
END IF
SELECT CASE UCASE$(winmode)
    CASE "D"
        title$ = "Default Window"
        full = _FULLSCREEN
        IF full <> 0 THEN _FULLSCREEN _OFF
        GOSUB ChangeFont
        LOCATE 16, 1 : PRINT SPACE$(80);: LOCATE 16, 41 - LEN(title$) \ 2: PRINT title$;
    CASE "F"
        title$ = "Full Screen"
        GOSUB ChangeFont
        _FULLSCREEN _SQUAREPIXELS
        full = _FULLSCREEN
        IF full = 0 THEN GOSUB nofull
        LOCATE 16, 1 : PRINT SPACE$(80);: LOCATE 16, 41 - LEN(title$) \ 2: PRINT title$;
    CASE "X"
        title$ = "Full Screen Stretched"
        GOSUB ChangeFont
        _FULLSCREEN _STRETCH
        full = _FULLSCREEN
        IF full = 0 THEN GOSUB nofull
        LOCATE 16, 1 : PRINT SPACE$(80);: LOCATE 16, 41 - LEN(title$) \ 2: PRINT title$;
    CASE ELSE
        title$ = "Window size Selected: " + winmode + " Font Size: " + LTRIM$(STR$(fontsize%))
        full = _FULLSCREEN
        IF full <> 0 THEN _FULLSCREEN _OFF
        style$ = "MONOSPACE"
        IF fontsize% < 19 THEN style$ = style$ + ", BOLD"
        fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
        GOSUB ChangeFont
        LOCATE 16, 1 : PRINT SPACE$(80);: LOCATE 16, 41 - LEN(title$) \ 2: PRINT title$;
END SELECT
LOCATE row%, column%
_DELAY .33
EXIT SUB
nofull:
_FULLSCREEN _OFF
RETURN
ChangeFont:
IF VAL(winmode) = 0 THEN
    _FONT 16 'select inbuilt 8x16 default font
    currentf& = _FONT
ELSE
    currentf& = _LOADFONT(fontpath$, fontsize%, style$)
    _FONT currentf&
END IF
IF currentf& <> f& AND f& <> defaultf& THEN _FREEFONT f&
f& = currentf&
RETURN
END SUB

 

| top |