administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

LightPT - OutputListIsClearedFromSpaces := False;

Browse source 
Coords - DrawLine
This commit is contained in:
Mikhalkovich Stanislav 2024-09-20 22:58:46 +03:00
parent 078281db17
commit 40335b873e
8 changed files with 47 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Configuration/GlobalAssemblyInfo.cs
View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3";
public const string Minor = "10";
public const string Build = "0";
public const string Revision = "3543";
public const string Revision = "3544";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%MINOR%=10
%REVISION%=3543
%COREVERSION%=0
%REVISION%=3544
%MINOR%=10
%MAJOR%=3

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.10.0.3543
3.10.0.3544

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.10.0.3543'
!define VERSION '3.10.0.3544'

19
TestSuite/CompilationSamples/Coords.pas
View file

@ -306,6 +306,14 @@ begin
dc.DrawRectangle(cb,cp,Rect(p.x,p.y,w,h));
end;
procedure LinePlay(dc: DrawingContext; x,y,x1,y1: real; c: Color; width: real);
begin
var cp := ColorPen(c,Width);
var p := fso.RealToScreen(Pnt(x,y));
var p1 := fso.RealToScreen(Pnt(x1,y1));
dc.DrawLine(cp,p,p1);
end;
procedure CorrectXYForTextHelper(var p: Point; w,h: real; Align: Alignment);
begin
case Align of
@ -383,6 +391,13 @@ type
public
procedure Play(dc: DrawingContext); override := RectanglePlay(dc,x,y,w,h,c,borderc);
end;
LineC = auto class(Command)
x,y,x1,y1: real;
c: Color;
width: real;
public
procedure Play(dc: DrawingContext); override := LinePlay(dc,x,y,x1,y1,c,width);
end;
TextC = auto class(Command)
x,y: real;
text: string;
@ -444,6 +459,10 @@ procedure DrawPoint(x,y: real; Color: GColor := Colors.Black; PointRadius: real
procedure DrawRectangle(x,y,w,h: real; color: GColor := Colors.White; borderColor: GColor := Colors.Black)
:= RectangleC.Create(x,y,w,h,color,borderColor).AddToListAndPlay;
/// Рисует отрезок
procedure DrawLine(x,y,x1,y1: real; Color: GColor := Colors.Black; Width: real := 1)
:= LineC.Create(x,y,x1,y1,color,width).AddToListAndPlay;
/// Рисует прямоугольник без границы
procedure FillRectangle(x,y,w,h: real; color: GColor := Colors.White)
:= RectangleC.Create(x,y,w,h,color,Colors.Transparent).AddToListAndPlay;

3
TestSuite/CompilationSamples/LightPT.pas
View file

@ -2808,9 +2808,10 @@ begin
raise e.InnerException;
end;
//InputList := InputList;
//OutputList := OutputList;
OutputList := OutputList;
FlattenOutput; // SSM 28.06.24 - и перед каждым тестом
OutputListIsClearedFromSpaces := False;
CheckTask(TName);
if TaskResult = BadSolution then
break; // хоть один тест неудачный - выходим!

19
bin/Lib/Coords.pas
View file

@ -306,6 +306,14 @@ begin
dc.DrawRectangle(cb,cp,Rect(p.x,p.y,w,h));
end;
procedure LinePlay(dc: DrawingContext; x,y,x1,y1: real; c: Color; width: real);
begin
var cp := ColorPen(c,Width);
var p := fso.RealToScreen(Pnt(x,y));
var p1 := fso.RealToScreen(Pnt(x1,y1));
dc.DrawLine(cp,p,p1);
end;
procedure CorrectXYForTextHelper(var p: Point; w,h: real; Align: Alignment);
begin
case Align of
@ -383,6 +391,13 @@ type
public
procedure Play(dc: DrawingContext); override := RectanglePlay(dc,x,y,w,h,c,borderc);
end;
LineC = auto class(Command)
x,y,x1,y1: real;
c: Color;
width: real;
public
procedure Play(dc: DrawingContext); override := LinePlay(dc,x,y,x1,y1,c,width);
end;
TextC = auto class(Command)
x,y: real;
text: string;
@ -444,6 +459,10 @@ procedure DrawPoint(x,y: real; Color: GColor := Colors.Black; PointRadius: real
procedure DrawRectangle(x,y,w,h: real; color: GColor := Colors.White; borderColor: GColor := Colors.Black)
:= RectangleC.Create(x,y,w,h,color,borderColor).AddToListAndPlay;
/// Рисует отрезок
procedure DrawLine(x,y,x1,y1: real; Color: GColor := Colors.Black; Width: real := 1)
:= LineC.Create(x,y,x1,y1,color,width).AddToListAndPlay;
/// Рисует прямоугольник без границы
procedure FillRectangle(x,y,w,h: real; color: GColor := Colors.White)
:= RectangleC.Create(x,y,w,h,color,Colors.Transparent).AddToListAndPlay;

3
bin/Lib/LightPT.pas
View file

@ -2808,9 +2808,10 @@ begin
raise e.InnerException;
end;
//InputList := InputList;
//OutputList := OutputList;
OutputList := OutputList;
FlattenOutput; // SSM 28.06.24 - и перед каждым тестом
OutputListIsClearedFromSpaces := False;
CheckTask(TName);
if TaskResult = BadSolution then
break; // хоть один тест неудачный - выходим!