本例效果图:
![](https://www.cnblogs.com/images/cnblogs_com/del/142973/o_8731.gif)
代码文件:
![](https://www.cnblogs.com/images/cnblogs_com/del/142973/o_8731.gif)
代码文件:
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)); {放大后的局部图像: 参数2是放大后的范围; 参数3-6是要被放大的范围; 参数7是单位} 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 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 206 ClientWidth = 339 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate OnDestroy = FormDestroy OnMouseMove = FormMouseMove OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 object CheckBox1: TCheckBox Left = 240 Top = 181 Width = 97 Height = 17 Caption = 'CheckBox1' TabOrder = 0 end end