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.