Ich habe nun eine CalculateEllipse Funkuion! mit dem Rückgabewert vom Typ TEllipseinfo entwickelt, die die Ellipse oder einen Bogen derselben zeichnet und die Punkte dieser Ellipse in ein Array von TPoiont Elementen schreibt. Diese Punkte können dann an eine Polygon Routine übergeben werden, um die Ellipse zu zeichnen. Dies soll meine Final-Version sein für meinen Ellipsenbogen. Diese Routine dürft Ihr gerne verwenden und in Freepascal einbauen, damit das Basis FPCanvas Objekt auch Ellipsenbögen zeichnen kann bei denen die Endpunkte des Bogens auch bekannt sind, werden von der Ellipsenfunktion mit berechnet, die aufwendige Berschnung der Ellipsenkoordinaten wird dann überflüssig.
Da ich bisher in keiner Mailingliste für Lazarus Entwickler registriert bin, posten ich Updates meiner Ellipsenrouine ab jetzt hier!
Code: Alles auswählen
function CalculateEllipse(Boundes: TRect; Angle1, Angle2: Double; var sx,sy,ex,ey: Integer): TEllipseInfo;
var info : TEllipseInfo;
r, y : integer;
a, b: integer;
xc,yc: integer;
rx1,ry1: integer;
rx2,ry2: integer;
Canv: TFPCustomCanvas;
c: TFPColor;
begin
info := TEllipseInfo.Create;
with Canv, info do
try
GatherEllipseInfo(Boundes);
a := (Boundes.Right - Boundes.Left) div 2;
b := (Boundes.Bottom- Boundes.Top) div 2;
xc := CenterPoint(Boundes).X;
yc := Centerpoint(Boundes).Y;
(*
rx1 := Info.cx + Round(a * cos(Angle1));
ry1 := Info.cy + Round(b * sin(Angle1));
rx2 := Info.cx + Round(a * cos(Angle2));
ry2 := Info.cy + Round(b * sin(Angle2));
*)
for r := 0 to InfoList.count-1 do
with PEllipseInfoData(InfoList[r])^ do
begin
for y := ytopmin to ytopmax do
begin
PutPixelDummy (Canv, x,y, r, Info);
(*
if x = rx1 then if PEllipseInfoData(InfoList[r])^.xd = rx1 then sx := x;
if y = ry1 then if PEllipseInfoData(InfoList[r])^.yd = ry1 then sy := y;
if x = rx2 then if PEllipseInfoData(InfoList[r])^.xd = rx2 then ex := x;
if y = ry2 then if PEllipseInfoData(InfoList[r])^.yd = ry2 then ey := y;
*)
end;
for y := ybotmin to ybotmax do
PutPixelDummy (Canv, x,y, r, Info);
(*
if x = rx1 then if PEllipseInfoData(InfoList[r])^.xd = rx1 then sx := x;
if y = ry1 then if PEllipseInfoData(InfoList[r])^.yd = ry1 then sy := y;
if x = rx2 then if PEllipseInfoData(InfoList[r])^.xd = rx2 then ex := x;
if y = ry2 then if PEllipseInfoData(InfoList[r])^.yd = ry2 then ey := y;
*)
end;
sx := Info.x1;
sy := Info.y1;
ex := Info.x2;
ey := Info.y2;
Result := Info;
finally
//info.Free;
end;
end;
PutPixelDummy sieht so aus:
[code]
procedure PutPixelDummy(Canv:TFPCustomCanvas; x,y,i:integer; Info: TEllipseInfo);
var LinePoints: PLinePoints; p: TPoint;
begin
PatternToPoints($FFFFFFFF, @LinePoints, Info); //aus ellipses.pp aufgerufen
p.X := x; p.y := y;
if i <= Info.NumPix then
if LinePoints^[i] then Info.Pixels[i] := p; //wenn im Pattern gesetzt, dann Pixel zeichnen in Info.Pixrels (zusätzlich eingefügt, um aus Info die Punkte zu erhalten)
end;
Code: Alles auswählen
TEllipseInfo = class
private
fcx, fcy, frx,fry,
fa1, fa2, frot : real;
fx1,fy1, fx2,fy2 : integer;
fnumpix: Integer;
InfoList : TList;
fpixels: array of TPoint;
procedure FreeList;
procedure ClearList;
function FindXIndex (x:integer) : integer;
procedure PrepareCalculation (var np:integer; var delta:real);
function NewInfoRec (anX:integer) : PEllipseInfoData;
procedure CalculateCircular (const b:TRect; var x,y,rx,ry:real);
function GetPixels(Index: Integer): TPoint;
procedure SetPixels(Index: Integer; p: TPoint);
public
constructor create;
destructor destroy; override;
function GetInfoForX (x:integer; var ytopmax,ytopmin,ybotmax,ybotmin:integer):boolean;
function GetInfoForX (x:integer; var Info:PEllipseInfoData):boolean;
procedure GatherEllipseInfo (const bounds:TRect);
procedure GatherArcInfo (const bounds:TRect; alpha1,alpha2:real);
property cx : real read fcx; // center point
property cy : real read fcy;
property rhor : real read frx; // radius
property rver : real read fry;
{ only usable when created with GatherArcInfo }
property a1 : real read fa1; // angle 1 and point on ellipse
property x1 : integer read fx1;
property y1 : integer read fy1;
property a2 : real read fa2; // angle 2 and point on ellipse
property x2 : integer read fx2;
property y2 : integer read fy2;
property NumPix: Integer read fnumpix; //Anzahl der Pnkte der Ellipse
property Pixels[Index: Integer]: TPoint read GetPixels write SetPixels; //Punkte der Ellipse wenn als Polygon zu zeichnen
end;
[code]
Ziel ist es meinen Ellipsenbogen auch unter Nutzung der TEllipsenfo Klasse zu zeichenen und später alle Parameter meiner Ellipse immer griffbereit zu haben wie bei den Ellipsen die das Canvas schon jetzt zeichnen kann.
hier! erhalte ich aber beim Abrufen der Pixelanzahl eine EAccessviolation. Deshalb der Post auch im og. Thread!
Um die NumberOfPixels (NumPix zu bekommen, habe ich GatherEllipseInfo so erweitert, dass ich NumberOfPixels an das Feld
fnumpix: Integer; property NumPix: Integer read fnumpix;
weiter gebe
und die Pixel an
fpixels: array of TPoint; //property Pixels[Index: integer]: TPoint read GetPixels;
[code]
..................
EllipseParams2Coords(50,50,100-50,100-50,-30+180,0+180,sx,sy,ex,ey);
canvas.Arc(50,50,100,100,sx,sy,ex,ey); //Kreis- oder Ellipsenbogen
CalculateEllipse(Rect(20,60,360,400),0,360,p1.X,p1.Y,p2.X,p2.Y);
for i := 0 to Info.NumPix-1 do /hier die Exceotion .... Bitte in "Arc Methode Verständinsfrage" beantworten und nur dort!
canvas.PolyLine(Info.Pixels[i]); //Hier will ich die Ellipsenpunkte zeichnen
..................
Code: Alles auswählen
procedure TEllipseInfo.GatherEllipseInfo (const bounds:TRect);
var infoP, infoM : PEllipseInfoData;
halfnumber,
r, NumberPixels, xtemp,yt,yb : integer;
pPy, pMy, x,y, rx,ry, xd,yd,ra, rdelta : real;
begin
ClearList;
CalculateCircular (bounds, x,y,rx,ry);
with bounds do
fcx := x;
fcy := y;
frx := rx;
fry := ry;
if (rx < 0.5) and (ry < 0.5) then
with NewInfoRec (round(x))^ do
begin
ytopmax := round(y);
ytopmin := ytopmax;
ybotmax := ytopmax;
ybotmin := ytopmax;
end
else
begin
PrepareCalculation (NumberPixels, rdelta);
fnumpix := NumberPixels; //von mir hinzugefügt
SetLength(fpixels,sizeof(TPoint)*fnumpix);
halfnumber := NumberPixels div 2;
pPy := maxint;
pMy := maxint;
ra := 0;
infoP := NewInfoRec (round(x + rx));
infoM := NewInfoRec (round(x - rx));
for r := 0 to NumberPixels do
begin
xd := rx * cos(ra);
yd := ry * sin(ra);
InfoP := NewInfoRec (round(x+rx)); //von mir hinzugefügt
InfoM := NewInfoRec (round(x-rx)); //von mir hinzugefügt
// take all 4 quarters
yt := round(y - yd);
yb := round(y + yd);
xtemp := round (x + xd);
// quarter 1 and 4 at the same x line
if infoP^.x <> xtemp then // has correct record ?
begin
with infoP^ do // ensure single width
begin
if r < halfnumber then
begin
if ytopmin = yt then
begin
inc (ytopmin);
dec (ybotmax);
end;
end
else
begin
if (ytopmax = pPy) and (ytopmax <> ytopmin) then
begin
dec (ytopmax);
inc (ybotmin);
end;
end;
pPy := ytopmin;
end;
if not GetInfoForX (xtemp, infoP) then // record exists already ?
infoP := NewInfoRec (xtemp); // create a new recod
end;
// lower y is top, min is lowest
with InfoP^ do
begin
if yt < ytopmin then
ytopmin := yt;
if yb < ybotmin then
ybotmin := yb;
if yt > ytopmax then
ytopmax := yt;
if yb > ybotmax then
ybotmax := yb;
end;
InfoP^.xd := round(xd);
InfoP^.yd := round(yd);
// quarter 2 and 3 on the same x line
xtemp := round(x - xd);
if infoM^.x <> xtemp then // has correct record ?
begin
with infoM^ do // ensure single width
begin
if r < halfnumber then
begin
if ytopmin = yt then
begin
inc (ytopmin);
dec (ybotmax);
end;
end
else
begin
if (ytopmax = pMy) and (ytopmax <> ytopmin) then
begin
dec (ytopmax);
inc (ybotmin);
end;
end;
pMy := ytopmin;
end;
InfoM^.xd := round(xd); //von mir hinzugefügt
InfoM^.yd := round(yd); //von mir hinzugefügt
if not GetInfoForX (xtemp, infoM) then // record exists already ?
infoM := NewInfoRec (xtemp); // create a new recod
end;
// lower y is top, min is lowest
with InfoM^ do
begin
if yt < ytopmin then
ytopmin := yt;
if yb < ybotmin then
ybotmin := yb;
if yt > ytopmax then
ytopmax := yt;
if yb > ybotmax then
ybotmax := yb;
end;
ra := ra + rdelta;
end;
end;
end;