WinAPI: PtInRegion、OffsetRgn

本例效果图:

---

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs;



type

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(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);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



var

  Rgn: HRGN;

  f: Boolean;

  x1,y1: Integer;



procedure TForm1.FormCreate(Sender: TObject);

begin

  Rgn := CreateEllipticRgn(11, 11, 111, 66);

  DoubleBuffered := True; {可以使用双倍缓存来禁止闪烁}

end;



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

  Shift: TShiftState; X, Y: Integer);

begin

  if PtInRegion(Rgn, X, Y) then {判断鼠标当前点是否在区域内}

  begin

    f := True;

    x1 := X;

    y1 := y;

  end;

end;



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

  Y: Integer);

begin

  if not f then Exit;

  OffsetRgn(Rgn, X-x1, Y-y1); {移动区域}

  Repaint;

  x1 := X;

  y1 := y;

end;



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

  Shift: TShiftState; X, Y: Integer);

begin

  f := False;

end;



procedure TForm1.FormPaint(Sender: TObject);

begin

  Canvas.Brush.Color := clSilver;

  Canvas.Brush.Style := bsCross;

  FillRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle);



  Canvas.Brush.Color := clRed;

  Canvas.Brush.Style := bsSolid;

  FrameRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle, 2, 2);

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  DeleteObject(Rgn);

end;



end.