用Delphi实现图像放大镜

在一些常用的看图软件中都带有一个可以放大局部图像的功能本实例就是为模仿这一功能开发的

向窗体上添加两个TImage组件其中一个TImage组件的Name属性设置为Image它充当原图片显示的载体另一个TImage组件的Name属性设置为Image它可以显示放大后的图像添加组件后的窗体如图所示

[[The No Picture]]

图 添加组件后的窗体

本例的核心是StretchBlt函数利用StretchBlt函数实现局部图像放大响应代码如下

procedure TFormImageMouseMove(Sender: TObject; Shift: TShiftState; X Y: Integer);

begin

StretchBlt(ImageCanvasHandleImageWidthImageHeight

ImageCanvasHandle XYSRCCOPY);

ImageRefresh;

ScreenCursors[]:=LoadCursorFromFile(MAGNIFYCUR);

SelfCursor:=;

end;

程序首先会调用StretchBlt函数以鼠标当前位置作为中心点以边长为选中Image组件上的局部图像并放大此局部图像到Image组件上然后通过调用Image组件的Refresh方法以刷新Image组件的显示最后设置鼠标指针为新的形状

程序代码如下

unit Unit;

interface

uses

Windows Messages SysUtils Variants Classes Graphics Controls Forms

Dialogs ExtCtrls StdCtrls;

type

TForm = class(TForm)

Image: TImage;

Image: TImage;

procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; XY: Integer);

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; XY: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form: TForm;

implementation

{$R *dfm}

procedure TFormImageMouseMove(Sender:TObject;Shift:TShiftState;XY: Integer);

begin

StretchBlt(ImageCanvasHandleImageWidthImageHeightImageCanvasHandle XYSRCCOPY);

ImageRefresh;

ScreenCursors[]:=LoadCursorFromFile(MAGNIFYCUR);

SelfCursor:=;

end;

procedure TFormFormMouseMove(Sender: TObject; Shift: TShiftState; XY: Integer);

begin

ScreenCursors[]:=crDefault;

SelfCursor:=;

end;

end

保存文件然后按F键运行程序程序运行结果如图所示

[[The No Picture]]

图 程序运行结果