博客
关于我
强烈建议你试试无所不能的chatGPT,快点击我
再学 GDI+[88]: TGPImage(8) - 放大镜
阅读量:7088 次
发布时间:2019-06-28

本文共 2319 字,大约阅读时间需要 7 分钟。

  hot3.png

本例效果图:
26153135_icJn.gif

代码文件:

unit Unit1;interfaceuses  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  endend

转载于:https://my.oschina.net/hermer/blog/319430

你可能感兴趣的文章