[ 移動リサイズサンプル ][ R010_描画用移動リサイズコントロールの基本クラス ]

unit plBaseDragResize;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Menus, ExtCtrls,
  Forms, GDIPOBJ, GDIPAPI;

const
  WM_CREATED_RESIZECONTROL = WM_APP+10;
type
  TplBaseDragResize = class;

  TplBaseRubberBand = class(TShape)
  protected
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TplBaseGrabHandle = class(TShape)
  protected
    FResizeBase : TplBaseDragResize;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TplBaseDragResize = class(TGraphicControl)
  private
    FGrabPoints     : array [0..7] of TPoint;
    FGrabHandle     : array [0..7] of TShape;
    FRubberBand     : TplBaseRubberBand;
    FGrabHandleSize : Integer;
    FGrabBrushColor : TColor;
    FGrabCornerOnly : Boolean;
    FGrabHorzOnly   : Boolean;
    FGrabVertOnly   : Boolean;
    FGrabIndex      : Integer;
    FOperateMouse   : Boolean;
    FIsInSelfRect   : Boolean;
    FCurrentX       : Integer;
    FCurrentY       : Integer;
    FDrawRect       : TRect;
    FDrawLeft       : Integer;
    FDrawTop        : Integer;
    FDrawRight      : Integer;
    FDrawBottom     : Integer;
    FDrawWidth      : Integer;
    FDrawHeight     : Integer;
    FInverseHolz    : Boolean;
    FInverseVert    : Boolean;
    FSelected       : Boolean;
    FMousethrough   : Boolean;
    FMoveOnly       : Boolean;
    FDispOnly       : Boolean;
    FInverseDisp    : Boolean;
    FZoomValue      : Integer;
    FExitMouseEvent : Boolean;
    FAntiAliasing   : Boolean;
    FEnabledUseMsg  : Boolean;
    FParentIsScrBox : Boolean;
    FParentAutoScr  : Boolean;
    procedure SetFSelected(const Value: Boolean);
    procedure SetFMoveOnly(const Value: Boolean);
    procedure SetFAntiAliasing(const Value: Boolean);
    procedure SetFZoomValue(const Value: Integer);
    procedure SetFDispOnly(const Value: Boolean);
    procedure SetFGrabBrushColor(const Value: TColor);
    procedure SetFGrabHandleSize(const Value: Integer);
    procedure SetFGrabCornerOnly(const Value: Boolean);
    procedure SetFGrabHorzOnly(const Value: Boolean);
    procedure SetFGrabVertOnly(const Value: Boolean);
    procedure SetFExitMouseEvent(const Value: Boolean);
  protected
    procedure Paint; override;
    procedure RectToGrabHandlePoints(ARect: TRect);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure SetParent(AParent: TWinControl); override;
    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
    procedure SetRubberBandGrabHandlePosSize;
    procedure CMVisiblechanged(var Message: TMessage);
      message CM_VISIBLECHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
    property ZoomValue : Integer read FZoomValue write SetFZoomValue;
    property ExitMouseEvent : Boolean read FExitMouseEvent write SetFExitMouseEvent;
  public
    constructor Create(AOwner: TComponent); override;
    procedure BringToFront(AControl: TGraphicControl = nil);
    procedure SendToBack(AControl: TGraphicControl = nil);
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
    procedure ResetInverseDisp;
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); virtual;
    property OnDblClick;
    property PopupMenu;
    property RubberBand     : TplBaseRubberBand read FRubberBand;
    property GrabBrushColor : TColor  read FGrabBrushColor write SetFGrabBrushColor;
    property GrabHandleSize : Integer read FGrabHandleSize write SetFGrabHandleSize;
    property GrabCornerOnly : Boolean read FGrabCornerOnly write SetFGrabCornerOnly;
    property GrabHorzOnly   : Boolean read FGrabHorzOnly   write SetFGrabHorzOnly;
    property GrabVertOnly   : Boolean read FGrabVertOnly   write SetFGrabVertOnly;
    property DrawRect     : TRect   read FDrawRect;
    property DrawLeft     : Integer read FDrawLeft;
    property DrawTop      : Integer read FDrawTop;
    property DrawRight    : Integer read FDrawRight;
    property DrawBottom   : Integer read FDrawBottom;
    property DrawWidth    : Integer read FDrawWidth;
    property DrawHeight   : Integer read FDrawHeight;
    property Selected     : Boolean read FSelected     write SetFSelected;
    property MoveOnly     : Boolean read FMoveOnly     write SetFMoveOnly;
    property DispOnly     : Boolean read FDispOnly     write SetFDispOnly;
    property InverseDisp  : Boolean read FInverseDisp  write FInverseDisp;
    property Mousethrough : Boolean read FMousethrough write FMousethrough;
    property AntiAliasing : Boolean read FAntiAliasing write SetFAntiAliasing;
  end;

implementation

uses
  Types,
  Math;

{ TplBaseDragResize }

type
  TScrollCtrl = class(TScrollBox);

//=============================================================================
//  コンストラクタ
//=============================================================================
constructor TplBaseDragResize.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ParentColor := False;
  Canvas.Brush.Style := bsClear;

  Width  := 100;
  Height := 100;

  FOperateMouse := False;

  FEnabledUseMsg  := False;
  FSelected       := False;
  FMousethrough   := False;
  FMoveOnly       := False;
  FDispOnly       := False;
  FInverseDisp    := False;
  FAntiAliasing   := True;
  FParentIsScrBox := False;
  FExitMouseEvent := False;
  FZoomValue      := 100;

  FGrabHandleSize := 8;
  FGrabBrushColor := clWhite;
  FGrabCornerOnly := False;
  FGrabHorzOnly   := False;
  FGrabVertOnly   := False;
  FGrabIndex      := -1;
  FIsInSelfRect   := False;

  FInverseHolz := False;
  FInverseVert := False;

  Self.Cursor := crSizeAll;
end;

//=============================================================================
//  SetParentメソッド処理
//=============================================================================
procedure TplBaseDragResize.SetParent(AParent: TWinControl);
var
  LGrabNo : Integer;
  LShape  : TplBaseGrabHandle;
begin
  inherited;

  if not Assigned(AParent) then exit;
  if Assigned(FRubberBand) then exit;

  //ラバーバンド生成
  FRubberBand := TplBaseRubberBand.Create(Self);
  FRubberBand.Parent      := Parent;
  FRubberBand.Brush.Style := bsClear;
  FRubberBand.Pen.Width   := 1;
  FRubberBand.Pen.Style   := psDot;
  FRubberBand.Visible     := False;

  //グラブハンドルの生成
  //各グラブハンドルのマウスカーソルの設定
  for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
    LShape         := TplBaseGrabHandle.Create(Self);
    LShape.Parent  := Parent;
    LShape.Width   := FGrabHandleSize;
    LShape.Height  := FGrabHandleSize;
    LShape.Visible := False;

    if (LGrabNo = 0) or (LGrabNo = 4) then begin
      LShape.Cursor := crSizeNWSE;
    end else
    if (LGrabNo = 2) or (LGrabNo = 6) then begin
      LShape.Cursor := crSizeNESW;
    end else
    if (LGrabNo = 1) or (LGrabNo = 5) then begin
      LShape.Cursor := crSizeNS;
    end else
    if (LGrabNo = 3)or (LGrabNo = 7)then begin
      LShape.Cursor := crSizeWE;
    end;
    FGrabHandle[LGrabNo] := LShape;
  end;

  FParentIsScrBox := Parent is TScrollBox;
  if FParentIsScrBox then begin
    FParentAutoScr := TScrollCtrl(Parent).AutoScroll;
  end;

  //描画コントロールが使用可能になったことを親に通知する
  if not FEnabledUseMsg then begin
    FEnabledUseMsg := True;
    PostMessage(Parent.Handle, WM_CREATED_RESIZECONTROL, WPARAM(Self), 0);
  end;
end;

//-----------------------------------------------------------------------------
//  CMVisiblechangedメッセージ処理
//  Vislbleプロパティが変更された時に発生するメソッドー
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  //ラバーバンドとグラブハンドルの表示・非表示も変更する
  SetRubberBandGrabHandlePosSize;
end;

//-----------------------------------------------------------------------------
//  GrabBrushColorプロパティの設定用メソッド
//  グラブハンドルの矩形の塗り潰しの色変更
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabBrushColor(const Value: TColor);
var
  LGrabNo : Integer;
begin
  if not Assigned(FRubberBand) then exit;

  if FGrabBrushColor <> Value then begin
    FGrabBrushColor := Value;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Brush.Color := FGrabBrushColor;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabHandleSizeプロパティの設定用メソッド
//  グラブハンドルのサイズの設定
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabHandleSize(const Value: Integer);
var
  LGrabNo : Integer;
begin
  if not Assigned(FRubberBand) then exit;

  if FGrabHandleSize <> Value then begin
    FGrabHandleSize := Value;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Width  := FGrabHandleSize;
      FGrabHandle[LGrabNo].Height := FGrabHandleSize;
    end;
  end;
end;

//=============================================================================
//  DoContextPopupメソッド
//  選択状態でない時はポップアップメニューを表示しない
//=============================================================================
procedure TplBaseDragResize.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
var
  LPos : TPoint;
begin
  inherited;
  if not Assigned(PopupMenu) then exit;

  PopupMenu.AutoPopup := False;
  if FSelected then begin
    LPos := ClientToScreen(MousePos);
    PopupMenu.Popup(LPos.X, LPos.Y);
  end else begin
    Handled := True;
  end;
end;

//-----------------------------------------------------------------------------
//  Selectedプロパティの設定メソッド
//  選択・選択解除のプロパティ
//  Trueにするとラバーバンドとグラブハンドルを表示する
//  Falseにするとそれらを非表示にする
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFSelected(const Value: Boolean);
begin
  if FSelected <> Value then begin
    FSelected := Value;
    if (FSelected = False) or FDispOnly then begin
      FGrabIndex    := -1;
      FIsInSelfRect := False;
    end;
    SetRubberBandGrabHandlePosSize;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  MoveOnlyプロパティの設定用メソッド
//  Trueにするとグラブハンドルを表示しない
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFMoveOnly(const Value: Boolean);
var
  LGrabNo : Integer;
begin
  if FMoveOnly <> Value then begin
    FMoveOnly := Value;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Visible := not FMoveOnly;
    end;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  DispOnlyプロパティの設定用メソッド
//  Trueにすると選択できなくなり表示専用となる
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFDispOnly(const Value: Boolean);
begin
  if FDispOnly <> Value then begin
    FDispOnly := Value;
    if FDispOnly then begin
      SetFSelected(False);
      Self.Cursor := crDefault;
    end else begin
      Self.Cursor := crSizeAll;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabCornerOnlyプロパティの設定用メソッド
//  4隅のグラブハンドルだけを表示する
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabCornerOnly(const Value: Boolean);
begin
  if FGrabCornerOnly <> Value then begin
    FGrabCornerOnly := Value;

    FGrabHorzOnly := False;
    FGrabVertOnly := False;
    SetRubberBandGrabHandlePosSize;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabHorzOnlyプロパティの設定用メソッド
//  水平方向リサイズ用の左右2つだけを表示
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabHorzOnly(const Value: Boolean);
begin
  if FGrabHorzOnly <> Value then begin
    FGrabHorzOnly := Value;

    FGrabCornerOnly := False;
    FGrabVertOnly   := False;
    SetRubberBandGrabHandlePosSize;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabVertOnlyプロパティの設定用メソッド
//  垂直方向リサイズ用の上下2つだけを表示
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabVertOnly(const Value: Boolean);
begin
  if FGrabVertOnly <> Value then begin
    FGrabVertOnly := Value;

    FGrabCornerOnly := False;
    FGrabHorzOnly   := False;
    SetRubberBandGrabHandlePosSize;
  end;
end;

//-----------------------------------------------------------------------------
//  AntiAliasingプロパティの設定用メソッド
//  アンチエイリアシング処理の設定
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFAntiAliasing(const Value: Boolean);
begin
  if FAntiAliasing <> Value then begin
    FAntiAliasing := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  ExitMouseEventプロパティの設定用メソッド
//  継承クラスでのマウスイベントの実装用
//  コンテナコントロールからの設定用
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFExitMouseEvent(const Value: Boolean);
begin
  if FExitMouseEvent <> Value then begin
    FExitMouseEvent := Value;
  end;
end;

//-----------------------------------------------------------------------------
//  ZoomValueプロパティの設定用メソッド
//  拡大・縮小表示の値の設定
//  本描画コントロールには実際の拡大・縮小表示の機能はない
//  コンテナ用コントロールからの操作用
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFZoomValue(const Value: Integer);
begin
  if FZoomValue <> Value then begin
    FZoomValue := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  最前面に移動
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.BringToFront(AControl: TGraphicControl);
var
  LGrabNo : Integer;
begin
  TControl(Self).BringToFront;
  if AControl <> nil then begin
    AControl.BringToFront;
  end;
  FRubberBand.BringToFront;
  for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
    FGrabHandle[LGrabNo].BringToFront;
    Application.ProcessMessages;
  end;
end;

//-----------------------------------------------------------------------------
//  最背面に移動
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SendToBack(AControl: TGraphicControl = nil);
var
  LGrabNo : Integer;
begin
  for LGrabNo := Length(FGrabHandle) - 1 downto 0 do begin
    FGrabHandle[LGrabNo].SendToBack;
    Application.ProcessMessages;
  end;
  if AControl <> nil then begin
    AControl.SendToBack;
  end;
  FRubberBand.SendToBack;
  TControl(Self).SendToBack;
end;

//=============================================================================
//  MouseDownメソッド
//  非選択状態の時は，マウス左ボタン押下で選択状態にして移動リサイズ可能にする
//  選択状態にするということは，ラバーバンドとグラブハンドルを表示すること
//
//  [Ctrl]キーが押下されていなければ，既に選択中のこのクラスのコントロールを
//  非選択状態にする(ラバーバンドとグラブハンドルを非表示にする)
//=============================================================================
procedure TplBaseDragResize.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LPosInParent : TPoint;
  LSelfRect    : TRect;
  LClipRect    : TRect;
  LControl     : TControl;
  LControlNo   : Integer;
  LParentForm  : TCustomForm;
begin
  inherited;
  if FDispOnly then exit;
  if FExitMouseEvent then exit;
  if Button <> mbLeft then exit;


  FOperateMouse := True;

  //キーによる操作を可能にする
  //親フォーム検出のこの方法は簡便法
  LParentForm := GetParentForm(Self);
  if LParentForm <> nil then begin
    LParentForm.ActiveControl := Parent;
  end;

  FOperateMouse := True;

  //-1の時はグラブハンドルが選択されていない状態
  FGrabIndex := -1;
  //マウスカーソルがグラブハンドル内にあるか調査
  if not FMoveOnly then begin
    for LControlNo := 0 to Length(FGrabPoints) - 1 do begin
      if FGrabHandle[LControlNo].Visible then begin
        if PtInRect(Bounds(FGrabPoints[LControlNo].X - 1,
                           FGrabPoints[LControlNo].Y - 1,
                           (FGrabHandleSize + 1) * 2,
                           (FGrabHandleSize + 1) * 2),
                           Point(X, Y)) then begin
          FCurrentX  := X;
          FCurrentY  := Y;
          FGrabIndex := LControlNo;
          Break;
        end;
      end;
    end;
  end;

  //マウスカーソルがグラブハンドル内でなければ本コントロール内かを調査
  LPosInParent := Self.ClientToParent(Point(X, Y));
  if FGrabIndex = -1 then begin
    LSelfRect := Bounds(Left, Top, Width, Height);
    FIsInSelfRect := PtInRect(LSelfRect, LPosInParent);
    if FIsInSelfRect then begin
      FCurrentX := LPosInParent.X;
      FCurrentY := LPosInParent.Y;
    end;
  end;

  FSelected := ((FGrabIndex >= 0) or FIsInSelfRect) and not FDispOnly;
  if FSelected then begin
    //[Ctrl]押下時は複数選択可能とするので選択は解除しない
    //複数選択時はマウス透過とし移動は親コントロールのマウスイベントで行う
    if (ssCtrl in Shift) then begin
      for LControlNo := 0 to Parent.ControlCount - 1 do begin
        LControl := Parent.Controls[LControlNo];
        if LControl Is TplBaseDragResize then begin
          if (LControl <> Self) then begin
            //1つでも既に選択状態のコントロールがある場合
            if TplBaseDragResize(LControl).Selected then begin
              TplBaseDragResize(LControl).Mousethrough := True;
              FMousethrough := True;
              break;
            end;
          end;
        end;
      end;
    end else begin
      //自分自身以外の選択を解除
      //選択状態になったらマウスの移動範囲をこの親コントロール内とする
      for LControlNo := 0 to Parent.ControlCount - 1 do begin
        LControl := Parent.Controls[LControlNo];
        if LControl Is TplBaseDragResize then begin
          TplBaseDragResize(LControl).Mousethrough := False;
          if (LControl <> Self) then begin
            TplBaseDragResize(LControl).SetFSelected(False);
          end;
        end;
      end;
      Invalidate;

      LClipRect := Parent.ClientRect;
      LClipRect.TopLeft     := Parent.ClientToScreen(LClipRect.TopLeft);
      LClipRect.BottomRight := Parent.ClientToScreen(LClipRect.BottomRight);
      ClipCursor(@LClipRect);
    end;
  end;
end;

//=============================================================================
//  MouseMoveメソッド
//=============================================================================
procedure TplBaseDragResize.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  LSelfRect     : TRect;
  LPosInParent  : TPoint;
  LWidth        : Integer;
  LHeight       : Integer;
  LIncX         : Integer;
  LIncY         : Integer;
  LHorzScrPos   : Integer;
  LVertScrPos   : Integer;
  LHorzScrRange : Integer;
  LVertScrRange : Integer;
begin
  inherited;

  LSelfRect := Bounds(Left, Top, Width, Height);

  if FExitMouseEvent then exit;
  if FDispOnly then exit;

  //マウスカーソルはグラブハンドル内にない
  if FGrabIndex = -1 then begin

    //オブジェクトの矩形内にある場合
    if FIsInSelfRect then begin
      LPosInParent := ClientToParent(Point(X, Y));

      LIncX := LPosInParent.X - FCurrentX;
      LIncY := LPosInParent.Y - FCurrentY;

      //親がTScrollBoxの時の処理
      //最下端から上方向への移動と最右端から左方向に移動する場合
      //この処理をしないと移動できない
      if FParentIsScrBox and FSelected then begin
        LHorzScrPos   := TScrollCtrl(Parent).HorzScrollBar.Position;
        LVertScrPos   := TScrollCtrl(Parent).VertScrollBar.Position;
        LHorzScrRange := TScrollCtrl(Parent).HorzScrollBar.Range;
        LVertScrRange := TScrollCtrl(Parent).VertScrollBar.Range;


        if (LIncY < 0) and (LVertScrPos > 0) then begin
          if ((Top + Height+ FGrabHandleSize) >= Parent.ClientHeight) then begin
            TScrollCtrl(Parent).VertScrollBar.Range := LVertScrRange - LIncY;
          end;
          if (Top <= 0) then begin
            TScrollCtrl(Parent).VertScrollBar.Position := LVertScrPos + LIncY;
          end;
        end;
        if (LIncX <= 0) and (LHorzScrPos > 0) then begin
          if ((Left + Width + FGrabHandleSize) >= Parent.ClientWidth) then begin
            TScrollCtrl(Parent).HorzScrollBar.Range := LHorzScrRange - LIncX;
          end;
          if (Left <= 0) then begin
            TScrollCtrl(Parent).HorzScrollBar.Position := LHorzScrPos + LIncX;
          end;
        end;
      end;

      SetBounds(Left + LIncX, Top + LIncY, Width, Height);

      FCurrentX := LPosInParent.X;
      FCurrentY := LPosInParent.Y;
    end else begin
      exit;
    end;
  end else begin
    //マウスカーソルがグラブハンドル内にある場合
    case FGrabIndex of
      0:
      begin
        Inc(LSelfRect.Left, X - FCurrentX);
        Inc(LSelfRect.Top,  Y - FCurrentY);
       end;
      1:
      begin
        Inc(LSelfRect.Top, Y - FCurrentY);
      end;
      2:
      begin
        Inc(LSelfRect.Right,  X - FCurrentX);
        Inc(LSelfRect.Top, Y - FCurrentY);
      end;
      3:
      begin
        Inc(LSelfRect.Right, X - FCurrentX);
      end;
      4:
      begin
        Inc(LSelfRect.Right, X - FCurrentX);
        Inc(LSelfRect.Bottom, Y - FCurrentY);
      end;
      5:
      begin
        Inc(LSelfRect.Bottom, Y - FCurrentY);
      end;
      6:
      begin
        Inc(LSelfRect.Left, X - FCurrentX);
        Inc(LSelfRect.Bottom, Y - FCurrentY);
      end;
      7:
      begin
        Inc(LSelfRect.Left, X - FCurrentX);
      end;
    end;

    LWidth  := LSelfRect.Right  - LSelfRect.Left;
    LHeight := LSelfRect.Bottom - LSelfRect.Top;
    SetBounds(LSelfRect.Left, LSelfRect.Top, LWidth, LHeight);

    FCurrentX := X;
    FCurrentY := Y;
  end;
end;

//=============================================================================
//  MouseUpメソッド
//
//  以下の処理
//  マウスカーソル移動範囲の制限を解除
//  グラブハンドルはどれも掴んでいないことにする
//  オブジェクトの矩形内も掴んでいないことにする
//=============================================================================
procedure TplBaseDragResize.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LLeft       : Integer;
  LTop        : Integer;
  LWidth      : Integer;
  LHeight     : Integer;
  LZoomValue  : Integer;
  LHorzRange  : Integer;
  LVertRange  : Integer;
  LControlNo  : Integer;
  LControl    : TControl;
  LCtrl       : TplBaseDragResize;
  LHorzScrPos : Integer;
  LVertScrPos : Integer;
begin
  inherited;
  if FExitMouseEvent then exit;
  if FDispOnly then exit;


  LZoomValue := FZoomValue div 100;
  if LZoomValue = 0 then LZoomValue := 1;


  //マウスカーソルはグラブハンドル内にない
  if FGrabIndex = -1 then begin
    //オブジェクトの矩形内にある場合
    if FIsInSelfRect then begin
      LLeft := Left div LZoomValue * LZoomValue;
      LTop  := Top  div LZoomValue * LZoomValue;
      SetBounds(LLeft, LTop, Width, Height);
    end;

    //親のTScrollBoxのサイズを調整
    //最下端から上方向への移動と最右端から左方向に移動した場合に必要
    if FParentIsScrBox then begin
      LHorzScrPos := TScrollCtrl(Parent).HorzScrollBar.Position;
      LVertScrPos := TScrollCtrl(Parent).VertScrollBar.Position;

      if (LHorzScrPos > 0) or (LVertScrPos > 0) then begin
        LHorzRange := 0;
        LVertRange := 0;
        for LControlNo := 0 to Parent.ControlCount - 1 do begin
          LControl := Parent.Controls[LControlNo];
          if LControl Is TplBaseDragResize then begin
            LCtrl := TplBaseDragResize(LControl);
            LHorzRange := Max(LHorzRange, LHorzScrPos + LCtrl.Left + LCtrl.Width);
            LVertRange := Max(LVertRange, LVertScrPos + LCtrl.Top + LCtrl.Height);
          end;
        end;
        TScrollCtrl(Parent).HorzScrollBar.Range := LHorzRange;
        TScrollCtrl(Parent).VertScrollBar.Range := LVertRange;
      end;
      if FParentIsScrBox then begin
        TScrollCtrl(Parent).AutoScroll := FParentAutoScr;
      end;
    end;
  end else begin
    //マウスカーソルがグラブハンドル内にある場合
    LLeft   := Left   div LZoomValue * LZoomValue;
    LTop    := Top    div LZoomValue * LZoomValue;

    //幅や高さを0にしてしまうとマウスで選択できなくなるのでその対策
    LWidth  := Width;
    LHeight := Height;
    LWidth  := Max(LZoomValue, LWidth  div LZoomValue * LZoomValue);
    LHeight := Max(LZoomValue, LHeight div LZoomValue * LZoomValue);
    SetBounds(LLeft, LTop, LWidth, LHeight);
  end;

  //ズームとTScrollBox関係の処理がなければ以下のコードだけでよい
  ClipCursor(nil);
  FGrabIndex    := -1;
  FIsInSelfRect := False;

  FOperateMouse := False;
end;

//=============================================================================
//  WM_LBUTTONDBLCLKメッセージ処理
//  外部からOnDblclickイベントを定義して使用する場合の対応策
//  マウスボタンUPと同じ処理をして描画コントロールを掴んでいない状態にする
//=============================================================================
procedure TplBaseDragResize.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  inherited;
  if FExitMouseEvent then exit;

  if Assigned(OnDblClick) then begin
    ClipCursor(nil);
    FGrabIndex    := -1;
    FIsInSelfRect := False;

    FOperateMouse := False;
  end;
end;

//=============================================================================
//  CM_HITTESTメッセージ処理
//  FMousethroughはマウス透過のプロパティ
//=============================================================================
procedure TplBaseDragResize.CMHitTest(var Message: TCMHitTest);
begin
  if (FMousethrough) or (FExitMouseEvent) then begin
    Message.Result := HTNOWHERE;
  end else begin
    inherited;
  end;
end;

//=============================================================================
//  描画コントロール(自分自身)の位置，サイズが変更になった場合
//  ラバーバンドとグラブハンドルも再描画
//=============================================================================
procedure TplBaseDragResize.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  if not Assigned(Parent) then exit;

  if (Top < Parent.ClientHeight) or ((Top + Height) > 0)
    or ((Left + Width) < 0) or (Left > Parent.ClientWidth) then begin
    SetRubberBandGrabHandlePosSize;
  end;

  if not FOperateMouse then begin
    if (AWidth <= 0) or (AHeight <= 0) then begin
      AWidth  := Max(AWidth, 1);
      AHeight := Max(AHeight, 1);
      SetBounds(ALeft, ATop, AWidth, AHeight);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ラバーバンドとグラブハンドルを指定サイズと位置に描画
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetRubberBandGrabHandlePosSize;
var
  LGrabNo : Integer;
begin
  if not FSelected then begin
    FRubberBand.Visible := False;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Visible := False;
    end;
    exit;
  end;

  //ラバーバンド
  FRubberBand.SetBounds(Left, Top, Width, Height);
  FRubberBand.Visible := Visible and not FDispOnly;

  //グラブハンドル
  if not FMoveOnly then begin
    RectToGrabHandlePoints(Bounds(Left, Top, Width, Height));
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Left    := FGrabPoints[LGrabNo].X;
      FGrabHandle[LGrabNo].Top     := FGrabPoints[LGrabNo].Y;
      FGrabHandle[LGrabNo].Visible := Visible and not FDispOnly;
    end;

    if Visible and not FDispOnly then begin
      if FGrabCornerOnly then begin
        FGrabHandle[1].Visible := False;
        FGrabHandle[3].Visible := False;
        FGrabHandle[5].Visible := False;
        FGrabHandle[7].Visible := False;
      end else
      if FGrabHorzOnly then begin
        FGrabHandle[0].Visible := False;
        FGrabHandle[1].Visible := False;
        FGrabHandle[2].Visible := False;
        FGrabHandle[4].Visible := False;
        FGrabHandle[5].Visible := False;
        FGrabHandle[6].Visible := False;

        FGrabHandle[3].Invalidate;
        FGrabHandle[7].Invalidate;
      end else
      if FGrabVertOnly then begin
        FGrabHandle[0].Visible := False;
        FGrabHandle[2].Visible := False;
        FGrabHandle[3].Visible := False;
        FGrabHandle[4].Visible := False;
        FGrabHandle[6].Visible := False;
        FGrabHandle[7].Visible := False;

        FGrabHandle[1].Invalidate;
        FGrabHandle[5].Invalidate;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  グラブハンドルの表示座標を計算
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.RectToGrabHandlePoints(ARect: TRect);
var
  LHalfW : Integer;
  LLeft  : Integer;
  LTop   : Integer;
begin
  LHalfW := FGrabHandleSize div 2;
  LLeft  := ARect.Left + (ARect.Right - ARect.Left) div 2;
  LTop   := ARect.Top + (ARect.Bottom - ARect.Top) div 2;

  FGrabPoints[0] := Point(ARect.Left - LHalfW,  ARect.Top - LHalfW);
  FGrabPoints[1] := Point(LLeft - LHalfW,       ARect.Top - LHalfW);
  FGrabPoints[2] := Point(ARect.Right - LHalfW, ARect.Top - LHalfW);
  FGrabPoints[3] := Point(ARect.Right - LHalfW, LTop - LHalfW);
  FGrabPoints[4] := Point(ARect.Right - LHalfW, ARect.Bottom - LHalfW);
  FGrabPoints[5] := Point(LLeft - LHalfW,       ARect.Bottom - LHalfW);
  FGrabPoints[6] := Point(ARect.Left - LHalfW,  ARect.Bottom - LHalfW);
  FGrabPoints[7] := Point(ARect.Left - LHalfW,  LTop - LHalfW);
end;

//=============================================================================
//  Paintメソッド処理
//  実際の描画処理は継承クラスのDrawRoutineメソッドで行う
//=============================================================================
procedure TplBaseDragResize.Paint;
begin
  inherited;
  if not Assigned(Parent) then exit;

  //幅や高さが負になった場合の処理
  if Width < 0 then begin
    FInverseHolz := not FInverseHolz;
    Width := Abs(Width);
    Left  := Left - Width;
    if FSelected then begin
      case FGrabIndex of
        0: FGrabIndex := 2;
        7: FGrabIndex := 3;
        6: FGrabIndex := 4;
        2: FGrabIndex := 0;
        3: FGrabIndex := 7;
        4: FGrabIndex := 6;
      end;
    end;
  end;
  if Height < 0 then begin
    FInverseVert := not FInverseVert;
    Height := Abs(Height);
    Top    := Top - Abs(Height);
    if FSelected then begin
      case FGrabIndex of
        0: FGrabIndex := 6;
        1: FGrabIndex := 5;
        2: FGrabIndex := 4;
        4: FGrabIndex := 2;
        5: FGrabIndex := 1;
        6: FGrabIndex := 0;
      end;
    end;
  end;


  //ラバーバンドとグラブハンドルの描画
  SetRubberBandGrabHandlePosSize;

  //描画ルーチンの実行
  DrawRoutine(Canvas);
end;

//-----------------------------------------------------------------------------
//  実際の描画用の処理
//  引数のACanvasにこのメソッド内の描画コードを実行する
//  実際の描画コードは派生クラスに継承メソッドを実装して行う
//
//  描画開始位置は常に(FDrawLeft, FDrawTop)
//  反転した描画が不要なら Rect(0, 0, Widht, Heidht) 内の描画でよい
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
begin
  if (ACanvas = nil) and (AGPBitmap = nil) then exit;

  //上下左右が反転の時
  if FInverseDisp and FInverseHolz and FInverseVert then begin
    //左右のX座標値(Left,Right)を交換する
    //上下のY座標値(Top,Bottom)を交換する
    FDrawLeft   := ClientRect.Right + AOffsetX;
    FDrawTop    := ClientRect.Bottom + AOffsetY;
    FDrawRight  := ClientRect.Left + AOffsetX;
    FDrawBottom := ClientRect.Top + AOffsetY;
    FDrawWidth  := -Width;
    FDrawHeight := -Height;
  end else
  //左右が反転の時
  if FInverseDisp and FInverseHolz then begin
    //左右のX座標値(Left,Right)を交換する
    FDrawLeft   := ClientRect.Right + AOffsetX;
    FDrawTop    := ClientRect.Top + AOffsetY;
    FDrawRight  := ClientRect.Left + AOffsetX;
    FDrawBottom := ClientRect.Bottom + AOffsetY;
    FDrawWidth  := -Width;
    FDrawHeight := Height;
  end else
  //上下が反転の時
  if FInverseDisp and FInverseVert then begin
    //上下のY座標値(Top,Bottom)を交換する
    FDrawLeft   := ClientRect.Left + AOffsetX;
    FDrawTop    := ClientRect.Bottom + AOffsetY;
    FDrawRight  := ClientRect.Right + AOffsetX;
    FDrawBottom := ClientRect.Top + AOffsetY;
    FDrawWidth  := Width;
    FDrawHeight := -Height;
  end else begin
    FDrawLeft   := ClientRect.Left + AOffsetX;
    FDrawTop    := ClientRect.Top + AOffsetY;
    FDrawRight  := ClientRect.Right + AOffsetX;
    FDrawBottom := ClientRect.Bottom + AOffsetY;
    FDrawWidth  := Width;
    FDrawHeight := Height;
  end;
  FDrawRect := Bounds(FDrawLeft, FDrawTop, FDrawWidth, FDrawHeight);
end;

//-----------------------------------------------------------------------------
//  FDraw関係の値を元に戻す
//  以下の値をFalseにすれば描画の際に反転状態を元に戻すことができる
//  外部からTGPBitmapを取得した場合反転した状態の画像となる
//  それを編集してこの描画コントロールで表示すると反転してしまう
//  その対策用
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.ResetInverseDisp;
begin
  FInverseHolz := False;
  FInverseVert := False;
end;

{ TplBaseGrabHandle }

//=============================================================================
//  グラブハンドルクラスのコンストラクタ
//  基本的な設定のみ
//=============================================================================
constructor TplBaseGrabHandle.Create(AOwner: TComponent);
begin
  inherited;
  FResizeBase := TplBaseDragResize(AOwner);

  Brush.Style := bsSolid;
  Brush.Color := clWhite;
  Pen.Color   := clBlack;
  Pen.Width   := 2;
  Pen.Style   := psSolid;
end;

//=============================================================================
//  CM_HITTESTメッセージ処理
//  TplBaseDragResizeがマウス透過時はグラブハンドルもマウスイベント透過とする
//=============================================================================
procedure TplBaseGrabHandle.CMHitTest(var Message: TCMHitTest);
begin
  if(FResizeBase.Mousethrough) or (FResizeBase.FExitMouseEvent) then begin
    Message.Result := HTNOWHERE;
  end else begin
    inherited;
  end;
end;

//=============================================================================
//  MouseDownメソッド処理
// TplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseGrabHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LPos : TPoint;
begin
  inherited;
  if FResizeBase.Selected then begin
    LPos := ClientToParent(Point(X, Y));
    FResizeBase.MouseDown(Button, Shift, LPos.X, LPos.Y);
  end;
end;

//=============================================================================
//  MouseMoveメソッド処理
// TplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseGrabHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  LPos : TPoint;
begin
  inherited;
  if FResizeBase.Selected then begin
    LPos := ClientToParent(Point(X, Y));
    FResizeBase.MouseMove(Shift, LPos.X, LPos.Y);
  end;
end;

//=============================================================================
//  MouseUpメソッド処理
// TplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseGrabHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LPos : TPoint;
begin
  inherited;
  if FResizeBase.Selected then begin
    LPos := ClientToParent(Point(X, Y));
    FResizeBase.MouseUp(Button, Shift, LPos.X, LPos.Y);
  end;
end;

{ TplBaseRubberBand }

//=============================================================================
//  ラバーバンドクラスのコンストラクタ
//  基本的な設定のみ
//=============================================================================
constructor TplBaseRubberBand.Create(AOwner: TComponent);
begin
  inherited;

  Brush.Style := bsClear;
  Pen.Color   := clBlack;
  Pen.Width   := 1;
  Pen.Style   := psDot;
end;

//=============================================================================
//  CM_HITTESTメッセージ処理
//  マウスイベントは全て透過
//  マウスイベントは全てTplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseRubberBand.CMHitTest(var Message: TCMHitTest);
begin
  Message.Result := HTNOWHERE;
end;

end.