我提供一个方法（我编过），是用image 框的缩放实现的，控制简单
我说说基本原理：
1. image有个strech属性，将它设为true
2. 计算出将要加载图片的大小，
调整image的尺寸，让它的长宽的比例 = 图片的长宽比例，把这个<b>比例尺</b>
保存到一个全局变量中
3. pannel与form 的缩放也要用到这个比例尺
我这儿有原代码，功能多了点（有图象的缩放，
画图(添/删)，和 编辑过图象的存储/打开）：
（程序基本写完，
有<b>bug</b>请<b><i>MAIL</i></b>我----catyy1101@yeah.net）
--------窗体文件---------------------------------
object Form1: TForm1
Left = 252
Top = 157
Width = 449
Height = 276
Caption = 'Form1'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -18
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 120
TextHeight = 18
object Panel1: TPanel
Left = 0
Top = 0
Width = 441
Height = 41
Align = alTop
TabOrder = 0
object sp_s: TSpeedButton
Left = 152
Top = 8
Width = 23
Height = 22
Hint = '缩小图象'
Caption = '缩'
ParentShowHint = False
ShowHint = True
OnClick = sp_sClick
end
object sp_us: TSpeedButton
Left = 176
Top = 8
Width = 23
Height = 22
Hint = '放大图象'
Caption = '放'
ParentShowHint = False
ShowHint = True
OnClick = sp_usClick
end
object sp_add: TSpeedButton
Left = 288
Top = 8
Width = 23
Height = 22
Hint = '做一次“编辑”'
Caption = '添'
ParentShowHint = False
ShowHint = True
OnClick = sp_addClick
end
object sp_del: TSpeedButton
Left = 312
Top = 8
Width = 23
Height = 22
Hint = '删除一个“编辑”'
Caption = '删'
ParentShowHint = False
ShowHint = True
OnClick = sp_delClick
end
object sp_save: TSpeedButton
Left = 16
Top = 8
Width = 23
Height = 22
Hint = '存储编辑过的图象'
Caption = '包'
ParentShowHint = False
ShowHint = True
OnClick = sp_saveClick
end
object sp_open: TSpeedButton
Left = 40
Top = 8
Width = 23
Height = 22
Hint = '打开已编辑的图象'
Caption = '解'
ParentShowHint = False
ShowHint = True
OnClick = sp_openClick
end
object sp_read: TSpeedButton
Left = 112
Top = 8
Width = 23
Height = 22
Caption = '读'
ParentShowHint = False
ShowHint = True
OnClick = sp_readClick
end
object sp_search: TSpeedButton
Left = 352
Top = 8
Width = 23
Height = 22
Hint = '?'
Caption = '查'
ParentShowHint = False
ShowHint = True
end
object sp_fit: TSpeedButton
Left = 216
Top = 8
Width = 23
Height = 22
Hint = '缩放图象到合适的大小'
Caption = '适'
ParentShowHint = False
ShowHint = True
OnClick = sp_fitClick
end
end
object Panel2: TPanel
Left = 0
Top = 41
Width = 441
Height = 189
Align = alClient
BevelInner = bvLowered
Color = clWindowFrame
TabOrder = 1
object Image1: TImage
Left = 34
Top = 2
Width = 327
Height = 177
Stretch = True
OnMouseDown = Image1MouseDown
end
object Memo1: TMemo
Left = 248
Top = 72
Width = 185
Height = 89
TabOrder = 0
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 230
Width = 441
Height = 19
Panels = <>
SimplePanel = False
end
object SaveDialog1: TSaveDialog
DefaultExt = 'cty'
Filter = '可编辑Bitmap/JPEG图象(*.cty)|*.cty'
Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing]
Left = 376
Top = 48
end
object OpenDialog1: TOpenDialog
Left = 408
Top = 48
end
end
---------------------------------------------------------------
---------单元文件----------------------------------------------
unit Unit_image_II;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Buttons, StdCtrls, ExtDlgs, ComCtrls, Grids;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
sp_s: TSpeedButton;
sp_us: TSpeedButton;
sp_add: TSpeedButton;
sp_del: TSpeedButton;
sp_save: TSpeedButton;
sp_open: TSpeedButton;
sp_read: TSpeedButton;
StatusBar1: TStatusBar;
sp_search: TSpeedButton;
Memo1: TMemo;
sp_fit: TSpeedButton;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
procedure sp_sClick(Sender: TObject);
procedure sp_usClick(Sender: TObject);
procedure sp_readClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sp_addClick(Sender: TObject);
procedure sp_saveClick(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure sp_fitClick(Sender: TObject);
procedure sp_delClick(Sender: TObject);
procedure sp_openClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
cat_add:string;
rule_1:integer; //用做分子
rule_2:integer; //用做分母
open_filename:string;
save_edit:boolean;
save_edit_II:boolean;
add_Number:integer;
x1,y1:integer;
{ Private declarations }
public
function int_from_div(aNum:real):integer;
procedure load_picture_size;
procedure where_show_picture;
procedure show_picture_fit_size;
procedure show_picture_window_size;
procedure show_picture_window_size_II;
procedure where_the_Form;
procedure mouse_fit_button;
procedure suoxiao;
procedure fangda;
procedure Draw_Picture_ASaveACount(xx,yy:integer);
procedure mouse_catch(xx,yy:integer);
procedure load_FromFile_AndDraw;//(ss:string);
procedure save_DB;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//~~ 将商取整，返回值为integer 型
function TForm1.int_from_div(aNum:real):integer;
var aa1:string;
begin
aa1 :=floattostr(int(aNum)); //div 是整数除，
result :=strtoint(aa1); //mod 是整数余
end;
//~~ 将加载图片的尺寸赋给 image1
procedure TForm1.load_picture_size;
begin
image1.Height :=image1.Picture.Height;
image1.Width :=image1.Picture.Width;
end;
//~~ 显示图片的位置（左上点坐标）
//.. 要调用int_from_div()
procedure TForm1.where_show_picture;
begin
if image1.width<Panel2.Width then
image1.Left :=int_from_div((panel2.Width-image1.Width)div 2) //~~
else
image1.Left :=4;
//
if image1.Height<panel2.Height then
image1.Top :=int_from_div(int((panel2.Height-image1.Height)div 2)) //~~
else
image1.Top :=4;
end;
//~~ 以合适的尺寸显示整个图片
procedure TForm1.show_picture_fit_size;
var
aa01,aa02:integer;
pp01,pp02:integer;
begin
aa01 := image1.Picture.Height;
aa02 := image1.Picture.Width;
// showmessage('h:'+inttostr(aa01)+' w:'+inttostr(aa02));
pp01 := screen.Height - 100; //去除窗口边框的高度
pp02 := screen.Width - 16; //去除窗口边框的宽度
if aa01 * pp02 / aa02 / pp01 - 1 > 0 then
if aa01 > pp01 then //图片高度较大
begin
image1.Height := pp01;
image1.Width := int_from_div(aa02 * pp01 div aa01);
//
form1.Left := 0; /////////////
form1.Top := 0; /////////////
form1.Height := screen.Height;// image1.Height + 100; /////////////
form1.Width := screen.Width;//image1.Width + 16; /////////////
//
rule_1 := pp01;
rule_2 := aa01;
end else begin
load_picture_size;
end;
if aa01 * pp02 / aa02 / pp01 - 1 < 0 then
if aa02 >pp02 then
begin
image1.Width := pp02;
image1.Height := int_from_div(aa01 * pp02 div aa02);
form1.Left := 0; /////////////
form1.Top := 0; /////////////
form1.Height := image1.Height + 100; /////////////
form1.Width := image1.Width + 16; /////////////
//
rule_1 := pp02;
rule_2 := aa02;
end else begin
load_picture_size;
end;
if aa01 / aa02 = pp01 / pp02 then
begin
if aa01 > pp01 then
begin
image1.Height := pp01;
image1.Width := pp02;
form1.Left := 0; /////////////
form1.Top := 0; /////////////
form1.Height := screen.Height;//image1.Height + 100; ////////////
form1.Width := screen.Width;//image1.Width + 16; ////////////
//
rule_1 := pp01;
rule_2 := aa01;
end else begin
load_picture_size; // ~~
form1.Height := image1.Height + 100; ////////////
form1.Width := image1.Width + 16; ////////////
//
rule_1 := 1;
rule_2 := 1;
end;
end;
end;
//~~ 窗口适应图片的大小 （窗口 < 图片时） 图片在窗口上的位置
procedure TForm1.show_picture_window_size;
begin
if not(image1.width+ 8< panel2.Width) then
Form1.Width :=image1.Width +16; //image 到 form 边框宽-象素
if not(image1.Height+ 8< panel2.Height) then
Form1.Height :=image1.Height +100; //image 到 form 边框高-象素
end;
//~~ 窗口适应图片的大小 （窗口 >> 图片时） 图片在窗口上的位置
procedure TForm1.show_picture_window_size_II;
begin
if (form1.width>449)and(form1.Height>276) then
begin
form1.Width :=image1.Width+16; //image 到 form 边框宽-象素
form1.Height :=image1.Height+100; //image 到 form 边框高-象素
end;
if (form1.width>449)and(not(form1.Height>276)) then
form1.Width :=image1.Width+16;
if (not(form1.width>449))and(form1.Height>276) then
form1.Height :=image1.Height+100;
end;
//~~ 窗口在屏幕上的位置
procedure TForm1.Where_the_Form; ///////////////////
begin
{ if screen.width>form1.Width then
form1.Left :=int_from_div((screen.Width-form1.Width) div 2)
else
form1.Left :=0;
if screen.Height>form1.Width then
form1.Top :=int_from_div((screen.Height-form1.Height) div 2)
else
form1.Top :=0;
}
end;
//~~
procedure TForm1.mouse_fit_button;
begin
//?
end;
//~~ 缩小显示的图象
procedure TForm1.suoxiao;
begin
image1.Width := int_from_div((image1.Width div 3)*2); //~~
image1.Height := int_from_div((image1.Height div 3)*2); //~~
//
rule_1 := rule_1 * 2; //比例尺-分子
rule_2 := rule_2 * 3; //比例尺-分母
end;
//~~ 放大显示图象
procedure TForm1.fangda;
begin
image1.width :=int_from_div((image1.Width div 2)*3);
image1.Height :=int_from_div((image1.Height div 2)*3); //~~
//
rule_1 := rule_1 * 3; //比例尺-分子
rule_2 := rule_2 * 2; //比例尺-分母
end;
//~~ 画图模块
procedure Tform1.Draw_Picture_ASaveACount(xx,yy:integer);
var ss:string;
begin
image1.Canvas.Pen.Mode := pmNot;
image1.Canvas.Brush.Style := bsCross;
xx := int_from_div(xx * rule_2 div rule_1);
yy := int_from_div(yy * rule_2 div rule_1);
// image1.canvas.Ellipse(xx-11,yy-11,xx+11+1,yy+11+1);
//
if not((xx=x1)and(yy=y1)) then
begin //这种判断机智不好
x1 := xx;
y1 := yy;
image1.canvas.Ellipse(xx-11,yy-11,xx+11+1,yy+11+1);
add_number := add_number+1;
ss := inttostr(xx)+'^'+inttostr(yy)+'^'+inttostr(add_number);
Memo1.Lines.Add(ss); //将数据存档
end else
if (xx=x1)and(yy=y1) then
Application.MessageBox('无法在当前位置再画图...','',mb_ok+mb_iconStop);
end;
//~~ 捕捉鼠标选中的图
procedure TForm1.mouse_catch(xx,yy:integer);
var
aa,bb:integer;
cc:integer; //用做随机指定圆半径----没什么用！
ss:string;
cat_x,cat_y:integer;
label
ppp;
begin
xx := xx * rule_2 div rule_1; // 比例尺，调整鼠标坐标
yy := yy * rule_2 div rule_1; // 比例尺，调整鼠标坐标
// xx := int_from_div(xx * rule_2 div rule_1); // 比例尺，调整鼠标坐标
// yy := int_from_div(yy * rule_2 div rule_1); // 比例尺，调整鼠标坐标
//
aa := 1;
while aa<Memo1.Lines.Count do //////////?
begin
{ ss := Memo1.Lines[aa];
bb := AnsiPos('^',ss);
cat_x := strtoint(copy(ss,1,bb-1)); //
ss := copy(ss,bb+1,Length(ss)-bb);
cat_y := strtoint(ss); //
} //
ss := Memo1.Lines[aa];
bb := AnsiPos('^',ss);
cat_x := strtoint(copy(ss,1,bb-1)); //
ss := copy(ss,bb+1,Length(ss)-bb);
bb := AnsiPos('^',ss);
cat_y := strtoint(copy(ss,1,bb-1)); //
//
cc := 11; //圆的半径
if ((cat_x-cc <= xx)and(xx <= cat_x+cc))
and((cat_y-cc <= yy)and(yy <= cat_y+cc)) then
begin
image1.Canvas.Pen.Mode := pmNot;
image1.canvas.Ellipse(cat_x-cc,cat_y-cc,cat_x+cc+1,cat_y+cc+1);
//
Memo1.Lines.Delete(aa); //删除memo1 中的该记录
goto ppp;
end;
//
aa := aa+1;
end;
ppp:
end;
//~~ 加载时依文件画图
procedure TForm1.load_FromFile_AndDraw;//(ss:string);
var
aa,bb:integer;
cat_x,cat_y:integer;
ss:string;
begin
image1.Visible := false; //初始化-加载图片到image1框
Image1.Picture.LoadFromFile(Memo1.Lines[0]);
load_picture_size; //~~ 将加载图片的尺寸赋给 image1
where_show_picture; //~~ 显示图片的位置（左上点坐标）
show_picture_window_size; //~~
// image1.Height := image1.Picture.Height;
// image1.Width := image1.Picture.Width;
image1.Visible := true;
//
show_picture_fit_size; //~~
where_show_picture; //~~
//
aa := 1;
while aa<Memo1.Lines.Count do
begin
ss := Memo1.Lines[aa];
bb := AnsiPos('^',ss);
cat_x := strtoint(copy(ss,1,bb-1)); //
ss := copy(ss,bb+1,Length(ss)-bb);
bb := AnsiPos('^',ss);
cat_y := strtoint(copy(ss,1,bb-1)); //
//
image1.Canvas.Pen.Mode := pmNot;
image1.Canvas.Brush.Style := bsCross;
image1.canvas.Ellipse(cat_x-11,cat_y-11,cat_x+11+1,cat_y+11+1);
//
aa := aa+1;
end;
end;
//~~ 将画图数据存入文件
//MEMO1 中的 数据格式为（以圆为例）：
// （圆心 x 值，圆心 y 值，半径 r 值）
procedure TForm1.save_DB;
begin
if Memo1.Lines.Text = '' then
Application.MessageBox('当前没有可编辑的图象，不能存储。'
,'存储错误',mb_ok+mb_IconStop)
else begin
// ? := inputBox('caption文本','label文本','EditPicture.cty');
// 保存在系统.EXE当前目录下
saveDialog1.Title := '保存';
if not(open_filename='') then
saveDialog1.FileName := open_filename;
if SaveDialog1.Execute then
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
//--------------
procedure TForm1.sp_sClick(Sender: TObject); //缩小
begin
if not((image1.width<18)or(image1.Height<18)) then
begin
Where_the_Form; //~~
//
image1.Visible :=false;
suoxiao; //~~
show_picture_window_size_II; //~~
where_show_picture; //~~
image1.Visible :=true;
end;
end;
procedure TForm1.sp_usClick(Sender: TObject); //放大
begin
Where_the_Form; //~~
//
image1.Visible :=true;
fangda; //~~
where_show_picture; //~~
show_picture_window_size; //~~
image1.Visible :=true;
end;
procedure TForm1.sp_readClick(Sender: TObject);
var aa:string;
label ppp;
begin
if (save_edit=false)and(save_edit_II=true) then
if Application.MessageBox('您编辑的图象没有保存,现在保存？'
,'',mb_YesNo+mb_DefButton1+mb_iconExclamation) = idNo then
begin
Memo1.Lines.Clear;
save_edit := false;
end else
goto ppp;
//
image1.Visible :=false; //初始化（复位）image1的属性
image1.Cursor :=crDefault; //
//
OpenDialog1.Filter :='BMP|*.bmp|JPG|*.jpg';//|All Files|*.*';
OpenDialog1.filename := '';
if (OpenDialog1.Execute=true) then
begin
aa := OpenDialog1.FileName;
//
Memo1.Lines.Add(aa);
//
image1.Picture.LoadFromFile(aa);
load_picture_size; //~~ 将加载图片的尺寸赋给 image1
where_show_picture; //~~ 显示图片的位置（左上点坐标）
show_picture_window_size; //~~
//
image1.Visible :=true;
end;
if (image1.Picture.width>Panel2.Width)
or(image1.Picture.Height>panel2.Height) then
image1.Cursor :=crHandPoint; // 从资源文件中调用 copy(aa1,1,length(aa1))
//
{ image2.Width := image1.Width;
image2.Height := image1.Height;
image2.Left := image1.Left;
image2.Top := image1.Top;
image2.Enabled := true; }
ppp:
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
cat_add := '';
rule_1 := 1;
rule_2 := 1;
open_filename := '';
save_edit := false; //检测是否保存了编辑的图象(保存=true)
save_edit_II := false; //检测是否没有打开编辑的图象（打开=true）
add_number := 0; //计数器-添加了几个图
x1 := 0;
y1 := 0;
//
Memo1.Visible := false;
Memo1.ScrollBars := ssHorizontal;
//
// image1.Canvas.Brush.Style := bsCross; //初始化填充模式
// 点击文件打开EXE 的处理
// ？？
end;
procedure TForm1.sp_addClick(Sender: TObject);
begin
if (image1.Width <= 18)or(image1.Height <= 18) then
Application.MessageBox('图片的长度或宽度不够，不能完成添加。'
,'添加信息',mb_ok+mb_iconInformation)
else
cat_add := 'true';
end;
procedure TForm1.sp_saveClick(Sender: TObject);
begin
save_DB; //~~
save_edit := true;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if cat_add='true' then
begin
draw_picture_ASaveACount(x,y); //~~ 调用画图模块
// if cat_add='true' then
// add_number := add_number+1;
end;
if cat_add='false' then
mouse_catch(x,y); //~~ 捕捉鼠标选中哪个图
end;
procedure TForm1.sp_fitClick(Sender: TObject);
begin
show_picture_fit_size; //~~
where_show_picture; //~~
end;
procedure TForm1.sp_delClick(Sender: TObject);
begin
cat_add := 'false';
end;
procedure TForm1.sp_openClick(Sender: TObject);
begin
OpenDialog1.DefaultExt := 'cty';
OpenDialog1.Filter := '可编辑Bitmap/JPEG图象(*.cty)|*.cty';
OpenDialog1.Title := '';
if OpenDialog1.Execute then
begin
open_filename := OpenDialog1.FileName;
Memo1.Lines.LoadFromFile(Open_FileName);
end;
//
load_FromFile_AndDraw; //~~
save_edit := false;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if memo1.Lines.Count=1 then
if Application.MessageBox('您撤消了对这副图的所有编辑删除它吗？'
,'',mb_yesNo+mb_defButton1+mb_iconInformation)=idyes then
begin
deletefile(open_filename);
end else
if saveDialog1.Execute then
Memo1.Lines.SaveToFile(savedialog1.FileName);
end;
end.
--------------------------------------------------------------
-------使用说明-----------------------------------------------
“读”--- 打开一个图片
“包”--- 将编辑过的图片保存成文件（扩展名--.cty）
“解”--- 打开一个编辑过的.cty 文件
“添”--- 在图片上画一个圈
“删”--- 删除图片上的一个圈
“缩”--- 缩小图片为原来的 66.7%
“放”--- 放大图片为原来的 1.5 倍
“适”--- 让图片以适应的大小显示
----------------------------------------------------------------
* * 我的显示分辨率是1024*768 其他分辨率还没测试过。
用delphi 5 编的，在win 98 下测试通过。
<font size=5> 才50分 ！</font>
