Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 308
» Latest member: Donaldvem
» Forum threads: 1,741
» Forum posts: 17,901

Full Statistics

Latest Threads
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155

 
  Custom Popup Window for Windows OS
Posted by: Pete - 12-01-2022, 11:02 AM - Forum: Works in Progress - No Replies

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_titlebar
    PALETTE 5, 63 ' Bright white.
    PALETTE 6, 8 ' Dark blue.
    LOCATE 1, 1
    COLOR 0, 5
    PRINT SPACE$(_WIDTH);
    LOCATE 1, 2: PRINT CHR$(240);
    LOCATE , 4: PRINT "Menu";
    msg$ = "Sam-Clip"
    LOCATE , _WIDTH / 2 - LEN(msg$) / 2 + 1: PRINT msg$;
    LOCATE , _WIDTH - 7: PRINT "Ä  þ  X";
    COLOR 15, 6
    VIEW PRINT 2 TO _HEIGHT
    CLS 2
    VIEW PRINT
END SUB

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 borderless_variables (WinCon AS Win_Control)
    WinCon.x = _SCREENX
    WinCon.y = _SCREENY
    WinCon.w = _WIDTH
    WinCon.h = _HEIGHT
    WinCon.fw = _FONTWIDTH
    WinCon.fh = _FONTHEIGHT
    WinCon.wintp = _SCREENY \ WinCon.fh: WinCon.winbt = _SCREENY \ WinCon.fh + _HEIGHT: WinCon.winlt = _SCREENX \ WinCon.fw: WinCon.winrt = _SCREENX \ WinCon.fw + _WIDTH
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

Pete

Print this item

  The QB64 IDE shell
Posted by: eoredson - 12-01-2022, 05:04 AM - Forum: Utilities - Replies (9)

Find attached the QB64 shell program.

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

Filters:  FIND      MORE      SORT      TYPE

Filename commands:
  COMPFILE COPY    DELETE    DIR      MKFILE    RENAME
  ENCRYPT  DECRYPT  GETATTR  SETATTR  LISTFILE  TOUCH

Directory commands: COMPDIR  LISTDIR  PUSHD    POPD
  TREE    TREEDEL  TOUCHDIR  CHDIR    MKDIR    RMDIR

Volume commands:
  DRIVES  LABEL    VOL      LISTDRIVE

The version history is:
Code: (Select All)
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-


[Image: qbshell.png]


[Image: qbshell2.png]

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.

-end-



Attached Files
.zip   QBSHELLI.ZIP (Size: 330.48 KB / Downloads: 9)
Print this item

  tweak Str$ for single and double
Posted by: Jack - 12-01-2022, 02:09 AM - Forum: General Discussion - Replies (9)

I think that this is worth looking into

Code: (Select All)
Dim As Single x
For x = 1 To .05 Step -.05
    Print x
Next x

output
Code: (Select All)
1
.95
.9
.85
.8
.7499999
.6999999
.6499999
.5999999
.5499999
.4999999
.4499999
.3999999
.3499998
.2999998
.2499998
.1999998
.1499998
9.999985E-02

if you change the format string in the function qbs *qbs_str(float value) in libqb.cpp from "% .6E" to "% .6G" you get

Code: (Select All)
1
0.95
0.9
0.85
0.8
0.75
0.7
0.65
0.6
0.55
0.5
0.45
0.4
0.35
0.3
0.25
0.2
0.15
0.0999998
similarly results for the function qbs *qbs_str(double value), changing the "E" to "G"

before change

Code: (Select All)
1
.95
.9
.85
.7999999999999998
.7499999999999998
.6999999999999997
.6499999999999997
.5999999999999996
.5499999999999996
.4999999999999996
.4499999999999996
.3999999999999996
.3499999999999996
.2999999999999997
.2499999999999997
.1999999999999997
.1499999999999997
.0999999999999997

after changing "E" to "G"
the change to G messes up if the exponent goes above 99 so more work is needed to make it work for the full range

Code: (Select All)
1
0.95
0.9
0.85
0.8
0.75
0.7
0.65
0.6
0.55
0.5
0.45
0.4
0.35
0.3
0.25
0.2
0.15
0.1

Print this item

  Compiler setting for accurate math?
Posted by: James D Jarvis - 11-30-2022, 07:49 PM - Forum: Help Me! - Replies (12)

Why does this happen?   

[Image: image.png]

when this is the code?

Code: (Select All)
Dim x
For x = 1 To .05 Step -.05
    Print x
    _Delay x
Next x


Is there a complier setting to keep this from happening?

Print this item

  Simple GUI example
Posted by: James D Jarvis - 11-30-2022, 07:20 PM - Forum: Programs - Replies (3)

all the cool kids are doing it so why not?

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

tempb.bxx = 9: tempb.byy = 1: tempb.bwid = 8: tempb.style = "MENU"
tempb.txt = "MENU2": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 9: tempb.byy = 2: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Hello": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 9: tempb.byy = 3: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Name?": tempb.tklr = 15: tempb.bklr = 5: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
Dim Shared username$
username$ = ""


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

Print this item

  IsNum
Posted by: SMcNeill - 11-30-2022, 04:00 PM - Forum: Utilities - Replies (4)

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.  Wink

Print this item

  Amazing Grace to test out Web Audio API
Posted by: CharlieJV - 11-30-2022, 03:09 AM - Forum: QBJS, BAM, and Other BASICs - No Replies

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.

Print this item

  Borderless window? RESIZE THIS!
Posted by: Pete - 11-29-2022, 11:46 PM - Forum: General Discussion - No Replies

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.

Pete

Print this item

  3d, maptriangle, fps...ect
Posted by: MasterGy - 11-29-2022, 06:55 PM - Forum: MasterGy - Replies (3)

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!


download:
https://drive.google.com/file/d/1yWJ4S9h...sp=sharing


[Image: v25-01-2022-11-29-19-49-47-24.jpg]

[Image: v25-01-2022-11-29-19-50-06-69.jpg]

[Image: v25-01-2022-11-29-19-50-54-33.jpg]

Print this item

  Wiki Code Error on _PRINTIMAGE
Posted by: NasaCow - 11-29-2022, 01:44 PM - Forum: Wiki Discussion - Replies (5)

FYI

_printimage first code set throws a syntax error on line 24
_PRINTIMAGE - QB64 Phoenix Edition Wiki

[Image: image.png]

Changed the offending line from:
_PUTIMAGE Page&, Prev&

To:
_PUTIMAGE (0, 0), Page&, Prev&

And all good!

Print this item