paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 16:09:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* implemented SetBkColor and GetBkColor for mode MCGAHi (640x480x2)

Browse Source 
git-svn-id: trunk@16005 -
This commit is contained in:
nickysn 2010-09-18 22:23:59 +00:00
parent 263fc7b6ff
commit d975466171
1 changed files with 16 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
packages/graph/src/go32v2/graph.pp
View File

@ -1246,6 +1246,20 @@ begin
else else
CallInt10($11); CallInt10($11);
VideoOfs := 0; VideoOfs := 0;
CurrentCGABorder := 0; {yes, TP7 CGA.BGI behaves *exactly* like that}
end;
procedure SetBkColorMCGA640(ColorNum: Word);
begin
if ColorNum > 15 then
exit;
CurrentCGABorder := (CurrentCGABorder and 16) or ColorNum;
SetCGABorder(CurrentCGABorder);
end;
function GetBkColorMCGA640: Word;
begin
GetBkColorMCGA640 := CurrentCGABorder and 15;
end; end;
procedure PutPixelMCGA640(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc} procedure PutPixelMCGA640(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
@ -3934,6 +3948,8 @@ const CrtAddress: word = 0;
mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette; mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
mode.InitMode := {$ifdef fpc}@{$endif}InitMCGA640; mode.InitMode := {$ifdef fpc}@{$endif}InitMCGA640;
mode.HLine := {$ifdef fpc}@{$endif}HLineMCGA640; mode.HLine := {$ifdef fpc}@{$endif}HLineMCGA640;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorMCGA640;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorMCGA640;
mode.XAspect := 10000; mode.XAspect := 10000;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);