Слова для скрытия управляющих кнопок и границ окна, полноэкраннный режим.
Код:
QUAN ActiveLibrary
: FUNCTION \ ( str -- ) ( "name" --> ) \ Получить адрес функции с именем, индетифицируемом строкой str из текущей загруженной библиотеки; создать слово "name", возвращающее адрес этой функции. name ( -- addr )
ActiveLibrary SWAP GETPROCADDRESS VALUE
;
" User32.dll" LOADLIBRARY CONSTANT User32.dll
User32.dll TO ActiveLibrary
" SetWindowLongA" FUNCTION SetWindowLongA@
" SetWindowPos" FUNCTION SetWindowPos@
" GetDesktopWindow" FUNCTION GetDesktopWindow@
" GetWindowRect" FUNCTION GetWindowRect@
VARIABLE QWinStyle
: QW-UPDATE-STYLE
hwnd @ 0 0 0 0 0 0x0027 7 SetWindowPos@ API DROP
;
: QWBHide \ ( -- )
hwnd @ -16 0x94000800 SetWindowLongA@ API3 QWinStyle ! ;
: QWBShow \ ( -- )
hwnd @ -16 QWinStyle @ SetWindowLongA@ API3 DROP ;
: QWB-HIDE \ ( -- )
QWBHide QW-UPDATE-STYLE ;
: QWB-SHOW \ ( -- )
QWBShow QW-UPDATE-STYLE
;
4 CELLS ARRAY NotFScrRect
4 CELLS ARRAY FScrRect
QUAN 'FULLSCREEN-OFF
VECT <FULLSCREEN>
: FULLSCREEN-ON \ ( -- )
hwnd @ NotFScrRect GetWindowRect@ API2 DROP
GetDesktopWindow@ API0 FScrRect GetWindowRect@ API2 DROP
QWBHide
hwnd @ -1
FScrRect @ FScrRect 1 -TH @ \ x y
FScrRect 2 -TH @ FScrRect 3 -TH @ \ w h
CR
0x0060
7 SetWindowPos@ API DROP
'FULLSCREEN-OFF TO <FULLSCREEN>
;
' FULLSCREEN-ON TO <FULLSCREEN>
: FULLSCREEN-OFF \ ( -- )
QWBShow
hwnd @ -2
NotFScrRect @ NotFScrRect 1 -TH @ \ x y
NotFScrRect 2 -TH @ NotFScrRect 3 -TH @ \ w h
CR
0x0060
7 SetWindowPos@ API DROP
USE FULLSCREEN-ON TO <FULLSCREEN>
; ' FULLSCREEN-OFF TO 'FULLSCREEN-OFF
' <FULLSCREEN> TO K_F12
Слова для скрытия управляющих кнопок и границ окна, полноэкраннный режим.
[code]QUAN ActiveLibrary
: FUNCTION \ ( str -- ) ( "name" --> ) \ Получить адрес функции с именем, индетифицируемом строкой str из текущей загруженной библиотеки; создать слово "name", возвращающее адрес этой функции. name ( -- addr )
ActiveLibrary SWAP GETPROCADDRESS VALUE
;
" User32.dll" LOADLIBRARY CONSTANT User32.dll
User32.dll TO ActiveLibrary
" SetWindowLongA" FUNCTION SetWindowLongA@
" SetWindowPos" FUNCTION SetWindowPos@
" GetDesktopWindow" FUNCTION GetDesktopWindow@
" GetWindowRect" FUNCTION GetWindowRect@
VARIABLE QWinStyle
: QW-UPDATE-STYLE
hwnd @ 0 0 0 0 0 0x0027 7 SetWindowPos@ API DROP
;
: QWBHide \ ( -- )
hwnd @ -16 0x94000800 SetWindowLongA@ API3 QWinStyle ! ;
: QWBShow \ ( -- )
hwnd @ -16 QWinStyle @ SetWindowLongA@ API3 DROP ;
: QWB-HIDE \ ( -- )
QWBHide QW-UPDATE-STYLE ;
: QWB-SHOW \ ( -- )
QWBShow QW-UPDATE-STYLE
;
4 CELLS ARRAY NotFScrRect
4 CELLS ARRAY FScrRect
QUAN 'FULLSCREEN-OFF
VECT <FULLSCREEN>
: FULLSCREEN-ON \ ( -- )
hwnd @ NotFScrRect GetWindowRect@ API2 DROP
GetDesktopWindow@ API0 FScrRect GetWindowRect@ API2 DROP
QWBHide
hwnd @ -1
FScrRect @ FScrRect 1 -TH @ \ x y
FScrRect 2 -TH @ FScrRect 3 -TH @ \ w h
CR
0x0060
7 SetWindowPos@ API DROP
'FULLSCREEN-OFF TO <FULLSCREEN>
;
' FULLSCREEN-ON TO <FULLSCREEN>
: FULLSCREEN-OFF \ ( -- )
QWBShow
hwnd @ -2
NotFScrRect @ NotFScrRect 1 -TH @ \ x y
NotFScrRect 2 -TH @ NotFScrRect 3 -TH @ \ w h
CR
0x0060
7 SetWindowPos@ API DROP
USE FULLSCREEN-ON TO <FULLSCREEN>
; ' FULLSCREEN-OFF TO 'FULLSCREEN-OFF
' <FULLSCREEN> TO K_F12[/code]