diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 47886fafa..ed5e2437d 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/Configuration/GlobalAssemblyInfo.cs @@ -15,7 +15,7 @@ internal static class RevisionClass public const string Major = "3"; public const string Minor = "8"; public const string Build = "0"; - public const string Revision = "2875"; + public const string Revision = "2878"; public const string MainVersion = Major + "." + Minor; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 800a0e2c2..ce8b522fc 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%MINOR%=8 -%REVISION%=2875 %COREVERSION%=0 +%REVISION%=2878 +%MINOR%=8 %MAJOR%=3 diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index dfdf31be3..25b049924 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.8.0.2875 +3.8.0.2878 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 4864ff4fe..c16898283 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.8.0.2875' +!define VERSION '3.8.0.2878' diff --git a/TestSuite/CompilationSamples/GraphWPF.pas b/TestSuite/CompilationSamples/GraphWPF.pas index 9180fcb5d..643582a9e 100644 --- a/TestSuite/CompilationSamples/GraphWPF.pas +++ b/TestSuite/CompilationSamples/GraphWPF.pas @@ -217,6 +217,10 @@ type procedure Load(fname: string); /// Заполняет содержимое графического окна обоями из файла с именем fname procedure Fill(fname: string); + /// Возвращает случайную точку в границах экрана. Необязательный параметр margin задаёт минимальный отступ от границы + function RandomPoint(margin: real := 0): Point; + /// Очищает графическое окно белым цветом + procedure Clear; end; // Специфический тип окна для модуля GraphWPF @@ -402,6 +406,32 @@ procedure DrawPolygon(points: array of Point; c: GColor); /// Рисует внутренность многоугольника, заданного массивом точек и цветом procedure FillPolygon(points: array of Point; c: GColor); +// ----------------------------------------------------- +//>> Класс Bitmap +// ----------------------------------------------------- +///!# +/// Класс битового образа +type Bitmap = class +private + bsource: TransformedBitmap; + procedure SetScaleX(scx: real); + function GetScaleX: real; + procedure SetScaleY(scy: real); + function GetScaleY: real; +public + constructor Create(fname: string); +/// Отразить битовый образ относительно горизонтальной оси + procedure FlipHorizontal; +/// Отразить битовый образ относительно вертикальной оси + procedure FlipVertical; +/// Коэффициент масштабирования по оси X + property ScaleX: real read GetScaleX write SetScaleX; +/// Коэффициент масштабирования по оси Y + property ScaleY: real read GetScaleY write SetScaleY; +/// Возвращает клон битового образа + function Clone: Bitmap; +end; + // ----------------------------------------------------- //>> Функции для вывода изображений и видео # GraphWPF functions for images and video // ----------------------------------------------------- @@ -409,6 +439,10 @@ procedure FillPolygon(points: array of Point; c: GColor); procedure DrawImage(x,y: real; fname: string); /// Рисует изображение из файла fname в позиции (x,y) размера w на h procedure DrawImage(x,y,w,h: real; fname: string); +/// Рисует изображение из битмапа в позиции (x,y) +procedure DrawImage(x,y: real; b: Bitmap); +/// Рисует изображение из битмапа в позиции (x,y) размера w на h +procedure DrawImage(x,y,w,h: real; b: Bitmap); /// Рисует немасштабированное изображение из файла fname в позиции (x,y) procedure DrawImageUnscaled(x,y: real; fname: string); /// Выводит видеоиз файла fname в позицию (x,y) @@ -616,13 +650,6 @@ var OnDrawFrame: procedure(dt: real); var AdditionalInit: procedure; function GetMouseArgs(e: MouseEventArgs): (Point,integer); -{procedure AddRightPanel(Width: real := 200; c: Color := Colors.LightGray); -procedure AddLeftPanel(Width: real := 200; c: Color := Colors.LightGray); -procedure AddTopPanel(Height: real := 100; c: Color := Colors.LightGray); -procedure AddBottomPanel(Height: real := 100; c: Color := Colors.LightGray); - -procedure AddStatusBar(Height: real := 24);} - {function GetDC: DrawingContext; procedure ReleaseDC(dc: DrawingContext); procedure FastDraw(d: DrawingContext->()); @@ -928,6 +955,60 @@ begin Result := dpic[fname]; end; +// ----------------------------------------------------- +//>> Класс Bitmap +// ----------------------------------------------------- +///!# +constructor Bitmap.Create(fname: string); +begin + Invoke(()->begin + bsource := new TransformedBitmap(GetBitmapImage(fname),new ScaleTransform()); + end); +end; + +function Bitmap.Clone: Bitmap; +begin + Result := Invoke&(()-> + begin + var b := new Bitmap(); + b.bsource := new TransformedBitmap(bsource.Source,bsource.Transform); + Result := b; + end); +end; + +procedure Bitmap.FlipHorizontal := ScaleY := -ScaleY; + +procedure Bitmap.FlipVertical := ScaleX := -ScaleX; + +procedure Bitmap.SetScaleX(scx: real); +begin + Invoke(()->begin + var sct := bsource.Transform as ScaleTransform; + sct.ScaleX := scx; + bsource := new TransformedBitmap(bsource.Source,sct); + end); +end; + +function Bitmap.GetScaleX: real; +begin + Result := InvokeReal(()->(bsource.Transform as ScaleTransform).ScaleX); +end; + +function Bitmap.GetScaleY: real; +begin + Result := InvokeReal(()->(bsource.Transform as ScaleTransform).ScaleY); +end; + +procedure Bitmap.SetScaleY(scy: real); +begin + Invoke(()->begin + var sct := bsource.Transform as ScaleTransform; + sct.ScaleY := scy; + bsource := new TransformedBitmap(bsource.Source,sct); + end); +end; + + procedure DrawPixelsP(x,y:real; px,py,pw,ph: integer; a: array [,] of Color); begin var (scalex,scaley) := ScaleToDevice; @@ -970,6 +1051,14 @@ begin ReleaseDC(dc); end; +procedure DrawImagePB(x,y: real; b: Bitmap); +begin + var dc := GetDC(); + var img := b.bsource; + dc.DrawImage(img, Rect(x, y, img.PixelWidth, img.PixelHeight)); + ReleaseDC(dc); +end; + procedure DrawImageP(x,y: real; fname: string); begin var dc := GetDC(); @@ -978,6 +1067,14 @@ begin ReleaseDC(dc); end; +procedure DrawImageWHPB(x,y,w,h: real; b: Bitmap); +begin + var dc := GetDC(); + var img := b.bsource; + dc.DrawImage(img, Rect(x, y, w, h)); + ReleaseDC(dc); +end; + procedure DrawImageWHP(x,y,w,h: real; fname: string); begin var dc := GetDC(); @@ -1226,6 +1323,10 @@ procedure FillPolygon(points: array of Point; c: GColor) := InvokeVisual(FillPol procedure DrawImage(x,y: real; fname: string) := InvokeVisual(DrawImageP,x,y,fname); procedure DrawImage(x,y,w,h: real; fname: string) := InvokeVisual(DrawImageWHP,x,y,w,h,fname); + +procedure DrawImage(x,y: real; b: Bitmap) := InvokeVisual(DrawImagePB,x,y,b); +procedure DrawImage(x,y,w,h: real; b: Bitmap) := InvokeVisual(DrawImageWHPB,x,y,w,h,b); + procedure DrawImageUnscaled(x,y: real; fname: string) := InvokeVisual(DrawImageUnscaledP,x,y,fname); procedure DrawVideo(x,y: real; fname: string) := InvokeVisual(DrawVideoP,x,y,fname); @@ -1672,6 +1773,14 @@ begin //FillWindow(fname); end; +procedure GraphWindowType.Clear; +begin + Window.Clear; +end; + + +function GraphWindowType.RandomPoint(margin: real): Point := Pnt(Random(margin,Width-margin),Random(margin,Height-margin)); + function GraphWindowType.Center: Point := Pnt(Width/2,Height/2); function GraphWindowType.ClientRect: GRect := Rect(0,0,Width,Height); diff --git a/TestSuite/CompilationSamples/GraphWPFBase.pas b/TestSuite/CompilationSamples/GraphWPFBase.pas index a12488aef..6f9bdc8de 100644 --- a/TestSuite/CompilationSamples/GraphWPFBase.pas +++ b/TestSuite/CompilationSamples/GraphWPFBase.pas @@ -143,8 +143,8 @@ type function Center: Point; /// Возвращает прямоугольник клиентской области окна function ClientRect: GRect; - /// Возвращает случайную точку в границах экрана. Необязательный параметр w задаёт минимальный отступ от границы - function RandomPoint(w: real := 0): Point; + /// Возвращает случайную точку в границах экрана. Необязательный параметр margin задаёт минимальный отступ от границы + function RandomPoint(margin: real := 0): Point; private procedure CenterOnScreenP; end; //{{{--doc: Конец секции 1 }}} @@ -237,7 +237,7 @@ procedure WindowType.Clear := Invoke(WindowTypeClearP); procedure WindowType.Clear(c: GColor); begin - raise new System.NotImplementedException('WindowType.Clear(c) пока не реализовано. Честное слово - в будущем!') + raise new System.NotImplementedException('WindowType.Clear(color) не реализовано') end; procedure WindowTypeSetSizeP(w, h: real); @@ -281,7 +281,7 @@ function WindowType.Center := Pnt(Width/2,Height/2); function WindowType.ClientRect := Rect(0,0,Width,Height); -function WindowType.RandomPoint(w: real): Point := Pnt(Random(w,Width-w),Random(w,Height-w)); +function WindowType.RandomPoint(margin: real): Point := Pnt(Random(margin,Width-margin),Random(margin,Height-margin)); function operator implicit(Self: (integer, integer)): Point; extensionmethod := new Point(Self[0], Self[1]); function operator implicit(Self: (integer, real)): Point; extensionmethod := new Point(Self[0], Self[1]); diff --git a/TestSuite/CompilationSamples/School.pas b/TestSuite/CompilationSamples/School.pas index 315f7b256..2d8fd02d3 100644 --- a/TestSuite/CompilationSamples/School.pas +++ b/TestSuite/CompilationSamples/School.pas @@ -71,8 +71,7 @@ function Divisors(n: integer): List; ///-- function Divizors(n: integer): List; -/// Возвращает список всех k делителей натурального числа n. -/// Если делителей не ровно k, возвращает пустой список +///-- function Divisors(n, k: integer): List; /// Возвращает Sin угла, заданного в градусах @@ -587,8 +586,7 @@ function Divisors(Self: integer): List; extensionmethod := function Divizors(Self: integer): List; extensionmethod := Divisors(Self); -/// Возвращает список всех k делителей натурального числа n. -/// Если делителей не ровно k, возвращает пустой список +///-- function Divisors(n, k: integer): List; begin n := Abs(n); // foolproof @@ -634,8 +632,7 @@ begin Result := L end; -/// Возвращает список всех k делителей натурального числа n. -/// Если делителей не ровно k, возвращает пустой список +///-- function Divisors(Self, k: integer): List; extensionmethod := Divisors(Self, k); diff --git a/TestSuite/CompilationSamples/WPFObjects.pas b/TestSuite/CompilationSamples/WPFObjects.pas index b44fefcce..4c5e8f317 100644 --- a/TestSuite/CompilationSamples/WPFObjects.pas +++ b/TestSuite/CompilationSamples/WPFObjects.pas @@ -112,23 +112,23 @@ type Invoke(DeleteP,ob); end; public - /// Перемещает объект на задний план + /// Перемещает графический объект на задний план procedure ToBack(ob: ObjectWPF); begin if not l.Contains(ob) then raise new Exception('На задний план нельзя переносить дочерние объекты'); Invoke(ToBackP,ob); end; - /// Перемещает объект на передний план + /// Перемещает графический объект на передний план procedure ToFront(ob: ObjectWPF); begin if not l.Contains(ob) then raise new Exception('На передний план нельзя переносить дочерние объекты'); Invoke(ToFrontP,ob); end; - /// Возвращает количество объектов ObjectWPF + /// Возвращает количество графических объектов property Count: integer read l.Count; - /// Возвращает или устанавливает i-тый объект ObjectWPF + /// Возвращает или устанавливает i-тый графический объект property Items[i: integer]: ObjectWPF read GetItem write SetItem; default; function Seq: sequence of ObjectWPF := l; @@ -140,19 +140,21 @@ type begin Result := l.GetEnumerator; end; - /// Очистить список игровых объектов + /// Очистить список графических объектов procedure Clear; begin for var i:=Count-1 downto 0 do Destroy(Items[i]); end; - /// Удалить все игровые объекты, удовлетворяющие условию + /// Удалить все графические объекты, удовлетворяющие условию procedure DestroyAll(condition: ObjectWPF -> boolean); begin for var i := Count - 1 downto 0 do if condition(Items[i]) then Destroy(Items[i]); end; + /// Возвращает инвертированный список графических объектов + function Reverse: IEnumerable := (Self as IEnumerable).Reverse; end; @@ -173,7 +175,7 @@ type transl: TranslateTransform; ChildrenWPF := new List; - procedure InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean := True); + procedure InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean := True; Hidden: boolean := False); public /// Направление движения по оси X. Используется методом Move auto property Dx: real; @@ -1157,13 +1159,26 @@ type var b := CreateBitmapImage(fname); Rest(x,y,b.PixelWidth,b.PixelHeight,b); end; + + procedure InitObHidden(x,y: real; fname: string); + begin + var b := CreateBitmapImage(fname); + var im := new System.Windows.Controls.Image(); + im.Source := b; + im.Width := b.PixelWidth; + im.Height := b.PixelHeight; + InitOb(x,y,b.PixelWidth,b.PixelHeight,im,True,True); + end; function GetInternalGeometry: Geometry; override; begin var r := Rect(0,0,Width,Height); Result := new RectangleGeometry(r); end; + /// + constructor Create(Hidden: boolean; x,y: real; fname: string) := Invoke(InitObHidden,x,y,fname); public function Element := ob as System.Windows.Controls.Image; + static function CreateInvisible(x,y: real; fname: string): PictureWPF := new PictureWPF(False,x,y,fname); /// Создает рисунок из файла fname с координатами левого верхнего угла (x,y) constructor (x,y: real; fname: string) := Invoke(InitOb2,x,y,fname); /// Создает рисунок из файла fname с координатами левого верхнего угла (x,y) и размерами (w,h) @@ -1238,9 +1253,58 @@ procedure __FinalizeModule__; //procedure BeginFrameBasedAnimationTime(DrawT: procedure(dt: real)); +/// Класс, содержащий константы направления +type Direction = class + /// Направление "Влево" + static property Left: (real,real) read (-1.0,0.0); + /// Направление "Вправо" + static property Right: (real,real) read (1.0,0.0); + /// Направление "Вверх" + static property Up: (real,real) read (0.0,-1.0); + /// Направление "Вниз" + static property Down: (real,real) read (0.0,1.0); + /// Направление "Влево вверх" + static property LeftUp: (real,real) read (-1.0,-1.0); + /// Направление "Влево вниз" + static property LeftDown: (real,real) read (-1.0,1.0); + /// Направление "Вправо вверх" + static property RightUp: (real,real) read (1.0,-1.0); + /// Направление "Вправо вниз" + static property RightDown: (real,real) read (1.0,1.0); + /// Нулевое направление (объект неподвижен) + static property Zero: (real,real) read (0.0,0.0); + /// Направление "Вперёд" для объекта + static function &Forward(obj: ObjectWPF): (real,real) + := (sin(Pi/180*obj.RotateAngle),-cos(Pi/180*obj.RotateAngle)); + /// Направление "Назад" для объекта + static function &Backward(obj: ObjectWPF): (real,real) + := (-sin(Pi/180*obj.RotateAngle),cos(Pi/180*obj.RotateAngle)); + /// Направление "Влево" для объекта + static function LeftSide(obj: ObjectWPF): (real,real) + := (-cos(Pi/180*obj.RotateAngle),-sin(Pi/180*obj.RotateAngle)); + /// Направление "Вправо" для объекта + static function RightSide(obj: ObjectWPF): (real,real) + := (cos(Pi/180*obj.RotateAngle),sin(Pi/180*obj.RotateAngle)); +end; + +/// Не отображать слой графических объектов (обычно вызывается в начале до создания графических объектов) +procedure HideObjects; + +/// Отображать слой графических объектов (вызывается после HideObjects и создания начальной сцены графических объектов) +procedure ShowObjects; implementation +procedure HideObjects; +begin + Invoke(()->begin host.Visibility := Visibility.Hidden end); +end; + +procedure ShowObjects; +begin + Invoke(()->begin host.Visibility := Visibility.Visible end); +end; + //procedure BeginFrameBasedAnimation(Draw: procedure; frate: integer) := GraphWPF.BeginFrameBasedAnimation(Draw,frate); //procedure BeginFrameBasedAnimationTime(DrawT: procedure(dt: real)) := GraphWPF.BeginFrameBasedAnimationTime(DrawT); @@ -1329,7 +1393,7 @@ begin Result := ObjectsIntersect(Self,ob); end; -procedure ObjectWPF.InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean); +procedure ObjectWPF.InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean; Hidden: boolean); begin can := new Canvas; gr := new Grid; @@ -1359,10 +1423,11 @@ begin gr.Children.Add(t); can.Children.Add(gr); - Objects.Add(Self); - //host.Children.Add(can); - FontSize := 16; + + if Hidden then + Visible := False; + Objects.Add(Self); end; procedure ObjectWPF.AddChildP(ch: ObjectWPF; al: Alignment); @@ -1508,6 +1573,7 @@ end; function ObjectsIntersect(o1,o2: ObjectWPF) := Invoke&(ObHelper.Create(o1,o2).IntersectP); +/// Возвращает список объектов, пересекающихся с данным function IntersectionList(Self: ObjectWPF): List; extensionmethod := Invoke&>(OLHelper.Create(Self).f); @@ -1515,8 +1581,10 @@ procedure ToFront(o: ObjectWPF) := Objects.ToFront(o); procedure ToBack(o: ObjectWPF) := Objects.ToBack(o); +/// Перемещает объект на передний план procedure ToFront(Self: ObjectWPF); extensionmethod := Objects.ToFront(Self); +/// Перемещает объект на задний план procedure ToBack(Self: ObjectWPF); extensionmethod := Objects.ToBack(Self); function operator implicit (t: (integer,integer)): (real,real); extensionmethod := (real(t[0]),real(t[1]));