[ 移動リサイズサンプル ][ 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;

  TplBaseExtendCtrl = class(TGraphicControl)
  private
    FBaseCtrl : TplBaseDragResize;
  public
    constructor Create(AOwner: TComponent); override;
  protected
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
    procedure Paint; override;
  end;

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

  TplBaseGrabHandle = class(TShape)                    private
  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;

    FSignX : Integer;
    FSignY : Integer;

    FExtendCtrl   : TplBaseExtendCtrl;
    FUseExtend    : Boolean;
    FAddExtend    : Integer;

    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);

    function GetFExtendRect: TRect;
    function GetExtendPosSize(const Value: Integer): Integer;
    function GetRealRect(AGPBitmap: TGPBitmap): TRect;
    procedure SetFInverseHolz(const Value: Boolean);
    procedure SetFInverseVert(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;
    procedure Loaded; override;
    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;
    procedure Invalidate; override;
    property OnDblClick;
    property PopupMenu;
    property RubberBand   : TplBaseRubberBand read FRubberBand;
    property Selected     : Boolean read FSelected     write SetFSelected;
    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;

    function GetGPBitmap: TGPBitmap;
    procedure SetColorToAlphaZero(ABitmap: TBitmap; TransColor: Cardinal);
    function BitmapToGPBitmap(SrcBitmap: TBitmap; var DstGPBitmap: TGPBitmap;
      PixelFmt: TPixelFormat = PixelFormat32bppARGB): Boolean;
    function GPBitmapToBitmap(SrcGPBitmap: TGPBitmap; DstBitmap: TBitmap): Boolean;
    function GetRegionFromGPBitmap(GDPBitmap: TGPBitmap; GDPRegion: TGPRegion): Boolean;
    function GetExtendGPbitmap(AGPBitmap: TGPBitmap): TGPBitmap;
    procedure SetBitmapCanvas_forDraw(ABitmap: TBitmap; var ACanvas: TCanvas;
      ATransColor: TColor);
   procedure BitmapToGPBitmap_forDraw(ABitmap: TBitmap; AGPBitmap: TGPBitmap;
     ATransColor: TColor; AOffsetX: Integer; AOffsetY: Integer);

    property UseExtend    : Boolean read FUseExtend write FUseExtend;
    property AddExtend : Integer read FAddExtend write FAddExtend;
    property ExtendCtrl   : TplBaseExtendCtrl  read FExtendCtrl write FExtendCtrl;
    property ExtendRect   : TRect    read GetFExtendRect;
    property ExtendLeft   : Integer  index 0 read GetExtendPosSize;
    property ExtendTop    : Integer  index 1 read GetExtendPosSize;
    property ExtendRight  : Integer  index 2 read GetExtendPosSize;
    property ExtendBottom : Integer  index 3 read GetExtendPosSize;
    property ExtendWidth  : Integer  index 4 read GetExtendPosSize;
    property ExtendHeight : Integer  index 5 read GetExtendPosSize;
    property SignX : Integer  read FSignX;
    property SignY : Integer  read FSignY;
  published
    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 MoveOnly     : Boolean read FMoveOnly     write SetFMoveOnly;
    property DispOnly     : Boolean read FDispOnly     write SetFDispOnly;
    property Mousethrough : Boolean read FMousethrough write FMousethrough;
    property AntiAliasing : Boolean read FAntiAliasing write SetFAntiAliasing;
    property InverseDisp  : Boolean read FInverseDisp  write FInverseDisp;
    property InverseHolz  : Boolean read FInverseHolz  write SetFInverseHolz;
    property InverseVert  : Boolean read FInverseVert  write SetFInverseVert;
  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;

  FUseExtend := False;
  FAddExtend := 0;

  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;

  if UseExtend and not Assigned(FExtendCtrl) then begin
    FExtendCtrl := TplBaseExtendCtrl.Create(Self);
    FExtendCtrl.Parent := AParent;
    BringToFront(FExtendCtrl);
  end;
end;

//=============================================================================
//  Loaded メソッド処理
//  Selected プロパティを False にする
//=============================================================================
procedure TplBaseDragResize.Loaded;
begin
  inherited;
  FSelected := False;
end;

//-----------------------------------------------------------------------------
//  CMVisiblechangedメッセージ処理
//  Vislbleプロパティが変更された時に発生するメソッドー
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.CMVisiblechanged(var Message: TMessage);
begin
  inherited;

  if Assigned(FExtendCtrl) then begin
    FExtendCtrl.Visible := Visible;
  end;

  //ラバーバンドとグラブハンドルの表示・非表示も変更する
  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;
      SetRubberBandGrabHandlePosSize;
      Invalidate;
    end;
  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;

//-----------------------------------------------------------------------------
//  InverseHolzプロパティの設定用メソッド
//  左右反転状態の設定状態
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFInverseHolz(const Value: Boolean);
begin
  if FInverseHolz <> Value then begin
    FInverseHolz := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  InverseVertプロパティの設定用メソッド
//  上下反転状態の設定状態
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFInverseVert(const Value: Boolean);
begin
  if FInverseVert <> Value then begin
    FInverseVert := Value;
    Invalidate;
  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) and (LParentForm <> Parent) 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
  LPosInParent  : TPoint;
  LLeft         : Integer;
  LTop          : Integer;
  LWidth        : Integer;
  LHeight       : Integer;
  LIncX         : Integer;
  LIncY         : Integer;
  LHorzScrPos   : Integer;
  LVertScrPos   : Integer;
  LHorzScrRange : Integer;
  LVertScrRange : Integer;
  LPixelSize    : Integer;
begin
  inherited;

  LPixelSize := ZoomValue div 100;

  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;

      LLeft := (Left + LIncX + Width)  div LPixelSize * LPixelSize;
      LTop  := (Top  + LIncY + Height) div LPixelSize * LPixelSize;

      SetBounds(LLeft - Width, LTop - Height, Width, Height);

      FCurrentX := LPosInParent.X div LPixelSize * LPixelSize;
      FCurrentY := LPosInParent.Y div LPixelSize * LPixelSize;
    end else begin
      exit;
    end;
  end else begin
    //マウスカーソルがグラブハンドル内にある場合
    LLeft   := Left;
    LTop    := Top;
    LWidth  := Width;
    LHeight := Height;

    case FGrabIndex of
      0:
      begin
        LLeft := Left + (X - FCurrentX);
        LTop  := Top  + (Y - FCurrentY);
       end;
      1:
      begin
        LTop := Top + (Y - FCurrentY);
      end;
      2:
      begin
        LWidth := Width + (X - FCurrentX);
        LTop   := Top + (Y - FCurrentY);
      end;
      3:
      begin
        LWidth := Width + (X - FCurrentX);
      end;
      4:
      begin
        LWidth  := Width  + (X - FCurrentX);
        LHeight := Height + (Y - FCurrentY);
      end;
      5:
      begin
        LHeight := Height + (Y - FCurrentY);
      end;
      6:
      begin
        LLeft   := left + (X - FCurrentX);
        LHeight := Height + (Y - FCurrentY);
      end;
      7:
      begin
        LLeft := Left + (X - FCurrentX);
      end;
    end;

    LLeft   := LLeft div LPixelSize * LPixelSize;
    LTop    := LTop  div LPixelSize * LPixelSize;

    LWidth  := (LWidth + (Left - LLeft)) div LPixelSize * LPixelSize;
    LHeight := (LHeight + (Top - LTop)) div LPixelSize * LPixelSize;

    SetBounds(LLeft, LTop, LWidth, LHeight);

    FCurrentX := X div LPixelSize * LPixelSize;
    FCurrentY := Y div LPixelSize * LPixelSize;
  end;
end;

//=============================================================================
//  MouseUpメソッド
//
//  以下の処理
//  マウスカーソル移動範囲の制限を解除
//  グラブハンドルはどれも掴んでいないことにする
//  オブジェクトの矩形内も掴んでいないことにする
//=============================================================================
procedure TplBaseDragResize.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LLeft       : Integer;
  LTop        : Integer;
  LWidth      : Integer;
  LHeight     : Integer;
  LPixelSize  : 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;


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

  //マウスカーソルはグラブハンドル内にない
  if FGrabIndex = -1 then begin
    //オブジェクトの矩形内にある場合
    if FIsInSelfRect then begin
      LLeft := Left div LPixelSize * LPixelSize;
      LTop  := Top  div LPixelSize * LPixelSize;
      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
    //マウスカーソルがグラブハンドル内にある場合

    LWidth  := Width;
    LHeight := Height;
    LLeft   := Left div LPixelSize * LPixelSize;
    LTop    := Top  div LPixelSize * LPixelSize;

    if LLeft < Left then begin
      LWidth := LWidth + (Left - LLeft);
    end;
    if LTop < Top then begin
      LHeight := LHeight + (Top - LTop);
    end;

    //幅や高さを0にしてしまうとマウスで選択できなくなるのでその対策
    LWidth  := Max(LPixelSize, LWidth  div LPixelSize * LPixelSize);
    LHeight := Max(LPixelSize, LHeight div LPixelSize * LPixelSize);
    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 FUseExtend then begin
    FExtendCtrl.SetBounds(Left - FAddExtend, Top - FAddExtend,
                           Width + FAddExtend * 2, Height + FAddExtend * 2);
  end;

//
  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 Parent = nil then Exit;
  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;


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

//-----------------------------------------------------------------------------
//  拡張描画領域用
//  ExtendRectプロパティの取得用メソッド
//  実際に描画している範囲のTRect値を計算
//-----------------------------------------------------------------------------
function TplBaseDragResize.GetFExtendRect: TRect;
var
  LGPBitmap : TGPBitmap;
begin
  if not FUseExtend then begin
    Result := Bounds(Left, Top, Width, Height);
    Exit;
  end;

  LGPBitmap := TGPBitmap.Create(FExtendCtrl.Width, FExtendCtrl.Height);
  try
    DrawRoutine(nil, LGPBitmap);
    Result := GetRealRect(LGPBitmap);
  finally
    FreeAndNil(LGPBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  GetFExtendRect メソッドで使用する関数
//  実際にデータがある TRect を取得
//-----------------------------------------------------------------------------
function TplBaseDragResize.GetRealRect(AGPBitmap: TGPBitmap): TRect;
var
  LImgWidth   : Integer;
  LImgHeight  : Integer;
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LAValue     : Byte;
  LXStartPos  : Integer;
  LXEndPos    : Integer;
  LYStartPos  : Integer;
  LYEndPos    : Integer;
begin
  LImgWidth  := AGPBitmap.GetWidth;
  LImgHeight := AGPBitmap.GetHeight;

  LXStartPos := LImgWidth;
  LXEndPos   := 0;
  LYStartPos := LImgHeight;
  LYEndPos   := 0;

  //TGPBitmapのビットマップデータ取得
  if AGPBitmap.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight), ImageLockModeWrite,
                                 PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  LScanLine   := LBmpData.Scan0;
  LDataStride := LBmpData.Stride;

  for LYPos := 0 to LImgHeight - 1 do begin
    LpRGBQuad  := PRGBQuad(LScanLine);

    for LXPos := 0 to LImgWidth - 1 do begin
      LAValue   := LpRGBQuad^.rgbReserved;
      if LAValue <> 0 then begin
        LXStartPos := Min(LXStartPos, LXPos);
        LYStartPos := Min(LYStartPos, LYPos);
        LXEndPos := Max(LXEndPos, LXPos);
        LYEndPos := Max(LYEndPos, LYPos);
      end;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

  AGPBitmap.UnlockBits(LBmpData);

  Result := Bounds(FExtendCtrl.Left + LXStartPos, FExtendCtrl.Top + LYStartPos,
                   LXEndPos - LXStartPos, LYEndPos - LYStartPos);
end;

//-----------------------------------------------------------------------------
//  拡張描画領域用
//  ExtendLeft等のプロパティ取得用関数
//  実際の描画開始位置とサイズを取得
//
//    0 ExtendLeft
//    1 ExtendTop
//    2 ExtendRight
//    3 ExtendBottom
//   4 ExtendWidth
//   5 ExtendHeight
//-----------------------------------------------------------------------------
function TplBaseDragResize.GetExtendPosSize(const Value: Integer): Integer;
var
  LRect : TRect;
begin
  LRect := GetFExtendRect;

  case Value of
    0: Result := LRect.Left;
    1: Result := LRect.Top;
    2: Result := LRect.Right;
    3: Result := LRect.Bottom;
    4: Result := LRect.Right - LRect.Left;
    5: Result := LRect.Bottom - LRect.Top;
  else
    Result := 0;
  end;
end;

//-----------------------------------------------------------------------------
//  描画内容をTGPBitmap 画像として取得する時に使用するメソッド
//  戻り値の TGPBitmap は呼出し側で生成 / 解放する必要はない
//-----------------------------------------------------------------------------
function TplBaseDragResize.GetGPBitmap: TGPBitmap;
var
  LGPBitmap : TGPBitmap;
begin
  if FUseExtend then begin
    LGPBitmap := TGPBitmap.Create(Width + AddExtend * 2, Height + AddExtend * 2);
  end else begin
    LGPBitmap := TGPBitmap.Create(Width, Height);
  end;
  try
    DrawRoutine(nil, LGPBitmap);
    Result := GetExtendGPbitmap(LGPBitmap);
  finally
    FreeAndNil(LGPBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  与えられたビットマップの指定の色のアルファ値を0(透明色)にする関数
//
//  ABitmap    : 処理対象のビットマップ．処理したビットマップを返す
//  TransColor : 透明にする色
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetColorToAlphaZero(ABitmap: TBitmap; TransColor: Cardinal);
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LTransR    : Byte;
  LTransG    : Byte;
  LTransB    : Byte;
  LRValue    : Byte;
  LGValue    : Byte;
  LBValue    : Byte;
  LYPos      : Integer;
  LXPos      : Integer;
  LScanArray : PRGBQArray;
  LColorQuad : RGBQUAD;
begin
  ABitmap.Canvas.Lock;

  ABitmap.PixelFormat := pf32bit;

  //指定色のR,LGValue,Bの各値を取得しておく
  LTransR := GetRValue(TransColor);
  LTransG := GetGValue(TransColor);
  LTransB := GetBValue(TransColor);

  for LYPos := 0 to ABitmap.Height - 1 do begin
    LScanArray := ABitmap.ScanLine[LYPos];

    for LXPos := 0 to ABitmap.Width - 1 do begin

      LRValue := LScanArray[LXPos].rgbRed;
      LGValue := LScanArray[LXPos].rgbGreen;
      LBValue := LScanArray[LXPos].rgbBlue;

      if (LTransR = LRValue) and (LTransG = LGValue) and (LTransB = LBValue) then begin
        LColorQuad.rgbBlue     := 0;
        LColorQuad.rgbGreen    := 0;
        LColorQuad.rgbRed      := 0;
        LColorQuad.rgbReserved := 0;
        LScanArray[LXPos] := LColorQuad;
      end else begin
        LScanArray[LXPos].rgbReserved := $FF;
      end;
    end;
  end;

  ABitmap.Canvas.Unlock;
end;

  //-----------------------------------------------------------------------------
//  TBitmap を TGPBitmap に変換
//  TGPBitmap は TBitmap のアルファチャンネルを処理しない
//  TBitmapのアルファ値をTGPBitmapのアルファ値に代入する
//  この処理ではアルファチャンネル付き TBitmapを TGPBitmap に変換する
//-----------------------------------------------------------------------------
function TplBaseDragResize.BitmapToGPBitmap(SrcBitmap: TBitmap; var DstGPBitmap: TGPBitmap;
  PixelFmt: TPixelFormat): Boolean;
type
  TRGBQArray = array [0..4095] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpRGBQuad   : PRGBQuad;
  LWidth      : Integer;
  LHeight     : Integer;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LScanArray  : PRGBQArray;
  LAValue     : Byte;
  LRValue     : Byte;
  LGValue     : Byte;
  LBValue     : Byte;
begin
  Result := False;

  LWidth  := SrcBitmap.Width;
  LHeight := SrcBitmap.Height;
  FreeAndNil(DstGPBitmap);
  DstGPBitmap := TGPBitmap.Create(LWidth, LHeight);

  if DstGPBitmap.LockBits(MakeRect(0, 0, LWidth, LHeight), ImageLockModeWrite,
                                   PixelFmt, LBmpData) <> Ok then exit;

  LScanLine   := LBmpData.Scan0;
  LDataStride := LBmpData.Stride;

  for LYPos := 0 to LHeight - 1 do begin
    LpRGBQuad  := PRGBQuad(LScanLine);
    LScanArray := SrcBitmap.ScanLine[LYPos];

    for LXPos := 0 to LWidth - 1 do begin

      LAValue := LScanArray[LXPos].rgbReserved;
      LRValue := LScanArray[LXPos].rgbRed;
      LGValue := LScanArray[LXPos].rgbGreen;
      LBValue := LScanArray[LXPos].rgbBlue;

      if (RGB(LRValue, LGValue, LBValue) = 0) and (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved :=  0;
      end else
      if (LAValue = 0) then begin
        LpRGBQuad^.rgbReserved := $FF;
      end else begin
        LpRGBQuad^.rgbRed := LRValue;
        LpRGBQuad^.rgbGreen := LGValue;
        LpRGBQuad^.rgbBlue := LBValue;
        LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      end;
      //色の塗り潰しの色指定が全てARGBで指定可能であればこの1行だけでよい
      //LpRGBQuad^.rgbReserved := LScanArray[LXPos].rgbReserved;
      Inc(LpRGBQuad);
    end;
    Inc(LScanLine, LDataStride);
  end;

  Result := True;
  DstGPBitmap.UnlockBits(LBmpData);
end;

  //-----------------------------------------------------------------------------
//  TGPBitmap を TBitmap に変換
//-----------------------------------------------------------------------------
function TplBaseDragResize.GPBitmapToBitmap(SrcGPBitmap: TGPBitmap;
  DstBitmap: TBitmap): Boolean;
var
  LhBitmap : HBITMAP;
begin
  DstBitmap.AlphaFormat := afDefined;
  SrcGPBitmap.GetHBITMAP(0, LhBitmap);
  DstBitmap.Handle := LhBitmap;
  Result := True;
end;

//-----------------------------------------------------------------------------
//  拡張描画領域用
//  引数のTGPBitmap(描画されているTGPBitmap)から実際の画像部分だけを取得
//  リージョンを作成してそのリージョンの位置から画像部分をコピーする
//-----------------------------------------------------------------------------
function TplBaseDragResize.GetExtendGPbitmap(AGPBitmap: TGPBitmap): TGPBitmap;
var
  LRetGPBitmap : TGPBitmap;
  LGPImageRgn  : TGPRegion;
  LGPGraphics  : TGPGraphics;
  LRgnRect     : TGPRect;
begin
  if not FUseExtend then begin
    Result := TGPBitmap(AGPBitmap.Clone);
    Exit;
  end;

  LGPImageRgn := TGPRegion.Create;
  try
  　GetRegionFromGPBitmap(AGPBitmap, LGPImageRgn);
    LGPGraphics := TGPGraphics.Create(Canvas.Handle);
    LGPImageRgn.GetBounds(LRgnRect, LGPGraphics);

    FreeAndNil(LGPGraphics);

    LRetGPBitmap := TGPBitmap.Create(LRgnRect.Width, LRgnRect.Height);
    LGPGraphics  := TGPGraphics.Create(LRetGPBitmap);

    LGPGraphics.DrawImage(AGPBitmap,
                          MakeRect(0, 0, LRgnRect.Width, LRgnRect.Height),
                          LRgnRect.X,
                          LRgnRect.Y,
                          LRgnRect.Width,
                          LRgnRect.Height,
                          UnitPixel);
    Result := TGPBitmap(LRetGPBitmap.Clone);
  finally
    FreeAndNil(LGPGraphics);
    FreeAndNil(LGPImageRgn);
    FreeAndNil(LRetGPBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  リージョンの作成用関数
//  拡張描画領域用
//  透明色以外のピクセルをリージョンにする
//  このリージョンを利用して実際の描画開始位置とサイズを取得する
//-----------------------------------------------------------------------------
function TplBaseDragResize.GetRegionFromGPBitmap(GDPBitmap: TGPBitmap;
  GDPRegion: TGPRegion): Boolean;
var
  LImgWidth   : Integer;
  LImgHeight  : Integer;
  LBmpData    : TBitmapData;
  LScanLine   : PByte;
  LpQuad      : PRGBQuad;
  LDataStride : Integer;
  LXPos       : integer;
  LYPos       : Integer;
  LAValue     : Byte;
  LRgnRect    : TGPRect;
  LInImage    : Boolean;
begin
  Result := False;
  GDPRegion.MakeEmpty;

  LImgWidth  := GDPBitmap.GetWidth;
  LImgHeight := GDPBitmap.GetHeight;

  //ビットマップとしてのデータを取得
  LRgnRect := MakeRect(0, 0, 0, 0);
  if GDPBitmap.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight),ImageLockModeWrite,
                        PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  LScanLine   := LBmpData.Scan0;
  LDataStride := LBmpData.Stride;

  LInImage := False;

  //リージョンの領域矩形(ピクセル数の初期値は0
  //透明色以外の時はそのピクセルを追加してUnionしていく
  LRgnRect := MakeRect(0, 0, 0, 0);

  for LYPos := 0 to LImgHeight - 1 do begin
    LpQuad := PRGBQuad(LScanLine);

    for LXPos := 0 to LImgWidth - 1 do begin
      LAValue    := LpQuad^.rgbReserved;

      if not LInImage then begin
        if LAValue <> 0 then begin
          LInImage   := True;
          LRgnRect.X := LXPos;
          LRgnRect.Y := LYPos;
          LRgnRect.Height := 1;
        end;
      end else begin
        if LAValue = 0 then begin
          LInImage       := False;
          LRgnRect.Width := LXPos - LRgnRect.X;
          GDPRegion.Union(LRgnRect);
        end;
      end;
      Inc(LpQuad);
    end;
    if LInImage then begin
      LInImage := False;
      LRgnRect.Width := LImgWidth - LRgnRect.X;
      GDPRegion.Union(LRgnRect);
    end;
    Inc(LScanLine, LDataStride);
  end;
  Result := True;

  GDPBitmap.UnlockBits(LBmpData);
end;

//-----------------------------------------------------------------------------
//  GDI+ を使用しない DrawRoutine で使用するメソッド
//  描画先の TBitmap とその TCanvas を設定
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetBitmapCanvas_forDraw(ABitmap: TBitmap; var ACanvas: TCanvas;
  ATransColor: TColor);
begin
  ABitmap.SetSize(Width + FAddExtend * 2, Height + FAddExtend * 2);
  ABitmap.PixelFormat := pf32bit;
  ABitmap.AlphaFormat := afIgnored;
  ACanvas := ABitmap.Canvas;
  ACanvas.Brush.Color := ATransColor;
  ACanvas.FillRect(ACanvas.ClipRect);
end;


//-----------------------------------------------------------------------------
//  GDI+ を使用しない DrawRoutine で使用するメソッド
//  描画を AGPBitmap (TGPBitmap) に返す処理
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.BitmapToGPBitmap_forDraw(ABitmap: TBitmap; AGPBitmap: TGPBitmap;
  ATransColor: TColor; AOffsetX: Integer; AOffsetY: Integer);
  var
    LTempGPBmp : TGPBitmap;
    LGPGraphic : TGPGraphics;
    LWidth     : Integer;
  LHeight      : Integer;
  begin
    LWidth  := ABitmap.Width;
    LHeight := ABitmap.Height;
    LTempGPBmp := TGPBitmap.Create(LWidth, LHeight);
    try
      // ここで透過色を透明に変えてアルファチャンネル付きの TBitmap にする
      SetColorToAlphaZero(ABitmap, ATransColor);
      ABitmap.AlphaFormat := afDefined;
      // TBitmap を TGPBitmap に変換
      BitmapToGPBitmap(ABitmap, LTempGPBmp, PixelFormat32bppARGB);

      // 描画先を AGPBitmap にした TGPGraphics に LTempGPBmp を描画
      if FUseExtend then begin
        LGPGraphic := TGPGraphics.Create(AGPBitmap);
        LGPGraphic.DrawImage(LTempGPBmp, AOffsetX, AOffsetY);
      end else begin
        LGPGraphic := TGPGraphics.Create(AGPBitmap);
        LGPGraphic.DrawImage(LTempGPBmp, AOffsetX, AOffsetY);
      end;
    finally
      FreeAndNil(LTempGPBmp);
      FreeAndNil(LGPGraphic);
    end;
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);

  FSignX := Sign(FDrawWidth);
  FSignY := Sign(FDrawHeight);
end;

//=============================================================================
//  Invalidate メソッド
//=============================================================================
procedure TplBaseDragResize.Invalidate;
begin
  if (FUseExtend and Assigned(FExtendCtrl)) then begin
    FExtendCtrl.Invalidate;
  end;
  inherited;
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;

   //描画ルーチンの実行
  if Assigned(FExtendCtrl) then begin
    DrawRoutine(FExtendCtrl.Canvas);
  end else begin
    DrawRoutine(Canvas);
  end;

  // ラバーバンドの位置とサイズ設定
  SetBounds(Left, Top, Width, Height);
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;

{ TplBaseExtendCtrl }

//=============================================================================
//  拡張描画用コントロール
//  コンストラクタ
//=============================================================================
constructor TplBaseExtendCtrl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ParentColor := False;
  Canvas.Brush.Style := bsClear;
  FBaseCtrl := TplBaseDragResize(AOwner);
  FBaseCtrl.ExtendCtrl := Self;
  FBaseCtrl.UseExtend := True;
end;

//=============================================================================
//  拡張描画用コントロール
 //  CM_HITTESTメッセージ処理
 //  マウスイベントは全て透過とする
//=============================================================================
procedure TplBaseExtendCtrl.CMHitTest(var Message: TCMHitTest);
begin
  Message.Result := HTNOWHERE;
end;

//=============================================================================
//  拡張描画用コントロール
//  Paint メソッド
//  ここで描画ルーチンを実行する
//=============================================================================
procedure TplBaseExtendCtrl.Paint;
begin
  inherited;
  FBaseCtrl.DrawRoutine(Canvas);
end;

end.