Fatal编程技术网
  • image/
  • Image 如何调整图片的大小？

Image 如何调整图片的大小？

image delphi

Image 如何调整图片的大小？,image,delphi,resize,delphi-7,Image,Delphi,Resize,Delphi 7,我有图像（500x500），但我需要将其调整为200x200并在TImage上绘制。如何达到这样的效果 注意我知道TImage中的拉伸属性，但我想以编程方式调整图像大小。如果您知道新尺寸不大于原始尺寸，您只需执行以下操作即可 procedure ShrinkBitmap(Bitmap: TBitmap; const NewWidth, NewHeight: integer); begin Bitmap.Canvas.StretchDraw( Rect(0, 0, NewWidth,

我有图像（500x500），但我需要将其调整为200x200并在TImage上绘制。如何达到这样的效果

注意
我知道TImage中的
拉伸
属性，但我想以编程方式调整图像大小。

如果您知道新尺寸不大于原始尺寸，您只需执行以下操作即可

procedure ShrinkBitmap(Bitmap: TBitmap; const NewWidth, NewHeight: integer);
begin
  Bitmap.Canvas.StretchDraw(
    Rect(0, 0, NewWidth, NewHeight),
    Bitmap);
  Bitmap.SetSize(NewWidth, NewHeight);
end;
如果您知道新维度不小于原始维度，我将编写相应的代码作为练习

如果你想要一个通用函数，你可以这样做

procedure ResizeBitmap(Bitmap: TBitmap; const NewWidth, NewHeight: integer);
var
  buffer: TBitmap;
begin
  buffer := TBitmap.Create;
  try
    buffer.SetSize(NewWidth, NewHeight);
    buffer.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), Bitmap);
    Bitmap.SetSize(NewWidth, NewHeight);
    Bitmap.Canvas.Draw(0, 0, buffer);
  finally
    buffer.Free;
  end;
end;
这种方法的缺点是执行两个像素的复制操作。我至少可以想出两种解决这个问题的办法。（哪个？

我经常使用本页中的
SmoothResize
过程：

缩放比StretchDraw函数好得多

不要让标题欺骗你。页面演示了如何调整JPG的大小，但SmoothResize过程本身使用位图来调整大小。调整PNG的大小也可以在类似的情况下完成，但如果使用此过程，将失去透明度

良好的可用性和图片质量提供了下面单元1）中的
调整图像大小的功能。代码取决于，2）和2）

该函数采用两个文件名或两个流。输入是（自动检测为）BMP、PNG、GIF或JPG，输出总是JPG


unit AwResizeImage;

interface

uses
  Windows, SysUtils, Classes, Graphics, Math, JPEG, GR32, GIFImage, PNGImage,
  GR32_Resamplers;

type
  TImageType = (itUnknown, itBMP, itGIF, itJPG, itPNG);
  TImageInfo = record
    ImgType: TImageType;
    Width: Cardinal;
    Height: Cardinal;
  end;

  function GetImageInfo(const AFilename: String): TImageInfo; overload;
  function GetImageInfo(const AStream: TStream): TImageInfo; overload;

  function ResizeImage(const ASource, ADest: String; const AWidth,
    AHeight: Integer; const ABackColor: TColor;
    const AType: TImageType = itUnknown): Boolean; overload;
  function ResizeImage(const ASource, ADest: TStream; const AWidth,
    AHeight: Integer; const ABackColor: TColor;
    const AType: TImageType = itUnknown): Boolean; overload;

implementation

type
  TGetDimensions = procedure(const ASource: TStream;
    var AImageInfo: TImageInfo);

  TCardinal = record
    case Byte of
      0: (Value: Cardinal);
      1: (Byte1, Byte2, Byte3, Byte4: Byte);
  end;

  TWord = record
    case Byte of
      0: (Value: Word);
      1: (Byte1, Byte2: Byte);
  end;

  TPNGIHDRChunk = packed record
    Width: Cardinal;
    Height: Cardinal;
    Bitdepth: Byte;
    Colortype: Byte;
    Compression: Byte;
    Filter: Byte;
    Interlace: Byte;
  end;

  TGIFHeader = packed record
    Signature: array[0..2] of Char;
    Version: array[0..2] of Char;
    Width: Word;
    Height: Word;
  end;

  TJPGChunk = record
    ID: Word;
    Length: Word;
  end;

  TJPGHeader = packed record
    Reserved: Byte;
    Height: Word;
    Width: Word;
  end;

const
  SIG_BMP: array[0..1] of Char = ('B', 'M');
  SIG_GIF: array[0..2] of Char = ('G', 'I', 'F');
  SIG_JPG: array[0..2] of Char = (#255, #216, #255);
  SIG_PNG: array[0..7] of Char = (#137, #80, #78, #71, #13, #10, #26, #10);

function SwapBytes(const ASource: Cardinal): Cardinal; overload;
var
  mwSource: TCardinal;
  mwDest: TCardinal;
begin
  mwSource.Value := ASource;
  mwDest.Byte1 := mwSource.Byte4;
  mwDest.Byte2 := mwSource.Byte3;
  mwDest.Byte3 := mwSource.Byte2;
  mwDest.Byte4 := mwSource.Byte1;
  Result := mwDest.Value;
end;

function SwapBytes(const ASource: Word): Word; overload;
var
  mwSource: TWord;
  mwDest: TWord;
begin
  mwSource.Value  := ASource;
  mwDest.Byte1 := mwSource.Byte2;
  mwDest.Byte2 := mwSource.Byte1;
  Result := mwDest.Value;
end;

procedure GetBMPDimensions(const ASource: TStream; var AImageInfo: TImageInfo);
var
  bmpFileHeader: TBitmapFileHeader;
  bmpInfoHeader: TBitmapInfoHeader;
begin
  FillChar(bmpFileHeader, SizeOf(TBitmapFileHeader), #0);
  FillChar(bmpInfoHeader, SizeOf(TBitmapInfoHeader), #0);
  ASource.Read(bmpFileHeader, SizeOf(TBitmapFileHeader));
  ASource.Read(bmpInfoHeader, SizeOf(TBitmapInfoHeader));
  AImageInfo.Width := bmpInfoHeader.biWidth;
  AImageInfo.Height := bmpInfoHeader.biHeight;
end;

procedure GetGIFDimensions(const ASource: TStream; var AImageInfo: TImageInfo);
var
  gifHeader: TGIFHeader;
begin
  FillChar(gifHeader, SizeOf(TGIFHeader), #0);
  ASource.Read(gifHeader, SizeOf(TGIFHeader));
  AImageInfo.Width := gifHeader.Width;
  AImageInfo.Height := gifHeader.Height;
end;

procedure GetJPGDimensions(const ASource: TStream; var AImageInfo: TImageInfo);
var
  cSig: array[0..1] of Char;
  jpgChunk: TJPGChunk;
  jpgHeader: TJPGHeader;
  iSize: Integer;
  iRead: Integer;
begin
  FillChar(cSig, SizeOf(cSig), #0);
  ASource.Read(cSig, SizeOf(cSig));
  iSize := SizeOf(TJPGChunk);
  repeat
    FillChar(jpgChunk, iSize, #0);
    iRead := ASource.Read(jpgChunk, iSize);
    if iRead <> iSize then
      Break;
    if jpgChunk.ID = $C0FF then
    begin
      ASource.Read(jpgHeader, SizeOf(TJPGHeader));
      AImageInfo.Width := SwapBytes(jpgHeader.Width);
      AImageInfo.Height := SwapBytes(jpgHeader.Height);
      Break;
    end
    else
      ASource.Position := ASource.Position + (SwapBytes(jpgChunk.Length) - 2);
  until False;
end;

procedure GetPNGDimensions(const ASource: TStream; var AImageInfo: TImageInfo);
var
  cSig: array[0..7] of Char;
  cChunkLen: Cardinal;
  cChunkType: array[0..3] of Char;
  ihdrData: TPNGIHDRChunk;
begin
  FillChar(cSig, SizeOf(cSig), #0);
  FillChar(cChunkType, SizeOf(cChunkType), #0);
  ASource.Read(cSig, SizeOf(cSig));
  cChunkLen := 0;
  ASource.Read(cChunkLen, SizeOf(Cardinal));
  cChunkLen := SwapBytes(cChunkLen);
  if cChunkLen = SizeOf(TPNGIHDRChunk) then
  begin
    ASource.Read(cChunkType, SizeOf(cChunkType));
    if AnsiUpperCase(cChunkType) = 'IHDR' then
    begin
      FillChar(ihdrData, SizeOf(TPNGIHDRChunk), #0);
      ASource.Read(ihdrData, SizeOf(TPNGIHDRChunk));
      AImageInfo.Width := SwapBytes(ihdrData.Width);
      AImageInfo.Height := SwapBytes(ihdrData.Height);
    end;
  end;
end;

function GetImageInfo(const AFilename: String): TImageInfo;
var
  fsImage: TFileStream;
begin
  fsImage := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
  try
    Result := GetImageInfo(fsImage);
  finally
    FreeAndNil(fsImage);
  end;
end;

function GetImageInfo(const AStream: TStream): TImageInfo;
var
  iPos: Integer;
  cBuffer: array[0..2] of Char;
  cPNGBuffer: array[0..4] of Char;
  GetDimensions: TGetDimensions;
begin
  GetDimensions := nil;
  Result.ImgType := itUnknown;
  Result.Width := 0;
  Result.Height := 0;
  FillChar(cBuffer, SizeOf(cBuffer), #0);
  FillChar(cPNGBuffer, SizeOf(cPNGBuffer), #0);
  iPos := AStream.Position;
  AStream.Read(cBuffer, SizeOf(cBuffer));
  if cBuffer = SIG_GIF then
  begin
    Result.ImgType := itGIF;
    GetDimensions := GetGIFDimensions;
  end
  else if cBuffer = SIG_JPG then
  begin
    Result.ImgType := itJPG;
    GetDimensions := GetJPGDimensions;
  end
  else if cBuffer = Copy(SIG_PNG, 1, 3) then
  begin
    AStream.Read(cPNGBuffer, SizeOf(cPNGBuffer));
    if cPNGBuffer = Copy(SIG_PNG, 4, 5) then
    begin
      Result.ImgType := itPNG;
      GetDimensions := GetPNGDimensions;
    end;
  end
  else if Copy(cBuffer, 1, 2) = SIG_BMP then
  begin
    Result.ImgType := itBMP;
    GetDimensions := GetBMPDimensions;
  end;
  AStream.Position := iPos;
  if Assigned(GetDimensions) then
  begin
    GetDimensions(AStream, Result);
    AStream.Position := iPos;
  end;
end;

procedure GIFToBMP(const ASource: TStream; const ADest: TBitmap);
var
  imgSource: TGIFImage;
begin
  imgSource := TGIFImage.Create();
  try
    imgSource.LoadFromStream(ASource);
    ADest.Assign(imgSource);
  finally
    FreeAndNil(imgSource);
  end;
end;

procedure JPGToBMP(const ASource: TStream; const ADest: TBitmap);
var
  imgSource: TJPEGImage;
begin
  imgSource := TJPEGImage.Create();
  try
    imgSource.LoadFromStream(ASource);
    ADest.Assign(imgSource);
  finally
    FreeAndNil(imgSource);
  end;
end;

procedure PNGToBMP(const ASource: TStream; const ADest: TBitmap);
var
  imgSource: TPNGImage;
begin
  imgSource := TPNGImage.Create();
  try
    imgSource.LoadFromStream(ASource);
    ADest.Assign(imgSource);
  finally
    FreeAndNil(imgSource);
  end;
end;

function ResizeImage(const ASource, ADest: String; const AWidth,
  AHeight: Integer; const ABackColor: TColor;
  const AType: TImageType = itUnknown): Boolean;
var
  fsSource: TFileStream;
  fsDest: TFileStream;
begin
  Result := False;
  fsSource := TFileStream.Create(ASource, fmOpenRead or fmShareDenyWrite);
  try
    fsDest := TFileStream.Create(ADest, fmCreate or fmShareExclusive);
    try
      Result := not Result; //hide compiler hint
      Result := ResizeImage(fsSource, fsDest, AWidth, AHeight, ABackColor, AType);
    finally
      FreeAndNil(fsDest);
    end;
  finally
    FreeAndNil(fsSource);
  end;
end;

function ResizeImage(const ASource, ADest: TStream; const AWidth,
  AHeight: Integer; const ABackColor: TColor;
  const AType: TImageType = itUnknown): Boolean;
var
  itImage: TImageType;
  ifImage: TImageInfo;
  bmpTemp: TBitmap;
  bmpSource: TBitmap32;
  bmpResized: TBitmap32;
  cBackColor: TColor32;
  rSource: TRect;
  rDest: TRect;
  dWFactor: Double;
  dHFactor: Double;
  dFactor: Double;
  iSrcWidth: Integer;
  iSrcHeight: Integer;
  iWidth: Integer;
  iHeight: Integer;
  jpgTemp: TJPEGImage;
begin
  Result := False;
  itImage := AType;
  if itImage = itUnknown then
  begin
    ifImage := GetImageInfo(ASource);
    itImage := ifImage.ImgType;
    if itImage = itUnknown then
      Exit;
  end;
  bmpTemp := TBitmap.Create();
  try
    case itImage of
      itBMP: bmpTemp.LoadFromStream(ASource);
      itGIF: GIFToBMP(ASource, bmpTemp);
      itJPG: JPGToBMP(ASource, bmpTemp);
      itPNG: PNGToBMP(ASource, bmpTemp);
    end;
    bmpSource := TBitmap32.Create();
    bmpResized := TBitmap32.Create();
    try
      cBackColor  := Color32(ABackColor);
      bmpSource.Assign(bmpTemp);
      bmpResized.Width := AWidth;
      bmpResized.Height := AHeight;
      bmpResized.Clear(cBackColor);
      iSrcWidth := bmpSource.Width;
      iSrcHeight := bmpSource.Height;
      iWidth := iSrcWidth;
      iHeight := iSrcHeight;
      with rSource do
      begin
        Left := 0;
        Top := 0;
        Right := iSrcWidth;
        Bottom := iSrcHeight;
      end;
      if (iWidth > AWidth) or (iHeight > AHeight) then
      begin
        dWFactor := AWidth / iWidth;
        dHFactor := AHeight / iHeight;
        if (dWFactor > dHFactor) then
          dFactor := dHFactor
        else
          dFactor := dWFactor;
        iWidth := Floor(iWidth * dFactor);
        iHeight := Floor(iHeight * dFactor);
      end;
      with rDest do
      begin
        Left := Floor((AWidth - iWidth) / 2);
        Top := Floor((AHeight - iHeight) / 2);
        Right := Left + iWidth;
        Bottom := Top + iHeight;
      end;
      bmpSource.Resampler := TKernelResampler.Create;
      TKernelResampler(bmpSource.Resampler).Kernel := TLanczosKernel.Create;
      bmpSource.DrawMode := dmOpaque;
      bmpResized.Draw(rDest, rSource, bmpSource);
      bmpTemp.Assign(bmpResized);
      jpgTemp := TJPEGImage.Create();
      jpgTemp.CompressionQuality := 80;
      try
        jpgTemp.Assign(bmpTemp);
        jpgTemp.SaveToStream(ADest);
        Result := True;
      finally
        FreeAndNil(jpgTemp);
      end;
    finally
      FreeAndNil(bmpResized);
      FreeAndNil(bmpSource);
    end;
  finally
    FreeAndNil(bmpTemp);
  end;
end;

end.



unitawresizeimage；
接口
使用
Windows、SysUtils、类、图形、数学、JPEG、GR32、GIFImage、PNGImage、，
GR32_重采样器；
类型
TImageType=（itUnknown、itBMP、itGIF、itJPG、itPNG）；
TImageInfo=记录
ImgType:TImageType；
宽度：基数；
身高：基数；
结束；
函数GetImageInfo（const AFilename:String）：TImageInfo；超载；
函数GetImageInfo（const AStream:TStream）：TImageInfo；超载；
函数ResizeImage（const ASource，ADest:String；const AWidth，
AHeight:整数；const-ABackColor:TColor；
常量AType:TImageType=itUnknown）：布尔值；超载；
函数大小图像（const ASource，ADest:TStream；const AWidth，
AHeight:整数；const-ABackColor:TColor；
常量AType:TImageType=itUnknown）：布尔值；超载；
实施
类型
TGetDimensions=程序（常量A来源：TStream；
var AImageInfo:TImageInfo）；
TCardinal=记录
大小写字节
0：（值：基数）；
1：（字节1，字节2，字节3，字节4：字节）；
结束；
TWord=记录
大小写字节
0：（值：Word）；
1：（字节1，字节2：字节）；
结束；
TPNGIHDRChunk=打包记录
宽度：基数；
身高：基数；
位深度：字节；
颜色类型：字节；
压缩：字节；
过滤器：字节；
隔行扫描：字节；
结束；
TGIFHeader=打包记录
签名：字符的数组[0..2]；
版本：字符的数组[0..2]；
宽度：字；
高度：字；
结束；
TJPGChunk=记录
ID：单词；
长度：字；
结束；
TJPGHeader=打包记录
保留：字节；
高度：字；
宽度：字；
结束；
常数
SIG_BMP:Char=（'B'，'M'）的数组[0..1]；
SIG_GIF:Char=（'G'，'I'，'F'）的数组[0..2]；
SIG_JPG:Char=（#255，#216，#255）的数组[0..2]；
SIG#u PNG:Char=（#137，#80，#78，#71，#13，#10，#26，#10）的数组[0..7]；
函数交换字节（const ASource:Cardinal）：Cardinal；超载；
变量
资料来源：TCardinal；
mwDest:TCardinal；
开始
mwSource.Value:=A来源；
mwDest.Byte1:=mwSource.Byte4；
mwDest.Byte2:=mwSource.Byte3；
mwDest.Byte3:=mwSource.Byte2；
mwDest.Byte4:=mwSource.Byte1；
结果：=mwDest.值；
结束；
函数交换字节（const-ASource:Word）：Word；超载；
变量
资料来源：TWord；
MWDST:TWord；
开始
mwSource.Value:=A来源；
mwDest.Byte1:=mwSource.Byte2；
mwDest.Byte2:=mwSource.Byte1；
结果：=mwDest.值；
结束；
过程GetBMPDimensions（const ASource:TStream；var AImageInfo:TImageInfo）；
变量
bmpFileHeader:TBitmapFileHeader；
bmpInfoHeader:TBitmapInfoHeader；
开始
FillChar（bmpFileHeader，SizeOf（TBitmapFileHeader），#0）；
FillChar（bmpInfoHeader，SizeOf（TBitmapInfoHeader），#0）；
ASource.Read（bmpFileHeader，SizeOf（TBitmapFileHeader））；
ASource.Read（bmpInfoHeader，SizeOf（TBitmapInfoHeader））；
AImageInfo.Width:=bmpInfoHeader.biWidth；
AImageInfo.Height:=bmpInfoHeader.biHeight；
结束；
过程GetGIFDimensions（const ASource:TStream；var AImageInfo:TImageInfo）；
变量
gifiheader:TGIFHeader；
开始
FillChar（gifHeader，SizeOf（TGIFHeader），#0）；
ASource.Read（gifHeader，SizeOf（TGIFHeader））；
AImageInfo.Width:=gifHeader.Width；
AImageInfo.Height:=gifHeader.Height；
结束；
过程GetJPGDimensions（const ASource:TStream；var AImageInfo:TImageInfo）；
变量
cSig:Char的数组[0..1]；
jpgChunk:TJPGChunk；
jpgHeader:TJPGHeader；
iSize：整数；
iRead：整数；
开始
FillChar（cSig，SizeOf（cSig），#0）；
ASource.Read（cSig，SizeOf（cSig））；
iSize:=SizeOf（TJPGChunk）；
重复
FillChar（jpgChunk，iSize，#0）；
iRead:=ASource.Read（jpgChunk，iSize）；
如果我是伊塞兹的话
打破
如果jpgChunk.ID=$C0FF，则
开始
ASource.Read（jpgHeader，SizeOf（TJPGHeader））；
AImageInfo.Width:=交换字节（jpgHeader.Width）；
AImageInfo.Height:=交换字节（jpgHeader.Height）；
打破
结束
其他的
ASource.Position:=ASource.Position+（交换字节（jpgChunk.Length）-2）；
直到错误；
结束；
过程GetPNGDimensions（const ASource:TStream；var AImageInfo:TImageInfo）；
变量
cSig:Char的数组[0..7]；
康克伦：红衣主教；
cChunkType:字符的数组[0..3]；
ihdrData:TPNGIHDRChunk；
开始
FillChar（cSig，SizeOf（cSig），#0）；
FillChar（cChunkType，SizeOf（cChunkType），#0）；
ASource.Read（cSig，SizeOf（cSig））；
cChunkLen:=0；
一个资源读取（cChunkLen，SizeOf（红衣主教））；
cChunkLen:=交换字节（cChunkLen）；
如果cChunkLen=SizeOf（TPNGIHDRChunk），则
开始
ASource.Read（cChunkType，SizeOf（cChunkType））；
如果AnsiUpperCase（cChunkType）=“IHDR”，则
开始
FillChar（ihdrData，SizeOf（TPNGIHDRChunk），#0）；
ASource.Read（ihdrData，SizeOf（TPNGIHDRChunk））；
目标

img := TIMage.create(nil);
img.picture.loadfromfile('any_file_type');
Result:= TBitmap.Create;
result.Width := newWidth;
result.Height := newHeight;
Result.Canvas.Draw(0,0,img.Picture.Graphic);



uses 
  GR32, GR32_Resamplers;

procedure Resize(InputPicture: TBitmap; OutputImage: TImage; const DstWidth, DstHeigth: Integer);
var
  Src, Dst: TBitmap32;
begin
  Dst := nil;
  try
    Src := TBitmap32.Create;
    try
      Src.Assign(InputPicture);
      SetHighQualityStretchFilter(Src);
      Dst := TBitmap32.Create;
      Dst.SetSize(DstWidth, DstHeigth);
      Src.DrawTo(Dst, Rect(0, 0, DstWidth, DstHeigth), Rect(0, 0, Src.Width, Src.Height));
    finally
      FreeAndNil(Src);
    end;
    OutputImage.Assign(Dst);
  finally
    FreeAndNil(Dst);
  end;
end;

// If you need to set a highest quality resampler, use this helper routine to configure it
procedure SetHighQualityStretchFilter(B: TBitmap32);
var
  KR: TKernelResampler;
begin
  if not (B.Resampler is TKernelResampler) then
  begin
    KR := TKernelResampler.Create(B);
    KR.Kernel := TLanczosKernel.Create;
  end
  else
  begin
    KR := B.Resampler as TKernelResampler;
    if not (KR.Kernel is TLanczosKernel) then
    begin
      KR.Kernel.Free;
      KR.Kernel := TLanczosKernel.Create;
    end;
  end;
end;