So if anyone ever wants to avoid the Windows title bar and create a custom title bar with functions, here's a little demo I whipped up...
It's all SCREEN 0, but you could just as easily make one with a graphics screen.
To drag the window, simply place the mouse pointer on the title bar and hold the left mouse button down, just as you always do for any windows title bar.
The various buttons are clickable. The menu functions are just for show, except for quit.
Pete
It's all SCREEN 0, but you could just as easily make one with a graphics screen.
To drag the window, simply place the mouse pointer on the title bar and hold the left mouse button down, just as you always do for any windows title bar.
The various buttons are clickable. The menu functions are just for show, except for 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 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
DIM AS INTEGER setxy
WIDTH 50, 25
DO: LOOP UNTIL _SCREENEXISTS
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&
REDIM SHARED p1(8), p2(5)
p1(1) = 0 ' Background reg and snooze.
p1(2) = 1 ' Highlight background.
p1(3) = 3 ' Open menu shadow.
p1(4) = 4 ' Show collapsed entries background.
p1(5) = 5 ' Tabs background.
p1(6) = 6 ' Strip between tabs and title bar.
p1(7) = 7 ' Open menu background.
p1(8) = 14 ' Highlight foreground text.
p2(1) = 0 ' Strip between tabs and title bar.
p2(2) = 8 ' Background all pages.
p2(3) = 56 ' Background snooze.
p2(4) = 62 ' Highlight Background.
p2(5) = 63 ' Tabs background.
rt.mrgn = 2: lt.mrgn = 3: tp.mrgn = 4: bt.mrgn = 2
IF lt.mrgn = 0 THEN lt.mrgn = 1 ' Default.
IF tp.mrgn = 0 THEN tp.mrgn = 1 ' Default.
LOCATE 1, 1
PALETTE 5, 63
PALETTE 6, 8
PALETTE 9, 7
PALETTE 7, 7
CALL sam_titlebar
COLOR 15, 6
VIEW PRINT 2 TO _HEIGHT
CLS 2
VIEW PRINT
fw = _FONTWIDTH
fh = _FONTHEIGHT
x = _SCREENX: y = _SCREENY
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
mx = _MOUSEX
my = _MOUSEY
' Check pseudo-title bar.
IF my = 1 THEN
' ID by screen character.
IF mx <> tmp% THEN
SELECT CASE CHR$(SCREEN(my, mx))
CASE "X", "þ", "Ä"
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
tmp$ = SPACE$(3): MID$(tmp$, 2, 1) = CHR$(SCREEN(my, mx))
IF MID$(tmp$, 2, 1) = "X" THEN: COLOR 15, 12 ELSE COLOR 15, 7
tmp% = mx: LOCATE my, mx - 1: PRINT tmp$;
CASE "ð", "M", "e", "n", "u" ' Menu.
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
' Exception.
tmp$ = SPACE$(3): MID$(tmp$, 2, 1) = "ð"
tmp% = 2: COLOR 15, 7: LOCATE my, 1: PRINT tmp$;
CASE ELSE
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
tmp% = 0
END SELECT
END IF
ELSE
IF tmp% THEN CALL sam_titlebar: tmp% = 0
END IF
IF GetAsyncKeyState(1) < 0 THEN
IF lb = 0 THEN lb = 1
ELSE
IF lb THEN lb = 0: dragx = 0: dragy = 0
END IF
z& = GetCursorPos(WinMse)
IF lb THEN
IF tmp% THEN
COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;: tmp% = 0
DO: LOOP UNTIL GetAsyncKeyState(1) = 0: lb = 0
_DELAY .1
SELECT CASE MID$(tmp$, 2, 1)
CASE "X"
SYSTEM
CASE "þ"
IF _FULLSCREEN THEN
_FULLSCREEN OFF
ELSE
_FULLSCREEN
END IF
CASE "Ä"
x& = ShowWindow&(hwnd&, 2)
DO: _LIMIT 1: LOOP UNTIL _SCREENICON = 0
CALL sam_titlebar
CASE "ð"
CALL sam_menu
END SELECT
tmp$ = ""
ELSEIF dragx THEN
IF WinMse.X_Pos <> oldxpos OR WinMse.Y_Pos <> oldypos THEN
j1 = (WinMse.X_Pos - oldxpos)
j2 = (WinMse.Y_Pos - oldypos)
x = x + j1: y = y + j2
_SCREENMOVE x, y
setxy = SetCursorPos(x + dragx, y + dragy)
END IF
z& = GetCursorPos(WinMse)
ELSEIF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + fh THEN
x = _SCREENX: y = _SCREENY
dragx = (WinMse.X_Pos - x)
dragy = fw \ 2 ' Set to middle of the title bar vertical height.
END IF
END IF
IF LEN(INKEY$) THEN SYSTEM
oldypos = WinMse.Y_Pos: oldxpos = WinMse.X_Pos
oldmx = mx: oldmy = my
LOOP
END
SUB sam_titlebar
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";
END SUB
SUB sam_menu ' Self-contained subroutine.
y = CSRLIN: x = POS(0)
LOCATE , , 0 ' Hide cursor
clipinsert.var = 0
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 = my
CASE 0
menu.var = -1 ' Menu open.
PCOPY 0, 1
PALETTE p1(7), p2(5)
PALETTE p1(3), p2(3)
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
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
END SUBPete
