[gelöst] Zugriff auf Pixelinformationen von Grafiken

[fliegermichl]

Ich habe in meinem CAD Programm eine Funktion, welche die aktuelle Zeichnungsansicht in die Windows Zwischenablage legt.
Die Zeichnung ist so skaliert, daß man mit Zoomfaktor 1 das Objekt beliebig drehen kann, ohne dass ein Teil davon den sichtbaren Bereich verläßt.

Wenn die aktuelle Ansicht aber in die Zwischenablage verschoben wird, dann soll nur der zum Objekt gehörige Bereich gespeichert werden.

Ausgangszustand:

Ansicht im Programm

screenshot.png (38.4 KiB) 4399 mal betrachtet

Was dann in der Zwischenablage landet sieht so aus:

Ergebnis im Clipboard

export.png (25.08 KiB) 4399 mal betrachtet

Dazu verwende ich in der Delphiversion den folgenden Code:
Das Control Image1 ist kein TImage sondern eine TPaintbox.

Code: Alles auswählen

procedure TMassen.SaveImageToClipBoard;
var
  Bitmap, Bitmap2 : TBitMap;
  sdf : Double;
  minx, miny, maxx, maxy : integer;
  col, row : integer;
  P : PByteArray;
  r, g, b : byte;
begin
  sdf := DrawFaktor;
  Bitmap := TBitmap.Create;
  Bitmap2 := nil;
  try
    minx := Image1.ClientWidth; maxx := 0;
    miny := Image1.ClientHeight; maxy := 0;
    Bitmap.Width  := minx;
    Bitmap.Height := miny;
    Bitmap.Canvas.Brush.Color := clWhite;
    Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
    Projekt.Draw(Image1.ClientRect, Bitmap.Canvas, False, False, False);
    Bitmap.BeginUpdate;
    for row := 0 to Bitmap.Height - 1 do
    begin
     P := Bitmap.ScanLine[row];
     for col := 0 to Bitmap.Width - 1 do
     begin
      r := P[col*4];
      g := P[col*4+1];
      b := P[col*4+2];
      if ((r <> 255) or (g <> 255) or (b <> 255)) then
      begin
       if MinX > col then Minx := col;
       if Maxx < col then Maxx := col;
       if MinY > row then Miny := row;
       if Maxy < row then Maxy := row;
      end;
     end;
    end;
    Bitmap.EndUpdate;
    Bitmap2 := TBitmap.Create;
    Bitmap2.Width := Maxx - Minx;
    Bitmap2.Height := Maxy - Miny;
    Bitmap2.Canvas.CopyRect(Rect(0, 0, Bitmap2.Width, Bitmap2.Height), Bitmap.Canvas, Rect(minx, miny, maxx-minx, maxy-miny));
    clipbrd.ClipBoard.Assign(Bitmap2);;
  finally
    Bitmap.Free();
    Bitmap2.Free();
    DrawFaktor := sdf;
  end;
end;

Mit Lazarus funktioniert das nicht mehr. Erstens warnt mich der Compiler, daß TBitmap.ScanLine nicht portierbar ist und dann sind die rohen Pixeldaten offenbar anders im Speicher als das bei Delphi der Fall ist, weil der ermittelte Farbanteil für b = 0 ist.

Gibt es mit den Möglichkeiten von Lazarus eine elegante (evtl. auch portierbare) Lösung für diese Aufgabe?

[theo]

Gibt es mit den Möglichkeiten von Lazarus eine elegante (evtl. auch portierbare) Lösung für diese Aufgabe?

Steht im Wiki: https://wiki.freepascal.org/Developing_ ... ng_example

BGRABitmap würde wahrscheinlich auch gehen.

[fliegermichl]

Ah super, Danke.

Der Code vereinfacht sich dann zu:

Code: Alles auswählen

implementation
uses intfgraphics, fpImage;

procedure TMassen.SaveImageToClipBoard;
var
  Bitmap, Bitmap2 : TBitMap;
  img : TLazIntfImage;
  iw, ih : integer;
  sdf : Double;
  clr : TFPColor;
  minx, miny, maxx, maxy : integer;
  col, row : integer;
begin
  sdf := DrawFaktor;
  Bitmap := TBitmap.Create;
  Bitmap2 := nil;
  try
    minx := Image1.ClientWidth; maxx := 0;
    miny := Image1.ClientHeight; maxy := 0;
    Bitmap.Width  := minx;
    Bitmap.Height := miny;
    Bitmap.Canvas.Brush.Color := Anwender.ansoBackgroundColor;
    Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
    Projekt.Draw(Image1.ClientRect, Bitmap.Canvas, False, False, False);
    img := Bitmap.CreateIntfImage;
    iw := img.Width;
    ih := img.Height;
    clr := TColorToFPColor(Anwender.ansoBackGroundColor);
    for row := 0 to ih - 1 do
     for col := 0 to iw - 1 do
       if (img.Colors[col, row] <> clr) then
       begin
         if MinX > col then Minx := col;
         if Maxx < col then Maxx := col;
         if MinY > row then Miny := row;
         if Maxy < row then Maxy := row;
       end;
    Bitmap2 := TBitmap.Create;
    Bitmap2.Width := Maxx - Minx;
    Bitmap2.Height := Maxy - Miny;
    Bitmap2.Canvas.CopyRect(Rect(0, 0, Bitmap2.Width, Bitmap2.Height), Bitmap.Canvas, Rect(minx, miny, maxx, maxy));
    clipbrd.ClipBoard.Assign(Bitmap2);
  finally
    Bitmap.Free();
    Bitmap2.Free();
    img.Free;
    DrawFaktor := sdf;
  end;
end;