熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> Delphi編程 >> 正文

用Delphi實現圖像放大鏡

2013-11-11 21:04:22  來源: 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
    推薦文章
    Copyright © 2005-2013 電腦知識網 Computer Knowledge   All rights reserved.