Verwirrung um TImage und den DPI Wert

[Athris]

Ich arbeite ja zurzeit noch mit dem was Delphi und VCL so her geben

Wobei ich jetzt auch festgestellt habe, dass das alles natürlich Windows Nativ ist... schade für die Mac Version.

[Redeemer]

Ist das eigentliche Problem eigentlich jetzt gelöst?

[DelphiSpass]

Wow super, der Code von Athris + TiGü klappt bestens

Jetzt hätte ich noch eine Frage, bei JPEG, wie kann ich in dem Fall noch die Kompressionsrate einstellen?
Bei einem TJpegImage stelle ich das mit .CompressionQuality ein.
Wie ginge es hier bei dem TGPBitmap?
Ich habe da in der Winapi.GDIAPI die PropertyTagJPEGQuality gefunden, das könnte damit zusammenhängen,
aber komme damit nicht klar, wie ich das setzen würde?

Viele Grüße, Jürgen

[himitsu]

vielleicht SetCompositingQuality?

Ansonsten würde ich wohl bei TGPBitmap>TGPImage.SetPropertyItem anfangen nachzusehn.

[Benmik]

Zu PropertyTagJPEGQuality sagt Microsoft:

Zitat:

Privates Tag, das vom Adobe Photoshop-Format verwendet wird. Nicht für die öffentliche Verwendung.

Was du brauchst, sollte hier beschrieben sein; in Delphi findest du hier etwas. Am besten ist aber wohl die Serie hier bei GitHub.

[DelphiSpass]

Danke, ich geht das kommende Wo. mal alles durch, schreibe dann hier wieder.

Hier noch etwas, was für Andere nützlich sein könnte,
mit dem im Thread gezeigten Code kann man auch als TIFF abspeichern, indem man das hier ergänzt:

Delphi-Quellcode:

...
    else if (AFileExt = '.TIF') or (AFileExt = '.TIFF') then
    begin
      Result := GetEncoderClsid('image/tiff', pClsid)
    end
...

[DelphiSpass]

Mit EncoderParameters hats geklappt
Nun kann ich die Auflösung und die Compression Rate einstellen (jedenfalls beim jpeg hatte ich Letzteres gebraucht).

Delphi-Quellcode:

function TFPrintOptions.SaveImageDPI(const vstrImagePath: String; const vpntImage: TPicture; const dpiResolution: Single = 300.0; const compressionQuality: Integer = 100): Boolean;
//save bmp/png/jpeg/tiff with DPI information, jpeg with compression level
var
  strDateiendung: string;
  pntBitmap: TBitmap;
  Bitmap: TGPBitmap;
  clsidEncoder: TGUID;
  EncoderResult: Integer;
  EncoderParameters: TEncoderParameters;
  QualityUL: ULONG;
  IsJpeg: Boolean;

  function GetEncoder(const AFileExt: string; out pClsid: TGUID): Integer;
  begin
    Result := -1;
    if AFileExt = '.BMP' then
    begin
      Result := GetEncoderClsid('image/bmp', pClsid)
    end
    else if AFileExt = '.PNG' then
    begin
      Result := GetEncoderClsid('image/png', pClsid)
    end
    else if (AFileExt = '.TIF') or (AFileExt = '.TIFF') then
    begin
      Result := GetEncoderClsid('image/tiff', pClsid)
    end
    else if (AFileExt = '.JPG') or (AFileExt = '.JPEG') then
    begin
      Result := GetEncoderClsid('image/jpeg', pClsid);
      IsJpeg := True;
    end;
  end;

begin
  Result := False;
  pntBitmap := TBitmap.Create;
  QualityUL := compressionQuality; //1...100
  try
    try
      pntBitmap.Assign(vpntImage);
      Bitmap := TGPBitmap.Create(pntBitmap.Handle, pntBitmap.Palette);
      try
        Bitmap.SetResolution(dpiResolution, dpiResolution);
        strDateiendung := UpperCase(ExtractFileExt(vstrImagePath));
        EncoderResult := GetEncoder(strDateiendung, clsidEncoder);
        if EncoderResult >= 0 then
        begin
          if IsJpeg and (QualityUL > 0) and (QualityUL <=100) then
          begin
            EncoderParameters.Count := 1;
            EncoderParameters.Parameter[0].Guid := EncoderQuality;
            EncoderParameters.Parameter[0].Type_ := EncoderParameterValueTypeLong;
            EncoderParameters.Parameter[0].NumberOfValues := 1;
            EncoderParameters.Parameter[0].Value := @QualityUL;
            Result := Bitmap.Save(vstrImagePath, clsidEncoder, @EncoderParameters) = TStatus.Ok;
          end else begin
            Result := Bitmap.Save(vstrImagePath, clsidEncoder) = TStatus.Ok;
          end;
        end;
      finally
        Bitmap.Free;
      end;
    except
      on E: Exception do
      begin
        raise Exception.Create('Error at saving Graphic File ' + vstrImagePath + ': ' + E.ClassName + ': ' + E.Message);
      end;
    end;
  finally
    pntBitmap.Free;
  end;
end;