再学 GDI+[88]: TGPImage(8) - 放大镜

本例效果图:

---

代码文件:

---

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