Como cambiar la resolucion (DPI) a un TBitmap

[[seoane]]

Yo tampoco encuentro la manera de cambiársela desde el objeto TBitmap, pero podemos hacerlo directamente sobre el archivo. La resolución se guarda en la cabecera del bitmap, así que no tenemos mas que cambiar esos valores en la cabecera.

Algo así:

Código Delphi [-]
procedure SaveToFileDPI(Bitmap: TBitmap; Filename: String; Rx, Ry: Double);
var
  Stream: TMemoryStream;
  InfoHeader: BITMAPINFOHEADER;
begin
  Bitmap.SaveToFile(Filename);
  with TFileStream.Create(Filename,fmOpenReadWrite) do
  try
    Seek(Sizeof(BITMAPFILEHEADER),soFromBeginning);
    Read(InfoHeader,Sizeof(InfoHeader));
    InfoHeader.biXPelsPerMeter:= Trunc((Rx * 10000) / 254);
    InfoHeader.biYPelsPerMeter:= Trunc((Ry * 10000) / 254);
    Seek(Sizeof(BITMAPFILEHEADER),soFromBeginning);
    Write(InfoHeader,Sizeof(InfoHeader));
  finally
    Free;
  end;
end;

// Por ejemplo si bitmap es un objeto del tipo TBitmap
SaveToFileDPI(Bitmap,'c:\1.bmp',300,300);

[JCarlosas]

Lo que estoy realmente salvando es un .jpg.
Mi rutina en esencia es algo asi.

Código Delphi [-]
        
var
         MiBitMap : TBitMap;    
        Begin
           
          MiBitMap := TBitMap.Create;         
          MiBitMap.SetSize(Ancho, Alto);
          
          //AQui dibujo lo que deseo en el bitmap y luego lo salvo como .jpg.
          MyJPEG := TJPEGImage.Create;
          try
           MyJPEG.Assign(MiBitMap);
           MyJPEG.CompressionQuality  := 100;
           MyJPEG.SaveToFile(FileName);
          finally
           MyJPEG.Free;
          end;
       end;

Y deseo cuando salve el archivo que ya tenga la resolucion incluida.
Quisiera no tener que hacer una salva intermedia a bmp, cambiar la resolucion y luego volver a salvarlo como .jpg y luego borrar el bmp.

Muchas gracias por la ayuda, intentare esa via sino encuentro otra.
Saludos a todos.
JCarlos

[[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);

[JCarlosas]

OK.
Muchisimas gracias.
Eso es lo que andaba buscando.
Saludos.
JCarlos

[JCarlosas]

Ya probe el ejemplo y trabaja a la perfeccion.

Por cierto quizas no me exprese bien en lo que deseaba hacer.
Realmente cuando dije:

Empezado por JCarlosas

debo salvar mi grafico en .jpg o .bmp.

Me referia a que a peticion del usuario era en un formato u otro.

Saludos a todos
y muy agradecido, me ha sido de gran ayuda los ejemplos

[jcarlos.matrix]

Aplique el jemplo tal cual como esta. y no me cambia. cargo una imagen de 929 kb y y en el archivo resultando da = 929 kb

[[seoane]]

Empezado por jcarlos.matrix

Aplique el jemplo tal cual como esta. y no me cambia. cargo una imagen de 929 kb y y en el archivo resultando da = 929 kb

¿Y cual debía ser el resultado? Ten en cuenta que solo cambias la resolución.

Una imagen de 100x100 píxeles con 72 ppp, ocupa exactamente lo mismo que una de 100x100 píxeles con 300 ppp, ya que sigue teniendo los mismos píxeles y en pantalla no apreciaras ningún cambio. El parámetro de la resolución solo sirve a la hora de imprimir la imagen para determinar la densidad de puntos con la que se debe imprimir. Es decir una imagen con el mismo tamaño de píxeles, pero con mayor resolución, se vera mas pequeña al imprimir, ya que se imprimirán mas puntos (píxeles) en el mismo espacio.