如何实现放大镜的功能 (50分)

比如要想看清一副图像的细节，只想放大看一看，并不影响原图
还有点问题,就是如果图象很大超过了窗体的大小,该如何是好

留下MAIL，给你发一个。

wjlicat@sina.com

卷起千堆雪tyn:
给我也发一个: freelzn@263.net

楼上几位去接收.

能给我一个么？

vine3@21cn.com

给我一个wdllove@sina.com

ljxielun@263.net
多谢

接受答案了.

da

??????????

●海南大学 叶斗彪
摘 要：为图象观察器增加一个“放大镜”，对图象进行局部放大，是产品推销商和动物解剖学师生们梦寐以求的。本文介绍实现图象局部、平滑和无闪烁放大的算法原理及实现技术。

关键词：放大镜 画布 Delphi CopyRect
实用价值
目前，有许多流行的图象观察软件和图象处理软件，为人们在电脑屏幕上浏览和加工美丽的图象提供了方便。然而遗憾的是，这些软件在图象放大方面却不尽如人意。它们往往只能对整幅图象进行放大，而不能随意地放大图象的局部，就连微软公司随Windows提供的画图软件也不例外。

对图象局部进行放大，具有极高的实用价值。产品推销商可以将此项技术应用于新产品的展示和推广之中，让用户能够对其产品的不同部位，如汽车的表面镀铬工艺和新型的挡风玻璃等进行放大观看。通过电脑网络上动物解剖课的学生，亦可用其放大小白鼠或是青蛙的不同部位，以便更清晰地观察血管和各种器官。就象在日常生活中，人们手持放大镜，在地图或照片上移动的情景！

本文介绍实现图象局部、平滑和无闪烁放大的算法原理，以及在Delphi中实现的技术。读完本文，您一定会为Delphi能用如此少的代码实现如此强大的功能惊叹不已，这是许多其它开发工具所无法比拟的。

算法原理
在Delphi中，可利用类Tcanvas的CopyRect方法实现图象的放大和缩小。其功能是将源画布上的一个指定矩形区域（简称源矩形）内的象素，拷贝到目的画布上的一个指定矩形区域（简称目的矩形）中。亦可称之为象素块复制，如图1所示。

由CopyMode属性确定拷贝的模式。在直接拷贝模式（cmSrcCopy）下，当源矩形与目的矩形相等时，图象不变；若源矩形大于目的矩形，图象则缩小；而当源矩形小于目的矩形时，图象便被放大（在目的矩形中扩展）。源矩形与目的矩形大小之比，决定图象的缩放倍数。CopyRect方法声明如下：

Procedure CopyRect(const Dest: TRect; Canvas: TCanvas; const Source: Trect);

其中参数，Dest为目的矩形，Canvas是源画布，Source为源矩形。

实现步骤


新建应用程序主目录C:/Magnifier及其子目录Images，将事先制作好的位图图象Picture.bmp存入Images目录。本例中，Picture.bmp的大小为260*310象素。
启动Delphi IDE，新建项目Magnifier.dpr，主窗体单元命名为Main.pas，存入C:/Magnifier目录。在主窗体上放置一个TPanel组件，并在其中加入两个TImage组件。两个TImage组件分别命名为ForeImage和BackImage，前者重叠于后者之上，并且都装入Picture.bmp位图。
主窗体和各组件的主要属性按表1设置：

表1 主窗体和各组件属性设置

组 件
属 性
设 置

Form1
BorderIcons.biMaximize
False

BorderStyle
bsNone

Color
clRed

Height
364

KeyPreview
True

Name
MainForm

Position
poScreenCenter

Width
294

WindowState
wsNormal

Panel1
Align
alNone

BevelInner
bvLowered

BevelOuter
bvRaised

BevelWidth
2

BorderStyle
bsNone

BorderWidth
2

Height
322

Name
FramePanel

Visible
Ture

Width
272

Image1
Align
alNone

AutoSize
True

Center
True

Height
310

Name
BackImage

Picture
Picture.bmp

Stretch
False

Visible
False

Width
260

Image2
Align
alNone

AutoSize
True

Center
True

Height
310

Name
ForeImage

Picture
Picture.bmp

Stretch
False

Visible
True

Width
260


上述各组件的许多属性，读者亦可根据个人的爱好设定。

在主单元Main.pas的implementation段声明常量和变量：
const

sSide=30;

dSide=45;

var

msHide: Boolean;

OldX, OldY, NewX, NewY: Integer;

DestRect, SourceRect : TRect;

其中，常量sSide和dSide用以控制“放大镜”的大小和放大倍数；变量msHide控制光标（鼠标）的隐藏和打开；其它变量用以确定放大部位。

建立主窗体MainForm的OnCreate事件，加入下列语句，以初始化变量及设置复制模式：
msHide:=True;

Canvas.CopyMode:=cmSrcCopy;

创建主窗体MainForm的OnKeyPress事件处理程序，在其begin与end之间输入语句“Close;”，当按任意键时结束程序运行。
定义过程ImageCopy，用于处理图象的放大和恢复，当移动鼠标时调用。这是实现图象局部放大最重要的过程，源代码如下。
procedure TMainForm.ImageCopy(BoxCenterX, BoxCenterY, BoxSide: Integer);

begin

with SourceRect do

begin

Left:=BoxCenterX-BoxSide;

Top:=BoxCenterY-BoxSide;

Right:=BoxCenterX+BoxSide;

Bottom:=BoxCenterY+BoxSide;

end;

with DestRect do

begin

Left:=BoxCenterX-dSide;

Top:=BoxCenterY-dSide;

Right:=BoxCenterX+dSide;

Bottom:=BoxCenterY+dSide;

end;

ForeImage.Canvas.CopyRect(DestRect, BackImage.Canvas, SourceRect);

end;

注意，别忘了在Main.pas的“type”中声明过程ImageCopy。

创建ForeImage的OnMouseMove事件处理程序，当鼠标在图象上移动时，获取其位置，并作为过程调用的实参。此时，光标隐藏，“放大镜”出现。随着“放大镜”的移动，图象新的部位被放大，滑过的部位又恢复原状。以下为begin与end之间的代码：
NewX:=X;

NewY:=Y;

if msHide then

begin

OldX:=NewX;

OldY:=NewY;

msHide:=False;

ShowCursor(False);

end else

begin

ImageCopy(OldX, OldY, dSide);

end;

ImageCopy(NewX, NewY, sSide);

OldX:=NewX;

OldY:=NewY;

建立主窗体MainForm的OnMouseMove事件处理程序，当鼠标移开图象时，“放大镜”隐藏，光标重新出现。源代码片段如下：
if not msHide then

begin

msHide:=True;

ShowCursor(True);

ImageCopy(OldX, OldY, dSide);

end;



编译运行
至此，已不再需要做更多的事情，立即编译运行吧。啊，美丽的照片出现在屏幕中央！试试放大效果。将鼠标徐徐移入相框，奇迹出现了，鼠标变成了“放大镜”，所到之处，图象的相应部位被放大，十分平滑，毫无闪烁。这不是同您手持放大镜，观看地图和照片的情景一样吗。好酷啊！还有什么能比这更激动人心的呢？！

技术剖析
以上介绍了利用了画布的CopyRect方法，将图象以象素块从后台隐藏的TImage组件画布上向前台TImage组件的画布上拷贝，以实现图象的放大与恢复的技术。由于这一技术的采用，在图象放大前不需要存储象素，此后直接从后台TImage组件画布上恢复图象。不仅节省了内存资源，也确保了对图象的局部进行平滑、无闪烁地放大。同时，程序源代码也简洁、明了。

“放大镜”的中心便是鼠标的位置，这样处理的好处是使得图象在“放大镜”中均匀展开，并确保图象边缘也能同样放大。

要改变“放大镜”的大小和图象的放大倍数，只需修改常量sSide和dSide的值。实际应用中，亦可灵活处置，如将它们设置成变量，由程序菜单控制。本例“放大镜”的大小为90*90个象素，放大倍数为1.5。值得一提的是，这里的“放大镜”比真正的玻璃放大镜的效果要好得多。玻璃放大镜是用凸透镜制成的，中间与边缘的放大倍数不一致，导致图象发生形变。而且，当一边移动一边观察时，很容易使人眼花缭乱。本文为您展示的“放大镜”则没有这些现象。

利用TCanvas的StretchDraw方法或其它方法，也可以实现图象的局部放大。另外，虽然本文介绍的算法已经相当令人满意，但还是可以作进一步修改的。例如在“放大镜”移动时，只放大和恢复必要的部分。有兴趣的读者不妨一试。

程序编译、运行环境为Delphi 3.0和中文Windows 98。

　

参考文献



《Delphi 3.0 编程参考手册》 [美] P. Thurrott, G. Brent, R. Bagdazian, S. Tendon 著 卢庆龄 蒋全 等译 清华大学出版社 1998年8月第1版








__________________________________________

//工程文件
program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
//窗体文件
object Form1: TForm1
Left = 3
Top = -1
Width = 792
Height = 584
Caption = '图象的局部放大'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnKeyPress = FormKeyPress
OnMouseMove = FormMouseMove
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 784
Height = 538
Align = alClient
TabOrder = 0
object Foreimage: TImage
Left = 128
Top = 0
Width = 329
Height = 449
Stretch = True
OnMouseMove = ForeimageMouseMove
end
object GroupBox1: TGroupBox
Left = 0
Top = 72
Width = 121
Height = 265
Caption = '放大参数设置'
TabOrder = 0
object Label1: TLabel
Left = 19
Top = 24
Width = 66
Height = 13
Caption = '原图局部大小'
end
object Label2: TLabel
Left = 19
Top = 104
Width = 66
Height = 13
Caption = '放大后的大小'
end
object s: TEdit
Left = 16
Top = 60
Width = 89
Height = 21
TabOrder = 0
Text = 's'
end
object d: TEdit
Left = 16
Top = 132
Width = 89
Height = 21
TabOrder = 1
Text = 'd'
end
object Button1: TButton
Left = 16
Top = 208
Width = 75
Height = 25
Caption = '设定'
TabOrder = 2
OnClick = Button1Click
end
end
object Button2: TButton
Left = 8
Top = 16
Width = 75
Height = 33
Caption = '装入图形'
TabOrder = 1
OnClick = Button2Click
end
end
object MainMenu1: TMainMenu
Left = 304
Top = 208
object N1: TMenuItem
Caption = '退出'
OnClick = N1Click
end
end
object OpenDialog1: TOpenDialog
Filter = '*.bmp'
InitialDir = 'c:/'
Left = 88
end
end
//单元文件
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Menus;
type
TForm1 = class(TForm)
Panel1: TPanel;
Foreimage: TImage;
GroupBox1: TGroupBox;
s: TEdit;
d: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
MainMenu1: TMainMenu;
N1: TMenuItem;
Button2: TButton;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageCopy(BoxCenterX, BoxCenterY, BoxSide: Integer);
procedure ForeimageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

var
sSide:Integer=60;dSide:Integer=100; //原图大小和放大后的大小
bmp:TBitmap;
var
msHide: Boolean;
OldX, OldY, NewX, NewY: Integer;
DestRect, SourceRect : TRect;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
s.text:=inttostr(sSide);
d.text:=inttostr(dSide);
bmp:=Tbitmap.Create;
//bmp.LoadFromFile('');
//ForeImage.Picture.LoadFromFile('');
Canvas.CopyMode:=cmSrcCopy;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not msHide then
begin
msHide:=True;
ShowCursor(True);
ImageCopy(OldX, OldY, dSide);
end;
end;
procedure TForm1.ImageCopy(BoxCenterX, BoxCenterY, BoxSide: Integer);
begin
//bmptemp:=TBitmap.Create;
with SourceRect do
begin
Left:=BoxCenterX-BoxSide;
Top:=BoxCenterY-BoxSide;
Right:=BoxCenterX+BoxSide;
Bottom:=BoxCenterY+BoxSide;
end;
//bmptemp.Canvas.CopyRect(re,bmp.canvas,SourceRect);
with DestRect do
begin
Left:=BoxCenterX-dSide;
Top:=BoxCenterY-dSide;
Right:=BoxCenterX+dSide;
Bottom:=BoxCenterY+dSide;
end;
ForeImage.Canvas.CopyRect(DestRect, bmp.Canvas, SourceRect);
//ForeImage.Canvas.StretchDraw(DestRect,bmp);
end;
procedure TForm1.ForeimageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
NewX:=X;
NewY:=Y;
if msHide then
begin
OldX:=NewX;
OldY:=NewY;
msHide:=False;
ShowCursor(False);
end else
begin
ImageCopy(OldX, OldY, dSide);
end;
ImageCopy(NewX, NewY, sSide);
OldX:=NewX;
OldY:=NewY;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
sSide:=strtoint(s.text);
dSide:=strtoint(d.text);
end;
procedure TForm1.N1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
w,h,w1,h1:Integer;
rec:Trect;
begin
if OpenDialog1.Execute then
begin
bmp.LoadFromFile(Opendialog1.FileName);
foreimage.AutoSize:=true;
foreimage.Picture.LoadFromFile(Opendialog1.FileName);
foreimage.AutoSize:=false;
end;
end;

end.