diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index df18d9d77..43ca41984 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 = "3"; - public const string Revision = "3108"; + public const string Revision = "3113"; 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 378fcc914..5bf5cf008 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=3 -%REVISION%=3108 %MINOR%=8 +%REVISION%=3113 +%COREVERSION%=3 %MAJOR%=3 diff --git a/InstallerSamples/Games/LifeWPF.pas b/InstallerSamples/Games/LifeWPF.pas new file mode 100644 index 000000000..2b66711c0 --- /dev/null +++ b/InstallerSamples/Games/LifeWPF.pas @@ -0,0 +1,296 @@ +// Игра "Жизнь" на торе +// Оптимизация хешированием по равномерной сетке +uses GraphWPF; + +const +/// Ширина клетки + w = 4.0; +/// Количество клеток по ширине + m = 300; +/// Количество клеток по высоте + n = 220; +/// Отступ поля от левой границы окна + x0 = 0; +/// Отступ поля от верхней границы окна + y0 = 21; +/// Количество клеток сетки по горизонтали + mk = 15; +/// Количество клеток сетки по вертикали + nk = 10; + +var + configuration,NeighborsA,NeighborsB: array [0..n+1,0..m+1] of byte; + updateA,updateB: array [1..nk,1..mk] of boolean; + CountCells: integer; + updateFlag: boolean; + generation: integer; + + // визуальные компоненты для прорисовки как единого целого + configurationVisual: DrawingVisual; + infoVisual: DrawingVisual; + +/// Нарисовать все изменившиеся ячейки +procedure DrawConfiguration; +begin + DrawOnVisual(configurationVisual,dc->begin + for var i:=1 to n do + for var j:=1 to m do + if configuration[i,j]=1 then + DrawRectangleDC(dc,x0+(j-1)*w+0.5,y0+(i-1)*w+0.5,w-1,w-1,Brushes.Black,nil); + end); +end; + +/// Нарисовать все изменившиеся ячейки +procedure DrawInfo; +begin + DrawOnVisual(infoVisual,dc->begin + TextOutDC(dc,14,0,'Поколение: '+generation); + TextOutDC(dc,Window.Width - 110,0,'Жителей: '+CountCells); + end); +end; + +/// Нарисовать поле +procedure DrawField; +begin + var hm := m div mk; + var hn := n div nk; + Pen.Color := Colors.LightGray; + for var i:=0 to m do + if i mod hm <> 0 then + Line(x0+i*w,y0,x0+i*w,y0+n*w); + for var i:=0 to n do + if i mod hn <> 0 then + Line(x0,y0+i*w,x0+m*w,y0+i*w); + Pen.Color := Colors.Gray; + for var i:=0 to m do + if i mod hm = 0 then + Line(x0+i*w,y0,x0+i*w,y0+n*w); + for var i:=0 to n do + if i mod hn = 0 then + Line(x0,y0+i*w,x0+m*w,y0+i*w); + FlushDrawingToBitmap; +end; + +/// Увеличить массив соседей для данной клетки +procedure IncNeighbors(i,j: integer); +begin + var i1,i2,j1,j2: integer; + if i=1 then i1:=n else i1:=i-1; + if i=n then i2:=1 else i2:=i+1; + if j=1 then j1:=m else j1:=j-1; + if j=m then j2:=1 else j2:=j+1; + NeighborsB[i1,j1] += 1; + NeighborsB[i1,j] += 1; + NeighborsB[i1,j2] += 1; + NeighborsB[i,j1] += 1; + NeighborsB[i,j2] += 1; + NeighborsB[i2,j1] += 1; + NeighborsB[i2,j] += 1; + NeighborsB[i2,j2] += 1; +end; + +/// Уменьшить массив соседей для данной клетки +procedure DecNeighbors(i,j: integer); +begin + var i1,i2,j1,j2: integer; + if i=1 then i1:=n else i1:=i-1; + if i=n then i2:=1 else i2:=i+1; + if j=1 then j1:=m else j1:=j-1; + if j=m then j2:=1 else j2:=j+1; + NeighborsB[i1,j1] -= 1; + NeighborsB[i1,j] -= 1; + NeighborsB[i1,j2] -= 1; + NeighborsB[i,j1] -= 1; + NeighborsB[i,j2] -= 1; + NeighborsB[i2,j1] -= 1; + NeighborsB[i2,j] -= 1; + NeighborsB[i2,j2] -= 1; +end; + +/// Поставить ячейку в клетку (i,j) +procedure SetCell(i,j: integer); +begin + if configuration[i,j] = 0 then + begin + configuration[i,j] := 1; + updateFlag := True; + IncNeighbors(i,j); + CountCells += 1; + end; +end; + +/// Убрать ячейку из клетки (i,j) +procedure UnSetCell(i,j: integer); +begin + if configuration[i,j] = 1 then + begin + configuration[i,j] := 0; + updateFlag := True; + DecNeighbors(i,j); + CountCells -= 1; + end; +end; + +/// Обработать ячейку (основные правила игры Жизнь) +procedure ProcessCell(i,j: integer); +begin + case NeighborsA[i,j] of +0..1,4..9: UnSetCell(i,j); +3: SetCell(i,j); + end; +end; + +/// Перейти к следующему поколению +procedure NextGen; +begin + var hm := m div mk; + var hn := n div nk; + for var ik:=1 to nk do // двойной цикл по ячейкам хеширования + begin + for var jk:=1 to mk do + begin + updateFlag := False; // обновлены ли данные в ячейке хеширования + var ifirst := (ik-1)*hn+1; + var ilast := (ik-1)*hn+hn; + var jfirst := (jk-1)*hm+1; + var jlast := (jk-1)*hm+hm; + if updateA[ik,jk] then + begin + for var i:=ifirst to ilast do + for var j:=jfirst to jlast do + ProcessCell(i,j); + end + else + begin + var ik1,jk1,ik2,jk2: integer; + if ik=1 then ik1:=nk else ik1:=ik-1; + if ik=nk then ik2:=1 else ik2:=ik+1; + if jk=1 then jk1:=mk else jk1:=jk-1; + if jk=mk then jk2:=1 else jk2:=jk+1; + var l := updateA[ik,jk1]; + var r := updateA[ik,jk2]; + var u := updateA[ik1,jk]; + var d := updateA[ik2,jk]; + var lu := updateA[ik1,jk1]; + var ld := updateA[ik2,jk1]; + var ru := updateA[ik1,jk2]; + var rd := updateA[ik2,jk2]; + if u then + for var j:=jfirst+1 to jlast-1 do + ProcessCell(ifirst,j); + if d then + for var j:=jfirst+1 to jlast-1 do + ProcessCell(ilast,j); + if l then + for var i:=ifirst+1 to ilast-1 do + ProcessCell(i,jfirst); + if r then + for var i:=ifirst+1 to ilast-1 do + ProcessCell(i,jlast); + if u or l or lu then + ProcessCell(ifirst,jfirst); + if u or r or ru then + ProcessCell(ifirst,jlast); + if d or l or ld then + ProcessCell(ilast,jfirst); + if d or r or rd then + ProcessCell(ilast,jlast); + end; + updateB[ik,jk] := updateFlag; + end; + end; +end; + +procedure InitWindow; +begin + if (m mod mk<>0) or (n mod nk<>0) then + begin + Writeln('Размер кластера не согласован с размером поля. Программа завершена'); + exit + end; + Window.SetSize(x0+m*w,y0+n*w); + Window.CenterOnScreen; + Window.Title := 'Игра "Жизнь"'; + //Window.IsFixedSize := True; + Font.Name := 'Arial'; + Font.Size := 14; +end; + +/// Инициализировать массивы и конфигурацию поля +procedure InitArrays; +begin + for var i:=0 to n+1 do + for var j:=0 to m+1 do + configuration[i,j] := 0; + NeighborsB := configuration; + NeighborsA := NeighborsB; + for var ik:=1 to nk do + for var jk:=1 to mk do + updateB[ik,jk] := True; + updateA := updateB; + CountCells := 0; +end; + +var yc := n div 2; +var xc := m div 2; + +/// Инициализировать начальную конфигурацию +procedure InitConfiguration; +begin + SetCell(yc,xc); + SetCell(yc,xc+1); + SetCell(yc,xc+2); + SetCell(yc-1,xc+2); + SetCell(yc+1,xc+1); + + {var tx := -3; + var ty := -4; + SetCell(tx + xc,ty + yc); + SetCell(tx + xc,ty + yc+1); + SetCell(tx + xc,ty + yc+2); + SetCell(tx + xc-1,ty + yc+2); + SetCell(tx + xc-2,ty + yc+1); + + SetCell(xc,yc); + SetCell(xc+1,yc+1); + SetCell(xc+1,yc-1); + SetCell(xc+2,yc+1); + SetCell(xc+2,yc-1); + SetCell(xc+3,yc);} +end; + + + +begin + InitWindow; + InitArrays; + InitConfiguration; + + DrawField; + + // визуальный элемент для рисования конфигурации + // при повторном рисовании на нем старое изображение автоматически стирается + configurationVisual := CreateVisual; + // визуальный элемент для рисования инфомации + infoVisual := CreateVisual; + + DrawConfiguration; + DrawInfo; + + MillisecondsDelta; + generation := 0; + while True do + begin + generation += 1; + + NeighborsA := NeighborsB; + updateA := updateB; + NextGen; + //Sleep(30); + DrawConfiguration; + if generation mod 10 = 0 then + DrawInfo; + if generation mod 1000 = 0 then + Writeln('Поколение ',generation,': ',MillisecondsDelta/1000,' с'); + end; +end. diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 615a7049f..0d9fc2217 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.8.3.3108 +3.8.3.3113 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 9449e5051..a63a80933 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.8.3.3108' +!define VERSION '3.8.3.3113' diff --git a/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs b/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs index e32311004..cd97908b3 100644 --- a/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs +++ b/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs @@ -174,7 +174,7 @@ namespace SyntaxVisitors.SugarVisitors var stat = new statement_list(indexvar,fe2); ReplaceUsingParent(fe, stat); ProcessNode(fe2.in_what); - ProcessNode(forstat.list[0]); + ProcessNode(forstat); } else DefaultVisit(fe); } diff --git a/TestSuite/CompilationSamples/GraphWPF.pas b/TestSuite/CompilationSamples/GraphWPF.pas index d9dea9ebe..4ad68f70b 100644 --- a/TestSuite/CompilationSamples/GraphWPF.pas +++ b/TestSuite/CompilationSamples/GraphWPF.pas @@ -39,6 +39,7 @@ type GRect = System.Windows.Rect; /// Тип окна GWindow = System.Windows.Window; + /// Тип пера GPen = System.Windows.Media.Pen; /// Тип точки Point = System.Windows.Point; @@ -48,6 +49,12 @@ type Vector = System.Windows.Vector; /// Тип кисти GBrush = System.Windows.Media.Brush; + /// Набор предопределенных кистей + Brushes = System.Windows.Media.Brushes; + /// Контекст рисования + DrawingContext = System.Windows.Media.DrawingContext; + /// Визуальный объект для отрисовки с помощью контекста рисования + DrawingVisual = System.Windows.Media.DrawingVisual; /// Тип стиля шрифта FontStyle = (Normal,Bold,Italic,BoldItalic); @@ -478,6 +485,8 @@ function Pnt(x,y: real): GPoint; function Rect(x,y,w,h: real): GRect; /// Возвращает однотонную цветную кисть, заданную цветом function ColorBrush(c: Color): GBrush; +/// Возвращает однотонную цветную кисть случайного цвета +function RandomColorBrush: GBrush; /// Возвращает однотонное цветное перо, заданное цветом function ColorPen(c: Color): GPen; /// Возвращает однотонное цветное перо, заданное цветом и толщиной @@ -704,12 +713,24 @@ function TextWidthPFont(text: string; f: FontOptions): real; function TextHeightPFont(text: string; f: FontOptions): real; /// Размер текста (совместно с FastDraw) function TextSizePFont(text: string; f: FontOptions): Size; +/// Создает визуальный объект и добавляет его к отображаемым объектам +function CreateVisual: DrawingVisual; +/// Удаляет визуальный объект из отображаемых +procedure RemoveVisual(visual: DrawingVisual); +/// Рисует на визуальном объекте с помощью контекста рисования +procedure DrawOnVisual(visual: DrawingVisual; proc: DrawingContext->()); +/// Рисует все визуальные объекты на битмапе рендеринга и очищает список визуальных объектов +procedure FlushDrawingToBitmap; -procedure AddToHost(v: Visual); -{function GetDC: DrawingContext; -procedure ReleaseDC(dc: DrawingContext); -procedure FastClear(var dc: DrawingContext);} +//procedure AddToHost(v: Visual); +//procedure RemoveFromHost(v: Visual); + +function GetDC: DrawingContext; +//procedure ReleaseDC(dc: DrawingContext); +//procedure FastClear(var dc: DrawingContext); +//procedure HostToRenderBitmap; + procedure __InitModule__; procedure __FinalizeModule__; @@ -741,8 +762,17 @@ function clRandom := RandomColor(); function Pnt(x,y: real) := new Point(x,y); function Rect(x,y,w,h: real) := new System.Windows.Rect(x,y,w,h); function ColorBrush(c: Color) := GetBrush(c); -function ColorPen(c: Color) := new GPen(GetBrush(c),Pen.Width); -function ColorPen(c: Color; w: real) := new GPen(GetBrush(c),w); +function RandomColorBrush := GetBrush(RandomColor); +function ColorPen(c: Color): GPen; +begin + Result := new GPen(GetBrush(c),Pen.Width); + Result.Freeze +end; +function ColorPen(c: Color; w: real): GPen; +begin + Result := new GPen(GetBrush(c),w); + Result.Freeze +end; function RandomPoint(w: real): Point := Pnt(Random(w,Window.Width-w),Random(w,Window.Height-w)); @@ -797,6 +827,11 @@ begin Host.children.Add(v); end; +procedure RemoveFromHost(v: Visual); +begin + Host.children.Remove(v); +end; + function GetDC: DrawingContext; begin var visual := new DrawingVisual(); @@ -818,6 +853,31 @@ begin HostToRenderBitmap end; +/// Создает визуальный объект и добавляет его к отображаемым объектам +function CreateVisual: DrawingVisual; +begin + var visual: DrawingVisual; + Redraw(()->begin visual := new DrawingVisual; AddToHost(visual) end ); + Result := visual; +end; + +/// Удаляет визуальный объект из отображаемых +procedure RemoveVisual(visual: DrawingVisual) := Redraw(()->RemoveFromHost(visual)); + +/// Рисует на визуальном объекте с помощью контекста рисования +procedure DrawOnVisual(visual: DrawingVisual; proc: DrawingContext->()); +begin + Redraw(()->begin + var dc := visual.RenderOpen(); + proc(dc); + dc.Close; + end); +end; + +/// Рисует все визуальные объекты на битмапе рендеринга и очищает список визуальных объектов +procedure FlushDrawingToBitmap := Redraw(()->HostToRenderBitmap()); + + procedure FastDraw(commands: DrawingContext->()); begin Invoke(()-> diff --git a/TestSuite/CompilationSamples/GraphWPFBase.pas b/TestSuite/CompilationSamples/GraphWPFBase.pas index 511301664..316e48541 100644 --- a/TestSuite/CompilationSamples/GraphWPFBase.pas +++ b/TestSuite/CompilationSamples/GraphWPFBase.pas @@ -60,7 +60,11 @@ var //var BrushesDict := new Dictionary; -function GetBrush(c: GColor): GBrush := new SolidColorBrush(c); +function GetBrush(c: GColor): GBrush; +begin + Result := new SolidColorBrush(c); + Result.Freeze +end; {begin if not (c in BrushesDict) then begin diff --git a/TestSuite/CompilationSamples/graph3d.pas b/TestSuite/CompilationSamples/graph3d.pas index 664a31eeb..0470a6fc0 100644 --- a/TestSuite/CompilationSamples/graph3d.pas +++ b/TestSuite/CompilationSamples/graph3d.pas @@ -1205,12 +1205,15 @@ type private function CreateStoryboard: StoryBoard; begin + //Println('CreateStoryboard'); sb := new StoryBoard; var storyboardName := 's' + sb.GetHashCode; MainWindow.Resources.Add(storyboardName, sb); var an := AnimationCompleted; sb.Completed += (o, e) -> begin + //Println('CompletedStoryBoardStart'); MainWindow.Resources.Remove(storyboardName); + //Println('CompletedStoryBoardEnd'); if an <> nil then an; end; @@ -1742,10 +1745,8 @@ type // Клонируем. Надо еще списки клонировать! А то в a+a во втором списке последний элемент - клонированный - в обоих списках! //lf := lf.Clone; llf[lli] := lf; - lf.Completed += procedure -> + lf.Completed := procedure -> begin - //Print('Completed '+lf.GetType.ToString); - //Println(i+1); lll[i+1].Begin; end; end; @@ -3498,7 +3499,8 @@ var //{{{--doc: Конец секции 1 }}} - +procedure Proba2; +function Any(x, y, z: real; c: Color): ObjectWithMaterial3D; ///-- procedure __InitModule__; @@ -4609,8 +4611,8 @@ type a.Points := Arr(P3D(0, 0, 0), P3D(3, 0, 0), P3D(3, 0, 0), P3D(3, 3, 0), P3D(3, 3, 0), P3D(3, 3, 3)); a.Color := c;} - var a := new My13D; - a.Material := c; + {var a := new My13D; + a.Material := c;} {var aa := 1; @@ -4630,10 +4632,10 @@ type a.EndAngle := 360; a.ThetaDiv := 60;} - {var a := new HelixToolkit.Wpf.TubeVisual3D; - var p := new Point3DCollection(Arr(P3D(1,2,0),P3D(2,1,0),P3D(3,1,0))); - a.Diameter := 0.05; - a.Path := p;} + var a := new HelixToolkit.Wpf.TubeVisual3D; + var p := new Point3DCollection(Arr(P3D(0,0,0),P3D(2,0,0),P3D(2,2,0),P3D(2,2,2))); + a.Diameter := 0.3; + a.Path := p; {var a := new LegoVisual3D(); a.Rows := 1; @@ -4650,7 +4652,7 @@ function MyH(x, y, z, Length: real; c: Color): MyAnyT := Inv(()->MyAnyT.Create(x function MyH(x, y, z, Length: real; c: Material): MyAnyT := Inv(()->MyAnyT.Create(x, y, z, Length, c)); -function Any(x, y, z: real; c: Color): AnyT := Inv(()->AnyT.Create(x, y, z, c)); +function Any(x, y, z: real; c: Color): ObjectWithMaterial3D := Inv(()->AnyT.Create(x, y, z, c)); // Сервисные функции и классы diff --git a/TestSuite/foreach_index_loop.pas b/TestSuite/foreach_index_loop.pas new file mode 100644 index 000000000..01860aa7c --- /dev/null +++ b/TestSuite/foreach_index_loop.pas @@ -0,0 +1,9 @@ +begin + var l := Lst(0); + foreach var x in |0,1,5| index i do + begin + loop 2 do + l += i + end; + Assert(l.SequenceEqual(|0,0,0,1,1,2,2|)); +end. \ No newline at end of file diff --git a/VisualPascalABCNET/Form1.cs b/VisualPascalABCNET/Form1.cs index c24a915af..9e42bfe4a 100644 --- a/VisualPascalABCNET/Form1.cs +++ b/VisualPascalABCNET/Form1.cs @@ -234,6 +234,7 @@ namespace VisualPascalABC // PascalABCCompiler.StringResourcesLanguage.CurrentLanguageName = PascalABCCompiler.StringResourcesLanguage.AccessibleLanguages[0]; InitializeComponent(); + tsAutoInsertCode.Visible = false; VisualPABCSingleton.MainForm = this; WorkbenchStorage.MainProgramThread = System.Threading.Thread.CurrentThread; diff --git a/bin/Lib/Graph3D.pas b/bin/Lib/Graph3D.pas index 664a31eeb..0470a6fc0 100644 --- a/bin/Lib/Graph3D.pas +++ b/bin/Lib/Graph3D.pas @@ -1205,12 +1205,15 @@ type private function CreateStoryboard: StoryBoard; begin + //Println('CreateStoryboard'); sb := new StoryBoard; var storyboardName := 's' + sb.GetHashCode; MainWindow.Resources.Add(storyboardName, sb); var an := AnimationCompleted; sb.Completed += (o, e) -> begin + //Println('CompletedStoryBoardStart'); MainWindow.Resources.Remove(storyboardName); + //Println('CompletedStoryBoardEnd'); if an <> nil then an; end; @@ -1742,10 +1745,8 @@ type // Клонируем. Надо еще списки клонировать! А то в a+a во втором списке последний элемент - клонированный - в обоих списках! //lf := lf.Clone; llf[lli] := lf; - lf.Completed += procedure -> + lf.Completed := procedure -> begin - //Print('Completed '+lf.GetType.ToString); - //Println(i+1); lll[i+1].Begin; end; end; @@ -3498,7 +3499,8 @@ var //{{{--doc: Конец секции 1 }}} - +procedure Proba2; +function Any(x, y, z: real; c: Color): ObjectWithMaterial3D; ///-- procedure __InitModule__; @@ -4609,8 +4611,8 @@ type a.Points := Arr(P3D(0, 0, 0), P3D(3, 0, 0), P3D(3, 0, 0), P3D(3, 3, 0), P3D(3, 3, 0), P3D(3, 3, 3)); a.Color := c;} - var a := new My13D; - a.Material := c; + {var a := new My13D; + a.Material := c;} {var aa := 1; @@ -4630,10 +4632,10 @@ type a.EndAngle := 360; a.ThetaDiv := 60;} - {var a := new HelixToolkit.Wpf.TubeVisual3D; - var p := new Point3DCollection(Arr(P3D(1,2,0),P3D(2,1,0),P3D(3,1,0))); - a.Diameter := 0.05; - a.Path := p;} + var a := new HelixToolkit.Wpf.TubeVisual3D; + var p := new Point3DCollection(Arr(P3D(0,0,0),P3D(2,0,0),P3D(2,2,0),P3D(2,2,2))); + a.Diameter := 0.3; + a.Path := p; {var a := new LegoVisual3D(); a.Rows := 1; @@ -4650,7 +4652,7 @@ function MyH(x, y, z, Length: real; c: Color): MyAnyT := Inv(()->MyAnyT.Create(x function MyH(x, y, z, Length: real; c: Material): MyAnyT := Inv(()->MyAnyT.Create(x, y, z, Length, c)); -function Any(x, y, z: real; c: Color): AnyT := Inv(()->AnyT.Create(x, y, z, c)); +function Any(x, y, z: real; c: Color): ObjectWithMaterial3D := Inv(()->AnyT.Create(x, y, z, c)); // Сервисные функции и классы diff --git a/bin/Lib/GraphWPF.pas b/bin/Lib/GraphWPF.pas index cdef99488..a06c2bbb5 100644 --- a/bin/Lib/GraphWPF.pas +++ b/bin/Lib/GraphWPF.pas @@ -39,6 +39,7 @@ type GRect = System.Windows.Rect; /// Тип окна GWindow = System.Windows.Window; + /// Тип пера GPen = System.Windows.Media.Pen; /// Тип точки Point = System.Windows.Point; @@ -48,6 +49,12 @@ type Vector = System.Windows.Vector; /// Тип кисти GBrush = System.Windows.Media.Brush; + /// Набор предопределенных кистей + Brushes = System.Windows.Media.Brushes; + /// Контекст рисования + DrawingContext = System.Windows.Media.DrawingContext; + /// Визуальный объект для отрисовки с помощью контекста рисования + DrawingVisual = System.Windows.Media.DrawingVisual; /// Тип стиля шрифта FontStyle = (Normal,Bold,Italic,BoldItalic); @@ -478,6 +485,8 @@ function Pnt(x,y: real): GPoint; function Rect(x,y,w,h: real): GRect; /// Возвращает однотонную цветную кисть, заданную цветом function ColorBrush(c: Color): GBrush; +/// Возвращает однотонную цветную кисть случайного цвета +function RandomColorBrush: GBrush; /// Возвращает однотонное цветное перо, заданное цветом function ColorPen(c: Color): GPen; /// Возвращает однотонное цветное перо, заданное цветом и толщиной @@ -704,12 +713,24 @@ function TextWidthPFont(text: string; f: FontOptions): real; function TextHeightPFont(text: string; f: FontOptions): real; /// Размер текста (совместно с FastDraw) function TextSizePFont(text: string; f: FontOptions): Size; +/// Создает визуальный объект и добавляет его к отображаемым объектам +function CreateVisual: DrawingVisual; +/// Удаляет визуальный объект из отображаемых +procedure RemoveVisual(visual: DrawingVisual); +/// Рисует на визуальном объекте с помощью контекста рисования +procedure DrawOnVisual(visual: DrawingVisual; proc: DrawingContext->()); +/// Рисует все визуальные объекты на битмапе рендеринга и очищает список визуальных объектов +procedure FlushDrawingToBitmap; -procedure AddToHost(v: Visual); -{function GetDC: DrawingContext; -procedure ReleaseDC(dc: DrawingContext); -procedure FastClear(var dc: DrawingContext);} +//procedure AddToHost(v: Visual); +//procedure RemoveFromHost(v: Visual); + +function GetDC: DrawingContext; +//procedure ReleaseDC(dc: DrawingContext); +//procedure FastClear(var dc: DrawingContext); +//procedure HostToRenderBitmap; + procedure __InitModule__; procedure __FinalizeModule__; @@ -741,8 +762,17 @@ function clRandom := RandomColor(); function Pnt(x,y: real) := new Point(x,y); function Rect(x,y,w,h: real) := new System.Windows.Rect(x,y,w,h); function ColorBrush(c: Color) := GetBrush(c); -function ColorPen(c: Color) := new GPen(GetBrush(c),Pen.Width); -function ColorPen(c: Color; w: real) := new GPen(GetBrush(c),w); +function RandomColorBrush := GetBrush(RandomColor); +function ColorPen(c: Color): GPen; +begin + Result := new GPen(GetBrush(c),Pen.Width); + Result.Freeze +end; +function ColorPen(c: Color; w: real): GPen; +begin + Result := new GPen(GetBrush(c),w); + Result.Freeze +end; function RandomPoint(w: real): Point := Pnt(Random(w,Window.Width-w),Random(w,Window.Height-w)); @@ -797,6 +827,11 @@ begin Host.children.Add(v); end; +procedure RemoveFromHost(v: Visual); +begin + Host.children.Remove(v); +end; + function GetDC: DrawingContext; begin var visual := new DrawingVisual(); @@ -818,6 +853,31 @@ begin HostToRenderBitmap end; +/// Создает визуальный объект и добавляет его к отображаемым объектам +function CreateVisual: DrawingVisual; +begin + var visual: DrawingVisual; + Redraw(()->begin visual := new DrawingVisual; AddToHost(visual) end ); + Result := visual; +end; + +/// Удаляет визуальный объект из отображаемых +procedure RemoveVisual(visual: DrawingVisual) := Redraw(()->RemoveFromHost(visual)); + +/// Рисует на визуальном объекте с помощью контекста рисования +procedure DrawOnVisual(visual: DrawingVisual; proc: DrawingContext->()); +begin + Redraw(()->begin + var dc := visual.RenderOpen(); + proc(dc); + dc.Close; + end); +end; + +/// Рисует все визуальные объекты на битмапе рендеринга и очищает список визуальных объектов +procedure FlushDrawingToBitmap := Redraw(()->HostToRenderBitmap()); + + procedure FastDraw(commands: DrawingContext->()); begin Invoke(()-> diff --git a/bin/Lib/GraphWPFBase.pas b/bin/Lib/GraphWPFBase.pas index 511301664..316e48541 100644 --- a/bin/Lib/GraphWPFBase.pas +++ b/bin/Lib/GraphWPFBase.pas @@ -60,7 +60,11 @@ var //var BrushesDict := new Dictionary; -function GetBrush(c: GColor): GBrush := new SolidColorBrush(c); +function GetBrush(c: GColor): GBrush; +begin + Result := new SolidColorBrush(c); + Result.Freeze +end; {begin if not (c in BrushesDict) then begin