mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 16:39:16 +02:00
+ support for changing window size in keyboard and video units
* still has bugs, but good for a start git-svn-id: trunk@11997 -
This commit is contained in:
parent
600da72d75
commit
4a5a3e3118
@ -915,9 +915,11 @@ begin
|
|||||||
|
|
||||||
case (iMsg^.iClass) of
|
case (iMsg^.iClass) of
|
||||||
IDCMP_CLOSEWINDOW: begin
|
IDCMP_CLOSEWINDOW: begin
|
||||||
writeln('gotclosewindow!');
|
|
||||||
GotCloseWindow;
|
GotCloseWindow;
|
||||||
end;
|
end;
|
||||||
|
IDCMP_CHANGEWINDOW: begin
|
||||||
|
GotResizeWindow;
|
||||||
|
end;
|
||||||
IDCMP_VANILLAKEY: begin
|
IDCMP_VANILLAKEY: begin
|
||||||
writeln('vanilla keycode: ',iMsg^.code);
|
writeln('vanilla keycode: ',iMsg^.code);
|
||||||
KeyCode:=iMsg^.code;
|
KeyCode:=iMsg^.code;
|
||||||
|
@ -27,6 +27,8 @@ uses
|
|||||||
Video units, and Free Vision }
|
Video units, and Free Vision }
|
||||||
procedure GotCloseWindow;
|
procedure GotCloseWindow;
|
||||||
function HasCloseWindow: boolean;
|
function HasCloseWindow: boolean;
|
||||||
|
procedure GotResizeWindow;
|
||||||
|
function HasResizeWindow(var winw:longint; var winh: longint): boolean;
|
||||||
|
|
||||||
var
|
var
|
||||||
videoWindow : pWindow;
|
videoWindow : pWindow;
|
||||||
@ -56,6 +58,7 @@ var
|
|||||||
oldcursorType: word;
|
oldcursorType: word;
|
||||||
|
|
||||||
gotCloseWindowMsg: boolean;
|
gotCloseWindowMsg: boolean;
|
||||||
|
gotResizeWindowMsg: boolean;
|
||||||
|
|
||||||
procedure SysInitVideo;
|
procedure SysInitVideo;
|
||||||
var counter: longint;
|
var counter: longint;
|
||||||
@ -76,11 +79,11 @@ begin
|
|||||||
WA_MaxHeight,32768,
|
WA_MaxHeight,32768,
|
||||||
// WA_IDCMP,IDCMP_MOUSEBUTTONS Or IDCMP_RAWKEYS,
|
// WA_IDCMP,IDCMP_MOUSEBUTTONS Or IDCMP_RAWKEYS,
|
||||||
WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY Or
|
WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY Or
|
||||||
IDCMP_CLOSEWINDOW,
|
IDCMP_CLOSEWINDOW Or IDCMP_CHANGEWINDOW,
|
||||||
WA_Title,DWord(PChar('Free Pascal Video Output')),
|
WA_Title,DWord(PChar('Free Pascal Video Output')),
|
||||||
WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or
|
WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or
|
||||||
WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET Or
|
WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET Or
|
||||||
// WFLG_SIZEGADGET Or WFLG_SIZEBBOTTOM Or
|
WFLG_SIZEGADGET Or WFLG_SIZEBBOTTOM Or
|
||||||
WFLG_CLOSEGADGET)
|
WFLG_CLOSEGADGET)
|
||||||
]);
|
]);
|
||||||
|
|
||||||
@ -105,6 +108,7 @@ begin
|
|||||||
oldcursorType:=crHidden;
|
oldcursorType:=crHidden;
|
||||||
|
|
||||||
gotCloseWindowMsg:=false;
|
gotCloseWindowMsg:=false;
|
||||||
|
gotResizeWindowMsg:=false;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -121,29 +125,17 @@ function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
|
|||||||
|
|
||||||
var
|
var
|
||||||
I : Integer;
|
I : Integer;
|
||||||
|
dx : integer;
|
||||||
|
dy : integer;
|
||||||
begin
|
begin
|
||||||
|
dx := (Mode.col * 8) - videoWindow^.GZZWidth;
|
||||||
{
|
dy := (Mode.row * 16) - videoWindow^.GZZHeight;
|
||||||
I:=SysVideoModeCount-1;
|
SizeWindow(videoWindow,dx,dy);
|
||||||
SysSetVideoMode:=False;
|
|
||||||
While (I>=0) and Not SysSetVideoMode do
|
ScreenWidth:=Mode.col;
|
||||||
If (Mode.col=SysVMD[i].col) and
|
ScreenHeight:=Mode.row;
|
||||||
(Mode.Row=SysVMD[i].Row) and
|
ScreenColor:=Mode.color;
|
||||||
(Mode.Color=SysVMD[i].Color) then
|
SysSetVideoMode:=true;
|
||||||
SysSetVideoMode:=True
|
|
||||||
else
|
|
||||||
Dec(I);
|
|
||||||
If SysSetVideoMode then
|
|
||||||
begin
|
|
||||||
if SysVideoModeSelector(Mode) then
|
|
||||||
begin
|
|
||||||
ScreenWidth:=SysVMD[I].Col;
|
|
||||||
ScreenHeight:=SysVMD[I].Row;
|
|
||||||
ScreenColor:=SysVMD[I].Color;
|
|
||||||
end else SysSetVideoMode := false;
|
|
||||||
end;
|
|
||||||
}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -274,6 +266,19 @@ begin
|
|||||||
gotCloseWindowMsg:=false;
|
gotCloseWindowMsg:=false;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure GotResizeWindow;
|
||||||
|
begin
|
||||||
|
gotResizeWindowMsg:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function HasResizeWindow(var winw:longint; var winh: longint): boolean;
|
||||||
|
begin
|
||||||
|
HasResizeWindow:=gotResizeWindowMsg;
|
||||||
|
winw:=videoWindow^.GZZWidth div 8;
|
||||||
|
winh:=videoWindow^.GZZHeight div 16;
|
||||||
|
gotResizeWindowMsg:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
const
|
const
|
||||||
SysVideoDriver : TVideoDriver = (
|
SysVideoDriver : TVideoDriver = (
|
||||||
|
Loading…
Reference in New Issue
Block a user