selectclipregionu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit SelectClipRegionU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    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 FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ClippingRegion: HRGN;       // a handle to the clipping region
  DraggingRect: Boolean;      // indicates that a drag operation is occurring
  TheRect: TRect;             // the dragged rectangle
  MouseOffsetX,               // used to offset the dragged rectangle
  MouseOffsetY: Integer;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  {create an elliptical region to be used for clippping}
  ClippingRegion := CreateEllipticRgn(40, 40, ClientWidth-50, ClientHeight-50);

  {create a rectangle}
  SetRect(TheRect, (ClientWidth div 2)-30, (ClientHeight div 2)-30,
          (ClientWidth div 2)+30, (ClientHeight div 2)+30);

  {initialize the dragging flag}
  DraggingRect := FALSE;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  {select the elliptical region as the clipping region}
  SelectClipRgn(Canvas.Handle, ClippingRegion);

  {indicate if the dragged rectangle is visible within the clipping region}
  if RectVisible(Canvas.Handle, TheRect) then
    Caption := Caption+'Rect Visible'
  else
    Caption := Caption+'Rect Not Visible';

  {draw the perimeter of the clipping region in red}
  Canvas.Brush.Color := clRed;
  FrameRgn(Canvas.Handle, ClippingRegion, Canvas.Brush.Handle, 4, 4);

  {draw the draggable rectangle in blue}
  Canvas.Brush.Color := clBlue;
  Canvas.FillRect(TheRect);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {if the mouse was clicked within the draggable rectangle}
  if PtInRect(TheRect, Point(X, Y)) then
  begin
    {indicate that a drag operation has commenced}
    DraggingRect := TRUE;

    {retrieve the offset of the current mouse coordinate withing the
     dragged rectangle.  this is used when moving the rectangle so that the
     original spot where the mouse was clicked inside of the rectangle is
     preserved.  otherwise, when the rectangle is moved the upper left hand
     corner of the rectangle will be positioned at the mouse cursor position}
    MouseOffsetX := X-TheRect.Left;
    MouseOffsetY := Y-TheRect.Top;
  end;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  {if a drag operation is occurring...}
  if DraggingRect then
  begin
    {erase the form's canvas}
    Form1.Canvas.Brush.Color := clBtnFace;
    Form1.Canvas.FillRect(TheRect);

    {move the dragged rectangle, offsetting it from the current mouse position
     so that the original clicked location within the rectangle is preserved}
    OffsetRect(TheRect, X-TheRect.Left-MouseOffsetX,
               Y-TheRect.Top-MouseOffsetY);

    {initialize the form's caption}
    Caption := 'SelectClipRgn Example - ';

    {indicate if the rectangle is within the elliptical region}
    if RectInRegion(ClippingRegion, TheRect) then
      Caption := Caption+'Rect In Region - '
    else
      Caption := Caption+'Rect Not In Region - ';

    {repaint the form to display the changes}
    Form1.Repaint;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {indicate that the drag operation has stopped}
  DraggingRect := FALSE;
end;                       

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {the region is no longer needed, so delete it}
  DeleteObject(ClippingRegion);
end;

end.