Idee für Ellipsenbogen unter Nutzung von ellipses.pp Unit (TEllipseInfo - Klasse)

Für Fragen zur Programmiersprache auf welcher Lazarus aufbaut
Antworten
Mario Peters
Beiträge: 27
Registriert: Sa 26. Apr 2025, 22:41

Idee für Ellipsenbogen unter Nutzung von ellipses.pp Unit (TEllipseInfo - Klasse)

Beitrag von Mario Peters »

Hallo

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;   
Meine erweiterte TEllipseInfo sieht hetzt so aus

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
..................
Hier ist meine erweiterte GatherEllipseInfo():

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;
Für die FPC Community ist vor Allem die CalculateEllipse() Funktion interessant. Das soll mein Dankeschön für bisher erhaltene Hilfe im Verständisfrage Thread sein!

Mario Peters
Beiträge: 27
Registriert: Sa 26. Apr 2025, 22:41

Re: Idee für Ellipsenbogen unter Nutzung von ellipses.pp Unit (TEllipseInfo - Klasse)

Beitrag von Mario Peters »

NOCH EINE VARIANTE

Code: Alles auswählen

program ardemo;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, vipgfx, tools, myTTF,  Types, fpcanvas, fpcnvs, math, ellipses;

type
  TEllipse_Info = class                                             //Dieses Demo verwendet die Unit ellipses.pp, deshalb hier anderer Klassenname
  private
    FCenterX, FCenterY: Integer;
    FRadiusX, FRadiusY: Integer;
    FStartAngle, FEndAngle: Double;
    FStartPoint, FEndPoint: TPoint;                              //zunächst eine separate TTllipseInfo Klasse die ich deshalb auch TEllipse_Info genannt 
                                                                                  //habe
  public                                                                      //Nach diesem Muster könnte auch die vordefinierte TEllipseInfo Klasse erweitert werden
    //die übernimmt die Daten der Ellipse und berechet auch die Koordinaten der Bogenenden 
    constructor Create(AX, AY, ARx, ARy: Integer; AStartAngle, AEndAngle: Double);
    procedure CalculateEndpoints;    //hier werden die Koordinaten der Bogenenden berechnet
    property CenterX: Integer read FCenterX;
    property CenterY: Integer read FCenterY;
    property RadiusX: Integer read FRadiusX;
    property RadiusY: Integer read FRadiusY;
    property StartAngle: Double read FStartAngle;
    property EndAngle: Double read FEndAngle;
    property StartPoint: TPoint read FStartPoint;  //die Bogenenden 
    property EndPoint: TPoint read FEndPoint;      //als XY Koordinaten
  end;

constructor TEllipse_Info.Create(AX, AY, ARx, ARy: Integer; AStartAngle, AEndAngle: Double);
begin
  FCenterX := AX;
  FCenterY := AY;
  FRadiusX := ARx;
  FRadiusY := ARy;
  FStartAngle := AStartAngle;
  FEndAngle := AEndAngle;
  CalculateEndpoints;
end;

procedure TEllipse_Info.CalculateEndpoints;
var
  rad: Double;
begin
  // Startpunkt berechnen
  rad := DegToRad(FStartAngle);
  FStartPoint.X := FCenterX + Round(FRadiusX * cos(rad));
  FStartPoint.Y := FCenterY - Round(FRadiusY * sin(rad));

  // Endpunkt berechnen
  rad := DegToRad(FEndAngle);
  FEndPoint.X := FCenterX + Round(FRadiusX * cos(rad));
  FEndPoint.Y := FCenterY - Round(FRadiusY * sin(rad));
end;

//eine beliebige eigene Ellipsenroutine
procedure DrawEllipse(xm,ym,xR,yR,stangle,endangle: Extended);
var
  angle: extended;
  a,b,x: extended;
  yp,yn: Extended;
  px,py: int64;
  y,p,e: Extended;
  r: Extended;
begin
  angle := 0.0;
  angle := stangle;
  x := xm; y := ym;
  a := xR; b := yR;
  e := sqrt(sqr(a)-sqr(b))/a;
  r := sqr(b)/(1-sqr(e)*sqr(cos(angle)));
  while angle < endangle do
  begin
    a := x / cos(angle);  b := y / sin(angle);      //x = a * cos(angle); y = b * sin(angle)
    yp := b/a * sqrt(sqr(a)-sqr(x));
    py := Round(yp);
    PutPixelClip(vscreen,Round(x),Round(yp),RGBA($77,$77,$77,$ff));
    yn := -b/a * sqrt(sqr(a)-sqr(x));
    py := round(yp);
  end;
end;

var
  EI: TEllipse_Info;
  canvas: TFPfclCanvas;
  Bounds: TRect;
  astartangle,aendangle: double;
  ax,ay,arx,ary: integer;
  FontPath: String;
  pic,pic2: gfxImage;

begin
  astartangle := 45;
  aendangle := 135;
  Bounds.Left := 100;
  Bounds.Top  := 200;
  Bounds.Right := 450;
  Bounds.Bottom := 350;

  ax := centerpoint(Bounds).X;  //Bounds.Right + Bounds.Left) div 2;
  ay := centerpoint(Bounds).Y;  //Bounds.Bottom + Bounds.Top) div 2;
  arx := (Bounds.Right - Bounds.Left) div 2;
  ary := (Bounds.Bottom - Bounds.Top) div 2;
  EI := TEllipse_Info.Create(AX,AY, arx, ary, AStartAngle,AEndAngle);
  ax := EI.CenterX;
  ay := EI.CenterY;

  jpegLoad(pic,'girl.jpg');   //nur pic am Ende frei geben
  jpegLoad(pic2,'pic.jpg');

  Fontpath := ParamStr(0);
  FontPath := ExtractFilePath(FontPath);

  initGFXsystem(1280, 720, false);                                   //eigenes Grafiksystem (vipgfx von Kirill Kranz)

  canvas := TFPfclCanvas.Create;                                  //wie PTC definiert dieses ein Surface das nicht zwingend der Bidschirm sein muss
                                                                                         //hier aber der 
  canvas.Surface:=vscreen;                                            //Bildschirm ist
  repeat
    canvas.Pen.FPColor := colGreen;
    canvas.EllipseSector(AX,AY,aRX,aRY,aStartAngle,aEndAngle,canvas.Pen.FPColor);  //eine von mir definierte Methode
                                                                                                                                           //Basis TFPCustomCanvas, eigenes Canvas Objekt                       
                                                                                                                                           //abgeleitet
    canvas.Line(EI.CenterX, EI.CenterY, EI.StartPoint.X, EI.StartPoint.Y);
    canvas.Line(EI.CenterX, EI.CenterY, EI.FEndPoint.X,EI.FEndPoint.Y);

    updateGFXsystem;

until gfxDone or keyboard[KEY_ESCAPE];

//canvas.Free;
finishGFXsystem;
ReturnFPSstring;

freeimage(pic);

//gfxwrite(IntToStr(measuredTicks));

FinishGFXSystem;
canvas.Free;

 
end.


wp_xyz
Beiträge: 5277
Registriert: Fr 8. Apr 2011, 09:01

Re: Idee für Ellipsenbogen unter Nutzung von ellipses.pp Unit (TEllipseInfo - Klasse)

Beitrag von wp_xyz »

Code: Alles auswählen

//eine beliebige eigene Ellipsenroutine
procedure DrawEllipse(xm,ym,xR,yR,stangle,endangle: Extended);
...
begin
  ...
  while angle < endangle do
  begin
    a := x / cos(angle);  b := y / sin(angle);      //x = a * cos(angle); y = b * sin(angle)
    yp := b/a * sqrt(sqr(a)-sqr(x));
    py := Round(yp);
    PutPixelClip(vscreen,Round(x),Round(yp),RGBA($77,$77,$77,$ff));
    yn := -b/a * sqrt(sqr(a)-sqr(x));
    py := round(yp);
  end;
end;
Kann das stimmen? In der while-Schleife sehe ich nirgends, wo die Variable angle hochgezählt wird. Ich denke, das ist eine Totschleife.

Mario Peters
Beiträge: 27
Registriert: Sa 26. Apr 2025, 22:41

Re: Idee für Ellipsenbogen unter Nutzung von ellipses.pp Unit (TEllipseInfo - Klasse)

Beitrag von Mario Peters »

wp_xyz hat geschrieben: Di 9. Sep 2025, 23:58

Code: Alles auswählen

//eine beliebige eigene Ellipsenroutine
procedure DrawEllipse(xm,ym,xR,yR,stangle,endangle: Extended);
...
begin
  ...
  while angle < endangle do
  begin
    a := x / cos(angle);  b := y / sin(angle);      //x = a * cos(angle); y = b * sin(angle)
    yp := b/a * sqrt(sqr(a)-sqr(x));
    py := Round(yp);
    PutPixelClip(vscreen,Round(x),Round(yp),RGBA($77,$77,$77,$ff));
    yn := -b/a * sqrt(sqr(a)-sqr(x));
    py := round(yp);
  end;
end;
Kann das stimmen? In der while-Schleife sehe ich nirgends, wo die Variable angle hochgezählt wird. Ich denke, das ist eine Totschleife.
Jetzt wo Du mich drauf hinweist, sehe ich es auch, es wurde auch keine Ellipse angezeigt, jetzt weiß ich auch warum. Habe für mein Beispiel die Ellipsenmethode aus meinen vorherigen Entwürfen verwendet. Meine DrawEllipse() Prozedur hat noch andere Fehler die ich fixen muss.

Antworten