再学 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