图像放大(200分)

  • 主题发起人 主题发起人 ts7000
  • 开始时间 开始时间
T

ts7000

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
image1.Width :=image2.Width *2;
image1.Height :=image2.Height *2;

image1.Canvas.StretchDraw(rect(0,0,image2.Width *2,image2.Height *2),image2.Picture.Graphic );
image1.Picture.SaveToFile(ExtractFilePath(application.ExeName)+'first.bmp' );
if fileexists(ExtractFilePath(application.ExeName)+'first.bmp') then
image2.Picture.LoadFromFile(ExtractFilePath(application.ExeName)+'first.bmp')
else
application.MessageBox(pchar('图像打开失败。'),'错误',mb_iconerror+mb_ok);
image1.Canvas .Refresh ;
end;
请问
为什么放大后只显示部分图像?
分数不够可以再加
 
难道没有人会吗?
 
今天没时间了,后天我把毕业实习报告写完,再看吧
头疼啊!
 
你的问题是什么?

这段代码在我这里很好,没问题。我把image1的stretch设成True。
 
看一下
http://www.huzhou.zj.cn/~fhb
 
to ts7000 :
很简单的程序为什么写的这么麻烦?

procedure TForm1.BitBtn1Click(Sender: TObject);
var
Bmp :TBitmap;
begin
Bmp :=TBitmap.Create;
Bmp.Width :=Image2.Picture.Bitmap.Width*2;
Bmp.Height :=Image2.Picture.Bitmap.Height*2;
StretchBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,
Image2.Picture.Bitmap.Canvas.Handle,0,0,Image2.Picture.Bitmap.Width,Image2.Picture.Bitmap.Height,SRCCOPY);
Image1.AutoSize :=True;
Image1.Picture.Bitmap.Assign(Bmp);
Bmp.Free;
end;
 
你将image1换成TBitmap类型的变量
procedure TForm1.Button2Click(Sender: TObject);
var
Canvas: TCanvas;
MyBitmap: TBitmap;
i_width,i_high:integer;
r_s,r_o :TRect;
begin
MyBitmap := TBitmap.Create;
MyBitmap.LoadFromFile(p17.bmp');
r_s := Rect(0, 0, MyBitmap.Width, MyBitmap.Height);
r_o := Rect(0, 0, image2.Width, image2.Height); //设定目的矩形框的大小
image2.Canvas.CopyRect(r_o, MyBitmap.Canvas, r_s );
MyBitmap.Free;
end;
 
procedure TForm1.Button1Click(Sender:TObject);
var
R1:TRect;
begin
with R1 do
begin
Top:=0;
Left:=0;
Right:=Bitmap2.Width * 2;
Bottom:=Bitmap2.Height * 2;
end;
Bitmap1.Canvas.CopyRect(ClientRect,Bitmap2.Canvas,R1);
end;
 
对不起,也许我说的不够详细,我是想连续放大,仅放大一次我已经实现了,但在放大的基础上
再放大时,出现了只显示部分图像,请各位帮忙实现,谢谢。
 
问题解决了,但为什么,连续放大几次后,delphi会显示参数错误,请卷起千堆雪tyn再帮帮忙OK?
 
个你一个单元:
/////////////////////////////////////////////////////////////////////
unit Unit5;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ToolWin, ImgList, ExtCtrls, jpeg, FileCtrl;

type
TForm5 = class(TForm)
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
ToolButton16: TToolButton;
ImageList1: TImageList;
Panel1: TPanel;
Image1: TImage;
StatusBar1: TStatusBar;
procedure FormShow(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ToolButton9Click(Sender: TObject);
private
{ Private declarations }
w,h:integer;//width & height of image
wratio,hratio:real;

ratio:real;

wmove,hmove:boolean;
mmstartx,mmstarty:integer;//mouse move start coordinate (x,y)

imagefilelist:tstringlist;
imageposition:integer;
function filesize(filename:string):int64;
procedure errorshowimage(filename:string);
procedure okshowimage(filename:string);
procedure showimage(filename:string);
procedure toolbuttonstatus;
public
{ Public declarations }
procedure wmgetminmaxinfo(var msg:twmgetminmaxinfo);message wm_getminmaxinfo;
end;

const
HANDOPENCURSOR = 133;
HANDCLOSECURSOR = 166;

var
Form5: TForm5;

implementation

uses unit1, unit6;

{$R *.DFM}
{$R CUR.RES}

procedure tform5.wmgetminmaxinfo(var msg:twmgetminmaxinfo);
begin
msg.MinMaxInfo^.ptMinTrackSize.x:=400;
msg.MinMaxInfo^.ptMinTrackSize.y:=200;
msg.Result:=0;
end;

function tform5.filesize(filename:string):int64;
var
sr:tsearchrec;
begin
result:=0;
if findfirst(filename,faanyfile,sr)=0 then result:=sr.Size;
findclose(sr);
end;

procedure tform5.errorshowimage(filename:string);
begin
with statusbar1 do
begin
panels[0].text:='';
panels[1].text:=form1.int64tocommastr( filesize(filename) )+' Byte(s)';
panels[2].text:='';
panels[3].text:='Error';
end;
end;

procedure tform5.okshowimage(filename:string);
begin
with statusbar1 do
begin
panels[0].text:=inttostr( trunc(100*ratio) )+'%';
panels[1].text:=form1.int64tocommastr( filesize(filename) )+' Byte(s)';
panels[2].text:=inttostr(w) + ' * '+inttostr(h);
panels[3].text:='Ok';
end;
end;

procedure tform5.showimage(filename:string);
begin
if not fileexists(filename) then
messagedlg('File '+filename+' does not exist.',mterror,[mbok],0)
else
begin
try
with image1 do
begin
visible:=false;
autosize:=true;
Picture.LoadFromFile(filename);
w:=picture.Width;
h:=picture.Height;
autosize:=false;

if (w>panel1.Width-8)or(h>panel1.Height-8) then
begin
wratio:=(w/1.0)/( (panel1.Width)/1.0 );
hratio:=(h/1.0)/( (panel1.height)/1.0 );
if ( wratio > hratio ) then
begin
width:=panel1.Width;
height:=trunc(h/wratio);
top:=(panel1.Height-height) div 2;
left:=0;
visible:=true;

ratio:=1/wratio;
end
else
begin
height:=panel1.height ;
width:=trunc(w/hratio);
top:=0;
left:=(panel1.width-width) div 2;
visible:=true;

ratio:=1/hratio;
end;
end
else
begin
top:=(panel1.Height -h) div 2;
left:=(panel1.width -w) div 2;
visible:=true;

ratio:=1;
end;
cursor:=crdefault;
end;
wmove:=false;//it is not neccessary to move image on horizontal direction
hmove:=false;//it is not neccessary to move image on vertical direction

okshowimage(filename);

if uppercase( extractfileext(filename) ) = '.ICO' then
begin
toolbutton5.enabled:=false;
toolbutton6.enabled:=false;
toolbutton7.enabled:=false;
end
else toolbuttonstatus;
except
image1.Picture:=nil;
errorshowimage(filename);
messagedlg('Can not open picture file: '+filename,mterror,[mbyes],0);
end;
end;
end;

procedure TForm5.FormShow(Sender: TObject);
var
i:integer;
begin
ratio:=0;

caption:='Picture show - '+form1.listbox1.items[form1.listbox1.itemindex];
showimage(form1.listbox1.items[form1.listbox1.itemindex]);

imageposition:=0;
imagefilelist.Clear;

i:=form1.ListBox1.ItemIndex;
while(i<form1.ListBox1.Items.Count)do
begin
if form1.ispicturefile(form1.listbox1.items) then
imagefilelist.Add(form1.listbox1.items);
inc(i);
end;
i:=0;
while(i<form1.ListBox1.ItemIndex) do
begin
if form1.ispicturefile(form1.listbox1.items) then
imagefilelist.Add(form1.listbox1.items);
inc(i);
end;

if imagefilelist.Count =1 then
begin
toolbutton2.Enabled:=false;
toolbutton3.Enabled:=false;
end
else
begin
toolbutton2.Enabled:=false;
toolbutton3.Enabled:=true;
end;
end;

procedure TForm5.ToolButton3Click(Sender: TObject);
begin
toolbutton2.Enabled:=true;

inc(imageposition);
caption:='Picture show - '+imagefilelist.strings[imageposition];

showimage(imagefilelist.strings[imageposition]);

if imageposition=imagefilelist.count-1 then toolbutton3.Enabled:=false;
end;

procedure TForm5.ToolButton2Click(Sender: TObject);
begin
toolbutton3.Enabled:=true;
dec(imageposition);
caption:='Picture show - '+imagefilelist.strings[imageposition];

showimage(imagefilelist.strings[imageposition]);

if imageposition=0 then toolbutton2.Enabled:=false;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
screen.Cursors[HANDOPENCURSOR]:=loadcursor(hinstance,'HANDOPEN');
screen.Cursors[HANDCLOSECURSOR]:=loadcursor(hinstance,'HANDCLOSE');
imagefilelist:=tstringlist.Create;
end;

procedure TForm5.FormDestroy(Sender: TObject);
begin
imagefilelist.Free;
end;

procedure TForm5.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=27 then close;
if ( (key=ord(vk_back)) or (key=ord(vk_return)) ) and (toolbutton2.Enabled =true) then toolbutton2click(nil);
if (key=ord(vk_space)) and (toolbutton3.Enabled =true) then toolbutton3click(nil);
end;

procedure TForm5.FormResize(Sender: TObject);
begin
showimage(imagefilelist.strings[imageposition]);
end;

procedure TForm5.ToolButton6Click(Sender: TObject);//normal
begin
if statusbar1.Panels[3].Text='Ok' then
begin
if statusbar1.Panels[0].Text<>'100%' then
begin
with image1 do
begin
visible:=false;
width:=w;
height:=h;
top:=(panel1.Height - h)div 2;
left:=(panel1.width - w)div 2;
visible:=true;

wmove:=width > panel1.Width;
hmove:=height > panel1.height;
if wmove or hmove then Cursor :=HANDOPENCURSOR
else Cursor :=crdefault;
end;
statusbar1.Panels[0].Text:='100%';
ratio:=1;

toolbuttonstatus;
end;
end;
end;

procedure TForm5.ToolButton5Click(Sender: TObject);//zoom in
begin
if statusbar1.Panels[3].Text='Ok' then
begin

if ratio<=1 then ratio:=ratio /2
else ratio:=ratio-1;

if ratio>=1/20 then
begin
with image1 do
begin
visible:=false;
width:=trunc(w*ratio);
height:=trunc(h*ratio);
left:=(panel1.width-width) div 2;
top:=(panel1.height-height) div 2;
visible:=true;
okshowimage(imagefilelist.strings[imageposition]);

wmove:=width > panel1.Width;
hmove:=height > panel1.height;
if wmove or hmove then Cursor :=HANDOPENCURSOR
else Cursor :=crdefault;

end;
end
else
begin
ratio:=ratio*2;
end;

toolbuttonstatus;
end;
end;

procedure tform5.toolbuttonstatus;
begin
toolbutton5.Enabled :=ratio>=1/10;
toolbutton6.enabled:=true;
toolbutton7.Enabled :=trunc(ratio)<4;
end;

procedure TForm5.ToolButton7Click(Sender: TObject);//zoom out
begin
if statusbar1.Panels[3].Text='Ok' then
begin
if ratio<1 then ratio:=ratio * 2
else ratio:=ratio+1/3;

if trunc(ratio)<5 then
begin
with image1 do
begin
visible:=false;
width:=trunc(w*ratio);
height:=trunc(h*ratio);
left:=(panel1.width-width) div 2;
top:=(panel1.height-height) div 2;
visible:=true;
okshowimage(imagefilelist.strings[imageposition]);

wmove:=width > panel1.Width;
hmove:=height > panel1.height;
if wmove or hmove then Cursor :=HANDOPENCURSOR
else Cursor :=crdefault;

end;
end
else
begin
ratio:=ratio-1;
end;

toolbuttonstatus;
end;
end;

procedure TForm5.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (wmove or hmove) and ( shift = [ssleft] ) then
begin
if wmove then
begin
with image1 do
begin
if (left<0) and ( (x-mmstartx)>0 ) then
begin
if x-mmstartx>-left then left:=0
else left:=left+(x-mmstartx);
end;


if (panel1.Width-left<width) and ( (x-mmstartx)<0 ) then
begin
if -(x-mmstartx)>width-panel1.width+left then left:=-(width-panel1.width)
else left:=left+(x-mmstartx);
end;
end;
end;
if hmove then
begin
with image1 do
begin
if (top<0) and ( (y-mmstarty)>0 ) then
begin
if y-mmstarty>-top then top:=0
else top:=top+(y-mmstarty);
end;


if (panel1.height-top<height) and ( (y-mmstarty)<0 ) then
begin
if -(y-mmstarty)>height-panel1.height+top then top:=-(height-panel1.height)
else top:=top+(y-mmstarty);
end;
end;
end;
end;
end;

procedure TForm5.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (wmove or hmove) and (button=mbleft) then
begin
// mouse_event(mouseeventf_leftup,x,y,0,0);

image1.Cursor :=HANDCLOSECURSOR;//why not work???

// mouse_event(mouseeventf_leftdown,x,y,0,0);

mmstartx:=x;
mmstarty:=y;
end;
end;

procedure TForm5.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (wmove or hmove) then image1.Cursor :=HANDOPENCURSOR;
end;

procedure TForm5.ToolButton9Click(Sender: TObject);
begin
form6.showmodal;
end;
end.
/////////////////////////////////////////////////////////////////////
 

Similar threads

后退
顶部