Como cambiar la resolucion (DPI) a un TBitmap

[[seoane]]

Primero dices:

debo salvar mi grafico en .jpg o .bmp.

Y luego dices:

Lo que estoy realmente salvando es un .jpg.

Muchas veces pienso que si la gente explicara lo que realmente quiere ahorraríamos mucho tiempo

De todas formas podemos hacer para el jpg lo mismo que hicimos para el bmp, es decir, modificar la parte del fichero donde se guardan esos valores. en el caso del jpeg esta información se guarda en el segmento AP0, así que añadimos un nuevo segmento AP0 con la información que queremos y borramos la información anterior.

El código nos quedaría mas o menos así:

Código Delphi [-]
uses jpeg;

procedure AjustarDPI(Origen, Destino: TStream; Rx,Ry: Word);
var
  AP0: array[1..18] of byte;
  Buffer: array[0..$FFFF] of Char;
  Header: array[1..4] of byte;
  Size: Integer;
begin
  Origen.Seek(0,soFromBeginning);
  Origen.ReadBuffer(Header,2);
  if (Header[1] <> $FF) or (Header[2] <> $D8) then
    raise Exception.Create('Identificador incorrecto');
  Destino.WriteBuffer(Header,2);
  FillChar(AP0,Sizeof(AP0),#0);
  AP0[1]:= $FF;
  AP0[2]:= $E0;
  AP0[4]:= Sizeof(AP0) - 2;
  AP0[5]:= Byte('J');AP0[6]:= Byte('F');AP0[7]:= Byte('I');AP0[8]:= Byte('F');
  AP0[10]:= 1; AP0[11]:= 2;
  AP0[12]:= 1;
  AP0[13]:= Rx shr 8; AP0[14]:= Rx and $FF;
  AP0[15]:= Ry shr 8; AP0[16]:= Ry and $FF;
  Destino.WriteBuffer(AP0,Sizeof(AP0));
  repeat
    Origen.ReadBuffer(Header,4);
    Size:= ((Header[3] shl 8) + Header[4]) - 2;
    case Header[2] of
      $FE, $E0..$EF: Origen.Seek(Size,soFromCurrent);
      $01,$D0..$D9: begin
                      Destino.WriteBuffer(Header,2);
                      Origen.Seek(-2,soFromCurrent)
                    end
      else
      begin
        Origen.ReadBuffer(Buffer,Size);
        Destino.WriteBuffer(Header,4);
        Destino.WriteBuffer(Buffer,Size);
      end;
    end;
  until Header[2] = $DA;
  Destino.CopyFrom(Origen,Origen.Size - Origen.Position);
end;

procedure SaveToFileDPI(Imagen: TJpegImage; Filename: String; Rx, Ry: Word);
var
  Temp: TMemoryStream;
  Stream: TFileStream;
begin
  Temp:= TMemoryStream.Create;
  try
    Imagen.SaveToStream(Temp);
    Stream:= TFileStream.Create(Filename, fmCreate);
    try
      AjustarDPI(Temp,Stream,Rx,Ry);
    finally
      Stream.Free;
    end;
  finally
    Temp.Free;
  end;
end;

Para usarlo solo tienes que sustituir esta linea:

Código Delphi [-]
MyJPEG.SaveToFile(FileName);

Por esta otra:

Código Delphi [-]
SaveToFileDPI(MyJPEG,FileName,300,300);