Unit _CalcThread;

Interface

Uses
   System.Classes, Vcl.Graphics, Vcl.Imaging.pngimage, Vcl.Imaging.jpeg;

Type
   TCodecType   = (cdPNG, cdJPEG);
   TOnCalcDone   = Procedure(Codec: TCodecType; Size: Int64) Of Object;
   TCalcThread   = Class(TThread)
                 Private
                     fSize         : Int64;
                     fCodec      : TCodecType;
                     fBitmap      : TBitmap;
                     fOnCalcDone   : TOnCalcDone;
                     Procedure EventOnCalcDone;
                 Public
                     Constructor Create(Codec: TCodecType; Bitmap: TBitmap;
                        OnCalcDone: TOnCalcDone);
                     Procedure Execute; Override;
                     Destructor Destroy; Override;
                 End;

Implementation

// Absicherung des Eriegnis-Aufrufs --------------------------------------------
Procedure TCalcThread.EventOnCalcDone;
Begin
   If Assigned(fOnCalcDone) Then                     // Sicherheitsprüfung
      FOnCalcDone(fCodec, fSize);                  // Ereignis auslösen
End;

// Ein Thread wird erstellt ----------------------------------------------------
Constructor TCalcThread.Create(Codec: TCodecType; Bitmap: TBitmap;
   OnCalcDone: TOnCalcDone);
Begin
   fSize:= -1;                                 // ungültigen Wert vorgeben
   fCodec:= Codec;                              // Codec merken
   fOnCalcDone:=OnCalcDone;                        // Zeiger auf Ereignis merken
   fBitmap:=TBitmap.Create;                        // TBitmap anlegen
   fBitmap.Assign(Bitmap);                           // Bild kopieren
   FreeOnTerminate:=True;                           // Speicher selbst freigeben

   Inherited Create(True);                           // Thread erstellen
   Priority:= tpIdle;                        // geringe Priorität
//   Resume;                                          // "Start" löst Exception aus!
   Start;                                       // "Resume" ist veraltet
End;

// Der eigentliche Thread (=die Berechnung) ------------------------------------
Procedure TCalcThread.Execute;
Var
   lMemStream      : TMemoryStream;
Begin
   lMemStream:=TMemoryStream.Create;               // Nur im Speicher arbeiten
   Try
      Case fCodec Of
         cdPNG   :   With TPngImage.Create Do         // temp. PNG-Objekt anlegen
                  Try
                     Filters:=[pfNone, pfSub, pfUp, pfAverage, pfPaeth];
                     CompressionLevel:=9;            // Maximale Kompression
                     Assign(fBitmap);               // Bilddaten übernehmen
                     SaveToStream(lMemStream);      // virtuell abspeichern
                     fSize:=lMemStream.Size;         // Größe merken
                  Finally
                     Free;                           // PNG-Objekt freigeben
                  End;
         cdJPEG:   With TJPEGImage.Create Do         // tenp. JPEG-Objekt anlegen
                  Try
                     CompressionQuality:=80;         // 100 = max, 1 = min
                     Assign(fBitmap);               // Bilddaten übernehmen
                     SaveToStream(lMemStream);      // virtuell abspeichern
                     fSize:=lMemStream.Size;         // Größe merken
                  Finally
                     Free;                           // JPEG-Objekt freigeben
                  End;
      End;
   Finally
      lMemStream.Free;                              // TMemoryStream freigeben
      Synchronize(EventOnCalcDone);                  // Das Ende mitteilen
   End;
End;

// Der Thread wird beendet -----------------------------------------------------
Destructor TCalcThread.Destroy;
Begin
   fBitmap.Free;                                    // TBitmap selbst freigeben
   fOnCalcDone:=nil;                                 // Zeiger löschen
   Inherited;                                       // den Rest ausführen
End;

End.