本例效果图:
代码文件:
unit Unit1;
interfaceuses 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.