Rect Zuweisung an ClipRect von FPCavas funktioniert nicht. Warum?

[thosch]

Hallo,

Ich benutze in einem Projekt die Klasse FPCanvas, genauer gesagt eine Ableitung davon mit eigenen Methoden. Mein konkretes Derivat stammt von FPImageCanvas ab.
Aber der ClipRecord wird doch schon in TFPCanvas definiert und instanziiert.

Code: Alles auswählen

procedure TFPCustomCanvas.SetClipRect(const AValue: TRect);
var
  lNewRegion: TFPRectRegion;
begin
  lNewRegion := TFPRectRegion.Create;
  lNewRegion.Rect := AValue;
  if FClipRegion <> nil then FClipRegion.Free;
  FClipRegion := lNewRegion;
end;  

Ich weise hier die Werte zu:

Code: Alles auswählen

procedure TVisibleControl.SetDimensions(Aleft, ATop, AWidth, AHeight: Integer);
var R: TRect;
begin
  FLeft := ALeft;
  FTop  := ATop;
  FWidth := AWidth;
  FHeight := AHeight;
  R.Left := ALeft; R.Width := AWidth;
  R.Top  := ATop;  R.Bottom:= ATop + AHeight;
  FCanvas.Width := FWidth;
  FCanvas.Height := FHeight;
  FCanvas.ClipRect := R;
end;     

TVisibleControl ist Bestandteil meines Projektes und beutzt mein Canvas Objekt, abgeleitet von TFPImageCanvas aus fclimage.

Warum erhalte ich dann für ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom den Wert 0?


.

[wp_xyz]

Bist du sicher, dass du auf den ClipRect "deines" von TFPImageCanvas abgeleiteten Canvas zugreifst, und nicht auf den aus der Graphics-Unit? Die beiden haben nichts miteinander zu tun.

[thosch]

@wp_xyz:

Ja, bin ich, da ich die Graphics Unit nicht verwende.

Nur Classes, Sysutils, FPCanvas, FPImage und fpcnvs.

fpcnvs enthält mein abgeletetes Canvas Objekt, abgeleitet von fpimagecanvas.

[wp_xyz]

Ich habe gefunden, dass Clipping mit fcl-Image prinzipiell nicht funktionieren kann, denn in der Routine PointInside() der unit Clipping steckt ein Bug:

Code: Alles auswählen

function PointInside (const x,y:integer; bounds:TRect) : boolean;
begin
  SortRect (bounds);
  with Bounds do
    result := (x >= left) and (x <= right) and
              (y >= top) and (y <= bottom);   // richtig
//              (y >= bottom) and (y <= top);  // aktueller Code
end;

Ich habe das eben im BugTracker gemeldet (https://bugs.freepascal.org/view.php?id=38889).

Nach dieser Korrektur funktioniert das Clipping. Allerdings gibt mir Canvas.ClipRect die richtigen Koordinaten des ClipRect aus. Ich vermute daher, dass der von dir geschilderte Fehler in deinem Programm liegt.

Hier mein Code, den ich zum Testen verwendet habe:

Code: Alles auswählen

program project1;
uses
  Types, fpImage, fpCanvas, fpImgCanv, fpWritePng;
var
  canvas: TFPCustomCanvas;
  image: TFPCustomImage;
  writer: TFPCustomImageWriter;
  R: TRect;

begin
  { Create an image 100x100 pixels}
  image := TFPMemoryImage.Create(100,100);

  { Attach the image to the canvas }
  canvas := TFPImageCanvas.Create(image);

  R := Rect(0, 0, 100, 50);

  { Set the pen styles }
  with canvas do
  begin
    Pen.Mode := pmCopy;
    Pen.Style := psSolid;
    Pen.Width := 1;
    Pen.FPColor := colWhite;
    ClipRect := R;
    Clipping := true;
  end;

  WriteLn('L:', Canvas.ClipRect.Left, ' T:', Canvas.ClipRect.Top, ' R:', Canvas.ClipRect.Right, ' B:', Canvas.ClipRect.Bottom);

  { Draw a circle }
  canvas.Ellipse (10,10, 90,90);

  { Draw two lines }
  canvas.Line(0, 0, 100, 100);
  canvas.Line(0, 100, 100, 0);

  { Create the writer }
  writer := TFPWriterPNG.Create;

  { Save to file }
  image.SaveToFile('DrawTest.png', writer);

  { Clean up! }
  canvas.Free;
  image.Free;
  writer.Free;

  ReadLn;
end.