Warning: ob_start(): function 'compress_handler' not found or invalid function name in /www/htdocs/xfmantis/core.php on line 18
0001953: Zeichenfunktion Ellipse - Mantis
Mantis - X-Force
Viewing Issue Advanced Details
ID: Category: Severity: Reproducibility: Date Submitted: Last Update:
1953 Allgemein minor always 29.06.08 12:52 08.08.08 03:00
Reporter: Natter Platform:  
Assigned To: Jim_Raynor OS:  
Priority: normal OS Version:  
Status: closed Product Version: V0.915a02  
Product Build: Resolution: fixed  
Projection: none      
ETA: none Fixed in Version: V0.915a03  
Summary: 0001953: Zeichenfunktion Ellipse
Description: Blending.pas benötigt eine Zeichenfunktion für Kreis/Ellipse. Benötigt wird das z.B. um die Reichweite von Granaten anzuzeigen.
Steps To Reproduce:
Additional Information: Beispiel für Linie:
procedure HLine(Surface: TDirectDrawSurface;const Mem: TDDSurfaceDesc;FromX,ToX,Y: Integer;Col: TBlendColor);
var
  Left,Right : Integer;
  Pixel : Integer;
  Length : Integer;
  i : Integer;
begin
  if (Y < Surface.ClippingRect.Top) then
    exit;
  if (Y >= Surface.ClippingRect.Bottom) then
    exit;
  // Determine which is left and right by value
  if FromX=ToX then exit;
  if (FromX > ToX) then
  begin
    left := ToX;
    right := FromX + 1;
  end
  else
  begin
    left := FromX;
    right := ToX + 1;
  end;
  // Clip the line
  if (left < Surface.ClippingRect.left) then
    Left := Surface.ClippingRect.left;
  if (right > Surface.ClippingRect.right) then
    Right := Surface.ClippingRect.right;
  Length:=Right-Left;
  if Length<=0 then exit;
  Pixel:=Integer(Mem.lpSurface)+(Mem.lPitch*Y);
  if Mode32Bit then
  begin
    inc(Pixel,Left shl 2);
    repeat
      PInteger(Pixel)^ := Col;
      inc(Pixel,4);
      dec(Length);
    until (Length = 0);
  end
  else
  begin
    inc(Pixel,left shl 1);
    i := Length mod 2;
    dec(Length,i);
    while i > 0 do
    begin
      PWord(Pixel)^:=Col;
      inc(Pixel,2);
      dec(i);
    end;
    if (Length > 1) then
    begin
      Col := Col or (Col shl 16);
      repeat
        PInteger(Pixel)^:=Col;
        inc(Pixel,4);
        dec(Length,2);
      until (Length = 0);
    end;
  end;
end;
Relationships
Attached Files:

Notes
(0003392)
Jim_Raynor   
07.07.08 00:01   
So hier gibts schonmal ne theoretische Ellipse-Funktion für ein normales Canvas:

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  r,w,i: Integer;
  x,y,z: Integer;
  Points: Array of TPoint;
  Seg : Integer;
  Poi1, Poi2, Poi3, Poi4: PPoint;
  rad: double;
begin
  w:=(PaintBox1.Width div 2)-1;
  r:=(PaintBox1.Height div 2)-1;

  Seg:=max(30,((w+r) div 10));

  with PaintBox1.Canvas do
  begin
    FillRect(PaintBox1.ClientRect);

    i:=(Seg div 4);
    SetLength(Points,((i+1)*4));

    Poi1:=Addr(Points[0]);
    Poi2:=Addr(Points[(i*2)+1]);
    Poi3:=Addr(Points[2+i*2]);
    Poi4:=Addr(Points[(i*4)+3]);

    for z:=0 to i do
    begin
      rad:=(z/Seg)*Pi*2;
      X:=round(w*sin(rad));
      Y:=round(r*cos(rad));

      Poi1.X:=w+X; Poi1.Y:=Y+r;
      Poi2.X:=Poi1.X; Poi2.Y:=r-Y;
      Poi3.X:=w-X; Poi3.Y:=Poi2.Y;
      Poi4.X:=Poi3.X; Poi4.Y:=Poi1.Y;

      inc(Poi1); inc(Poi3);
      dec(Poi2); dec(Poi4);
    end;
  end;

  PaintBox1.Canvas.Polyline(Points);
end;

Muss jetzt noch optimiert und für TDirectDrawSurface angepasst werden.