mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 13:19:27 +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
rtl/morphos
@ -915,9 +915,11 @@ begin
|
||||
|
||||
case (iMsg^.iClass) of
|
||||
IDCMP_CLOSEWINDOW: begin
|
||||
writeln('gotclosewindow!');
|
||||
GotCloseWindow;
|
||||
end;
|
||||
IDCMP_CHANGEWINDOW: begin
|
||||
GotResizeWindow;
|
||||
end;
|
||||
IDCMP_VANILLAKEY: begin
|
||||
writeln('vanilla keycode: ',iMsg^.code);
|
||||
KeyCode:=iMsg^.code;
|
||||
|
@ -27,6 +27,8 @@ uses
|
||||
Video units, and Free Vision }
|
||||
procedure GotCloseWindow;
|
||||
function HasCloseWindow: boolean;
|
||||
procedure GotResizeWindow;
|
||||
function HasResizeWindow(var winw:longint; var winh: longint): boolean;
|
||||
|
||||
var
|
||||
videoWindow : pWindow;
|
||||
@ -56,6 +58,7 @@ var
|
||||
oldcursorType: word;
|
||||
|
||||
gotCloseWindowMsg: boolean;
|
||||
gotResizeWindowMsg: boolean;
|
||||
|
||||
procedure SysInitVideo;
|
||||
var counter: longint;
|
||||
@ -76,11 +79,11 @@ begin
|
||||
WA_MaxHeight,32768,
|
||||
// WA_IDCMP,IDCMP_MOUSEBUTTONS Or IDCMP_RAWKEYS,
|
||||
WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY Or
|
||||
IDCMP_CLOSEWINDOW,
|
||||
IDCMP_CLOSEWINDOW Or IDCMP_CHANGEWINDOW,
|
||||
WA_Title,DWord(PChar('Free Pascal Video Output')),
|
||||
WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or
|
||||
WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET Or
|
||||
// WFLG_SIZEGADGET Or WFLG_SIZEBBOTTOM Or
|
||||
WFLG_SIZEGADGET Or WFLG_SIZEBBOTTOM Or
|
||||
WFLG_CLOSEGADGET)
|
||||
]);
|
||||
|
||||
@ -105,6 +108,7 @@ begin
|
||||
oldcursorType:=crHidden;
|
||||
|
||||
gotCloseWindowMsg:=false;
|
||||
gotResizeWindowMsg:=false;
|
||||
end;
|
||||
|
||||
|
||||
@ -121,29 +125,17 @@ function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
dx : integer;
|
||||
dy : integer;
|
||||
begin
|
||||
|
||||
{
|
||||
I:=SysVideoModeCount-1;
|
||||
SysSetVideoMode:=False;
|
||||
While (I>=0) and Not SysSetVideoMode do
|
||||
If (Mode.col=SysVMD[i].col) and
|
||||
(Mode.Row=SysVMD[i].Row) and
|
||||
(Mode.Color=SysVMD[i].Color) then
|
||||
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;
|
||||
}
|
||||
dx := (Mode.col * 8) - videoWindow^.GZZWidth;
|
||||
dy := (Mode.row * 16) - videoWindow^.GZZHeight;
|
||||
SizeWindow(videoWindow,dx,dy);
|
||||
|
||||
ScreenWidth:=Mode.col;
|
||||
ScreenHeight:=Mode.row;
|
||||
ScreenColor:=Mode.color;
|
||||
SysSetVideoMode:=true;
|
||||
end;
|
||||
|
||||
|
||||
@ -274,6 +266,19 @@ begin
|
||||
gotCloseWindowMsg:=false;
|
||||
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
|
||||
SysVideoDriver : TVideoDriver = (
|
||||
|
Loading…
Reference in New Issue
Block a user