个你一个单元:
/////////////////////////////////////////////////////////////////////
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.
/////////////////////////////////////////////////////////////////////