我有一张图片(500x500),但我需要将其调整大小为200x200并绘制在TImage上。如何实现这样的结果?
注意
我知道TImage中的Stretch
属性,但我想通过编程方式调整图像大小。
如果您知道新的尺寸不比原来的大,那么您可以简单地执行以下操作:
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;
这种方法的缺点是要进行两次像素复制操作。我可以想到至少两种解决该问题的方法。(哪两种?)
从下面的单元中提供的ResizeImage
函数(们)具有出色的易用性和图片质量。1) 该代码依赖于Graphics32、GIFImage2)和PNGImage2)。
该函数接受两个文件名或两个流。输入可以(自动检测为)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.
注意:
我经常使用这个页面上的SmoothResize
过程: http://www.swissdelphicenter.ch/torry/printcode.php?id=1896
与StretchDraw函数相比,缩放效果更佳。
不要被标题所迷惑。该页面演示了如何调整JPG大小,但SmoothResize过程本身使用位图进行调整大小。类似地,可以使用此过程调整PNG,但如果使用此过程,则会失去透明度。
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;
我在这方面进行了相当广泛的测试(10种算法/库)。我只提到前三个。
如果您懒得阅读,请跳到我的结论
:)
JanFX库
现已纳入肥胖绝地武士的发行版。幸运的是,你可以从绝地武士中提取此文件,而不必将整个庞然大物拖入你的项目中。
它提供了非常好的平滑效果(不如Graphics32好,但足够好),而且速度快得多。
注意:Jedi中的JanFX.pas存在缺陷:在启用范围检查时无法工作。您需要在代码之前定义{$R-}。就是这样。Jedi的人员输入了这个错误,因为他们总是关闭范围检查进行编译。
JanFx.SmoothResize(SrcBMP, DstBMP);
Graphics32库
输出质量非常好。
但如果你只需要一个重采样器,使用整个Graphics32库可能有些过度。JanFx更小更便携。Graphics32将给你略微更好的结果,但处理时间大约要慢10倍!
StretchBlt
如果您不想涉及外部库,请查看StretchBlt。
与Graphics32相比,这不会给您最好的结果,但是它比Graphics32快得多。
(请参见下面的代码)
结论:
在输出质量和速度之间取得最佳平衡的StretchBlt是我的程序的最终选择。它不仅在降采样方面表现出色,而且在升采样方面也表现良好。
{-------------------------------------------------------------------------------------------------------------
Uses MS Windows StretchBlt
BEST (see tester)
Zoom: In/Out
Keep aspect ration: No
Stretch provided in: pixels
Resize down: VERY smooth. Better than JanFX.SmoothResize.
Resize up: better (sharper) than JanFX.SmoothResize
Time: similar to JanFx
BitBlt only does copy. NO STRETCH
https://msdn.microsoft.com/en-us/library/windows/desktop/dd162950(v=vs.85).aspx
-------------------------------------------------------------------------------------------------------------}
function StretchF(BMP: TBitmap; OutWidth, OutHeight: Integer): TBitmap;
begin
if (BMP.Width < 12) OR (BMP.Height< 12) then
begin
ShowMessage('Cannot stretch images under 12 pixels!'); { 'WinStretchBltF' will crash if the image size is too small (below 10 pixels)}
EXIT(NIL);
end;
Result:= TBitmap.Create;
TRY
Result.PixelFormat:= BMP.PixelFormat; { Make sure we use the same pixel format as the original image }
SetLargeSize(Result, OutWidth, OutHeight);
SetStretchBltMode(Result.Canvas.Handle, HALFTONE);
SetBrushOrgEx (Result.Canvas.Handle, 0,0, NIL);
StretchBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, BMP.Canvas.Handle, 0, 0, BMP.Width, BMP.Height, SRCCOPY);
FINALLY
FreeAndNil(Result);
RAISE;
END;
end;
对于任何类型的图像,您都可以使用以下代码:
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);