PaintBox in ScrollBox nach JPG

[cltom]

Hallo,

folgende Prozedur verwende ich, um aus den Inhalt einer PaintBox in eine JPG zu speichern (siehe unten). Das Ding hab ich ziemlich sicher irgendwo hier auf der DP gefunden. Sie funktioniert auch bestens. Allerdings nicht so ganz, sich die PaintBox innerhalb einer ScrollBox befindet. Da hab ich nämlich dann die ScrollBalken der ScrollBox mit drauf (nebst einem schwarzen Rand).

Woher kommt das und hat jemand eine idee, wie ich es abstellen kann?

danke, grüße
cltom

Delphi-Quellcode:

{*******************************************************************}
procedure TUserInterfaceOps.PaintBoxToJPGClip(apbx : TPaintBox; filename : string; toclip : boolean);
{*******************************************************************}
var
  img_jpg : TImage;
  jpg : TJpegImage;
  jpgformat       : word;
  adata           : THandle;
  apalette        : HPalette;
begin

  img_jpg := TImage.Create(nil);
  img_jpg.Visible := false;

  img_jpg.Width := apbx.Width;
  img_jpg.Height := apbx.Height;

  if assigned(img_jpg.Picture.Graphic) then
  begin
    img_jpg.Picture.Graphic.Width:= apbx.Width;
    img_jpg.Picture.Graphic.Height:= apbx.Height;
  end;

  img_jpg.Canvas.CopyRect(Bounds(0,0,img_jpg.Width, img_jpg.Height),apbx.Canvas, apbx.ClientRect);

  jpg := TJpegImage.Create;
  with jpg do
    begin
      Assign(img_jpg.Picture.Graphic);
      if toclip then
        begin
          jpg.SaveToClipboardFormat(jpgformat, adata, apalette);
          ClipBoard.SetAsHandle(jpgformat,adata);
        end
      else
        SaveToFile(filename);
      Free;
    end;

  img_jpg.free;

end;

[himitsu]

OK, die Scrollbalken könnte man ausblenden, nach dem Screenshot abschneiden, oder den Screenshotbereich einschränken, so das Balken die da nicht drauf sind.


Das Andere geht natürlich garnicht.

Eine PaintBox ist nur für die Ausgabe .... sie speichert keine Bilddaten.

Heißt: Alles was nicht sichtbar ist, da gibt es es kein Bild.



PS: Bevor Windows anfing über den DesktopWindowsManager die Fenster zwischenzuspeichern, damit er die transparenten (Aero) besser/schneller berechnen kann, da reichte es schon, mal schnell ein anderes fenster vor der Paintbox langzuziehen, oder das Startmenü aufzumachen .... schon war das Bild weg.



Lösung: Mach es richtig, nutzte die PaintBox nur zur Darstellung und verwalte dein Bild intern in einem Bitmap, welches im OnPaint und bei Änderungen auf die PintBox gemalt wird.

Oder verwende ein TImage mit einem Bitmap drin.

Oder zeichne alles doppelt (Lösung 1, aber eventuell etwas schneller) => auf die PaintBox und in ein TBitMap ... das TBitMap wird für's OnPaint verwendet, um die fehlenden stellen neu zu zeichnen.

Oder merk dir was alles gezeichnet wird, während es auf der PaintBox landet. Im OnPaint werden die Zeichenbefehle dann erneut ausgeführt, genauso wie für deine Kopie.





Und warum im Himmels Willen verwendest du INTERN ein TImage?

Ein TImage ist nur für die Ausgabe.

Intern verwendet man entweder direkt das gewünschte Grafikformat, samt der passenden Variable,
oder man nimmt ein TGraphic und legt darin eine Instanz des benötigten Formates an.
Man könnte magimal nich TPicture verwenden, wenn man sich nicht um das Format kümmern will. (TPicture ist das, was auch das TImage intern verwendet)


In Deinem Fall hätte man das Bild entweder direkt auf das Canvas des TJpegImage malen können, oder du hättest eben nochmal ein TBitmap drumrummachen können.
(das TBitmap nimmst du eh schon, allerdings umständlich verpackt in dem TImage, da es das Standardformat ist, wenn TPicture nichts Anderes vorgesetzt bekommt)

[cltom]

Auweh, und ich war noch froh, dass das Ding funktioniert hat. Danke für die ausführliche Antwort.

Aber Du hast natürlich Recht, das war ein Gefrickel. Irgendwie bin ich immer dabei hängen geblieben, direkt auf die PaintBox zu zeichnen. Ich hab die Zeichenroutinen auf die TBitmap umgelenkt und siehe da, es klappt auch. Komisch, ich hab das immer vermieden, weil ich dachte, das würde mit den GDI+ Aufrufen nicht klappen. Geht aber anstandslos.

Fehlt noch das Kopieren der TBitmap in die TPaintBox. Das hier ist im OnPaint der PaintBox, das angezeigt Bild stimmt aber noch nicht (es ist verzerrt, offenbar wird die gesamte (große) Bitmap in den sichtbaren Bereich der PaintBox geschrieben. Und weil die Bitmap größer ist als der sichtbare Bereich der PaintBox kommt dabei ein Holler heraus.

Delphi-Quellcode:

  ClipRect := Rect(0,0,DestinationB.Width,DestinationB.Height);
  DestinationPB.Canvas.CopyRect(DestinationPB.Canvas.ClipRect, DestinationB.Canvas, DestinationB.Canvas.ClipRect);

DestinationB ist eine TBitMap
DestinationPB ist eine TPaintBox.
Die Größen der beiden sind gleich, aber irgendwas stimmt noch nicht ganz (oder, wahrscheinlicher: ich hab irgendwas noch nicht verstanden)

Falls jemand später über diesen Thread stolpert, stelle ich hier noch eine (hoffentlich) korrekt(ere) Lösung rein (wieder aus der DP selber):

Delphi-Quellcode:

procedure SaveBitmapAsJPG(Sender: TObject);
var
  jpg: TJpegImage;
begin
  with dlg_save do
  begin
    DefaultExt := '*.jpg';
    Filter := 'Jpg (*.jpg) | *.jpg';
    if Execute then
      begin
        jpg := TJpegImage.Create;
        Try
          jpg.Assign(myBitmap);
          jpg.SaveToFile(ChangeFileExt(dlg_save.FileName, '.jpg'));
        Finally
          jpg.Free;
        end;
      end;
  end;
end;

[cltom]

Also, hier noch die Antwort zu meiner eigenen Frage, nur für's Archiv, fall jemand über den Thread stolpert:

so sieht jetzt das OnPaint der PaintBox aus:

Delphi-Quellcode:

procedure Tfrm_main.pbx_mainPaint(Sender: TObject);
begin
// Größe der Bitmap setzen
  myDrawClass.SetSize(fDestinationPaintBox.Width,fDestinationPaintBox.Height);
//zeichnen
  myDrawClass.Draw;
// Bitmap nach Paintbox kopieren
  BitBlt(fDestinationPaintBox.Canvas.Handle, 0, 0, myDrawClass.Destination.Width, myDrawClass.Destination.Height, myDrawClass.Destination.Canvas.Handle, 0, 0, SRCCOPY);
end;

SetSize ruft seinerseits nur das SetSize der TBitmap auf.

[richnessnotes]

Thanks for sharing this thing about the PaintBox in a ScrollBox. I have read every detailed post. At first, I had no idea on how to do the procedure. It is good that I have learned something new here.