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

+ introduced the ColorType (=word) to the graph unit. This is the type, used to

Browse Source 
represent a color. This is intended to make it easier to add support for
  24-bit and 32-bit color to the graph unit on platforms that support it.

git-svn-id: trunk@40805 -
This commit is contained in:
nickysn 2019-01-08 08:50:44 +00:00
parent a9696520fb
commit 72a9c94b49
3 changed files with 32 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/graph/src/inc/fills.inc
View File

@ -412,7 +412,7 @@ var
end;
Procedure FloodFill (x, y : smallint; Border: word);
Procedure FloodFill (x, y : smallint; Border: ColorType);
{********************************************************}
{ Procedure FloodFill() }
{--------------------------------------------------------}
@ -426,7 +426,7 @@ var
Beginx : smallint;
d, e : Byte;
Cont : Boolean;
BackupColor : Word;
BackupColor : ColorType;
x1, x2, prevy: smallint;
Begin
GetMem(DrawnList,sizeof(PFloodLine)*((ViewHeight div YResDiv) + 1));

32
packages/graph/src/inc/graph.inc
View File

@ -78,8 +78,8 @@ const
var
CurrentColor: Word;
CurrentBkColor: Word;
CurrentColor: ColorType;
CurrentBkColor: ColorType;
CurrentX : smallint; { viewport relative }
CurrentY : smallint; { viewport relative }
@ -237,7 +237,7 @@ var
Flag : Boolean; { determines pixel direction in thick lines }
NumPixels : smallint;
PixelCount : smallint;
OldCurrentColor: Word;
OldCurrentColor: ColorType;
swtmp : smallint;
TmpNumPixels : smallint;
begin
@ -673,7 +673,8 @@ var
TempTerm: graph_float;
xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
plxpyp, plxmyp, plxpym, plxmym: smallint;
BackupColor, TmpAngle, OldLineWidth: word;
BackupColor: ColorType;
TmpAngle, OldLineWidth: word;
CounterClockwise : Boolean;
Begin
If LineInfo.ThickNess = ThickWidth Then
@ -817,7 +818,7 @@ var
j : smallint;
TmpFillPattern : byte;
OldWriteMode : word;
OldCurrentColor : word;
OldCurrentColor : ColorType;
begin
{ convert to global coordinates ... }
x1 := x1 + StartXViewPort;
@ -991,7 +992,8 @@ var
Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
var
j: smallint;
OldWriteMode, OldCurColor: word;
OldWriteMode: word;
OldCurColor: ColorType;
LineSets : LineSettingsType;
Begin
{ CP is always RELATIVE coordinates }
@ -1132,7 +1134,7 @@ type
ptw = array[0..2] of longint;
var
k: longint;
oldCurrentColor: word;
oldCurrentColor: ColorType;
oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
Begin
{$ifdef logging}
@ -1541,7 +1543,7 @@ end;
procedure SetFillStyle(Pattern : word; Color: word);
procedure SetFillStyle(Pattern : word; Color: ColorType);
begin
{ on invalid input, the current fill setting will be }
@ -1559,7 +1561,7 @@ end;
end;
procedure SetFillPattern(Pattern: FillPatternType; Color: word);
procedure SetFillPattern(Pattern: FillPatternType; Color: ColorType);
{********************************************************}
{ Changes the Current FillPattern to a user defined }
{ pattern and changes also the current fill color. }
@ -1595,7 +1597,7 @@ end;
{ - No contour is drawn for the lines }
{********************************************************}
var y : smallint;
origcolor : longint;
origcolor : ColorType;
origlinesettings: Linesettingstype;
origwritemode : smallint;
begin
@ -1706,27 +1708,27 @@ end;
{--------------------------------------------------------------------------}
procedure SetColor(Color: Word);
procedure SetColor(Color: ColorType);
Begin
CurrentColor := Color;
end;
function GetColor: Word;
function GetColor: ColorType;
Begin
GetColor := CurrentColor;
end;
function GetBkColorDefault: Word;
function GetBkColorDefault: ColorType;
Begin
GetBkColorDefault := CurrentBkColor;
end;
procedure SetBkColorDefault(ColorNum: Word);
procedure SetBkColorDefault(ColorNum: ColorType);
{ Background color means background screen color in this case, and it is }
{ INDEPENDANT of the viewport settings, so we must clear the whole screen }
{ with the color. }
@ -1752,7 +1754,7 @@ end;
end;
function GetMaxColor: word;
function GetMaxColor: ColorType;
{ Checked against TP VGA driver - CEC }
begin

24
packages/graph/src/inc/graphh.inc
View File

@ -434,6 +434,8 @@ type
type
ColorType = Word;
RGBRec = packed record
Red: smallint;
Green: smallint;
@ -461,7 +463,7 @@ type
FillSettingsType = record
pattern : word;
color : word;
color : ColorType;
end;
FillPatternType = array[1..8] of byte;
@ -518,8 +520,8 @@ TYPE
defpixelproc = procedure(X,Y: smallint);
{ standard plot and get pixel }
getpixelproc = function(X,Y: smallint): word;
putpixelproc = procedure(X,Y: smallint; Color: Word);
getpixelproc = function(X,Y: smallint): ColorType;
putpixelproc = procedure(X,Y: smallint; Color: ColorType);
{ clears the viewport, also used to clear the device }
clrviewproc = procedure;
@ -589,8 +591,8 @@ TYPE
CircleProc = procedure(X, Y: smallint; Radius:Word);
SetBkColorProc = procedure(ColorNum: Word);
GetBkColorProc = function: Word;
SetBkColorProc = procedure(ColorNum: ColorType);
GetBkColorProc = function: ColorType;
TYPE
@ -759,8 +761,8 @@ procedure InitGraph(var GraphDriver:smallint;var GraphMode:smallint;const PathTo
procedure DetectGraph(var GraphDriver:smallint;var GraphMode:smallint);
function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
function RegisterBGIDriver(driver: pointer): smallint;
procedure SetFillStyle(Pattern : word; Color: word);
procedure SetFillPattern(Pattern: FillPatternType; Color: word);
procedure SetFillStyle(Pattern : word; Color: ColorType);
procedure SetFillPattern(Pattern: FillPatternType; Color: ColorType);
Function GetDriverName: string;
procedure MoveRel(Dx, Dy: smallint);
procedure MoveTo(X,Y: smallint);
@ -769,9 +771,9 @@ Function GetDriverName: string;
function GetDirectVideo: boolean;
{ -------------------- Color/Palette ------------------------------- }
function GetColor: Word;
procedure SetColor(Color: Word);
function GetMaxColor: word;
function GetColor: ColorType;
procedure SetColor(Color: ColorType);
function GetMaxColor: ColorType;
procedure SetPalette(ColorNum: word; Color: shortint);
procedure GetPalette(var Palette: PaletteType);
@ -787,7 +789,7 @@ Function GetDriverName: string;
procedure DrawPoly(NumPoints : word;var polypoints);
procedure LineRel(Dx, Dy: smallint);
procedure LineTo(X,Y : smallint);
procedure FloodFill(x : smallint; y : smallint; Border: word);
procedure FloodFill(x : smallint; y : smallint; Border: ColorType);
{ -------------------- Circle related routines --------------------- }
procedure GetAspectRatio(var Xasp,Yasp : word);