⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 offsetrectu.pas

📁 DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.
💻 PAS
字号:
unit OffsetRectU;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Button1: TButton;
    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 SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Rect1, Rect2: TRect;                  // the two test rectangles
  DragRect: PRect;                      // points to the rectangle being dragged
  DraggingRect: Boolean;                // indicates if a drag is occurring
  MouseOffsetX, MouseOffsetY: Integer;  // used to offset the dragged rectangle

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  {initialize the two test rectangles}
  SetRect(Rect1, 10, 30, 110, 130);
  SetRect(Rect2, 60, 80, 160, 180);

  {initialize the drag flag to indicate that dragging is not occurring}
  DraggingRect := FALSE;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  Intersection, Union: TRect;  // shows the union and intersection
begin
  {retrieve the union of the two test rectangles}
  UnionRect(Union, Rect1, Rect2);

  {draw this union rectangle in green}
  Form1.Canvas.Brush.Color := clGreen;
  Form1.Canvas.FillRect(Union);

  {draw the two test rectangles in red}
  Form1.Canvas.Brush.Color := clRed;
  Form1.Canvas.FillRect(Rect1);
  Form1.Canvas.FillRect(Rect2);

  {retrieve the intersection of the two test rectangles}
  IntersectRect(Intersection, Rect1, Rect2);

  {draw this intersection in blue}
  Form1.Canvas.Brush.Color := clBlue;
  Form1.Canvas.FillRect(Intersection);

  {indicate if the two rectangles are at exactly the same coordinates}
  if EqualRect(Rect1, Rect2) then
    Form1.Caption := 'OffsetRectExample - Rectangles are equal'
  else
    Form1.Caption := 'OffsetRectExample - Rectangles are not equal';
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {if the mouse was clicked inside of the first rectangle...}
  if PtInRect(Rect1, Point(X, Y)) then
  begin
    {indicate that dragging has commenced}
    DraggingRect := TRUE;

    {indicate that we are dragging rectangle 1}
    DragRect := @Rect1;
  end;

  {if the mouse was clicked inside of the second rectangle...}
  if PtInRect(Rect2, Point(X, Y)) then
  begin
    {indicate that dragging has commenced}
    DraggingRect := TRUE;

    {indicate that we are dragging rectangle 2}
    DragRect := @Rect2;
  end;

  {if a dragging operation has started...}
  if DraggingRect then
  begin
    {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-DragRect^.Left;
    MouseOffsetY := Y-DragRect^.Top;
  end;
end;

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

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

    {repaint the form}
    Form1.Repaint;
  end;
end;

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

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  {increase or decrease the size of the last dragged rectangle. the amount by
   which to increase or decrease the size is stored in the Tag property of
   the speed buttons on the toolbar}
  if DragRect<>NIL then
    InflateRect(DragRect^, TSpeedButton(Sender).Tag, TSpeedButton(Sender).Tag);

  {repaint the form to show the results}
  Form1.Repaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  {force rectangle 2 to become an exact duplicate of rectangle 1}
  CopyRect(Rect2, Rect1);

  {repaint the form to show the results}
  Form1.Repaint;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -