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

 

1. //只支持jpeg、bmp 格式
3. uses jpeg
5. procedure SmoothResize(var TargetBmp:TBitmap; SourceBmp : TBitmap ; frameColor:TColor =-1);
6. begin
7.   SetStretchBltMode(TargetBmp.Canvas.Handle,STRETCH_HALFTONE);
8.   StretchBlt(TargetBmp.Canvas.Handle,0,0,TargetBmp.Width,TargetBmp.Height,SourceBmp.Canvas.Handle,0,0,SourceBmp.Width,SourceBmp.Height,SRCCOPY);
9.   if frameColor >-1 then  begin
10.     TargetBmp.Canvas.Brush.Color := frameColor;
11.     TargetBmp.Canvas.FrameRect(Rect(0,0,TargetBmp.Width,TargetBmp.Height ));
12.   end;
13. end;
15. function DateTimeTOString(dt:TDateTime):shortstring;
16. begin
17.   Result :=formatDatetime('yyyymmddhhmmss',dt);
18. end;
20. //使用
21. procedure TfrmWorkerEdit.SpeedButton1Click(Sender: TObject);
22. var
23.   bmp1 ,bmp2 : TBitmap;
24.   jpg1 : TJPEGImage;
25.   PhotoPath ,fn :string;
27. begin
28.   bmp1 := TBitmap.Create;
29.   bmp2 := TBitmap.Create;
30.   try
31.     bmp1.Width := Image1.Width;
32.     bmp1.Height :=Image1.Height ;
33.     PhotoPath := ExtractFilePath(ParamStr(0))+'photo/';
34.     if not DirectoryExists(PhotoPath) then CreateDir(PhotoPath);
36.     with fDM.OpenDialog1  do begin
37.       Title :='请选择文件';
38.       Filter :='所支持的图片格式(*.jpg;*.JPEG;*,bmp)|*.jpg;*.JPEG;*,bmp';  
39.     end;
41.     if fDM.OpenDialog1.Execute  then
42.       fn := fDM.OpenDialog1.FileName;
43.     if not FileExists(fn) then Exit;
44.     if (UpperCase(ExtractFileExt(fn))='.JPG') or
45.        (UpperCase(ExtractFileExt(fn))='.JPEG') then begin
46.           jpg1 :=TJPEGImage.Create;
47.           try
48.             jpg1.LoadFromFile(fn);
49.             bmp2.Assign(jpg1);
50.           finally
51.             jpg1.Free;
52.           end;
53.     end else begin
54.       bmp2.LoadFromFile(fn);
55.     end;
56.     SmoothResize(bmp1,bmp2,clBlue );
57.     Image1.Picture.Bitmap := bmp1;
58.     bmp1.SaveToFile(PhotoPath + DateTimeTOString(Now())+'.bmp') ;
59.   finally
60.     bmp1.Free;
61.     bmp2.Free;
62.   end;   
63. end;