请问Delphi中如何实现将图片(bmp、jpg)缩小存盘?(100分)

  • 主题发起人 主题发起人 blurblur
  • 开始时间 开始时间
B

blurblur

Unregistered / Unconfirmed
GUEST, unregistred user!
不知道这个在图象处理中再简单不过的操作为什么在编程中这么难实现。
以前在VB、PB中只能借助科达控件,但它存盘的图象虽然小,但不标准,
别的软件或标准图象控件根本无法正确显示。前阵开始学习Delphi,
现在再次被这个问题所困扰,图象显示的功能倒很强大,但对于缩小保存
好象Delphi依然无能为力。
请问有没有好的实现办法呢,望指点,谢谢。
 
将图片转换成 JPG 格式后保存到数据库中。
 
我的意思是说比如我有很多1200X768的bmp或jpg图片,想缩小为尺寸为1/2或1/3,大小为
20~30K的jpg的图片.我第一次来论坛,更是个Delphi新手,谢谢指教.
 
// Width_X,Heigth_X 分别为宽度和高度的缩小
// Ex: ZoomMinPhoto(Image1,Image2,2,2); 缩小两倍
procedure ZoomMinPhoto(var SourceImage,DestImage:TImage;Width_X,Height_X:Integer);
var
sWidth,sHeight:Integer;
I,J:Integer;
pDest,pSource:HBITMAP;
begin
if Image1.Picture=Nil then exit;

sWidth:=Image1.Picture.Width-1;
sHeight:=Image1.Picture.Height-1;

pSource:=Image1.Canvas.Handle;
pDest:=Image2.Canvas.Handle;

for I:=0 to sWidth do
begin
for J:=0 to sHeight do
begin
BitBlt(pDest,(I div Width_X),(J div Height_X),1,1,pSource,I,J,SRCCOPY);
end;
end;
end;
 
用楼上的方法可以缩小尺寸,存成jpg文件,可以用TJPEGIMAGE的方法来进行。降低JPG质量

可以减小JPG的尺寸。
 
zhihuali多谢你的帮助.现在已经可以缩小存盘.可惜只是裁减了图片左上角一块,而不是
全图缩放.还是我哪里做得有问题,麻烦你在看看代码.拜托了.
 
to: blurblur
贴出源代码。
 
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
以下是代码:form上就防了两个Image,3个Button.
Button2-----加载Jpg图片
Button3-----加载Bmp图片
Button4-----存盘
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
我是个菜鸟,这个问题困绕了我好几天.多谢大虾费心.
不胜感激.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

unit jpg;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Jpeg,extctrls, StdCtrls, ExtDlgs;

type
TForm1 = class(TForm)
Image1: TImage;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Image2: TImage;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ZoomMinPhoto(var SourceImage,DestImage:TImage;Width_X,Height_X:Integer);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.ZoomMinPhoto(var SourceImage,DestImage:TImage;Width_X,Height_X:Integer);
var
sWidth,sHeight:Integer;
I,J:Integer;
pDest,pSource:HBITMAP;
begin
if Image1.Picture=Nil then exit;
sWidth:=Image1.Picture.Width-1;
sHeight:=Image1.Picture.Height-1;

pSource:=Image1.Canvas.Handle;
pDest:=Image2.Canvas.Handle;

for I:=0 to sWidth do
begin
for J:=0 to sHeight do
begin
BitBlt(pDest,(I div Width_X),(J div Height_X),1,1,pSource,I,J,SRCCOPY);
end;
end;
end;



procedure TForm1.Button2Click(Sender: TObject); //LoadJpg
var
FBmp :TBitmap;
FJpg :TJpegImage;
tms: TMemoryStream;
begin
tms:=TMemoryStream.Create;
FJpg :=TJpegImage.Create;
tms.LoadFromFile('c:/1.jpg');
FJpg.LoadFromStream(tms);
FBmp :=TBitmap.Create;
FBmp.Assign(FJpg);
Image1.Picture.Bitmap.Assign(FBmp);
FBmp.Free;
FJpg.Free;
tms.free;
end;

procedure TForm1.Button3Click(Sender: TObject); //LoadBmp
var
FBmp :TBitmap;
tms: TMemoryStream;
begin
tms:=TMemoryStream.Create;
tms.LoadFromFile('c:/2.bmp');
FBmp :=TBitmap.Create;
FBmp.LoadFromStream(tms);
Image1.Picture.Bitmap.Assign(FBmp);
FBmp.Free;
tms.free;
end;

procedure TForm1.Button4Click(Sender: TObject); //saveImage
var
fjpeg:TJpegimage;
begin
ZoomMinPhoto(Image1,Image2,2,2); //缩小两倍
fjpeg:=Tjpegimage.create;
fjpeg.assign(image2.picture.bitmap);
fjpeg.savetofile('c:/123.jpg'); //另存为Jpeg文件
fjpeg.free;
end;

end.
 
后退
顶部