zhihuali,我今天刚来这里,不太熟,怎么会一给分,问题的帖子就不见了.(10分)

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

blurblur

Unregistered / Unconfirmed
GUEST, unregistred user!
麻烦你再给我看看代码.多谢了.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
以下是代码: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.


 
to : blurblur
1.将 Image1 的 AutoSize:=True; Image2 的 AutoSize:=False;
2.函数改为:
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;

Image2.Width:=(sWidth+1) div Width_X;
Image2.Height:=(sHeight+1) div Height_X;

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

for I:=0 to sWidth do
for J:=0 to sHeight do
BitBlt(pDest,(I div Width_X),(J div Height_X),1,1,pSource,I,J,SRCCOPY);
end;
 
兄弟:
给分后你看看你的屏幕上左上方,是不是有‘我的已答问题’,点他就可以看到给分后的问题
 
接受答案了.
 
后退
顶部