
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.
object Form1: TForm1
OnCreate=FormCreate OnDestroy=FormDestroy OnMouseMove=FormMouseMove OnPaint=FormPaint
object CheckBox1: TCheckBox ... end
end