Firemonkey Bild Perspektivisch zeichnen

[Peter666]

Hi,

ich hab mal ne Frage bezüglich folgendem Problem. Ich würde gerne ein Bild perspektivisch in ein anderes Zeichnen.

Zu dem Bild hab ich noch folgende Rahmeninformation:

untenlinks=0.186, 0.04
untenrechts=1.0, 0.0
obenlinks=0.0, 0.995
obenrechts=0.823, 0.733
bereich=0.067, 0.2275, 0.457, 0.6655

Delphi-Quellcode:

procedure TfrmPromoter.FormCreate(Sender: TObject);
var
  bottomLeft: TPointF;
  bottomRight: TPointF;
  dropZone: TRectF;
  topLeft: TPointF;
  topRight: TPointF;
  content: TSizeF;
  Poly: TPolygon;

  function RealPoint(P: TPointF): TPointF;
  var
    w, h: integer;
  begin
    w := Image1.Bitmap.Width;
    h := Image1.Bitmap.Height;
    result := PointF(w * P.x, h * (1 - P.y));
  end;

  function RealRect(R: TRectF): TRectF;
  var
    P1, P2: TPointF;
  begin
    P1 := RealPoint(PointF(R.Left, R.Top));
    P2 := RealPoint(PointF(R.Right, R.Bottom));
    result := rectf(P1.x, P1.y, P2.x, P2.y);
  end;

begin
  bottomLeft := PointF(0.186, 0.04);
  bottomRight := PointF(1.0, 0.0);
  dropZone := rectf(0.067, 0.2275, 0.457, 0.6655);
  topLeft := PointF(0.0, 0.995);
  topRight := PointF(0.823, 0.733);

  content.cx := 640;
  content.cy := 1136;

  setlength(Poly, 4);
  Poly[0] := RealPoint(topLeft);
  Poly[1] := RealPoint(topRight);
  Poly[2] := RealPoint(bottomRight);
  Poly[3] := RealPoint(bottomLeft);

  with Image1.Bitmap do
  begin
    Canvas.BeginScene;
    Canvas.Fill.Color := $FFFF0000;
    Canvas.FillPolygon(Poly, 1);

    Canvas.Fill.Color := $FFFF000FF;
    Canvas.FillRect(RealRect(dropZone), 0, 0, [], 1);
    Canvas.EndScene;
  end;
end;

und damit möchte ich ein Screenshot in das virtuelle Laptopdisplay zeichnen.

Peter

[Uwe Raabe]

Eventuell ist das hier für dich interessant? TPerspectiveTransformEffect

[Peter666]

Danke, das probiere ich mal aus. In erster Linie wäre es praktisch zu sehen, wie ich mit den vorgegebenen Werten (ich hab hier für andere Bilder ähnliche Einträge) zumindest ein Rechteck über den gewünschten Bildausschnitt zeichnen kann. Der Designer von dem ich das hab, sagte mir das wären die Werte die sein Sketch Tool liefert.
Quasi sowas:

<key>bottomLeft</key>
<string>{0.186, 0.04}</string>
<key>bottomRight</key>
<string>{1., 0.0}</string>
<key>width</key>
<integer>640</integer>
<key>height</key>
<real>1136</real>
<key>dropzone</key>
<string>{{0.067, 0.2275}, {0.457, 0.6655}}</string>
<key>topLeft</key>
<string>{0., .995}</string>
<key>topRight</key>
<string>{.823, 0.733}</string>

Die Vorlagen finden sich zum Teil auf dribble und sind frei nutzbar. Ich finde die Idee schön ein Screenshot zu nehmen, in eine Anwendung zu ziehen und das wird mir dann in das Bild gerendert und das Ergebnis als PNG gespeichert.

Peter

[Peter666]

Anbei mal das Beispiel. Das Rechteck ist jetzt ziemlich sicher an der richtigen Stelle, aber die Perspektive stimmt nicht. Laut Designer sind die Koordinaten relativ zu dem Rechteck. Keine Ahnung was er damit meint, vielleicht hat ja jemand eine Idee?

Peter

[Uwe Raabe]

Die Perspektivkoordinaten sind relativ zum Image2 gemeint:

Delphi-Quellcode:

  image2.BoundsRect := dropzone(0.067, 0.2275, 0.457, 0.6655, w, h);

  w := Round(Image2.Width);
  h := Round(Image2.Height);

  with PerspectiveTransformEffect1 do
  begin
    BottomLeft := fixpoint(PointF(0.186, 0.04), w, h);
    BottomRight := fixpoint(PointF(1.0, 0.0), w, h);
    TopLeft := fixpoint(PointF(0.0, 0.995), w, h);
    TopRight := fixpoint(PointF(0.823, 0.733), w, h);
    Enabled := true;
  end;

Vielleicht die Hilfsroutingen gleich von Integer auf Single umstellen, dann spart man sich das Runden.

[Peter666]

Ui Danke, jetzt gehts. Das war eh nur ein Proof of Concept. Die Umwandlung werde ich komplett in eine eigene Klasse packen und in der auch die Werte aus einer XML lesen. Muss ich nur noch einen Weg finden die Perspektivische Transformation über Matrix in einer Canvas zu lösen, damit ich nicht von der Anzeige abhängig bin. Danke für den Tipp, manchmal sieht man den Wald vor lauter Bäumen nicht.

Delphi-Quellcode:

function CalcMatrix(TopLeft, TopRight, BottomRight,
  BottomLeft: TPointF): TMatrix;
var
  Wx0, Wy0, Wx1, Wy1, Wx2, Wy2, Wx3, Wy3: Single;
  dx1, dx2, px, dy1, dy2, py: Single;
  g, hh, k: Single;
begin
  Wx0 := TopLeft.X;
  Wy0 := 1 - TopLeft.Y;

  Wx1 := TopRight.X;
  Wy1 := 1 - TopRight.Y;

  Wx2 := BottomRight.X;
  Wy2 := 1 - BottomRight.Y;

  Wx3 := BottomLeft.X;
  Wy3 := 1 - BottomLeft.Y;

  px := Wx0 - Wx1 + Wx2 - Wx3;
  py := Wy0 - Wy1 + Wy2 - Wy3;
  dx1 := Wx1 - Wx2;
  dx2 := Wx3 - Wx2;
  dy1 := Wy1 - Wy2;
  dy2 := Wy3 - Wy2;
  k := dx1 * dy2 - dx2 * dy1;
  if k <> 0 then
  begin
    g := (px * dy2 - py * dx2) / k;
    hh := (dx1 * py - dy1 * px) / k;

    result.m11 := Wx1 - Wx0 + g * Wx1;
    result.m21 := Wx3 - Wx0 + hh * Wx3;
    result.m31 := Wx0;
    result.m12 := Wy1 - Wy0 + g * Wy1;
    result.m22 := Wy3 - Wy0 + hh * Wy3;
    result.m32 := Wy0;
    result.m13 := g;
    result.m23 := hh;
    result.m33 := 1;
  end
  else
    FillChar(result, SizeOf(result), 0);
end;

function fixpoint(const P: TPointF; const backgroundImageWidth,
  backgroundImageHeight: Single): TPointF;
// Point in relative coordinates to the rectangle. topright (1,1)
begin
  result := PointF(P.X * backgroundImageWidth,
    (1 - P.Y) * backgroundImageHeight);
end;

function dropzone(const lowerLeftX, lowerLeftY, imageWidth, imageHeight: Single;
  const backgroundImageWidth, backgroundImageHeight: Single): TRectF;
begin
  result.left := backgroundImageWidth * lowerLeftX;
  result.Bottom := backgroundImageHeight * (1 - lowerLeftY);

  result.Right := result.left + (backgroundImageWidth * imageWidth);
  result.Top := result.Bottom - (backgroundImageHeight * imageHeight);
end;

procedure TfrmPromoter.FormCreate(Sender: TObject);
begin
  FBackground := TBitmap.CreateFromFile('laptop.png');
  FScreenshot := TBitmap.CreateFromFile('screenshot.jpg');
end;

procedure TfrmPromoter.FormDestroy(Sender: TObject);
begin
  FBackground.Free;
  FScreenshot.Free;
end;

procedure TfrmPromoter.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  R: TRectF;
  BottomLeft, BottomRight, TopLeft, TopRight: TPointF;
  Matrix: TMatrix;
begin
  Canvas.DrawBitmap(FBackground, RectF(0, 0, FBackground.Width,
    FBackground.Height), RectF(0, 0, ClientWidth, ClientHeight), 1);

  BottomLeft := PointF(0.186, 0.04);
  BottomRight := PointF(1.0, 0.0);
  TopLeft := PointF(0.0, 0.995);
  TopRight := PointF(0.823, 0.733);

  Canvas.SetMatrix(CalcMatrix(TopLeft, TopRight, BottomRight, BottomLeft));
  Canvas.DrawBitmap(FScreenshot, RectF(0, 0, FScreenshot.Width,
    FScreenshot.Height), dropzone(0.067, 0.2275, 0.457, 0.6655, ClientWidth,
    ClientHeight), 1);
end;

So ganz korrekt ist das noch nicht, vielleicht sieht ja jemand den Fehler. Die Calcmatrix hab ich aus FMX.Filter.Custom.pas geborgt und leicht angepasst, da ich ja schon die relative Größe habe.

Peter

[Peter666]

Ich hab das ganze jetzt fertig und es funktioniert prima. Allerdings gibts wohl ein Problem mit Firemonkey und großen Bildern. Ich hab hier ein PNG mit 6200*2200 Bildpunkten und wenn ich das lade in eine TBitmap ist der Inhalt totaler Unsinn. Erst nachdem ich das ganze skaliert hab (auf die Hälfte), gehts.

Das kann man mit der beiliegenden Bilddatei testen.

Peter