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

DrawPixels

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2019-05-16 15:42:16 +03:00
parent e86dd93227
commit 4d547d9af3
11 changed files with 74 additions and 102 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 = "4";
public const string Build = "2";
public const string Revision = "2050";
public const string Revision = "2055";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=2
%REVISION%=2050
%MINOR%=4
%REVISION%=2055
%COREVERSION%=2
%MAJOR%=3

9
InstallerSamples/Graphics/GraphWPF/DrawPixels.pas Normal file
View file

@ -0,0 +1,9 @@
uses GraphWPF;
begin
Window.SetSize(640, 480);
var m := MatrGen(640,480,(x,y)->RGB(2 * x - y, x - 3 * y, x + y));
MillisecondsDelta.Println;
DrawPixels(0,0,m);
MillisecondsDelta.Println;
end.

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.4.2.2050'
!define VERSION '3.4.2.2055'

2
SyntaxVisitors/SugarVisitors/TupleVisitor.cs
View file

@ -39,7 +39,7 @@ namespace SyntaxVisitors.SugarVisitors
public override void visit(tuple_node tup)
{
var dn = new dot_node(new dot_node(new ident("?System"), new ident("Tuple")), new ident("Create", tup.source_context));
var dn = new dot_node(new dot_node(new ident("?System", tup.source_context), new ident("Tuple", tup.source_context), tup.source_context), new ident("Create", tup.source_context));
var mc = new method_call(dn, tup.el, tup.source_context);
//var sug = new sugared_expression(tup, mc, tup.source_context); - нет никакой семантической проверки - всё - на уровне синтаксиса!

69
TestSuite/CompilationSamples/GraphWPF.pas
View file

@ -200,11 +200,13 @@ type
//>> Графические примитивы # GraphWPF primitives
// -----------------------------------------------------
/// Рисует пиксел в точке (x,y) цветом c
procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color);
/// Рисует пиксел в точке (x,y) цветом c
procedure SetPixel(x,y: real; c: Color);
/// Рисует двумерный массив пикселов с координатами левой верхней вершины (x,y)
procedure DrawPixels(x,y: real; a: array [,] of Color);
/// Рисует прямоугольник пикселей размера (w,h), задаваемых отображением f, начиная с левого верхнего угла с координатами (x,y)
procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color);
/// Рисует двумерный массив пикселей pixels начиная с левого верхнего угла с координатами (x,y)
procedure DrawPixels(x,y: real; pixels: array [,] of Color);
/// Рисует прямоугольную область (px,py,pw,ph) двумерного массива пикселей pixels начиная с левого верхнего угла с координатами (x,y)
procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer);
/// Рисует эллипс с центром в точке (x,y) и радиусами rx и ry
procedure Ellipse(x,y,rx,ry: real);
/// Рисует контур эллипса с центром в точке (x,y) и радиусами rx и ry
@ -767,32 +769,45 @@ begin
Result := dpic[fname];
end;
procedure DrawPixelsP(x,y: real; a: array [,] of Color);
procedure DrawPixelsP(x,y:real; px,py,pw,ph: integer; a: array [,] of Color);
begin
var (scalex,scaley) := ScaleToDevice;
var sw := a.ColCount;
var sh := a.RowCount;
var bitmap := new WriteableBitmap(sw, sh, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil);
var stride := sw * (bitmap.Format.BitsPerPixel div 8); // stride - это длина одной строки
var bitmap := new WriteableBitmap(pw, ph, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil);
var pixels := new byte[a.RowCount*a.ColCount*4];
var p := 0;
for var i := 0 to a.RowCount-1 do
for var j := 0 to a.ColCount-1 do
begin
pixels[p] := a[i,j].B;
p += 1;
pixels[p] := a[i,j].G;
p += 1;
pixels[p] := a[i,j].R;
p += 1;
pixels[p] := a[i,j].A;
p += 1;
end;
bitmap.WritePixels(new Int32Rect(0, 0, sw, sh), pixels, stride, 0);
var stride := pw*4; // stride - это размер одной строки в байтах
var size := stride*ph;
// var pixels := new byte[w*h*4];
// var p := 0;
// for var dy := ay to ay+h-1 do
// for var dx := ax to ax+w-1 do
// begin
// pixels[p] := a[dx,dy].B; p += 1;
// pixels[p] := a[dx,dy].G; p += 1;
// pixels[p] := a[dx,dy].R; p += 1;
// pixels[p] := a[dx,dy].A; p += 1;
// end;
// bitmap.WritePixels(new Int32Rect(0, 0, w, h), pixels, stride, 0);
//так на 10-20% быстрее
var pixels := System.Runtime.InteropServices.Marshal.AllocHGlobal(size);
var curr_ptr := pixels;
for var dy := py to py+ph-1 do
for var dx := px to px+pw-1 do
begin
var c := a[dx,dy];
PByte(curr_ptr.ToPointer)^ := c.B; curr_ptr := curr_ptr + 1;
PByte(curr_ptr.ToPointer)^ := c.G; curr_ptr := curr_ptr + 1;
PByte(curr_ptr.ToPointer)^ := c.R; curr_ptr := curr_ptr + 1;
PByte(curr_ptr.ToPointer)^ := c.A; curr_ptr := curr_ptr + 1;
end;
bitmap.WritePixels(new Int32Rect(0, 0, pw, ph), pixels, size, stride);
System.Runtime.InteropServices.Marshal.FreeHGlobal(pixels);
var dc := GetDC();
dc.DrawImage(bitmap, Rect(x, y, bitmap.PixelWidth, bitmap.PixelHeight));
dc.DrawImage(bitmap, Rect(x, y, pw, ph));
ReleaseDC(dc);
end;
@ -915,7 +930,9 @@ procedure SetPixel(x,y: real; c: Color) := InvokeVisual(SetPixelP, x, y, c);
procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color)
:= InvokeVisual(SetPixelsP, x, y, w, h, f);
procedure DrawPixels(x,y: real; a: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,a);
procedure DrawPixels(x,y: real; pixels: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,0,0,pixels.GetLength(0),pixels.GetLength(1),pixels);
procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer) := InvokeVisual(DrawPixelsP,x,y,px,py,pw,ph,pixels);
procedure ArcPFull(x, y, r, angle1, angle2: real; p: GPen) := ArcSectorPFull(x, y, r, angle1, angle2, nil, p, false);

6
TestSuite/errors/err0319.pas
View file

@ -1,6 +0,0 @@
type AAA = record s: string[4] end;
begin
var f := OpenFile&<AAA>('a.dat');
//f.Read;
end.

24
TestSuite/lambda_capture_local_vs_field.pas
View file

@ -1,24 +0,0 @@
type
t1 = class
static a: integer := 1;//не обязательно статичное поле
procedure p1;
begin
var a := 2;
var p: procedure := ()->begin
Assert(a=2);
end;
p;
end;
end;
begin
(new t1).p1;
end.

24
TestSuite/lambda_nonstatic_from_static.pas
View file

@ -1,24 +0,0 @@
type
t1 = class
b: byte;
static procedure p1(b: byte);
begin
var p: procedure;
p := ()->
begin
p := ()->
begin
b := b;
end;
end;
end;
end;
begin
Assert(1=1);
end.

2
VisualPascalABCNET/UserOptions.cs
View file

@ -13,7 +13,7 @@ namespace VisualPascalABC
public bool EnableFolding = false; // SSM 4.09.08
public bool ShowMathBraket = false;
public bool ConverTabsToSpaces = true;
public bool deleteEXEAfterExecute = true;
public bool deleteEXEAfterExecute = false;
public bool deletePDBAfterExecute = true;
public bool UseOutputDirectory = false;
public string OutputDirectory = null;

32
bin/Lib/GraphWPF.pas
View file

@ -200,13 +200,13 @@ type
//>> Графические примитивы # GraphWPF primitives
// -----------------------------------------------------
/// Рисует пиксел в точке (x,y) цветом c
procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color);
/// Рисует пиксел в точке (x,y) цветом c
procedure SetPixel(x,y: real; c: Color);
/// Рисует двумерный массив пикселей, левым верхнум углом на координатах окна (x;y)
procedure DrawPixels(x,y: real; a: array [,] of Color);
/// Рисует прямоугольную область (ax;ay;w;h) из двумерного массива пикселей, левым верхнум углом на координатах окна (x;y)
procedure DrawPixels(x,y: real; ax,ay, w,h: integer; a: array [,] of Color);
/// Рисует прямоугольник пикселей размера (w,h), задаваемых отображением f, начиная с левого верхнего угла с координатами (x,y)
procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color);
/// Рисует двумерный массив пикселей pixels начиная с левого верхнего угла с координатами (x,y)
procedure DrawPixels(x,y: real; pixels: array [,] of Color);
/// Рисует прямоугольную область (px,py,pw,ph) двумерного массива пикселей pixels начиная с левого верхнего угла с координатами (x,y)
procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer);
/// Рисует эллипс с центром в точке (x,y) и радиусами rx и ry
procedure Ellipse(x,y,rx,ry: real);
/// Рисует контур эллипса с центром в точке (x,y) и радиусами rx и ry
@ -769,13 +769,13 @@ begin
Result := dpic[fname];
end;
procedure DrawPixelsP(x,y:real; ax,ay, w,h: integer; a: array [,] of Color);
procedure DrawPixelsP(x,y:real; px,py,pw,ph: integer; a: array [,] of Color);
begin
var (scalex,scaley) := ScaleToDevice;
var bitmap := new WriteableBitmap(w, h, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil);
var bitmap := new WriteableBitmap(pw, ph, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil);
var stride := w*4; // stride - это размер одной строки в байтах
var size := stride*h;
var stride := pw*4; // stride - это размер одной строки в байтах
var size := stride*ph;
// var pixels := new byte[w*h*4];
@ -794,8 +794,8 @@ begin
//так на 10-20% быстрее
var pixels := System.Runtime.InteropServices.Marshal.AllocHGlobal(size);
var curr_ptr := pixels;
for var dy := ay to ay+h-1 do
for var dx := ax to ax+w-1 do
for var dy := py to py+ph-1 do
for var dx := px to px+pw-1 do
begin
var c := a[dx,dy];
PByte(curr_ptr.ToPointer)^ := c.B; curr_ptr := curr_ptr + 1;
@ -803,11 +803,11 @@ begin
PByte(curr_ptr.ToPointer)^ := c.R; curr_ptr := curr_ptr + 1;
PByte(curr_ptr.ToPointer)^ := c.A; curr_ptr := curr_ptr + 1;
end;
bitmap.WritePixels(new Int32Rect(0, 0, w, h), pixels, size, stride);
bitmap.WritePixels(new Int32Rect(0, 0, pw, ph), pixels, size, stride);
System.Runtime.InteropServices.Marshal.FreeHGlobal(pixels);
var dc := GetDC();
dc.DrawImage(bitmap, Rect(x, y, w, h));
dc.DrawImage(bitmap, Rect(x, y, pw, ph));
ReleaseDC(dc);
end;
@ -930,9 +930,9 @@ procedure SetPixel(x,y: real; c: Color) := InvokeVisual(SetPixelP, x, y, c);
procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color)
:= InvokeVisual(SetPixelsP, x, y, w, h, f);
procedure DrawPixels(x,y: real; a: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,0,0,a.GetLength(0),a.GetLength(1),a);
procedure DrawPixels(x,y: real; pixels: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,0,0,pixels.GetLength(0),pixels.GetLength(1),pixels);
procedure DrawPixels(x,y: real; ax,ay, w,h: integer; a: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,ax,ay,w,h,a);
procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer) := InvokeVisual(DrawPixelsP,x,y,px,py,pw,ph,pixels);
procedure ArcPFull(x, y, r, angle1, angle2: real; p: GPen) := ArcSectorPFull(x, y, r, angle1, angle2, nil, p, false);