delphi 根据区域剪切画板

2018-10-30

本例效果图:



代码文件:
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.
阅读25