用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]]
　　 圖 程序運行結果
From:http://tw.wingwit.com/Article/program/Delphi/201311/8410.html