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;
댓글 없음:
댓글 쓰기