关于位图文件漫游、放大、缩小代码 ( 积分: 200 )

哪位大侠有image1控件装入位图后，进行全图漫游、以某定点为中心放大、缩小的源代码呀，谢谢，即完成功能如下：
1：可以进行全图漫游
2：以某定点为中心进行放大
3：以某定点为中心进行缩小
这里需要提的是一定要以某定点为中心进行放大缩小，高分求源码，急用，谢谢

哪位大侠有image1控件装入位图后，进行全图漫游、以某定点为中心放大、缩小的源代码呀，谢谢，即完成功能如下：
1：可以进行全图漫游
2：以某定点为中心进行放大
3：以某定点为中心进行缩小
这里需要提的是一定要以某定点为中心进行放大缩小，高分求源码，急用，谢谢

实现图象局部放大的原理和方法
实用价值
目前，有许多流行的图象观察软件和图象处理软件，为人们在电脑屏幕上浏览和加工美丽的图象提供了方便。
然而遗憾的是，这些软件在图象放大方面却不尽如人意。它们往往只能对整幅图象进行放大，而不能随意地
放大图象的局部，就连微软公司随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。




＊ 本栏目所有内容，版权均归原作者所有。
＊ 如果您发现链接错误或其它问题，请写信通知栏目负责人“chq”。

查查以前的帖子，有很多

我需要以某个固定点为中心进行放大，缩小整个图像，可以移动图像等，有做过的请告诉一个源代码好吗

有哪位做过的吗，能不能把源代码传给我呀，急用呀，谢谢

http://www.2ccc.com/article.asp?articleid=2036
看这个，《DELPHI数字图像处理》附盘

其第3章内有你所需要的图像放大缩小源代码

谢谢，我现在可以放大，但是主要问题在以某点为中心放大，而且加上漫游后会出现问题，哪位大侠对地图漫游和放大熟悉的，请留下QQ好吗，我的QQ：30023210,我把现在我做的代码发给你们，然后帮我看看如何改正。谢谢

希望能认识这方面的高手，如果想以源代码来要钱的朋友，请不要联系我，谢谢，只是交流

我大概写了下，比较占用资源，比较乱，不过基本功能是实现了
unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, ImgList, ExtCtrls, StdCtrls, ExtDlgs;

type
TfrmMain = class(TForm)
ToolBar1: TToolBar;
btnZoomOut: TToolButton;
btnRecover: TToolButton;
ToolButton3: TToolButton;
btnMove: TToolButton;
ImageList1: TImageList;
btnZoomIn: TToolButton;
StatusBar: TStatusBar;
imgMap: TImage;
btnOpenPic: TToolButton;
ToolButton2: TToolButton;
OpenPictureDialog: TOpenPictureDialog;
procedure btnOpenPicClick(Sender: TObject);
procedure imgMapMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgMapMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormResize(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure imgMapMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure btnMoveClick(Sender: TObject);
procedure btnRecoverClick(Sender: TObject);
procedure btnZoomInClick(Sender: TObject);
procedure btnZoomOutClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
theCursor:Integer;//当前光标状态
{
originMap ->原图，为了以后不再因载入文件而带来的延迟，特加此缓冲
bmp ->当前内存缓冲，主要为了放大缩小用
}
originMap,bmp:TBitmap;
oldX,oldY:Integer;//保存需要搽除的坐标点
oldRect:TRect;//保存绝对放大后上一次所截取的区域
zoomStateouble;//保存当前放大缩小状态

isLeftDown:Integer;//判断左键是否按下，标示拖动开始
dragOldX,dragOldY:Integer;

mendZoomIn:Integer;//修正最后一次ZoomIn的地图偏差

//矢量图支持
maxWidth,maxHeight:Integer;
isWmf:Integer;
public
{ Public declarations }
procedure DrawPoint(const AX,AY:Integer;needNew:Boolean);
procedure ZoomOut(const AX,AY:Integer);
procedure ZoomIn(const AX,AY:Integer);
procedure MapMoveTo(var endX,endY:Integer);

procedure LogOldRect;
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
Screen.Cursors[1] :=LoadCursorFromFile('zout.cur');//放大
Screen.Cursors[2] :=LoadCursorFromFile('zin.cur');//缩小
Screen.Cursors[3] :=LoadCursorFromFile('hand.cur');//拖动
Screen.Cursors[4] :=LoadCursorFromFile('handDown.cur');//拖动，按下的手
theCursor :=0;

originMap :=TBitmap.Create;
bmp :=TBitmap.Create;
bmp.LoadFromFile('map.bmp');
originMap.Assign(bmp);
imgMap.Canvas.StretchDraw(imgMap.ClientRect,originMap);

Self.DoubleBuffered :=True;

oldRect :=Rect(0,0,bmp.Width,bmp.Height);//初始化
zoomState :=1;
mendZoomIn:=0;

isWmf :=0;
//由下面的测试得知默认的PenMode是4，即pmCopy
//ShowMessage(IntToStr(Byte(bmp.Canvas.Pen.Mode)));
end;

procedure TfrmMain.btnZoomOutClick(Sender: TObject);
begin
if not (mendZoomIn<0) then//修正状态，不允许继续点击
theCursor :=1
else begin
ShowMessage('修正，自动恢复');
btnRecover.Click;
end;
end;

procedure TfrmMain.btnZoomInClick(Sender: TObject);
begin
if not (mendZoomIn<0) then//修正状态，不允许继续点击
theCursor :=2
else begin
ShowMessage('修正，自动恢复');
btnRecover.Click;
end;
end;

procedure TfrmMain.btnRecoverClick(Sender: TObject);
begin
theCursor :=0;
bmp.Width :=imgMap.ClientWidth;
bmp.Height:=imgMap.ClientHeight;
oldRect :=Rect(0,0,bmp.Width,bmp.Height);
bmp.FreeImage;
bmp.Canvas.Pen.Mode :=pmCopy;
bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect,originMap);
imgMap.Canvas.FillRect(imgMap.ClientRect);
imgMap.Picture.Assign(bmp);
zoomState :=1;

mendZoomIn:=0;
end;

procedure TfrmMain.btnMoveClick(Sender: TObject);
begin
theCursor :=3;
end;

procedure TfrmMain.imgMapMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Screen.Cursor<>theCursor then Screen.Cursor :=theCursor;
StatusBar.Panels[0].Text :=Format('座标位置(%d,%d)',[X,Y]);
if (Screen.Cursor<3) then
DrawPoint(X,Y,True)
else if (isLeftDown>0)and(zoomState>=1) then//拖动
begin
MapMoveTo(x,y);
dragOldX :=x;
dragOldY :=y;
end;

end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bmp.Destroy;
bmp :=nil;
originMap.Destroy;
originMap :=nil;
end;
//指示当前鼠标所在点
//采用异或的方法来画图，画出一个区域(半径为3的红色圆)
procedure TfrmMain.DrawPoint(const AX,AY:Integer;needNew:Boolean);
var
circle:Integer;//区域标示，本变量根据不同光标确定不同大小的区域
begin
if isWmf=0 then//对矢量图不画点
begin
circle :=0;
case theCursor of
0: circle :=4;
1..4: circle :=10;
end;
if imgMap.Canvas.Pen.Mode<>pmXor then
imgMap.Canvas.Pen.Mode :=pmXor;
//搽除
imgMap.Canvas.Ellipse(oldX-circle,oldY-circle,oldX+circle,oldY+circle);
if needNew then
imgMap.Canvas.Ellipse(AX-circle,AY-circle,AX+circle,AY+circle);
oldX :=AX;
oldY :=AY;
end;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
if Assigned(bmp) then
begin
bmp.Width :=imgMap.ClientWidth;
bmp.Height:=imgMap.ClientHeight;
bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect,originMap);
imgMap.Picture.Assign(bmp);
end;
end;

procedure TfrmMain.ZoomOut(const AX,AY:Integer);
const zoutFactorouble =1.25;
var
allRect:TRect;
x,y :Integer;
oRect :TRect;//原始区域
begin
//计算绝对坐标
x :=Round((AX +oldRect.Left) *zoutFactor);
y :=Round((AY +oldRect.Top) *zoutFactor);
oldRect.Left :=x -AX;
oldRect.Right:=oldRect.Left +imgMap.Width;
oldRect.Top :=y -AY;
oldRect.Bottom:=oldRect.Top +imgMap.Height;

oRect :=Rect(0,0,bmp.Width,bmp.Height); //记录原大小

//固定放大倍数，一次1.25
bmp.Width :=Round(bmp.Width * zoutFactor);
bmp.Height:=Round(bmp.Height* zoutFactor);
allRect :=Rect(0,0,bmp.Width,bmp.Height);

if isWmf=0 then
begin
//绝对放大
bmp.Canvas.CopyRect(bmp.Canvas.ClipRect,bmp.Canvas,oRect);
end
else begin//矢量图的支持
oRect :=Rect(0,0,originMap.Width,originMap.Height);
bmp.Canvas.CopyRect(bmp.Canvas.ClipRect,originMap.Canvas,oRect);
end;
//复制，实现放大效果
imgMap.Canvas.CopyRect(imgMap.ClientRect,bmp.Canvas,oldRect);

if isWmf=1 then//或许能够释放一些资源
bmp.FreeImage;


//标记当前状态
zoomState :=zoomState *zoutFactor;
end;
procedure TfrmMain.ZoomIn(const AX,AY:Integer);
const zinFactorouble =0.8;
var
x,y :Integer;
eRect :TRect;//目标区域
begin
if (bmp.Width>=imgMap.Width)and(bmp.Height>imgMap.Height) then
begin
eRect :=Rect(0,0,Round(bmp.Width * zinFactor),Round(bmp.Height* zinFactor));
//绝对缩小
bmp.Canvas.CopyRect(eRect,bmp.Canvas,Rect(0,0,bmp.Width,bmp.Height));
//修正图片大小
bmp.Width :=eRect.Right -eRect.Left;
bmp.Height:=eRect.Bottom -eRect.Top;

//可视区域的计算
//固定缩小倍数，一次0.8
//计算绝对坐标
x :=Round((AX +oldRect.Left) *zinFactor);
y :=Round((AY +oldRect.Top) *zinFactor);

oldRect.Left :=x -AX;
oldRect.Top :=y -AY;
oldRect.Right:=oldRect.Left +imgMap.ClientWidth;
oldRect.Bottom:=oldRect.Top +imgMap.ClientHeight;

//对出错状态进行标记
if (oldRect.Left<0)or(oldRect.Top<0)
or(oldRect.Right>bmp.Canvas.ClipRect.Right)
or(bmp.Canvas.ClipRect.Bottom<oldRect.Bottom)
then
Dec(mendZoomIn);
{
//修正左侧边界
if oldRect.Left<0 then
begin
oldRect.Right:=imgMap.ClientWidth;
oldRect.Left :=0;
end
else begin//修正右侧边界
oldRect.Right:=oldRect.Left +imgMap.ClientWidth;
if bmp.Canvas.ClipRect.Right<oldRect.Right then
begin
oldRect.Right:=bmp.Canvas.ClipRect.Right;
oldRect.Left :=oldRect.Right -imgMap.ClientWidth;
end;
end;
//修正上侧边界
if oldRect.Top<0 then
begin
oldRect.Bottom:=imgMap.ClientHeight;
oldRect.Top :=0;
end
else begin//修正下侧边界
oldRect.Bottom:=oldRect.Top +imgMap.ClientHeight;
if bmp.Canvas.ClipRect.Bottom<oldRect.Bottom then
begin
oldRect.Bottom :=bmp.Canvas.ClipRect.Bottom;
oldRect.Top :=oldRect.Bottom -imgMap.ClientHeight;
end;
end;
}
//复制，实现缩小效果
imgMap.Canvas.FillRect(imgMap.Canvas.ClipRect);
imgMap.Canvas.CopyRect(imgMap.ClientRect,bmp.Canvas,oldRect);

//标记当前状态
zoomState :=zoomState *zinFactor;

LogOldRect;
end;
end;

procedure TfrmMain.imgMapMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
if theCursor=1 then
ZoomOut(x,y)
else if (theCursor=2)and(zoomState>1) then
ZoomIn(x,y);
isLeftDown :=0;
if Screen.Cursor=4 then Screen.Cursor :=3;
end;

procedure TfrmMain.imgMapMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
isLeftDown :=1;
dragOldX :=x;
dragOldY :=y;
if Screen.Cursor=3 then Screen.Cursor :=4;
end;

//根据dragOldX_Y和当前的endX,endY来实现拖动
procedure TfrmMain.MapMoveTo(var endX,endY:Integer);
procedure ModifyTheRect;
begin
//修正左侧边界
if oldRect.Left<0 then
begin
oldRect.Right:=imgMap.ClientWidth;
oldRect.Left :=0;
end
else begin//修正右侧边界
oldRect.Right:=oldRect.Left +imgMap.ClientWidth;
if bmp.Canvas.ClipRect.Right<oldRect.Right then
begin
oldRect.Right:=bmp.Canvas.ClipRect.Right;
oldRect.Left :=oldRect.Right -imgMap.ClientWidth;
end;
end;
//修正上侧边界
if oldRect.Top<0 then
begin
oldRect.Bottom:=imgMap.ClientHeight;
oldRect.Top :=0;
end
else begin//修正下侧边界
oldRect.Bottom:=oldRect.Top +imgMap.ClientHeight;
if bmp.Canvas.ClipRect.Bottom<oldRect.Bottom then
begin
oldRect.Bottom :=bmp.Canvas.ClipRect.Bottom;
oldRect.Top :=oldRect.Bottom -imgMap.ClientHeight;
end;
end;
end;
var
x,y :Integer;
begin
//计算绝对坐标
x :=dragOldX +oldRect.Left;
y :=dragOldY +oldRect.Top;

oldRect.Left :=x -endX;
oldRect.Top :=y -endY;
oldRect.Right:=oldRect.Left +imgMap.ClientWidth;
oldRect.Bottom:=oldRect.Top +imgMap.ClientHeight;
if not (mendZoomIn<0) then
ModifyTheRect;
{
else begin
ShowMessage('越界，自动恢复');
btnRecover.Click;
end;
}
imgMap.Canvas.FillRect(imgMap.ClientRect);
imgMap.Canvas.CopyRect(imgMap.ClientRect,bmp.Canvas,oldRect);

LogOldRect;
end;

procedure TfrmMain.LogOldRect;
begin
StatusBar.Panels[1].Text :=Format('OldRect(%d,%d,%d,%d)',[oldRect.Left,oldRect.Top,oldRect.Right,oldRect.Bottom]);
StatusBar.Panels[2].Text :=Format('BmpClipRect(%d,%d,%d,%d)',[bmp.Canvas.ClipRect.Left,bmp.Canvas.ClipRect.Top,bmp.Canvas.ClipRect.Right,bmp.Canvas.ClipRect.Bottom]);
end;

procedure TfrmMain.btnOpenPicClick(Sender: TObject);
var
wmfMap:TMetafile;
wmfMapCanvas:TMetafileCanvas;
begin
if OpenPictureDialog.Execute then
begin
if UpperCase(ExtractFileExt(OpenPictureDialog.FileName))=UpperCase('.wmf') then
begin
wmfMap :=TMetafile.Create;
wmfMap.LoadFromFile(OpenPictureDialog.FileName);
wmfMapCanvas :=TMetafileCanvas.Create(wmfMap,GetDC(originMap.Handle));

maxWidth :=1024 *4;
maxHeight:=768 *4;
originMap.Width :=maxWidth;
originMap.Height:=maxHeight;
originMap.Canvas.FillRect(originMap.Canvas.ClipRect);
originMap.Canvas.StretchDraw(originMap.Canvas.ClipRect,wmfMap);
btnRecover.Click;
wmfMapCanvas.Destroy;
wmfMap.Destroy;

isWmf :=1;
end;
end;
end;

end.

接受答案了.