FMX: Image->Bitmap wird abgeschnitten

[nikosophi]

Hy,

ich habe in einem FMX Projekt auf einer Form ein TImage.
Das soll einfach gespeichert werden.
Dazu kopiere ich es in eine TBitmap und speichere mit SaveToFile.
Funktioniert auch - aber das Bild ist recht und unten abgeschnitten.

Delphi-Quellcode:

procedure TFHaupt.btnThisClick(Sender: TObject);
var
  MyBitmap: TBitmap;
  rectFrame: TRectF;
begin
  MyBitmap := TBitmap.Create(round(image1.Width), round(image1.height));
  MyBitmap.Assign(Image1.Bitmap);
  with MyBitmap.Canvas do begin
    BeginScene;
    // einen Rahmen ums Bild zeichnen
    Stroke.Kind  := TBrushKind.Solid;
    Stroke.Color := TAlphaColorRec.Coral;
    StrokeThickness := 4;
    rectFrame.Create(  0,  0, Image1.width , image1.height);
    DrawRect(RectFrame, 20, 20, AllCorners, 1.0);
    EndScene;
  end;
  MyBitmap.SaveToFile('c:\temp\BildErgebnis.png');
      mmo.lines.add('Image1.width: '+ FloatToStr(Image1.width));
      mmo.lines.add('Image1.Height:'+ FloatToStr(Image1.height));
      mmo.lines.add('MyBitmap.width: '+ IntToStr(MyBitmap.width));
      mmo.lines.add('MyBitmap.Height:'+ IntToStr(MyBitmap.height));
  MyBitmap.Free;
end;

Das sieht man auch an der Ausgabe im Memo:

Delphi-Quellcode:

Image1.width: 837
Image1.Height:420
MyBitmap.width: 1000
MyBitmap.Height:667

An der Umwandlung von Image.width ( single) nach bitmap.width (integer) kanns ja wohl nicht liegen.

Muss man da noch irgendwas skalieren?

Danke schon mal fürs lesen.

[Harry Stahl]

Image.width ist nicht gleich Bitmap.width

TImage ist so eine Art Container, der ein Bitmap enthält. Da kann der Container in der Darstellung auf der Form kleiner oder größer als das Bitmap selber sein.

Du musst also immer mit der Größen von Image.Bitmap arbeiten oder eben selbst eine Größe Vorgeben, wenn Image.Bitmap noch keinen Inhalt hat.

Das kannst Du Dir selber mal verdeutlichen, wenn Du eine etwas größere Bitmap in das TImage lädst und den Wrapmode des TImage auf "Original" stellst. Dann siehst Du, dass das größere Bitmap in dem kleineren TImage nicht vollständig angezeigt wird. Die relevante Größe für die Grafik eben das Bitmap und nicht das TImage.

[nikosophi]

Danke Harry!

Hab ich jetzt verstanden. Aber wohl doch nicht ganz.

Das Zeichnen eines Rahmens und einer Diagonale sollte doch dann auch in dem Bitmap Ausmassen erfolgen, oder?
Ich habe die Ausmasse des Image der Einfachheit halber im Create auf die der geladenen Bitmap gesetzt.

Delphi-Quellcode:

procedure TForm5.FormCreate(Sender: TObject);
begin
  // Das Original Bild in der Original Größe laden und darstellen
  Image1.align    := TAlignLayout.None;
  Image1.wrapmode := TImageWrapMode.Original;
  Image1.Bitmap.LoadFromFile('c:\temp\bildOriginal.png');
  Image1.width    := Image1.bitmap.width;
  Image1.height   := Image1.bitmap.height;
end;

procedure TForm5.Button1Click(Sender: TObject);
var
  MyBitmap: TBitmap;
  rectFrame: TRectF;
  pkt1, pkt2: TPointF;
begin
  MyBitmap := TBitmap.Create(round(image1.bitmap.Width), round(image1.bitmap.height));

  pkt1 := PointF(10.0, 10.0);
  pkt2 := PointF(Image1.bitmap.width-20 , image1.bitmap.height-20);

  // Die Bitmap des Original Bildes in ein Bitmap übernehmen
  MyBitmap.Assign(Image1.Bitmap);
  // und Rahmen und Diagonale drübermalen
  if MyBitmap.Canvas.BeginScene then begin
    MyBitmap.Canvas.Stroke.Kind     := TBrushKind.Solid;
    MyBitmap.Canvas.Stroke.Color    := TAlphaColorRec.Coral;
    MyBitmap.Canvas.StrokeThickness := 4;
    rectFrame.TopLeft     := pkt1;
    rectFrame.BottomRight := pkt2;
    MyBitmap.Canvas.DrawRect(RectFrame, 20, 20, AllCorners, 1.0);
    MyBitmap.Canvas.DrawLine(pkt1,pkt2, 1.0);
    MyBitmap.Canvas.EndScene;
  end;
  // Ergebnis speichern
  MyBitmap.SaveToFile('c:\temp\BildErgebnis.png');
      mmo.lines.add('Image1.bitmap.width:   '+ FloatToStr(Image1.bitmap.width));
      mmo.lines.add('Image1.bitmap.Height:  '+ FloatToStr(Image1.bitmap.height));
      mmo.lines.add('MyBitmap.width:        '+ IntToStr(MyBitmap.width));
      mmo.lines.add('MyBitmap.Height:       '+ IntToStr(MyBitmap.height));
      mmo.lines.add('MyBitmap.canvas.width: '+ IntToStr(MyBitmap.canvas.width));
      mmo.lines.add('MyBitmap.canvas.Height:'+ IntToStr(MyBitmap.canvas.height));
  MyBitmap.Free;

end;

Delphi-Quellcode:

Image1.bitmap.width:   1000
Image1.bitmap.Height:  667
MyBitmap.width:        1000
MyBitmap.Height:       667
MyBitmap.canvas.width: 1000
MyBitmap.canvas.Height:667

Also die Höhe und breite scheint ja jetzt zu passen, aber das Zeichnen DrawRect und DrawLine scheinen noch einen anderen Masstab zu haben.

In den angehängten Bildern sieht man in grün den Originalrahmen, mit Paint gezeichnet.
Im Ergebnis ist der orange Rahmen ( aus DrawRect ) zu groß.

Müssen da noch irgendewelche Pixelformate oder Skalierungen angepasst werden?

[nikosophi]

Ok, alles gut:

Da gibts in der Tat ein Bitmapscale. Das stand auf 2.0.

MyBitmap := TBitmap.Create(round(image1.bitmap.Width), round(image1.bitmap.height));
Image1.bitmap.BitmapScale := 1.0;
MyBitmap.BitmapScale := 1.0;
pkt1 := PointF(10.0, 10.0);
pkt2 := PointF(Image1.bitmap.width-20 , image1.bitmap.height-20);

Jetzt passt das gezeichnete auch genau drauf.
Danke.

[Harry Stahl]

Also, wenn ich Deinen Original-Quellcode verwende, sieht das Ergebnis bei mir aus, wie in Anlage 1 (Bildergebnis1).

Wenn ich den Source-Code wie folgt abändere (Berücksichtigung von StrokeThickness),

Delphi-Quellcode:

  pkt1 := PointF(4.0, 4.0);
  pkt2 := PointF(Image1.bitmap.width-4 , image1.bitmap.height-4);

dann sieht es aus wie in Anlage 2(BildErgebnis2), nehme an, so wolltest Du es.

[nikosophi]

Ja, jetzt passt es. Es geht mir nicht um die paar Pixel der Linienbreite.
Wenn ich nicht explizit:

bitmap.BitmapScale := 1.0;

sondern auf 2.0 lasse, wie es wohl Standard ist, dann werden Linien viel zu weit gezeichnet. Vermutlich halt doppelt so lang. Sieht man nicht mehr, da es abgeschnitten wird ( oranger Rahmen im ersten Post).

Ich arbeite an einem IMac. Vielleicht hat das was mit Retina zu tun - weiß der Fuchs.

Entscheidend war dein Hinweis, dass ich mit der Bitmap und nicht mit dem Image arbeiten muß.