pascalabcnet/TestSamples/FormatterTests/input/Graph.pas
Бондарев Иван e6e67c193c initial commit
2015-05-14 21:35:07 +02:00

644 lines
15 KiB
ObjectPascal

unit graph;
interface
{***** Dos Style - Const *****}
const
{for SetBkColor, SetColor, SetFillStyle, SetRGBPalette / 16Color}
Black = 0;
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
DarkGray = 8;
LightBlue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
{for SetLineStyle}
SolidLn = 0;
DottedLn = 1;
CenterLn = 2;
DashedLn = 3;
UserBitLn = 4;
NormWidth = 1;
ThickWidth = 3;
{for SetTextJustify}
LeftText = 0;
CenterText = 1;
RightText = 2;
BottomText = 0;
TopText = 2;
{for SetTextStyle?}
DefaultFont = 0;
TriplexFont = 1;
SmallFont = 2;
SansSerifFont = 3;
GothicFont = 4;
HorizDir = 0;
VertDir = 1;
{for SetFillStyle}
EmptyFill = 0;
SolidFill = 1;
LineFill = 2; {-----}
LtSlashFill = 3; {/////}
SlashFill = 4; {/////}
BkSlashFill = 5; {\\\\\}
LtBkSlashFill = 6; {\\\\\}
HatchFill = 7; {+++++}
XHatchFill = 8; {XXXXX}
InterleaveFill = 9;
WideDotFill = 10;
CloseDotFill = 11;
UserFill = 12;
{for SetWriteMode}
CopyPut = 0; { MOV }
XORPut = 1; { XOR }
{Graphics drivers constants }
detect = 0;
cga = 1;
mcga = 2;
ega = 3;
ega64 = 4;
egamono = 5;
ibm8514 = 6;
hercmono = 7;
att400 = 8;
vga = 9;
pc3270 = 10;
{ graphics modes constants. }
cgac0 = 0;
cgac1 = 1;
cgac2 = 2;
cgac3 = 3;
cgahi = 4;
mcgac1 = 1;
mcgac2 = 2;
mcgac3 = 3;
mcgamed = 4;
mcgahi = 5;
egalo = 0;
egahi = 1;
ega64lo = 0;
ega64hi = 1;
egamonohi = 3;
hercmonohi = 0;
att400c0 = 0;
att400c1 = 1;
att400c2 = 2;
att400c3 = 3;
att400med = 4;
att400hi = 5;
vgalo = 0;
vgamed = 1;
vgahi = 2;
pc3270hi = 0;
ibm8514lo = 0;
ibm8514hi = 1;
{Graphics error codes}
grok = 0;
grnoinitgraph = -1;
grnotdetected = -2;
grfilenotfound = -3;
grinvaliddriver = -4;
grnoloadmem = -5;
grnoscanmem = -6;
grnofloodmem = -7;
grfontnotfound = -8;
grnofontmem = -9;
grinvalidmode = -10;
grerror = -11;
grioerror = -12;
grinvalidfont = -13;
grinvalidfontnum = -14;
grinvaliddevicenum =-15;
grinvalidversion = -18;
TopOn = true;
TopOff = false;
ClipOn = true;
ClipOff = false;
UserCharSize = 0;
{***** Dos Style - Type *****}
type
TColor = integer;
ArcCoordsType = record
x, y,
xstart, ystart,
xend, yend : integer;
end;
FillPatternType = array [1..8] of byte;
FillSettingsType = record
pattern : word;
color : word;
end;
LineSettingsType = record
linestyle : word;
pattern : word;
thickness : word;
end;
const
MaxColors = 15;
type
PaletteType = record
size : byte;
colors : array[0..maxcolors] of shortint;
end;
PointType = record
x, y : integer;
end;
TextSettingsType = record
font : word;
direction : word;
charsize : word;
horiz : word;
vert : word;
end;
ViewPortType = record
x1, y1, x2, y2 : integer;
clip : boolean;
end;
PointsType = array [1..100] of integer;
procedure InitGraph(var GraphDrv, GraphMode : integer; path_to_driver : string);
procedure CloseGraph;
function GetMaxX : integer;
function GetMaxY : integer;
function GetX : integer;
function GetY : integer;
procedure SetViewPort(x1, y1, x2, y2: integer; clip: Boolean);
procedure SetFillStyle(Pattern, Color: word);
procedure SetFillPattern(upattern : FillPatternType; Color: word);
procedure SetLineStyle(LineStyle, Pattern, Thickness: word);
procedure SetWriteMode(WriteMode: integer);
procedure GetArcCoords(var ArcCoords: ArcCoordsType);
procedure GetFillSettings(var FillInfo: FillSettingsType);
procedure GetFillPAttern(var FillPattern: FillPatternType);
procedure GetLineSettings(var LineInfo: LineSettingsType);
function GetDriverName : String;
function GetGraphMode : integer;
procedure SetGraphMode(mode : integer);
function GetModeName(GraphMode : integer): string;
procedure GetAspectRatio(var ax, ay : word);
procedure SetAspectRatio(ax, ay : word);
procedure SetUserCharSize(multx, divx, multy, divy : word);
procedure GetTextSettings(var TextInfo : TextSettingsType);
procedure GetViewSettings(var ViewPort: ViewPortType);
procedure PutPixel(X, Y, Pixel : integer);
function GetPixel(X, Y : integer) : integer;
function GraphResult : integer;
function GraphErrorMsg(code : integer) : String;
function ImageSize(x1, y1, x2, y2 : integer) : integer;
procedure GetImage(x1, y1, x2, y2 : integer; p : pointer);
procedure PutImage(x, y : integer; p : pointer; i : integer);
procedure Arc(x, y : integer; StAngle, EndAngle, Radius: Word);
procedure Bar(x1, y1, x2, y2 : integer);
procedure Bar3D(x1, y1, x2, y2 : integer; Depth: word; Top: boolean);
procedure Circle(X, Y : integer; Radius : word);
procedure DrawPoly(NumPoints : word; var Points : integer);
procedure Ellipse(x, y: integer; StAngle, EndAngle, XRadius, YRadius: Word);
procedure FillEllipse(x, y: integer; XRadius, YRadius: Word);
procedure FillPoly(NumPoints : word; Points : PointsType);
procedure FloodFill(X, Y : integer; Color: TColor);
procedure MoveTo(X, Y : integer);
procedure LineTo(X, Y : integer);
procedure Line(x1, y1, x2, y2 : integer);
procedure LineRel(Dx, Dy : integer);
procedure MoveRel(Dx, Dy : integer);
procedure PieSlice(x, y: integer; StAngle, EndAngle, Radius: Word);
procedure Rectangle(x1, y1, x2, y2 : integer);
procedure RoundRect(x1, y1, x2, y2, x3, y3 : integer);
procedure Sector(x, y: integer; StAngle, EndAngle, XRadius, YRadius: Word);
{ *** color and palette routines *** }
procedure SetBkColor(Color : TColor);
procedure SetColor(Color : TColor);
function GetColor : TColor;
procedure SetRGBPalette(I, R, G, B: word);
procedure SetAllPalette(Palette : PaletteType );
procedure SetPalette(ColorNum : word; Color : shortint);
procedure SetRGBPalette(ColorNum : word; red, green, blue : byte);
function GetBkColor: word;
procedure GetDefaultPalette(var Palette: PaletteType);
function GetMaxColor: word;
procedure GetPalette(var Palette: PaletteType);
{ *** text routines *** }
procedure OutText(Text: String);
procedure OutTextXY(X, Y: Integer; Text: String);
procedure SetTextJustify(Horiz, Vert: word);
procedure SetTextStyle(Font, Direction, CharSize: Word);
function TextHeight(Text : String) : integer;
function TextWidth(Text : String) : integer;
function KeyPressed : Boolean;
function ReadKey : Char;
procedure Delay(msec : integer);
procedure ClearViewPort;
procedure ClearDevice;
implementation
const NotImplementedMessage = 'This function not implemented';
procedure InitGraph(var GraphDrv, GraphMode : integer; path_to_driver : string);
begin
raise new Exception(NotImplementedMessage);
end;
procedure CloseGraph;
begin
raise new Exception(NotImplementedMessage);
end;
function GetMaxX : integer;
begin
raise new Exception(NotImplementedMessage);
end;
function GetMaxY : integer;
begin
raise new Exception(NotImplementedMessage);
end;
function GetX : integer;
begin
raise new Exception(NotImplementedMessage);
end;
function GetY : integer;
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetViewPort(x1, y1, x2, y2: integer; clip: Boolean);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetFillStyle(Pattern, Color: word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetFillPattern(upattern : FillPatternType; Color: word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetLineStyle(LineStyle, Pattern, Thickness: word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetWriteMode(WriteMode: integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetArcCoords(var ArcCoords: ArcCoordsType);
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetFillSettings(var FillInfo: FillSettingsType);
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetFillPAttern(var FillPattern: FillPatternType);
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetLineSettings(var LineInfo: LineSettingsType);
begin
raise new Exception(NotImplementedMessage);
end;
function GetDriverName : String;
begin
raise new Exception(NotImplementedMessage);
end;
function GetGraphMode : integer;
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetGraphMode(mode : integer);
begin
raise new Exception(NotImplementedMessage);
end;
function GetModeName(GraphMode : integer): string;
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetAspectRatio(var ax, ay : word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetAspectRatio(ax, ay : word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetUserCharSize(multx, divx, multy, divy : word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetTextSettings(var TextInfo : TextSettingsType);
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetViewSettings(var ViewPort: ViewPortType);
begin
raise new Exception(NotImplementedMessage);
end;
procedure PutPixel(X, Y, Pixel : integer);
begin
raise new Exception(NotImplementedMessage);
end;
function GetPixel(X, Y : integer) : integer;
begin
raise new Exception(NotImplementedMessage);
end;
function GraphResult : integer;
begin
raise new Exception(NotImplementedMessage);
end;
function GraphErrorMsg(code : integer) : String;
begin
raise new Exception(NotImplementedMessage);
end;
function ImageSize(x1, y1, x2, y2 : integer) : integer;
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetImage(x1, y1, x2, y2 : integer; p : pointer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure PutImage(x, y : integer; p : pointer; i : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Arc(x, y : integer; StAngle, EndAngle, Radius: Word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Bar(x1, y1, x2, y2 : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Bar3D(x1, y1, x2, y2 : integer; Depth: word; Top: boolean);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Circle(X, Y : integer; Radius : word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure DrawPoly(NumPoints : word; var Points : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Ellipse(x, y: integer; StAngle, EndAngle, XRadius, YRadius: Word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure FillEllipse(x, y: integer; XRadius, YRadius: Word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure FillPoly(NumPoints : word; Points : PointsType);
begin
raise new Exception(NotImplementedMessage);
end;
procedure FloodFill(X, Y : integer; Color: TColor);
begin
raise new Exception(NotImplementedMessage);
end;
procedure MoveTo(X, Y : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure LineTo(X, Y : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Line(x1, y1, x2, y2 : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure LineRel(Dx, Dy : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure MoveRel(Dx, Dy : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure PieSlice(x, y: integer; StAngle, EndAngle, Radius: Word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Rectangle(x1, y1, x2, y2 : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure RoundRect(x1, y1, x2, y2, x3, y3 : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure Sector(x, y: integer; StAngle, EndAngle, XRadius, YRadius: Word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetBkColor(Color : TColor);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetColor(Color : TColor);
begin
raise new Exception(NotImplementedMessage);
end;
function GetColor : TColor;
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetRGBPalette(I, R, G, B: word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetAllPalette(Palette : PaletteType );
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetPalette(ColorNum : word; Color : shortint);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetRGBPalette(ColorNum : word; red, green, blue : byte);
begin
raise new Exception(NotImplementedMessage);
end;
function GetBkColor: word;
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetDefaultPalette(var Palette: PaletteType);
begin
raise new Exception(NotImplementedMessage);
end;
function GetMaxColor: word;
begin
raise new Exception(NotImplementedMessage);
end;
procedure GetPalette(var Palette: PaletteType);
begin
raise new Exception(NotImplementedMessage);
end;
procedure OutText(Text: String);
begin
raise new Exception(NotImplementedMessage);
end;
procedure OutTextXY(X, Y: Integer; Text: String);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetTextJustify(Horiz, Vert: word);
begin
raise new Exception(NotImplementedMessage);
end;
procedure SetTextStyle(Font, Direction, CharSize: Word);
begin
raise new Exception(NotImplementedMessage);
end;
function TextHeight(Text : String) : integer;
begin
raise new Exception(NotImplementedMessage);
end;
function TextWidth(Text : String) : integer;
begin
raise new Exception(NotImplementedMessage);
end;
function KeyPressed : Boolean;
begin
raise new Exception(NotImplementedMessage);
end;
function ReadKey : Char;
begin
raise new Exception(NotImplementedMessage);
end;
procedure Delay(msec : integer);
begin
raise new Exception(NotImplementedMessage);
end;
procedure ClearViewPort;
begin
raise new Exception(NotImplementedMessage);
end;
procedure ClearDevice;
begin
raise new Exception(NotImplementedMessage);
end;
end.