babaev-an/lasarus_compotents
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
lasarus_compotents/bgrabitmap/test/bgralape/extended_geometry_functions.inc

359 lines
13 KiB
PHP
Raw Permalink Blame History

procedure MyFillRectF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x1,y1,x2,y2: single;
begin
dm := TDrawMode(PInt32(Params^[5])^);
aa := PLongBool(Params^[6])^;
x1 := PSingle(Params^[0])^;
y1 := PSingle(Params^[1])^;
x2 := PSingle(Params^[2])^;
y2 := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.FillRectAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^);
target.LinearAntialiasing:= false;
end
else
target.FillPoly([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],PBGRAPixel(Params^[4])^,dm);
end;
procedure MyRectangleF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x1,y1,x2,y2: single;
begin
dm := TDrawMode(PInt32(Params^[6])^);
aa := PLongBool(Params^[7])^;
x1 := PSingle(Params^[0])^;
y1 := PSingle(Params^[1])^;
x2 := PSingle(Params^[2])^;
y2 := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.RectangleAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^);
target.LinearAntialiasing:= false;
end
else
target.FillPoly(target.ComputeWidePolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],PSingle(Params^[5])^),PBGRAPixel(Params^[4])^,dm);
end;
procedure MyRectangleWithFillF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x1,y1,x2,y2: single;
m: TBGRAMultishapeFiller;
begin
dm := TDrawMode(PInt32(Params^[7])^);
aa := PLongBool(Params^[8])^;
x1 := PSingle(Params^[0])^;
y1 := PSingle(Params^[1])^;
x2 := PSingle(Params^[2])^;
y2 := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.RectangleAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^);
target.LinearAntialiasing:= false;
end
else
begin
m := TBGRAMultishapeFiller.Create;
m.PolygonOrder:= poLastOnTop;
m.Antialiasing := false;
m.AddRectangle(x1,y1,x2,y2,PBGRAPixel(Params^[6])^);
m.AddPolygon(target.ComputeWidePolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],PSingle(Params^[5])^),PBGRAPixel(Params^[4])^);
m.Draw(target, dm);
m.Free;
end;
end;
procedure MyFillRoundRectF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x1,y1,x2,y2: single;
fill: TFillShapeInfo;
begin
dm := TDrawMode(PInt32(Params^[7])^);
aa := PLongBool(Params^[8])^;
x1 := PSingle(Params^[0])^;
y1 := PSingle(Params^[1])^;
x2 := PSingle(Params^[2])^;
y2 := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.FillRoundRectAntialias(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,[]);
target.LinearAntialiasing := false;
end
else
begin
fill := TFillRoundRectangleInfo.Create(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,[]);
target.FillShape(fill,PBGRAPixel(Params^[6])^,dm);
fill.Free;
end;
end;
procedure MyRoundRectF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x1,y1,x2,y2: single;
begin
dm := TDrawMode(PInt32(Params^[8])^);
aa := PLongBool(Params^[9])^;
x1 := PSingle(Params^[0])^;
y1 := PSingle(Params^[1])^;
x2 := PSingle(Params^[2])^;
y2 := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.RoundRectAntialias(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,PSingle(Params^[7])^,[]);
target.LinearAntialiasing := false;
end
else
target.FillPoly(target.ComputeWidePolygon(target.ComputeRoundRect(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,[]),PSingle(Params^[7])^),PBGRAPixel(Params^[6])^,dm);
end;
procedure MyRoundRectWithFillF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x1,y1,x2,y2: single;
m: TBGRAMultishapeFiller;
begin
dm := TDrawMode(PInt32(Params^[9])^);
aa := PLongBool(Params^[10])^;
x1 := PSingle(Params^[0])^;
y1 := PSingle(Params^[1])^;
x2 := PSingle(Params^[2])^;
y2 := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.RoundRectAntialias(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,PSingle(Params^[7])^,PBGRAPixel(Params^[8])^,[]);
target.LinearAntialiasing := false;
end
else
begin
m := TBGRAMultishapeFiller.Create;
m.PolygonOrder:= poLastOnTop;
m.Antialiasing := false;
m.AddRoundRectangle(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[8])^);
m.AddPolygon(target.ComputeWidePolygon(target.ComputeRoundRect(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,[]),PSingle(Params^[7])^),PBGRAPixel(Params^[6])^);
m.Draw(target, dm);
m.Free;
end;
end;
procedure MyFillEllipseF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x,y,rx,ry: single;
fill: TFillShapeInfo;
begin
dm := TDrawMode(PInt32(Params^[5])^);
aa := PLongBool(Params^[6])^;
x := PSingle(Params^[0])^;
y := PSingle(Params^[1])^;
rx := PSingle(Params^[2])^;
ry := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.FillEllipseAntialias(x,y,rx,ry,PBGRAPixel(Params^[4])^);
target.LinearAntialiasing:= false;
end
else
begin
if (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then exit;
fill := TFillEllipseInfo.Create(x,y,rx,ry);
target.FillShape(fill, PBGRAPixel(Params^[4])^,dm);
fill.Free;
end;
end;
procedure MyEllipseF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x,y,rx,ry: single;
begin
dm := TDrawMode(PInt32(Params^[6])^);
aa := PLongBool(Params^[7])^;
x := PSingle(Params^[0])^;
y := PSingle(Params^[1])^;
rx := PSingle(Params^[2])^;
ry := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.EllipseAntialias(x,y,rx,ry,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^);
target.LinearAntialiasing:= false;
end
else
target.FillPoly(target.ComputeEllipseBorder(x,y,rx,ry,PSingle(Params^[5])^),PBGRAPixel(Params^[4])^,dm);
end;
procedure MyEllipseWithFillF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x,y,rx,ry: single;
m: TBGRAMultishapeFiller;
begin
dm := TDrawMode(PInt32(Params^[7])^);
aa := PLongBool(Params^[8])^;
x := PSingle(Params^[0])^;
y := PSingle(Params^[1])^;
rx := PSingle(Params^[2])^;
ry := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
begin
target.LinearAntialiasing:= (dm=dmLinearBlend);
target.EllipseAntialias(x,y,rx,ry,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^);
target.LinearAntialiasing:= false;
end
else
begin
m := TBGRAMultishapeFiller.Create;
m.PolygonOrder:= poLastOnTop;
m.Antialiasing := false;
m.AddEllipse(x,y,rx,ry,PBGRAPixel(Params^[6])^);
m.AddPolygon(target.ComputeEllipseBorder(x,y,rx,ry,PSingle(Params^[5])^),PBGRAPixel(Params^[4])^);
m.Draw(target, dm);
m.Free;
end;
end;
procedure MyDrawLineF{$i lape.proc}
var dm: TDrawMode; aa: boolean;
x1,y1,x2,y2: single;
begin
dm := TDrawMode(PInt32(Params^[6])^);
aa := PLongBool(Params^[7])^;
x1 := PSingle(Params^[0])^;
y1 := PSingle(Params^[1])^;
x2 := PSingle(Params^[2])^;
y2 := PSingle(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
target.DrawLineAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^)
else
target.FillPoly(target.ComputeWidePolyline([PointF(x1,y1),PointF(x2,y2)],PSingle(Params^[5])^),PBGRAPixel(Params^[4])^,dm);
end;
procedure MyDrawPolyLineF{$i lape.proc}
type
PArrayOfTPointF = ^ArrayOfTPointF;
var
pts: PArrayOfTPointF;
dm: TDrawMode; aa: boolean;
begin
pts := Params^[0];
dm := TDrawMode(PInt32(Params^[3])^);
aa := PLongBool(Params^[4])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
target.DrawPolyLineAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^)
else
target.FillPoly(target.ComputeWidePolyline(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^,dm);
end;
procedure MyDrawPolygonF{$i lape.proc}
type
PArrayOfTPointF = ^ArrayOfTPointF;
var
pts: PArrayOfTPointF;
dm: TDrawMode; aa: boolean;
begin
pts := Params^[0];
dm := TDrawMode(PInt32(Params^[3])^);
aa := PLongBool(Params^[4])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
target.DrawPolygonAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^)
else
target.FillPoly(target.ComputeWidePolygon(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^,dm);
end;
procedure MyDrawPolyLineWithFillF{$i lape.proc}
type
PArrayOfTPointF = ^ArrayOfTPointF;
var
pts: PArrayOfTPointF;
dm: TDrawMode; aa: boolean;
multi: TBGRAMultishapeFiller;
begin
pts := Params^[0];
dm := TDrawMode(PInt32(Params^[4])^);
aa := PLongBool(Params^[5])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
target.DrawPolyLineAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^,PBGRAPixel(Params^[3])^)
else
begin
multi := TBGRAMultishapeFiller.Create;
multi.PolygonOrder := poLastOnTop;
multi.Antialiasing := false;
multi.AddPolygon(pts^,PBGRAPixel(Params^[3])^);
multi.AddPolygon(target.ComputeWidePolyline(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^);
multi.Draw(target,dm);
multi.Free;
end;
end;
procedure MyDrawPolygonWithFillF{$i lape.proc}
type
PArrayOfTPointF = ^ArrayOfTPointF;
var
pts: PArrayOfTPointF;
dm: TDrawMode; aa: boolean;
multi: TBGRAMultishapeFiller;
begin
pts := Params^[0];
dm := TDrawMode(PInt32(Params^[4])^);
aa := PLongBool(Params^[5])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
target.DrawPolygonAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^,PBGRAPixel(Params^[3])^)
else
begin
multi := TBGRAMultishapeFiller.Create;
multi.PolygonOrder := poLastOnTop;
multi.Antialiasing := false;
multi.AddPolygon(pts^,PBGRAPixel(Params^[3])^);
multi.AddPolygon(target.ComputeWidePolygon(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^);
multi.Draw(target,dm);
multi.Free;
end;
end;
procedure MyFillPolyF{$i lape.proc}
type
PArrayOfTPointF = ^ArrayOfTPointF;
var
pts: PArrayOfTPointF;
dm: TDrawMode; aa: boolean;
begin
pts := Params^[0];
dm := TDrawMode(PInt32(Params^[2])^);
aa := PLongBool(Params^[3])^;
if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
target.FillPolyAntialias(pts^,PBGRAPixel(Params^[1])^)
else
target.FillPoly(pts^,PBGRAPixel(Params^[1])^,dm);
end;
procedure RegisterExtendedGeometryFunctions(Compiler: TLapeCompiler);
begin
Compiler.addGlobalFunc('procedure _FillRectF(left, top, right, bottom: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillRectF);
Compiler.addGlobalFunc('procedure _RectangleF(left, top, right, bottom: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyRectangleF);
Compiler.addGlobalFunc('procedure _RectangleF(left, top, right, bottom: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyRectangleWithFillF);
Compiler.addGlobalFunc('procedure _FillRoundRectF(left, top, right, bottom, rx,ry: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillRoundRectF);
Compiler.addGlobalFunc('procedure _RoundRectF(left, top, right, bottom, rx,ry: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyRoundRectF);
Compiler.addGlobalFunc('procedure _RoundRectF(left, top, right, bottom, rx,ry: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyRoundRectWithFillF);
Compiler.addGlobalFunc('procedure _FillEllipseF(x,y,rx,ry: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillEllipseF);
Compiler.addGlobalFunc('procedure _EllipseF(x,y,rx,ry: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyEllipseF);
Compiler.addGlobalFunc('procedure _EllipseF(x,y,rx,ry: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyEllipseWithFillF);
Compiler.addGlobalFunc('procedure _DrawLineF(x1,y1,x2,y2: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyDrawLineF);
Compiler.addGlobalFunc('procedure _DrawPolyLineF(const pts: array of TPointF; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyDrawPolyLineF);
Compiler.addGlobalFunc('procedure _DrawPolygonF(const pts: array of TPointF; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyDrawPolygonF);
Compiler.addGlobalFunc('procedure _DrawPolyLineF(const pts: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyDrawPolyLineWithFillF);
Compiler.addGlobalFunc('procedure _DrawPolygonF(const pts: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyDrawPolygonWithFillF);
Compiler.addGlobalFunc('procedure _FillPolyF(const pts: array of TPointF; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillPolyF);
end;
Reference in New Issue View Git Blame Copy Permalink