Einzelnen Beitrag anzeigen

Schwedenbitter

Registriert seit: 22. Mär 2003
Ort: Finsterwalde
622 Beiträge
 
Turbo Delphi für Win32
 
#22

AW: JPEG CompressionQuality ermitteln

  Alt 26. Okt 2017, 14:17
Danke Euch allen für die tatkräftige Hilfe!
Wenn du mit TStatus GPStatus meinst jo..
Genau die meine ich. Und wenn ich Deinen Code richtig deute, gibt es entsprechendes also weder in Winapi.GDIPAPI , Winapi.GDIPOBJ noch Winapi.GDIPUTIL ?

Ich habe das jetzt mal umgestellt und es klappt (jedenfalls bei mir) tatsächlich:
Delphi-Quellcode:
Function CalcCompressionQuality(Const Image: GPIMAGE;
   Const MustFit: Boolean = False): TJPEGQualityRange;
Var
   aMS                  : TMemoryStream;
   aFormat, aEncoder      : TGUID;
   aSA                  : Winapi.ActiveX.IStream;
   aSize                  : Int64;
   lQ, hQ, Piv, oldPiv   : Integer;
   aEncParams            : Winapi.GDIPAPI.TEncoderParameters;
Begin
   Result:= 100;                                    // im Zeifel: beste Qualität!
   If (GdipGetImageRawFormat(Image, @aFormat) = Status.Ok) And
      (aFormat = ImageFormatJPEG) And               // nur bei JPEG ausführen
      (GetEncoderClsid('image/jpeg', aEncoder) > -1) Then
   Begin
      aMS:= TMemoryStream.Create;                  // TMemoryStream erzeugen
      aSA:= TStreamAdapter.Create(aMS, soOwned);   // aMS wird selbst aufgeräumt
      If (GdipSaveImageToStream(Image, aSA, @aEncoder, nil) = Status.Ok) Then
      Begin
         aSize:= aMS.Size;                           // Originalgröße ermitteln
         lQ:= Low( Result);                     // untere Grenze
         hQ:= High(Result);                     // obere Grenze
         Piv:= (hQ - lQ) Div 2;                     // in der Mitte anfangen
         Repeat
            aMS.Clear;                              // Stream leeren
            FillChar(aEncParams, SizeOf(aEncParams), 0);
            aEncParams.Count:= 1;
            With aEncParams.Parameter[0] Do
            Begin
               Guid:= EncoderQuality;      // um diese Einstellung geht es
               NumberOfValues:= 1;
               Type_:= EncoderParameterValueTypeLong;
               Value:= @Piv               // CompressionQuality setzen
            End;
            oldPiv:= Piv;                           // altes Pivot-Element merken

            If (GdipSaveImageToStream(Image, aSA, @aEncoder, @aEncParams) = Status.Ok) Then
            Begin
               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;
            End
            Else Break;                              // bei Fehlern abbrechen
         Until (Piv = oldPiv);                     // noch näher geht es nicht

         aSA:= nil;   // sicherheitshalber (http://www.delphipraxis.net/1384246-post23.html)

         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
      End;
   End;
End;
Eine Frage habe ich trotzdem noch: Wohin verschwindet Winapi.ActiveX.IStream ?
Dieser Stream kümmert sich um den ihm zugewiesenen TMemoryStream , so dass ich den nicht freigeben darf/muss. Aber trotz fehlender Freigabe von Winapi.ActiveX.IStream bringt mir mein Programm bei ReportMemoryLeaksOnShutdown:= True; am Ende keine Meldung.
Das wäre mir wichtig, weil mein Programm genauso lang läuft wieder Rechner und damit am Tag im Maximum mehrere hundert Bilder verarbeiten muss. Dass es am Ende des Programms automatisch aufgeräumt wird, reicht mir also leider nicht, wenn mir zwischendurch die Puste/der Speicher aus geht. Winapi.GDIPOBJ.TGPImage.Free ruft auch nur GdipDisposeImage(); auf...
Alex Winzer

Geändert von Schwedenbitter (26. Okt 2017 um 15:02 Uhr) Grund: Code geändert
  Mit Zitat antworten Zitat