+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://staging.qb64phoenix.com/forumdisplay.php?fid=9)
+---- Thread: Custom Popup Window for Windows OS (/showthread.php?tid=1212)
Custom Popup Window for Windows OS - Pete - 12-01-2022
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 SUBPete