将图片自己转换成BMP并缩放保存。

//只支持jpeg、bmp 格式

uses jpeg

procedure SmoothResize(var TargetBmp:TBitmap; SourceBmp : TBitmap ; frameColor:TColor =-1);
begin
SetStretchBltMode(TargetBmp.Canvas.Handle,STRETCH_HALFTONE);
StretchBlt(TargetBmp.Canvas.Handle,0,0,TargetBmp.Width,TargetBmp.Height,SourceBmp.Canvas.Handle,0,0,SourceBmp.Width,SourceBmp.Height,SRCCOPY);
if frameColor >-1 then begin
TargetBmp.Canvas.Brush.Color := frameColor;
TargetBmp.Canvas.FrameRect(Rect(0,0,TargetBmp.Width,TargetBmp.Height ));
end;
end;

function DateTimeTOString(dt:TDateTime):shortstring;
begin
Result :=formatDatetime('yyyymmddhhmmss',dt);
end;

//使用
procedure TfrmWorkerEdit.SpeedButton1Click(Sender: TObject);
var
bmp1 ,bmp2 : TBitmap;
jpg1 : TJPEGImage;
PhotoPath ,fn :string;

begin
bmp1 := TBitmap.Create;
bmp2 := TBitmap.Create;
try
bmp1.Width := Image1.Width;
bmp1.Height :=Image1.Height ;
PhotoPath := ExtractFilePath(ParamStr(0))+'photo/';
if not DirectoryExists(PhotoPath) then CreateDir(PhotoPath);

with fDM.OpenDialog1 do begin
Title :='请选择文件';
Filter :='所支持的图片格式(*.jpg;*.JPEG;*,bmp)|*.jpg;*.JPEG;*,bmp';
end;

if fDM.OpenDialog1.Execute then
fn := fDM.OpenDialog1.FileName;
if not FileExists(fn) then Exit;
if (UpperCase(ExtractFileExt(fn))='.JPG') or
(UpperCase(ExtractFileExt(fn))='.JPEG') then begin
jpg1 :=TJPEGImage.Create;
try
jpg1.LoadFromFile(fn);
bmp2.Assign(jpg1);
finally
jpg1.Free;
end;
end else begin
bmp2.LoadFromFile(fn);
end;
SmoothResize(bmp1,bmp2,clBlue );
Image1.Picture.Bitmap := bmp1;
bmp1.SaveToFile(PhotoPath + DateTimeTOString(Now())+'.bmp') ;
finally
bmp1.Free;
bmp2.Free;
end;
end;