用Delphi實現圖像放大鏡

2019-11-17 05:09:48

字體：大中小

來源：轉載

供稿：網友

　　在一些常用的看圖軟件中都帶有一個可以放大局部圖像的功能，本實例就是為模擬這一功能開發的。

　　向窗體上添加兩個TImage組件，其中一個TImage組件的Name屬性設置為Image1，它充當原圖片顯示的載體。另一個TImage組件的Name屬性設置為Image2，它可以顯示放大后的圖像。添加組件后的窗體如圖1所示。

圖1 添加組件后的窗體

　　本例的核心是StretchBlt函數，利用StretchBlt函數實現局部圖像放大，響應代碼如下：

PRocedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
　StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height,
　Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY);
　Image2.Refresh;
　Screen.Cursors[1]:=LoadCursorFromFile(’MAGNIFY.CUR’);
　Self.Cursor:=1;
end;
　　程序首先會調用StretchBlt函數，以鼠標當前位置作為中心點，以邊長為40選中Image1組件上的局部圖像，并放大此局部圖像到Image2組件上。然后通過調用Image2組件的Refresh方法以刷新Image2組件的顯示。最后設置鼠標指針為新的外形。

　　程序代碼如下：

unit Unit1;
interface
uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
　TForm1 = class(TForm)
　Image1: TImage;
　Image2: TImage;
　procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
　procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
private
　{ Private declarations }
public
　{ Public declarations }
end;

var
　Form1: TForm1;
　implementation
　{$R *.dfm}
　procedure TForm1.Image1MouseMove(Sender:TObject;Shift:TShiftState;X,Y: Integer);
　begin
　　StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height,Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY);
　　Image2.Refresh;
　　Screen.Cursors[1]:=LoadCursorFromFile(’MAGNIFY.CUR’);
　　Self.Cursor:=1;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
　Screen.Cursors[1]:=crDefault;
　Self.Cursor:=1;
end;
end.
　　保存文件，然后按F9鍵運行程序，程序運行結果如圖2所示。