Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Nicht sichtbaren TPaintBox Inhalt speichern (https://www.delphipraxis.net/183867-nicht-sichtbaren-tpaintbox-inhalt-speichern.html)

cramer 10. Feb 2015 11:51

Delphi-Version: 2006

Nicht sichtbaren TPaintBox Inhalt speichern
 
Ich baue mir eine QR-Code-Grafik in einer PaintBox MyPaintBox zusammen.
Diese Paintbox liegt auf einem TabSheet, welches der Benutzer nicht sieht.
Das klappt alles, bis auf das Speichern.
Code:
// MyPaintBox speichern ...
   if not QRCodeSave( 'c:\temp\test.bmp', MyPaintBox ) then
// ..

function QRCodeSave( aFileName : string; aPaintBox : TPaintBox ) : boolean;
var xBitmap        : Graphics.TBitmap;
    xWidth, xHeight : Integer;
Begin
   result := false;
   if fileDirOk( aFileName ) then begin
      try
         xWidth        := aPaintBox.Width;
         xHeight       := aPaintBox.Height;
         xBitmap       := Graphics.TBitmap.Create;
         xBitmap.Height := xHeight;
         xBitmap.Width := xWidth;
         xBitmap.Canvas.CopyRect( Rect( 0, 0, xWidth, xHeight ),
                                  aPaintBox.Canvas,
                                  Rect( 0, 0, xWidth, xHeight ) );
         try
            xBitmap.SaveToFile( aFileName );
            result := true;
         except
            on e:exception do begin
               FehlerOk( 'QR-Code Fehler : ' + e.Message );
            end;
         end;
      finally
         xBitmap.Free;
      end;
   end else begin
      // Ups
   end;
end;
:(
In der gespeicherten Datei befindet sich dann ein Ausschnitt aus dem gerade sichtbaren Tabsheet der der Position und dem Bereich der PaintBox entspricht.

Wenn ich die PaintBox im sichtbaren Bereich unterbringe, was aber nicht so sein soll, wird der richtige Inhalt gespeichert.

Die Frage ist nun, wie bekommt man den Inhalt einer nicht sichtbaren PaintBox in eine Datei.

Thanks in advance

DeddyH 10. Feb 2015 12:22

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Du könntest ja statt auf den Canvas der PaintBox in eine Offscreen-Bitmap zeichnen. Die lässt sich auf der Paintbox darstellen, lässt sich aber eben auch einfach abspeichern.

himitsu 10. Feb 2015 13:02

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Eine PaintBox hat niemals von ihrem Canvas eine "Kopie".
Man kann manchmal maximal noch den Desktop fragen, ob er den aktuellen Inhalt hat/kennt, aber wenn unsichtbar oder außerhalb des sichtbaren Bereichts, bzw. wenn etwas drüber liegt, dann natürlich nicht.

Wie bereits erwähnt, entweder sorgst du für den Zwischenspeicher. (z.B. Bitmap dahinter)
oder du benutzt etwas, wo das schon drin ist (TImage).

cramer 10. Feb 2015 14:55

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
:roll:
Das kommt wohl davon, wenn man um Grafiken immer einen großen Bogen gemacht hat.:oops:

Ich habs auf ein Timage umgestellt, dieses wird auch richtig gezeichnet nur klappt es wieder mit dem Speichern nicht, AV in:

Code:
function QRCodeSave( aFileName : string; aImage : Timage ) : boolean;
var xBitmap : Graphics.TBitmap;
Begin
   result := false;
   if fileDirOk( aFileName ) then begin
      try
         try
            xBitmap.Height := aImage.Height;
            xBitmap.Width := aImage.Width;
            xBitmap.Canvas.Draw( 0, 0, aImage.Picture.Graphic);
            xBitmap.SaveToFile( aFileName );
            result := true;
         except
            on e:exception do begin
               FehlerOk( 'QR-Code Fehler : ' + e.Message );
            end;
         end;
      finally
         xBitmap.Free;
      end;
   end;
end;

DeddyH 10. Feb 2015 14:58

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Wo ist denn die Zeile
Delphi-Quellcode:
xBitmap := TBitmap.Create;
:?:

Sir Rufo 10. Feb 2015 15:08

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Und was soll dir dieses Exception-Handling bringen?

Das sollte dich glücklich(er) machen:
Delphi-Quellcode:
procedure QRCodeSave( aFileName : string; aImage : Timage );
var xBitmap : Graphics.TBitmap;
Begin
  if not fileDirOk( aFileName ) then
    raise Exception.CreateFmt( '"%s" ist ungültig', [aFileName] );
  if not Assigned( aImage ) then
    raise EArgumentNilException.Create( 'aImage' );

  xBitmap := Graphics.TBitmap.Create;
  try
    xBitmap.Height := aImage.Height;
    xBitmap.Width := aImage.Width;
    xBitmap.Canvas.Draw( 0, 0, aImage.Picture.Graphic);
    xBitmap.SaveToFile( aFileName );
  finally
     xBitmap.Free;
  end;
end;

DeddyH 10. Feb 2015 15:13

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
BTW: wäre es so nicht einfacher?
Delphi-Quellcode:
xBitmap := Graphics.TBitmap.Create;
  try
    xBitmap.Assign(aImage.Picture.Graphic);
    xBitmap.SaveToFile( aFileName );
  finally
     xBitmap.Free;
  end;

Sir Rufo 10. Feb 2015 15:17

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Ja, aber was soll ich denn noch alles machen? :mrgreen:

(Was schreibe ich denn für heute in mein Berichtsheft? :gruebel:)

cramer 10. Feb 2015 16:16

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Vielen Dank ihr Beiden. :thumb: :thumb:

Zitat:

Zitat von DeddyH (Beitrag 1289432)
Wo ist denn die Zeile
Delphi-Quellcode:
xBitmap := TBitmap.Create;
:?:

:roll: Gute Frage
Jetzt funktionieren beide Versionen, die "Glücklich Machende" und die "BTW" auch.

Zur Frage "Und was soll dir dieses Exception-Handling bringen?"

"FileDirOK()" prüft den Pfad und legt ihn ggf an.
Wenn das schon nicht geht, liefert QRCodeSave "false" zurück und die übergeordneten Abläufe werten das aus.

FehlerOK() speichert einen Eintrag ins Fehlerlog und prüft, ob das Programm im "AutoMode" läuft.
Falls nicht, gibts auch noch einen Fehler-Dialog für den Anwender.

himitsu 10. Feb 2015 16:20

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Und was mir grade noch aufgefallen war:

Du willst also unsichtbar im Hintergrund ein Bild malen, wolltest dafür aber eine "sichtbare" Komponente auf der Form benutzen.

Also in dem Fall nimmt man natürlich eine unsichtbare "Komponente", welche man nicht auf das Form liegen hat.
-> TBitmap erstellen, drauf malen, speichern und Bitmap wieder freigeben

Aber da man den QR-Code eventuell auch mal anzeigen möchte, trennt man den Zeichen-Code komplett von irgendeiner Componente.
-> Zeichenfunktion bekommt ein TCanvas, dann noch eine X- und Y-Position und vielleicht noch die Größe Width/Height.
Dann ist es auch egal, ob man auf ein Bitmap, Jpeg, PNG oder ein TImage.Bitmap zeichnet.

-> TBitmap erstellen, die Funktion drauf malen lassen, speichern und Bitmap wieder freigeben
oder
-> TImage auf die Form und dann nur noch die Zeichenfunktion auf Image1.Picture.Bitmap.Canvas zeichnen lassen
(vorher natürlich noch die Größe der Bitmaps setzen, falls die Größe nicht bereits gesetzt ist)

cramer 10. Feb 2015 16:31

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
:thumb: Danke für die Zusatzinfos.

Sir Rufo 10. Feb 2015 16:40

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Ja, während du schreibst
Delphi-Quellcode:
if not QRsave( ... ) then
begin
  ShowMessage( 'Irgendwas ging da nicht' );
  Exit;
end;
if not FooMe( ... ) then
begin
  ShowMessage( ... );
  exit;
end;
schreibe ich einfach
Delphi-Quellcode:
QRsave( ... );
FooMe( ... );
habe das gleiche Verhalten und kann bei einem Fehler sehr exakt sagen, was genau in die Hose gegangen ist:
  • Der Dateiname ist ungültig
  • Die Instanz aImage ist nil
  • Das Speichern des Bitmaps ist aus dem Grund "..." fehlgeschlagen

pelzig 10. Feb 2015 17:16

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Antwort eines Pfuschers:

Bei vielen VCL-Elementen kann man Visible auf false setzen ODER Left auf minus Soundsoviel minus Komponentenbreite :oops:

Tand ist das Gebuild aus Menschenhand :pale:

Man möge mich in der DP bitte nicht deswegen lynchen!

Mogeln gehört zum Handwerk...

MfG

cramer 11. Feb 2015 09:39

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
@ Sir Rufo.
Danke für die Hinweise...:thumb:

Nur bei den entsprechenden Anwendungen(ca 100000 Zeilen PAS-Code ohne Komponenten, Kommentar- und Leer-Zeilen), die seit 14 Jahren stetig wachsen und an Funktionsumfang zunehmen, bedeutet eine Änderung der bisherigen Fehlerlog und Meldungsstruktur ein Redesign, welches ich mir zeitlich nicht leisten kann und möchte.:oops:

Mir graust es schon allein bei dem Gedanken, auf eine aktuelle XE? umzustellen, wenn ich mich nur an den steigenden Zeitaufwand bei jeder Umstellung von TP auf D1 auf D2 auf D5 und auf D2006 erinnere.:shock:

Um den zu erwartenden Kommentaren vorzubeugen: Sicherlich liegt einiges vom Aufwand her auch an einer nicht optimalen Programmstruktur. :wink:

himitsu 11. Feb 2015 10:25

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Zitat:

Zitat von pelzig (Beitrag 1289450)
Bei vielen VCL-Elementen kann man Visible auf false setzen ODER Left auf minus Soundsoviel minus Komponentenbreite :oops:

Das kann man auch bei der PaintBox, aber dann kann man da auch nicht mehr drauf malen.

Grund: TPaintBox und TLabel (PS: das "echte" Windows-Label ist TStaticText) haben keine eigene Zeichenfläche, sondern verwenden die Ausgabe/Canvas des Parents.
Es wird direkt somit direkt in die Ausgabe/Ansicht gemalt, aber da dieses nirgenwo zwischengespeichert ist, kann man es nicht "sicher" wieder auslesen.

Seit Vista benutzt Windows einen zwar Cache, durch den Desktop-Window-Manager, damit er die Transparenzen des Aero berechnen kann, aber es gibt keinen Weg diesen DWM nach einem Bild zu fragen.
In XP kennt man das, wenn man z.B. auf eine TPaintBox oder direkt auf das Form.Canvas malt ... wenn man das Fenster minimiert, aus dem Desktop rausschiebt oder ein anderes Fenster drüber schiebt, dann ist das gemalte weg/übermalt.

cramer 11. Feb 2015 11:55

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Zitat:

Zitat von himitsu (Beitrag 1289500)
Grund: TPaintBox und TLabel (PS: das "echte" Windows-Label ist TStaticText) haben keine eigene Zeichenfläche, sondern verwenden die Ausgabe/Canvas des Parents.
Es wird direkt somit direkt in die Ausgabe/Ansicht gemalt, aber da dieses nirgenwo zwischengespeichert ist, kann man es nicht "sicher" wieder auslesen.

Ja, das ist jetzt klar.

Kleine Analyse, so wie ich das jetzt sehe.

In meinem Fall lag die PaintBox auf einem Panel1 auf Tabsheet1 und wenn man auf ein anderes Tabsheet2 wechselt und wieder zurück bleibt der Inhalt der Paintbox scheinbar erhalten.

Weil vermutlich auf das darunterliegende Panel1 gemalt wurde, und dieses erhalten bleibt.

Beim Speichern war aber TabSheet2 aktiv und es wurde die Region der Paintbox mit den Inhalten des TabSheet2 gespeichert.

Ich habe den Vorschlag aufgenommen und es wird alles in den Bitmap gehandelt und fürs Anzeigen gibts ne Show.
Code:
function QRCodeShowImage( aImage : Timage; aSize : integer ) : boolean;
var scale : double;
begin
   result := false;
   try
      if ( ( QRCodeBitmap.Width > 0 ) and ( QRCodeBitmap.Height > 0 ) ) then begin
         aImage.Width := aSize;
         aImage.Height := aSize;
         Scale := aImage.Height / QRCodeBitmap.Height;
         aImage.Canvas.StretchDraw( Rect( 0, 0, Trunc( Scale * QRCodeBitmap.Width ),
                                                Trunc( Scale * QRCodeBitmap.Height ) ),
                                                QRCodeBitmap );
         result := true;
      end;
   except
      on e:exception do begin
         FehlerOk( 'QRCodeShow Fehler : ' + e.Message );
      end;
   end;
end;

function QRCodeSave( aFileName : string; aSize : integer ) : boolean;
var xBitmap : Graphics.TBitmap;
    scale : double;
Begin
   result := false;
   if fileDirOk( aFileName ) then begin
      try
         xBitmap := Graphics.TBitmap.Create;
         try
            if ( ( QRCodeBitmap.Width > 0 ) and ( QRCodeBitmap.Height > 0 ) ) then begin
               xBitmap.Width := aSize;
               xBitmap.Height := aSize;
               Scale := xBitmap.Height / QRCodeBitmap.Height;
               xBitmap.Canvas.StretchDraw( Rect( 0, 0, Trunc( Scale * QRCodeBitmap.Width ),
                                                       Trunc( Scale * QRCodeBitmap.Height ) ),
                                                       QRCodeBitmap );
               xBitmap.SaveToFile( aFileName );
               result := true;
            end;
         except
            on e:exception do begin
               FehlerOk( 'QR-Code Fehler : ' + e.Message );
            end;
         end;
      finally
         xBitmap.Free;
      end;
   end;
end;

himitsu 11. Feb 2015 13:16

AW: Nicht sichtbaren TPaintBox Inhalt speichern
 
Die Fehlerbehandlung ist aber wieder nicht "benutzbar". (siehe vorherrige Kommentare dazu)

Delphi-Quellcode:
   except
      on e:exception do begin
         FehlerOk( 'QRCodeShow Fehler : ' + e.Message );
      end;
   end;
Ruf diese Funktion mal auf und versuch beim Aufrufer den Fehler abzufangen (z.B. Try-Except) ... das geht natürlich nicht und du müsstest deiner Funktion wieder ein sinnloses "zeige Fehler nicht an"-Property mit geben.

Grade durch solche unnötigen Abhängigkeiten und Fehler-Dialoge verbaut man sich, daß ein Code einfach wiederverwendbar ist.
Durch Weglassen wird der Code wiederverwendbar, leichter wartbar, ist leichter zu debuggen, man kann leichter eine Fehlerlogging (z.B. Eurekalog) anbinden und der Code wird kürzer, übersicher und leichter verständlich.

Und wie man sieht, hast du auch noch doppelten Code.
Delphi-Quellcode:
procedure QRCodeShowImage( aBitmap : Graphics.TBitmap; aSize : integer );
var scale : double;
begin
   if ( ( QRCodeBitmap.Width > 0 ) and ( QRCodeBitmap.Height > 0 ) ) then begin
      aBitmap.Width := aSize;
      aBitmap.Height := aSize;
      Scale := aBitmap.Height / QRCodeBitmap.Height;
      aBitmap.Canvas.StretchDraw( Rect( 0, 0, Trunc( Scale * QRCodeBitmap.Width ),
                                              Trunc( Scale * QRCodeBitmap.Height ) ),
                                              QRCodeBitmap );
   end;
end;

procedure QRCodeSave( aFileName : string; aSize : integer );
var xBitmap : Graphics.TBitmap;
Begin
   CheckFileDir( aFileName );
   xBitmap := Graphics.TBitmap.Create;
   try
      QRCodeShowImage( xBitmap, aSize );
      xBitmap.SaveToFile( aFileName );
   finally
      xBitmap.Free;
   end;
end;
Alles was hier schief laufen kann, kann nur ein schwerer Fehler sein und sowas gehört als Exception.


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:43 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz