Firemonkey Bild Perspektivisch zeichnen

[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