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

fix #1757

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2019-02-22 09:27:54 +03:00
parent 0370d6b271
commit d2a5dd813b
4 changed files with 52 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
InstallerSamples/Games/DeleteByMouse.pas
View file

@ -22,7 +22,7 @@ end;
procedure MyMouseDown(x,y: real; mb: integer); procedure MyMouseDown(x,y: real; mb: integer);
begin begin
var ob := ObjectUnderPoint(x,y); var ob := ObjectUnderPoint(x,y);
if (ob<>nil) and (ob is RectangleWPF) then if (ob<>nil) and (ob is RectangleWPF) and (ob<>StatusRect) then
if ob.Number=CurrentDigit then if ob.Number=CurrentDigit then
begin begin
ob.Destroy; ob.Destroy;

5
VisualPascalABCNET/FontCombo.cs
View file

@ -74,8 +74,9 @@ namespace VisualPascalABC
//w += ttimg.Width*2; //w += ttimg.Width*2;
if (w > maxwid) if (w > maxwid)
maxwid = w; maxwid = w;
if (e.ItemHeight > 20) var ss = ScreenScale.Calc();
e.ItemHeight = 20; if (e.ItemHeight > Convert.ToInt32(20 * ss))
e.ItemHeight = Convert.ToInt32(20 * ss);
} }

54
bin/Lib/PABCSystem.pas
View file

@ -4701,7 +4701,7 @@ end;
procedure Read(var x: integer); procedure Read(var x: integer);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4714,7 +4714,7 @@ end;
procedure Read(var x: real); procedure Read(var x: real);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4727,7 +4727,7 @@ end;
procedure Read(var x: char); procedure Read(var x: char);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4740,7 +4740,7 @@ end;
procedure Read(var x: string); procedure Read(var x: string);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4753,7 +4753,7 @@ end;
procedure Read(var x: byte); procedure Read(var x: byte);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4766,7 +4766,7 @@ end;
procedure Read(var x: shortint); procedure Read(var x: shortint);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4779,7 +4779,7 @@ end;
procedure Read(var x: smallint); procedure Read(var x: smallint);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4792,7 +4792,7 @@ end;
procedure Read(var x: word); procedure Read(var x: word);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4805,7 +4805,7 @@ end;
procedure Read(var x: longword); procedure Read(var x: longword);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4818,7 +4818,7 @@ end;
procedure Read(var x: int64); procedure Read(var x: int64);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4831,7 +4831,7 @@ end;
procedure Read(var x: uint64); procedure Read(var x: uint64);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4844,7 +4844,7 @@ end;
procedure Read(var x: single); procedure Read(var x: single);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -4857,7 +4857,7 @@ end;
procedure Read(var x: boolean); procedure Read(var x: boolean);
begin begin
if input.sr <> nil then if input.sr <> nil then
read(input, x) Read(input, x)
else else
try try
CurrentIOSystem.read(x) CurrentIOSystem.read(x)
@ -5767,7 +5767,7 @@ begin
p := ptr; p := ptr;
end; end;
procedure write; procedure Write;
begin begin
end; end;
@ -5781,7 +5781,7 @@ begin
writeln(output); writeln(output);
end; end;
procedure write(obj: object); procedure Write(obj: object);
begin begin
if output.sw <> nil then if output.sw <> nil then
write_in_output(obj) write_in_output(obj)
@ -5793,7 +5793,7 @@ end;
// CurrentIOSystem.Write(ptr); // CurrentIOSystem.Write(ptr);
//end; //end;
procedure write(obj1, obj2: object); procedure Write(obj1, obj2: object);
begin begin
if output.sw <> nil then if output.sw <> nil then
begin begin
@ -5807,7 +5807,7 @@ begin
end; end;
end; end;
procedure write(params args: array of object); procedure Write(params args: array of object);
begin begin
for var i := 0 to args.length - 1 do for var i := 0 to args.length - 1 do
if output.sw <> nil then if output.sw <> nil then
@ -5816,7 +5816,7 @@ begin
CurrentIOSystem.Write(args[i]); CurrentIOSystem.Write(args[i]);
end; end;
procedure writeln(obj: object); procedure Writeln(obj: object);
begin begin
if output.sw <> nil then if output.sw <> nil then
begin begin
@ -5836,7 +5836,7 @@ end;
// CurrentIOSystem.Writeln; // CurrentIOSystem.Writeln;
//end; //end;
procedure writeln(obj1, obj2: object); procedure Writeln(obj1, obj2: object);
begin begin
if output.sw <> nil then if output.sw <> nil then
begin begin
@ -5852,14 +5852,14 @@ begin
end end
end; end;
procedure writeln; procedure Writeln;
begin begin
if output.sw <> nil then if output.sw <> nil then
writeln_in_output writeln_in_output
else CurrentIOSystem.Writeln; else CurrentIOSystem.Writeln;
end; end;
procedure writeln(params args: array of object); procedure Writeln(params args: array of object);
begin begin
if output.sw <> nil then if output.sw <> nil then
begin begin
@ -5875,11 +5875,11 @@ begin
end; end;
end; end;
procedure write(f: Text); procedure Write(f: Text);
begin begin
end; end;
procedure write(f: Text; val: object); procedure Write(f: Text; val: object);
begin begin
if f.fi = nil then if f.fi = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED));
@ -5902,13 +5902,13 @@ begin
end;} end;}
end; end;
procedure write(f: Text; params args: array of object); procedure Write(f: Text; params args: array of object);
begin begin
for var i := 0 to args.length - 1 do for var i := 0 to args.length - 1 do
write(f, args[i]); write(f, args[i]);
end; end;
procedure writeln(f: Text); procedure Writeln(f: Text);
begin begin
if f.fi = nil then if f.fi = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED));
@ -5918,13 +5918,13 @@ begin
f.sw.WriteLine; f.sw.WriteLine;
end; end;
procedure writeln(f: Text; val: object); procedure Writeln(f: Text; val: object);
begin begin
write(f, val); write(f, val);
writeln(f); writeln(f);
end; end;
procedure writeln(f: Text; params args: array of object); procedure Writeln(f: Text; params args: array of object);
begin begin
for var i := 0 to args.length - 1 do for var i := 0 to args.length - 1 do
write(f, args[i]); write(f, args[i]);

31
bin/Lib/WPFObjects.pas
View file

@ -145,7 +145,7 @@ type
ob: FrameworkElement; ob: FrameworkElement;
gr: Grid; // Grid связан только с текстом gr: Grid; // Grid связан только с текстом
t: TextBlock; t: TextBlock;
r: RotateTransform; rot: RotateTransform;
ChildrenWPF := new List<ObjectWPF>; ChildrenWPF := new List<ObjectWPF>;
procedure InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean := True); procedure InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean := True);
@ -189,7 +189,7 @@ type
begin begin
Result := GetInternalGeometry; Result := GetInternalGeometry;
var g := new TransformGroup(); var g := new TransformGroup();
g.Children.Add(r); g.Children.Add(rot);
g.Children.Add(new TranslateTransform(Left,Top)); g.Children.Add(new TranslateTransform(Left,Top));
Result.Transform := g; // версия Result.Transform := g; // версия
end; end;
@ -221,11 +221,11 @@ type
/// Правый нижний угол графического объекта /// Правый нижний угол графического объекта
property RightBottom: Point read Pnt(Left + Height,Top + Height); property RightBottom: Point read Pnt(Left + Height,Top + Height);
/// Угол поворота графического объекта (по часовой стрелке) /// Угол поворота графического объекта (по часовой стрелке)
property RotateAngle: real read InvokeReal(()->r.Angle) write Invoke(procedure->r.Angle := value); property RotateAngle: real read InvokeReal(()->rot.Angle) write Invoke(procedure->rot.Angle := value);
/// Центр поворота графического объекта /// Центр поворота графического объекта
property RotateCenter: Point property RotateCenter: Point
read Invoke&<Point>(()->new Point(r.CenterX,r.CenterY)) read Invoke&<Point>(()->new Point(rot.CenterX,rot.CenterY))
write Invoke(procedure->begin r.CenterX := value.X; r.CenterY := value.Y; end); write Invoke(procedure->begin rot.CenterX := value.X; rot.CenterY := value.Y; end);
/// Цвет графического объекта /// Цвет графического объекта
property Color: GColor property Color: GColor
read RGB(0,0,0) read RGB(0,0,0)
@ -287,7 +287,12 @@ type
end; end;
procedure EF(value: GColor) := Element.Fill := new SolidColorBrush(Value); procedure EF(value: GColor) := Element.Fill := new SolidColorBrush(Value);
procedure ES(value: GColor) := Element.Stroke := new SolidColorBrush(Value); procedure ES(value: GColor) := Element.Stroke := new SolidColorBrush(Value);
procedure EST(value: real) := Element.StrokeThickness := Value; procedure EST(value: real);
begin
Element.StrokeThickness := Value;
if Element.Stroke = nil then
Element.Stroke := new SolidColorBrush(Colors.Black)
end;
function WithNoBorderP: BoundedObjectWPF; function WithNoBorderP: BoundedObjectWPF;
begin begin
Element.Stroke := nil; Element.Stroke := nil;
@ -940,6 +945,12 @@ procedure SetLeft(Self: UIElement; l: integer) := Self.SetLeft(l);
procedure SetTop(Self: UIElement; t: integer) := Self.SetTop(t); procedure SetTop(Self: UIElement; t: integer) := Self.SetTop(t);
function MoveOn(Self: Point; vx,vy: real): Point; extensionmethod;
begin
Result.X := Self.X + vx;
Result.Y := Self.Y + vy;
end;
{procedure MoveTo(Self: UIElement; l,t: integer); extensionmethod; {procedure MoveTo(Self: UIElement; l,t: integer); extensionmethod;
begin begin
Canvas.SetLeft(Self,l); Canvas.SetLeft(Self,l);
@ -980,10 +991,10 @@ procedure ObjectWPF.InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean);
begin begin
can := new Canvas; can := new Canvas;
gr := new Grid; gr := new Grid;
r := new RotateTransform(0); rot := new RotateTransform(0);
r.CenterX := w / 2; rot.CenterX := w / 2;
r.CenterY := h / 2; rot.CenterY := h / 2;
can.RenderTransform := r; can.RenderTransform := rot;
ob := o; ob := o;
if SetWH then if SetWH then
(ob.Width,ob.Height) := (w,h); (ob.Width,ob.Height) := (w,h);