type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
encoderClsid: TGUID;
stat: TStatus;
Image: TGPImage;
begin
// Get a JPEG image from the disk.
Image := TGPImage.Create('..\..\Media\FRUIT.JPG');
// Get the CLSID of the Bitmap encoder.
GetEncoderClsid('image/bmp', encoderClsid);//这里设置格式!
TGPBitmap(image).SetResolution(96, 96);
stat := image.Save('HighRes.bmp', encoderClsid);
if(stat = Ok) then
memo1.Lines.Add('HighRes.bmp saved successfully.')
else
memo1.Lines.Add(GetStatus(Stat) + ' Attempt to save HighRes.bmp failed.');
函数有问题,当改写为
function ConvertPICintoBMP(cPic: TPicture; PixelBit, pWidth,
pHeight: Integer): TBitmap;
begin
Result := TBitmap.Create;
if (pWidth > 0) or (pHeight > 0) then
begin
Result.Width := pWidth;
Result.Height := pHeight;
end
else
begin
Result.Width := cPic.Width;
Result.Height := cPic.Height;
end;
Result.Canvas.StretchDraw(Result.Canvas.ClipRect, cPic.Graphic); //按照新尺寸重画图形
//其他图片格式转成JPG格式
function ConvertPICintoJPG(cPic: TPicture; jQuality: Integer;
pWidth: Integer = 0; pHeight: Integer = 0): TJpegImage; stdcall;
var
tBMP: TBitmap;
begin
Result := TJpegImage.Create;
if (pWidth > 0) or (pHeight > 0) then
begin
try
tBMP := TBitmap.Create; //创建一个过渡性BMP图片,用于更改图片尺寸
if pWidth <= 0 then pWidth := cPic.Width; //若pWidth为有效值则改变tBMP宽度,否则不变
if pHeight <= 0 then pHeight := cPic.Height; //若pHeight为有效值则改变tBMP高度,否则不变
tBMP.Width := pWidth;
tBMP.Height := pHeight;
tBMP.Canvas.StretchDraw(tBMP.Canvas.ClipRect, cPic.Graphic); //按照新尺寸重画图形
Result.Assign(tBMP);
finally
tBMP.Free;
end;//try Create tBMP
end
else Result.Assign(cPic); //if
//设置压缩质量
if jQuality in [1..100] then Result.CompressionQuality := jQuality;
end;
//其他图片格式转成BMP格式
function ConvertPICintoBMP(cPic: TPicture; PixelBit: Integer;
pWidth: Integer = 0; pHeight: Integer = 0): TBitmap; stdcall;
begin
Result := TBitmap.Create;
if (pWidth > 0) or (pHeight > 0) then
begin
if pWidth <= 0 then pWidth := cPic.Width; //若pWidth为有效值则改变tBMP宽度,否则不变
if pHeight <= 0 then pHeight := cPic.Height; //若pHeight为有效值则改变tBMP高度,否则不变
Result.Width := pWidth;
Result.Height := pHeight;
Result.Canvas.StretchDraw(Result.Canvas.ClipRect, cPic.Graphic); //按照新尺寸重画图形
end
else Result.Assign(cPic);