JPEG CompressionQuality ermitteln

[Schwedenbitter]

Ich habe das - etwas unorthodox - für mich selbst jetzt so gelöst:

Delphi-Quellcode:

Function CalcCompressionQuality(Const JPG: TJPEGImage;
   Const MustFit: Boolean = False): TJPEGQualityRange;
Var
   aMS            : TMemoryStream;
   aBMP            : TBitmap;
   aJPG            : TJPEGImage;
   aSize            : Int64;
   lQ, hQ         : Integer;
   Piv, oldPiv      : Integer;                        // Ausgangswert = 0
Begin
   aMS:=  TMemoryStream.Create;                     // TMemoryStream erzeugen
   aBMP:= TBitmap.Create;                           // TBitmap erzeugen
   aJPG:= TJPEGImage.Create;                        // TJPEGImage erzeugen
   Try
      JPG.SaveToStream(aMS);                        // in Stream ablegen
      aSize:= aMS.Size;                              // Originalgröße ermitteln
      aBMP.Assign(JPG);                              // Bild ins TBitmap kopieren
      lQ:=    Low(Result);                           // untere Grenze
      hQ:=    High(Result);                        // obere Grenze
      Piv:= (hQ - lQ) Div 2;                        // in der Mitte anfangen
      Repeat
         aMS.Clear;                                 // Stream leeren
         aJPG.CompressionQuality:= Piv;            // Kompressionsrate setzen
         aJPG.Assign(aBMP);                        // Bitmap kopieren/komprimieren
         aJPG.SaveToStream(aMS);                     // JPG in Stream kopieren
         oldPiv:= Piv;                              // altes Pivot-Element merken
         If (aMS.Size > aSize) Then                  // Ergebnis ist zu groß
         Begin
            hQ:= Piv;                              // obere Grenze = aktueller Wert
            Piv:= Piv - ((hQ -  lQ) Div 2);         // neuen Wert berechnen
         End
         Else Begin                                 // Ergebnis kleiner oder gleich
            lQ:= Piv;                              // untere Grenze = aktueller Wert
            Piv:= Piv + ((hQ - lQ) Div 2);         // neuen Wert berechnen
         End;
      Until (Piv = oldPiv);                        // noch näher geht es nicht

      If (MustFit) And                              // auf keinen Fall größer !!!
         (aMS.Size > aSize) Then                     // immer noch zu groß
            Result:= Pred(Piv)                     //   => eine Nummer kleiner
      Else   Result:= Piv;            // aMS.Size = aSize => exakten Wert übergeben
   Finally
      aMS.Free;                                    // TMemoryStream freigeben
      aBMP.Free;                                    // TBitmap freigeben
      aJPG.Free;                                    // TJPEGImage freigeben
   End;
End;

Vermutlich lässt sich das sogar noch optimieren. Vielleicht findet über die Zeit jemand eine saubere(re) Lösung.