paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-25 20:57:17 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fix various graphic problems

Browse Source
This commit is contained in:
pierre 2002-05-21 12:21:53 +00:00
parent 50edd7e912
commit 07436e5261
4 changed files with 284 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
fv/drivers.pas
View File

@ -77,8 +77,11 @@ USES
{$ENDIF} {$ENDIF}
video, video,
{$ifdef HasSysMsgUnit}
SysMsg,
{$endif HasSysMsgUnit}
{$IFDEF GRAPH_API} { GRAPH CODE } {$IFDEF GRAPH_API} { GRAPH CODE }
Graph, { Standard unit } Graph, { Standard unit }
{$ENDIF} {$ENDIF}
GFVGraph, { GFV graphics unit } GFVGraph, { GFV graphics unit }
FVCommon, Objects; { GFV standard units } FVCommon, Objects; { GFV standard units }
@ -410,6 +413,15 @@ and the button and double click variables are set appropriately.
---------------------------------------------------------------------} ---------------------------------------------------------------------}
PROCEDURE GetMouseEvent (Var Event: TEvent); PROCEDURE GetMouseEvent (Var Event: TEvent);
{$ifdef HasSysMsgUnit}
{-GetSystemEvent------------------------------------------------------
Checks whether a system event is available. If a system event has occurred,
Event.What is set to evCommand appropriately
10Oct2000 PM
---------------------------------------------------------------------}
procedure GetSystemEvent (Var Event: TEvent);
{$endif HasSysMsgUnit}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ EVENT HANDLER CONTROL ROUTINES } { EVENT HANDLER CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -573,11 +585,11 @@ VAR
MouseButtons: Byte; { Mouse button state } MouseButtons: Byte; { Mouse button state }
ScreenWidth : Byte; { Screen text width } ScreenWidth : Byte; { Screen text width }
ScreenHeight: Byte; { Screen text height } ScreenHeight: Byte; { Screen text height }
{$ifdef GRAPH_API} {$IFNDEF Use_Video_API}
ScreenMode : Sw_Word; { Screen mode } ScreenMode : Sw_Word; { Screen mode }
{$else not GRAPH_API} {$Else Use_Video_API}
ScreenMode : TVideoMode; { Screen mode } ScreenMode : TVideoMode; { Screen mode }
{$endif GRAPH_API} {$Endif Use_Video_API}
MouseWhere : TPoint; { Mouse position } MouseWhere : TPoint; { Mouse position }
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
@ -585,6 +597,7 @@ VAR
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{ API Units } { API Units }
USES USES
FVConsts,
Keyboard,Mouse; Keyboard,Mouse;
{***************************************************************************} {***************************************************************************}
@ -1136,14 +1149,12 @@ begin
MouseActionDown : MouseActionDown :
begin begin
Event.What:=evMouseDown; Event.What:=evMouseDown;
if (DownButtons=e.Buttons) and if (DownButtons=e.Buttons) and (LastWhere.X=MouseWhere.X) and (LastWhere.Y=MouseWhere.Y) and
(LastWhere.X=MouseWhere.X) and
(LastWhere.Y=MouseWhere.Y) and
(GetDosTicks-DownTicks<=DoubleDelay) then (GetDosTicks-DownTicks<=DoubleDelay) then
Event.Double:=true; Event.Double:=true;
DownButtons:=e.Buttons; DownButtons:=e.Buttons;
DownWhere.X:=MouseWhere.X; DownWhere.X:=MouseWhere.x;
DownWhere.Y:=MouseWhere.Y; DownWhere.Y:=MouseWhere.y;
DownTicks:=GetDosTicks; DownTicks:=GetDosTicks;
AutoTicks:=GetDosTicks; AutoTicks:=GetDosTicks;
if AutoTicks=0 then if AutoTicks=0 then
@ -1152,13 +1163,14 @@ begin
end; end;
MouseActionUp : MouseActionUp :
begin begin
AutoTicks:=0;
Event.What:=evMouseUp; Event.What:=evMouseUp;
AutoTicks:=0; AutoTicks:=0;
end; end;
end; end;
Event.Buttons:=e.Buttons; Event.Buttons:=e.Buttons;
Event.Where.X:=MouseWhere.X; Event.Where.X:=MouseWhere.x;
Event.Where.Y:=MouseWhere.Y; Event.Where.Y:=MouseWhere.y;
LastButtons:=Event.Buttons; LastButtons:=Event.Buttons;
LastWhere.x:=Event.Where.x; LastWhere.x:=Event.Where.x;
LastWhere.y:=Event.Where.y; LastWhere.y:=Event.Where.y;
@ -1176,6 +1188,41 @@ begin
FillChar(Event,sizeof(TEvent),0); FillChar(Event,sizeof(TEvent),0);
end; end;
{$ifdef HasSysMsgUnit}
{---------------------------------------------------------------------------}
{ GetSystemEvent }
{---------------------------------------------------------------------------}
procedure GetSystemEvent (Var Event: TEvent);
var
SysEvent : TsystemEvent;
begin
if PollSystemEvent(SysEvent) then
case SysEvent.typ of
SysNothing :
Event.What:=evNothing;
SysSetFocus :
Event.What:=cmReceivedFocus;
SysReleaseFocus :
Event.What:=cmReleasedFocus;
SysClose :
begin
Event.What:=evCommand;
Event.Command:=cmQuitApp;
end;
SysResize :
begin
Event.What:=evCommand;
Event.Command:=cmResizeApp;
Event.Id:=SysEvent.x;
Event.InfoWord:=SysEvent.y;
end;
else
Event.What:=evNothing;
end;
end;
{$endif HasSysMsgUnit}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ EVENT HANDLER CONTROL ROUTINES } { EVENT HANDLER CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -1218,45 +1265,69 @@ END;
{ InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB } { InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB }
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE InitVideo; PROCEDURE InitVideo;
VAR {$ifdef Use_Video_API}I, J: Sw_Integer; VAR
{$else not Use_Video_API} {$ifdef GRAPH_API}
{$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF} I, J: Integer;
{$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF} Ts : TextSettingsType;
{$IFDEF OS_OS2} Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF} {$else not GRAPH_API}
{$ENDIF} I, J: Integer;
{$IFDEF OS_DOS}
Ts: TextSettingsType;
{$ENDIF}
{$IFDEF OS_WINDOWS}
Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric;
{$ENDIF}
{$IFDEF OS_OS2}
Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics;
{$ENDIF}
{$ENDIF}
BEGIN BEGIN
{$ifdef GRAPH_API} {$ifdef GRAPH_API}
if Not TextmodeGFV then
begin
I := Detect; { Detect video card } I := Detect; { Detect video card }
J := 0; { Zero select mode } J := 0; { Zero select mode }
InitGraph(I, J, ''); { Initialize graphics } InitGraph(I, J, ''); { Initialize graphics }
I := Graph.GetMaxX; { Fetch max x size } I := Graph.GetMaxX; { Fetch max x size }
J := Graph.GetMaxY; { Fetch max y size } J := Graph.GetMaxY; { Fetch max y size }
If (DefFontHeight = 0) Then { Font height not set } If (DefFontHeight = 0) Then { Font height not set }
J := (Graph.GetMaxY+1) DIV DefLineNum { Approx font height } J := (Graph.GetMaxY+1) DIV DefLineNum { Approx font height }
Else J := DefFontHeight; { Use set font height } Else J := DefFontHeight; { Use set font height }
I := J DIV (TextHeight('H')+4); { Approx magnification } I := J DIV (TextHeight('H')+4); { Approx magnification }
If (I < 1) Then I := 1; { Must be 1 or above } If (I < 1) Then I := 1; { Must be 1 or above }
GetTextSettings(Ts); { Get text style } GetTextSettings(Ts); { Get text style }
SetTextStyle(Ts.Font, Ts.Direction, I); { Set new font settings } SetTextStyle(Ts.Font, Ts.Direction, I); { Set new font settings }
SysFontWidth := TextWidth('H'); { Transfer font width } SysFontWidth := TextWidth('H'); { Transfer font width }
SysFontHeight := TextHeight('H')+4; { Transfer font height } SysFontHeight := TextHeight('H')+4; { Transfer font height }
ScreenWidth := (SysScreenWidth+1) DIV ScreenWidth := (SysScreenWidth+1) DIV
SysFontWidth; { Calc screen width } SysFontWidth; { Calc screen width }
ScreenHeight := (SysScreenHeight+1) DIV ScreenHeight := (SysScreenHeight+1) DIV
SysFontHeight; { Calc screen height } SysFontHeight; { Calc screen height }
{$else not GRAPH_API} {$ifdef USE_VIDEO_API}
Video.InitVideo; ScreenMode.color:=true;
ScreenWidth:=Video.ScreenWidth; ScreenMode.col:=ScreenWidth;
ScreenHeight:=Video.ScreenHeight; ScreenMode.row:=ScreenHeight;
SetViewPort(0,0,ScreenWidth,ScreenHeight,true,true); {$endif USE_VIDEO_API}
GetVideoMode(ScreenMode); end
I := ScreenWidth*8 -1; { Mouse width } else
J := ScreenHeight*8 -1; { Mouse height } {$endif GRAPH_API}
SysScreenWidth := I + 1; begin
SysScreenHeight := J + 1; Video.InitVideo;
SysFontWidth := 8; { Font width } ScreenWidth:=Video.ScreenWidth;
SysFontHeight := 8; { Font height } ScreenHeight:=Video.ScreenHeight;
{$endif not GRAPH_API} SetViewPort(0,0,ScreenWidth,ScreenHeight,true,true);
{$ifndef USE_VIDEO_API}
{ScreenMode : Sw_Word; } { Screen mode }
{$else not USE_VIDEO_API}
GetVideoMode(ScreenMode);
{$endif USE_VIDEO_API}
I := ScreenWidth*8 -1; { Mouse width }
J := ScreenHeight*8 -1; { Mouse height }
SysScreenWidth := I + 1;
SysScreenHeight := J + 1;
SysFontWidth := 8; { Font width }
SysFontHeight := 8; { Font height }
end;
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -1264,13 +1335,16 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE DoneVideo; PROCEDURE DoneVideo;
BEGIN BEGIN
{$ifdef GRAPH_API} {$ifdef GRAPH_API}
CloseGraph; if Not TextmodeGFV then
{$else not GRAPH_API} CloseGraph
{$ifdef USE_video_api} else
Video.DoneVideo; {$endif GRAPH_API}
{$endif USE_video_api} {$ifdef USE_video_api}
{$endif not GRAPH_API} Video.DoneVideo;
{$else not USE_video_api}
; { nothing to do }
{$endif not USE_video_api}
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -1278,9 +1352,16 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE ClearScreen; PROCEDURE ClearScreen;
BEGIN BEGIN
{$ifndef GRAPH_API} {$ifdef GRAPH_API}
if Not TextmodeGFV then
Graph.ClearDevice
else
{$endif GRAPH_API}
{$ifdef USE_video_api}
Video.ClearScreen; Video.ClearScreen;
{$endif GRAPH_API} {$else not USE_video_api}
; { nothing to do }
{$endif not USE_video_api}
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -1489,7 +1570,10 @@ BEGIN
END. END.
{ {
$Log$ $Log$
Revision 1.14 2002-05-16 20:21:50 pierre Revision 1.15 2002-05-21 12:21:53 pierre
* fix various graphic problems
Revision 1.14 2002/05/16 20:21:50 pierre
+ fix for bug report 1953 adapted from S Wiktor + fix for bug report 1953 adapted from S Wiktor
Revision 1.13 2001/10/02 16:35:50 pierre Revision 1.13 2001/10/02 16:35:50 pierre

6
fv/fvconsts.pas
View File

@ -182,6 +182,7 @@ const
cmNewVideo = 47; cmNewVideo = 47;
cmTransfer = 48; cmTransfer = 48;
cmResizeApp = 49; cmResizeApp = 49;
cmQuitApp = 57;
cmRecordHistory = 60; cmRecordHistory = 60;
cmGrabDefault = 61; cmGrabDefault = 61;
@ -625,7 +626,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 2002-05-21 12:00:49 pierre Revision 1.4 2002-05-21 12:21:53 pierre
* fix various graphic problems
Revision 1.3 2002/05/21 12:00:49 pierre
+ cmResizeApp added + cmResizeApp added
Revision 1.2 2001/08/05 02:03:13 peter Revision 1.2 2001/08/05 02:03:13 peter

190
fvision/drivers.pas
View File

@ -77,8 +77,11 @@ USES
{$ENDIF} {$ENDIF}
video, video,
{$ifdef HasSysMsgUnit}
SysMsg,
{$endif HasSysMsgUnit}
{$IFDEF GRAPH_API} { GRAPH CODE } {$IFDEF GRAPH_API} { GRAPH CODE }
Graph, { Standard unit } Graph, { Standard unit }
{$ENDIF} {$ENDIF}
GFVGraph, { GFV graphics unit } GFVGraph, { GFV graphics unit }
FVCommon, Objects; { GFV standard units } FVCommon, Objects; { GFV standard units }
@ -410,6 +413,15 @@ and the button and double click variables are set appropriately.
---------------------------------------------------------------------} ---------------------------------------------------------------------}
PROCEDURE GetMouseEvent (Var Event: TEvent); PROCEDURE GetMouseEvent (Var Event: TEvent);
{$ifdef HasSysMsgUnit}
{-GetSystemEvent------------------------------------------------------
Checks whether a system event is available. If a system event has occurred,
Event.What is set to evCommand appropriately
10Oct2000 PM
---------------------------------------------------------------------}
procedure GetSystemEvent (Var Event: TEvent);
{$endif HasSysMsgUnit}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ EVENT HANDLER CONTROL ROUTINES } { EVENT HANDLER CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -573,11 +585,11 @@ VAR
MouseButtons: Byte; { Mouse button state } MouseButtons: Byte; { Mouse button state }
ScreenWidth : Byte; { Screen text width } ScreenWidth : Byte; { Screen text width }
ScreenHeight: Byte; { Screen text height } ScreenHeight: Byte; { Screen text height }
{$ifdef GRAPH_API} {$IFNDEF Use_Video_API}
ScreenMode : Sw_Word; { Screen mode } ScreenMode : Sw_Word; { Screen mode }
{$else not GRAPH_API} {$Else Use_Video_API}
ScreenMode : TVideoMode; { Screen mode } ScreenMode : TVideoMode; { Screen mode }
{$endif GRAPH_API} {$Endif Use_Video_API}
MouseWhere : TPoint; { Mouse position } MouseWhere : TPoint; { Mouse position }
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
@ -585,6 +597,7 @@ VAR
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{ API Units } { API Units }
USES USES
FVConsts,
Keyboard,Mouse; Keyboard,Mouse;
{***************************************************************************} {***************************************************************************}
@ -1136,14 +1149,12 @@ begin
MouseActionDown : MouseActionDown :
begin begin
Event.What:=evMouseDown; Event.What:=evMouseDown;
if (DownButtons=e.Buttons) and if (DownButtons=e.Buttons) and (LastWhere.X=MouseWhere.X) and (LastWhere.Y=MouseWhere.Y) and
(LastWhere.X=MouseWhere.X) and
(LastWhere.Y=MouseWhere.Y) and
(GetDosTicks-DownTicks<=DoubleDelay) then (GetDosTicks-DownTicks<=DoubleDelay) then
Event.Double:=true; Event.Double:=true;
DownButtons:=e.Buttons; DownButtons:=e.Buttons;
DownWhere.X:=MouseWhere.X; DownWhere.X:=MouseWhere.x;
DownWhere.Y:=MouseWhere.Y; DownWhere.Y:=MouseWhere.y;
DownTicks:=GetDosTicks; DownTicks:=GetDosTicks;
AutoTicks:=GetDosTicks; AutoTicks:=GetDosTicks;
if AutoTicks=0 then if AutoTicks=0 then
@ -1152,13 +1163,14 @@ begin
end; end;
MouseActionUp : MouseActionUp :
begin begin
AutoTicks:=0;
Event.What:=evMouseUp; Event.What:=evMouseUp;
AutoTicks:=0; AutoTicks:=0;
end; end;
end; end;
Event.Buttons:=e.Buttons; Event.Buttons:=e.Buttons;
Event.Where.X:=MouseWhere.X; Event.Where.X:=MouseWhere.x;
Event.Where.Y:=MouseWhere.Y; Event.Where.Y:=MouseWhere.y;
LastButtons:=Event.Buttons; LastButtons:=Event.Buttons;
LastWhere.x:=Event.Where.x; LastWhere.x:=Event.Where.x;
LastWhere.y:=Event.Where.y; LastWhere.y:=Event.Where.y;
@ -1176,6 +1188,41 @@ begin
FillChar(Event,sizeof(TEvent),0); FillChar(Event,sizeof(TEvent),0);
end; end;
{$ifdef HasSysMsgUnit}
{---------------------------------------------------------------------------}
{ GetSystemEvent }
{---------------------------------------------------------------------------}
procedure GetSystemEvent (Var Event: TEvent);
var
SysEvent : TsystemEvent;
begin
if PollSystemEvent(SysEvent) then
case SysEvent.typ of
SysNothing :
Event.What:=evNothing;
SysSetFocus :
Event.What:=cmReceivedFocus;
SysReleaseFocus :
Event.What:=cmReleasedFocus;
SysClose :
begin
Event.What:=evCommand;
Event.Command:=cmQuitApp;
end;
SysResize :
begin
Event.What:=evCommand;
Event.Command:=cmResizeApp;
Event.Id:=SysEvent.x;
Event.InfoWord:=SysEvent.y;
end;
else
Event.What:=evNothing;
end;
end;
{$endif HasSysMsgUnit}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ EVENT HANDLER CONTROL ROUTINES } { EVENT HANDLER CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -1218,45 +1265,69 @@ END;
{ InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB } { InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB }
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE InitVideo; PROCEDURE InitVideo;
VAR {$ifdef Use_Video_API}I, J: Sw_Integer; VAR
{$else not Use_Video_API} {$ifdef GRAPH_API}
{$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF} I, J: Integer;
{$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF} Ts : TextSettingsType;
{$IFDEF OS_OS2} Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF} {$else not GRAPH_API}
{$ENDIF} I, J: Integer;
{$IFDEF OS_DOS}
Ts: TextSettingsType;
{$ENDIF}
{$IFDEF OS_WINDOWS}
Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric;
{$ENDIF}
{$IFDEF OS_OS2}
Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics;
{$ENDIF}
{$ENDIF}
BEGIN BEGIN
{$ifdef GRAPH_API} {$ifdef GRAPH_API}
if Not TextmodeGFV then
begin
I := Detect; { Detect video card } I := Detect; { Detect video card }
J := 0; { Zero select mode } J := 0; { Zero select mode }
InitGraph(I, J, ''); { Initialize graphics } InitGraph(I, J, ''); { Initialize graphics }
I := Graph.GetMaxX; { Fetch max x size } I := Graph.GetMaxX; { Fetch max x size }
J := Graph.GetMaxY; { Fetch max y size } J := Graph.GetMaxY; { Fetch max y size }
If (DefFontHeight = 0) Then { Font height not set } If (DefFontHeight = 0) Then { Font height not set }
J := (Graph.GetMaxY+1) DIV DefLineNum { Approx font height } J := (Graph.GetMaxY+1) DIV DefLineNum { Approx font height }
Else J := DefFontHeight; { Use set font height } Else J := DefFontHeight; { Use set font height }
I := J DIV (TextHeight('H')+4); { Approx magnification } I := J DIV (TextHeight('H')+4); { Approx magnification }
If (I < 1) Then I := 1; { Must be 1 or above } If (I < 1) Then I := 1; { Must be 1 or above }
GetTextSettings(Ts); { Get text style } GetTextSettings(Ts); { Get text style }
SetTextStyle(Ts.Font, Ts.Direction, I); { Set new font settings } SetTextStyle(Ts.Font, Ts.Direction, I); { Set new font settings }
SysFontWidth := TextWidth('H'); { Transfer font width } SysFontWidth := TextWidth('H'); { Transfer font width }
SysFontHeight := TextHeight('H')+4; { Transfer font height } SysFontHeight := TextHeight('H')+4; { Transfer font height }
ScreenWidth := (SysScreenWidth+1) DIV ScreenWidth := (SysScreenWidth+1) DIV
SysFontWidth; { Calc screen width } SysFontWidth; { Calc screen width }
ScreenHeight := (SysScreenHeight+1) DIV ScreenHeight := (SysScreenHeight+1) DIV
SysFontHeight; { Calc screen height } SysFontHeight; { Calc screen height }
{$else not GRAPH_API} {$ifdef USE_VIDEO_API}
Video.InitVideo; ScreenMode.color:=true;
ScreenWidth:=Video.ScreenWidth; ScreenMode.col:=ScreenWidth;
ScreenHeight:=Video.ScreenHeight; ScreenMode.row:=ScreenHeight;
SetViewPort(0,0,ScreenWidth,ScreenHeight,true,true); {$endif USE_VIDEO_API}
GetVideoMode(ScreenMode); end
I := ScreenWidth*8 -1; { Mouse width } else
J := ScreenHeight*8 -1; { Mouse height } {$endif GRAPH_API}
SysScreenWidth := I + 1; begin
SysScreenHeight := J + 1; Video.InitVideo;
SysFontWidth := 8; { Font width } ScreenWidth:=Video.ScreenWidth;
SysFontHeight := 8; { Font height } ScreenHeight:=Video.ScreenHeight;
{$endif not GRAPH_API} SetViewPort(0,0,ScreenWidth,ScreenHeight,true,true);
{$ifndef USE_VIDEO_API}
{ScreenMode : Sw_Word; } { Screen mode }
{$else not USE_VIDEO_API}
GetVideoMode(ScreenMode);
{$endif USE_VIDEO_API}
I := ScreenWidth*8 -1; { Mouse width }
J := ScreenHeight*8 -1; { Mouse height }
SysScreenWidth := I + 1;
SysScreenHeight := J + 1;
SysFontWidth := 8; { Font width }
SysFontHeight := 8; { Font height }
end;
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -1264,13 +1335,16 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE DoneVideo; PROCEDURE DoneVideo;
BEGIN BEGIN
{$ifdef GRAPH_API} {$ifdef GRAPH_API}
CloseGraph; if Not TextmodeGFV then
{$else not GRAPH_API} CloseGraph
{$ifdef USE_video_api} else
Video.DoneVideo; {$endif GRAPH_API}
{$endif USE_video_api} {$ifdef USE_video_api}
{$endif not GRAPH_API} Video.DoneVideo;
{$else not USE_video_api}
; { nothing to do }
{$endif not USE_video_api}
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -1278,9 +1352,16 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE ClearScreen; PROCEDURE ClearScreen;
BEGIN BEGIN
{$ifndef GRAPH_API} {$ifdef GRAPH_API}
if Not TextmodeGFV then
Graph.ClearDevice
else
{$endif GRAPH_API}
{$ifdef USE_video_api}
Video.ClearScreen; Video.ClearScreen;
{$endif GRAPH_API} {$else not USE_video_api}
; { nothing to do }
{$endif not USE_video_api}
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -1489,7 +1570,10 @@ BEGIN
END. END.
{ {
$Log$ $Log$
Revision 1.14 2002-05-16 20:21:50 pierre Revision 1.15 2002-05-21 12:21:53 pierre
* fix various graphic problems
Revision 1.14 2002/05/16 20:21:50 pierre
+ fix for bug report 1953 adapted from S Wiktor + fix for bug report 1953 adapted from S Wiktor
Revision 1.13 2001/10/02 16:35:50 pierre Revision 1.13 2001/10/02 16:35:50 pierre

6
fvision/fvconsts.pas
View File

@ -182,6 +182,7 @@ const
cmNewVideo = 47; cmNewVideo = 47;
cmTransfer = 48; cmTransfer = 48;
cmResizeApp = 49; cmResizeApp = 49;
cmQuitApp = 57;
cmRecordHistory = 60; cmRecordHistory = 60;
cmGrabDefault = 61; cmGrabDefault = 61;
@ -625,7 +626,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 2002-05-21 12:00:49 pierre Revision 1.4 2002-05-21 12:21:53 pierre
* fix various graphic problems
Revision 1.3 2002/05/21 12:00:49 pierre
+ cmResizeApp added + cmResizeApp added
Revision 1.2 2001/08/05 02:03:13 peter Revision 1.2 2001/08/05 02:03:13 peter