首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
您现在的位置: 程式碼之家 >> 編程語言 >  >> 更多程式語言 >> Delphi

GDI+ 實現放大鏡效果:TGPImage 局部放大繪製範例

     編輯:Delphi

效果展示

放大鏡動畫

核心邏輯

  • 載入圖片 TGPImage,視窗大小匹配圖片尺寸
  • 滑鼠移動時記錄座標,構建放大區域矩形 rt (150x150)
  • OnPaint 中:

g.DrawImage(img, 0, 0, img.Width, img.Height); // 原圖
if CheckBox1.Checked then begin
  g.FillRectangle(b, rt.X+2, rt.Y+2, rt.Width, rt.Height); // 陰影
  g.DrawImage(img, rt, rt.X, rt.Y, rt.Width/n, rt.Height/n, UnitPixel); // 放大繪製
  g.DrawRectangle(p, rt); // 邊框
end;

關鍵:DrawImage 多載允許指定來源矩形 (滑鼠區域) 繪製到目標矩形 (放大鏡區域),n=2.0 為放大倍率。

完整單元代碼


unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm)
  CheckBox1: TCheckBox;
  procedure FormCreate(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
  procedure FormPaint(Sender: TObject);
  procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
end;
var Form1: TForm1;
implementation {$R *.dfm} uses GDIPOBJ, GDIPAPI;
var img: TGPImage; rt: TGPRectF; n: Single = 2.0;
procedure TForm1.FormCreate(Sender: TObject);
begin
  img := TGPImage.Create('c:\temp\test.png');
  ClientWidth := img.GetWidth; ClientHeight := img.GetHeight;
  Position := poDesktopCenter; DoubleBuffered := True;
  CheckBox1.Caption := '使用放大鏡';
  CheckBox1.Left := ClientWidth - CheckBox1.Width;
  CheckBox1.Top := ClientHeight - CheckBox1.Height - 2;
end;
procedure TForm1.FormDestroy(Sender: TObject); begin img.Free; end;
procedure TForm1.FormPaint(Sender: TObject);
var g: TGPGraphics; p: TGPPen; b: TGPSolidBrush;
begin
  g := TGPGraphics.Create(Canvas.Handle);
  p := TGPPen.Create(MakeColor(128,255,255,255));
  b := TGPSolidBrush.Create(aclBlack);
  g.DrawImage(img, 0, 0, img.GetWidth, img.GetHeight);
  if CheckBox1.Checked then begin
    g.FillRectangle(b, MakeRect(rt.X+2, rt.Y+2, rt.Width, rt.Height));
    g.DrawImage(img, rt, rt.X, rt.Y, rt.Width/n, rt.Height/n, UnitPixel);
    g.DrawRectangle(p, rt);
  end;
  b.Free; p.Free; g.Free;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if CheckBox1.Checked then begin rt := MakeRect(X, Y, 150.0, 150); Repaint; end;
end;
end.

DFM 要點


object Form1: TForm1
  OnCreate=FormCreate OnDestroy=FormDestroy OnMouseMove=FormMouseMove OnPaint=FormPaint
  object CheckBox1: TCheckBox ... end
end
  1. 上一篇文章:
  2. 下一篇文章:
Copyright © 程式碼之家 All Rights Reserved