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.