2011년 3월 3일 목요일

jpg 이미지의 dpi를 조절하자

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;

//사용
SaveToFileDPI(MyJPEG,FileName,300,300);
//예제
var
 j : TJpegImage;
begin
 j := TJpegImage.Create;
 j.Palette := 0;
 j.CompressionQuality := 100;
 j.PixelFormat := jf8Bit;
 j.Grayscale := False;
 j.Compress;
 j.Assign(Image1.Picture.Bitmap);
 j.SaveToFile(SourceFileName2);
 SaveToFileDPI(j,SourceFileName2,200,200);
 j.Free;

댓글 없음:

댓글 쓰기