再学 GDI+[75]: 区域(4) - 根据区域剪切画板

本例效果图:

---

代码文件:

---

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 FormPaint(Sender: TObject);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure CheckBox1Click(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



uses GDIPOBJ, GDIPAPI;



var

  rt: TRect;

  flag: Boolean;

  x1,y1: Integer;



procedure TForm1.FormCreate(Sender: TObject);

begin

  Self.Color := clWhite;

  rt := ClientRect;

  InflateRect(rt, -ClientWidth div 3, -ClientHeight div 3);



  CheckBox1.Caption := '剪切区域';

  CheckBox1.Checked := True;



  DoubleBuffered := True;

end;



procedure TForm1.FormPaint(Sender: TObject);

var

  g : TGPGraphics;

  b: TGPSolidBrush;

  rgn: TGPRegion;

  str: string;

  font: TGPFont;

  RectF: TGPRectF;

  i: Integer;

begin

  RectF := MakeRect(0.0, 0, ClientWidth+10, ClientHeight);



  str := '';

  for i := 0 to 800 do str := str + IntToStr(Random(2));



  g := TGPGraphics.Create(Canvas.Handle);

  b := TGPSolidBrush.Create(aclBlue);



  rgn := TGPRegion.Create(MakeRect(rt));



  if CheckBox1.Checked then g.SetClip(rgn); {用区域剪切画板}



  font := TGPFont.Create(Canvas.Handle);

  g.DrawString(str, -1, font, RectF, nil, b);



  rgn.Free;

  font.Free;

  b.Free;

  g.Free;

end;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  if PtInRect(rt, Point(X,Y)) then

  begin

    x1 := X;

    y1 := Y;

    flag := True;

  end;

end;



procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if not flag then Exit;

  OffsetRect(rt, X-x1, Y-y1);

  x1 := X;

  y1 := Y;

  Repaint;

end;



procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  flag := False;

end;



procedure TForm1.CheckBox1Click(Sender: TObject);

begin

  Repaint;

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 184

  ClientWidth = 243

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  Position = poDesktopCenter

  OnCreate = FormCreate

  OnMouseDown = FormMouseDown

  OnMouseMove = FormMouseMove

  OnMouseUp = FormMouseUp

  OnPaint = FormPaint

  PixelsPerInch = 96

  TextHeight = 13

  object CheckBox1: TCheckBox

    Left = 170

    Top = 159

    Width = 65

    Height = 17

    Caption = 'CheckBox1'

    TabOrder = 0

    OnClick = CheckBox1Click

  end

end