[ 移動リサイズサンプル ] [ R020_背景として使用するコンテナ用のコントロール ]

unit plContainerPanel;

interface

uses
  Windows, Messages,SysUtils, Classes, Graphics, Controls, StdCtrls, ExtCtrls,
  Forms, plBaseDragResize, GDIPAPI, GDIPOBJ, GDIPUTIL, Generics.Collections;

type
  TplContainerPanel = class;

  TplCtrlList = class(TList<TplBaseDragResize>)
  private
    function GetFItemIndex: Integer;
    procedure SetFItemIndex(const Value: Integer);
  protected
    procedure Notify(const Item: TplBaseDragResize; Action:
      TCollectionNotification); override;
  published
  public
    procedure Clear;
    function SelCount: Integer;
    property ItemIndex  : Integer read GetFItemIndex write SetFItemIndex;
  end;

  TplContainerPanel = class(TCustomPanel)
  private
    FCtrlList         : TplCtrlList;
    FBackImagePath    : string;
    FBackBitmap       : TBitmap;
    FBackImage        : Boolean;
    FExitMouseEvent   : Boolean;
    FDragFlag         : Boolean;
    FDragStartY       : Integer;
    FDragStartX       : Integer;
    FRubberShape      : TShape;
    FSelectMode       : Boolean;
    FPtInAnyCtrlRect  : Boolean;
    FZoomOriginValue  : Integer;
    FZoomBeforeValue  : Integer;
    FZoomCurrensValue : Integer;
    FZoomValue        : Integer;
    procedure SetBackImage(const Value: Boolean);
    procedure SetFExitMouseEvent(const Value: Boolean);
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MoveResizeControlByKey(ALeft, ATop, AWidth, AHeight,
      AdecX, AdecY, AdecW, AdecH: Integer);
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    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 DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
    procedure WMCreatedresizecontrol(var Message: TMessage);
      message WM_CREATED_RESIZECONTROL;
    procedure CMColorchanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function PtInResizeCtrl(X, Y: Integer; ACtrl: TplBaseDragResize): Boolean;
    function GetPtInResizeCtrl(X, Y: Integer): TplBaseDragResize;
    procedure SelectAllCtrls;
    procedure DeSelectAllCtrls;
    procedure DeleteCtrl(AIndex: Integer = -1);
    procedure DeleteAllCtrls;
    procedure BringToFrontCtrl(AIndex: Integer = -1);
    procedure SendToBackCtrl(AIndex: Integer = -1);
    procedure SetZOrderCtrl(ACtrl: TplBaseDragResize; NewIndex: Integer=-1); overload;
    procedure SetZOrderCtrl(OldIndex: Integer; NewIndex: Integer=-1); overload;
    procedure SetZoomValue(AZoomValue: Integer = 100);
    function SelectedCtrlsRect: TRect;
    function LocatedCtrlsRange: TPoint;
    procedure AlignSelectedCtrls(AType: TAlign);
    procedure CascadeSelectedCtrls(ADistance: Integer);
    function GPBitmapFromSelectedCtrls: TGPBitmap;
    procedure BitmapFromSelectedCtrls(ABitmap: TBitmap);
    property ExitMouseEvent : Boolean read FExitMouseEvent write SetFExitMouseEvent;
  published
    property Align;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnKeyDown;
    property PopupMenu;
    property Color;
    property CtrlList   : TplCtrlList read FCtrlList;
    property BackImage  : Boolean read FBackImage   write SetBackImage;
    property SelectMode : Boolean read FSelectMode  write FSelectMode;
    property ZoomValue  : Integer read FZoomValue;
  end;

implementation

uses
  Math,
  plGPResizeLine;

{TplContainerPanel}

type
  TContainerCtrl  = class(TCustomPanel);
  TBaseResizeCtrl = class(TplBaseDragResize);

var
  FSelfBackControl : TplContainerPanel;

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

  DoubleBuffered   := True;
  ParentBackground := False;
  //[csOpaque]は必要に応じて...
  ControlStyle := ControlStyle + [csOpaque];

  FSelfBackControl  := Self;

  FZoomOriginValue  := 100;
  FZoomBeforeValue  := FZoomOriginValue;
  FZoomCurrensValue := FZoomOriginValue;
  FZoomValue        := 100;

  FSelectMode      := False;
  FPtInAnyCtrlRect := False;

  FCtrlList := TplCtrlList.Create;

  BorderStyle := bsNone;
  Color       := clWhite;
  FBackImage  := False;

  FBackBitmap    := TBitmap.Create;
  FBackImagePath := ExpandFileName('backTexture_01.bmp');
  if FileExists(FBackImagePath) then begin
    FBackBitmap.LoadFromFile(FBackImagePath);
  end;
end;

//=============================================================================
//  デコンストラクタ
//=============================================================================
destructor TplContainerPanel.destroy;
begin
  FreeAndNil(FCtrlList);
  FreeAndNil(FBackBitmap);

  inherited;
end;

//-----------------------------------------------------------------------------
//  描画コントロールが生成されてParentの設定が終了した時のメッセージ
//  描画コントロールから送られてくるメッセージ
//
//  管理用の配列に追加
//  拡大表示中に描画コントロールを追加した場合，その描画コントロールも拡大
//
//  [備考]
//  コントロール生成を検出だけであればCM_CONTROLCHANGEメッセージが使用可能
//  CM_CONTROLCHANGEは子コントロールの生成，削除の際に発生する
//-----------------------------------------------------------------------------
procedure TplContainerPanel.WMCreatedresizecontrol(
  var Message: TMessage);
var
  LCtrl : TplBaseDragResize;
begin
  LCtrl := TplBaseDragResize(Message.WParam);
  FCtrlList.Add(LCtrl);
  SetZoomValue(-1);
end;

//=============================================================================
//  Paintメソッド
//  背景用の画像を描画
//=============================================================================
procedure TplContainerPanel.Paint;
var
  LBitmap : TBitmap;
begin
  inherited;

  if (Assigned(FBackBitmap)) and FBackImage then begin
    LBitmap := TBitmap.Create;
    try
      //大きなサイズになるとリソース不足になる
      LBitmap.SetSize(Width, Height);
      LBitmap.Canvas.Brush.Bitmap := FBackBitmap;
      LBitmap.Canvas.FillRect(LBitmap.Canvas.ClipRect);
      Canvas.Draw(0, 0, LBitmap);
    finally
      FreeAndNil(LBitmap);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  CM_COLORCHANGEDメッセージ処理
//  色を変更すると背景画像が非表示になるのでプロパティを変更しておく
//-----------------------------------------------------------------------------
procedure TplContainerPanel.CMColorchanged(var Message: TMessage);
begin
  inherited;
  if not Assigned(Parent) then exit;

  FBackImage := False;
  Invalidate;
end;

//-----------------------------------------------------------------------------
//  BackImageプロパティの設定用メソッド
//  背景画像の表示・非表示の切り換え
//-----------------------------------------------------------------------------
procedure TplContainerPanel.SetBackImage(const Value: Boolean);
begin
  if Value <> FBackImage then begin
    FBackImage := Value;
    Invalidate;
  end;
end;

//=============================================================================
//  DoContextPopupメソッド
//
//  カーソルが描画コントロールの矩形領域内にある時だけポップアップメニューを表示
//  複数のコントロールが選択状態になっていない時は無効
//
//  [備考]
//  複数の描画コントロールが選択状態の時はマウスイベントが透過状態になっている
//  したがって FindDragTarget関数ではコントロールの検出はできない
//=============================================================================
procedure TplContainerPanel.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
var
  LPos    : TPoint;
  LCtrl   : TplBaseDragResize;
  LCtrlNo : Integer;
  LSelCnt : Integer;
  LFlag   : Boolean;
begin
  inherited;
  if not Assigned(PopupMenu) then exit;

  PopupMenu.AutoPopup := False;
  LPos.X := MousePos.X;
  LPos.Y := MousePos.Y;

  LFlag   := False;
  LSelCnt := 0;
  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LCtrlNo];
    if LCtrl.Selected then  Inc(LSelCnt);
    if PtInResizeCtrl(LPos.X, LPos.Y, LCtrl) then begin
      LFlag := True;
    end;
  end;

  if LFlag and (LSelCnt >= 2) then begin
    LPos := ClientToScreen(MousePos);
    PopupMenu.Popup(LPos.X, LPos.Y);
  end else begin
    Handled := True;
  end;
end;

//-----------------------------------------------------------------------------
//  指定したインデックスの描画コントロールを削除
//  インデックスを指定しない場合は選択中の全てのコントロールを削除
//-----------------------------------------------------------------------------
procedure TplContainerPanel.DeleteCtrl(AIndex: Integer);
var
  LCtrlNo  : Integer;
  LCtrl    : TplBaseDragResize;
  LDelFlag : Boolean;
begin
  if FCtrlList.Count <= 0 then exit;

  LDelFlag := False;
  if AIndex >= 0 then begin
    if AIndex < FCtrlList.Count then begin
      FCtrlList.Delete(AIndex);
      LDelFlag := True;
    end;
  end else begin
    for LCtrlNo := FCtrlList.Count - 1 downto 0 do begin
      LCtrl := FCtrlList[LCtrlNo];
      if LCtrl.Selected then begin
        FCtrlList.Delete(LCtrlNo);
        LDelFlag := True;
      end;
    end;
  end;

  //Zオーダが最上位のコントロールを選択状態にする
  AIndex := FCtrlList.Count - 1;
  if (AIndex >= 0) and LDelFlag then begin
    FCtrlList[AIndex].Selected := True;
  end;
end;

//-----------------------------------------------------------------------------
//  表示中の全ての描画コントロールを削除
//-----------------------------------------------------------------------------
procedure TplContainerPanel.DeleteAllCtrls;
begin
  FCtrlList.Clear;
end;

//-----------------------------------------------------------------------------
//  表示中の全ての描画コントロールを選択
//-----------------------------------------------------------------------------
procedure TplContainerPanel.SelectAllCtrls;
var
  LCtrl   : TplBaseDragResize;
  LCtrlNo : Integer;
begin
  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LCtrlNo];
    LCtrl.Selected     := True;
    LCtrl.Mousethrough := True;
  end;
end;

//-----------------------------------------------------------------------------
//  全てのコントロールの選択を解除
//-----------------------------------------------------------------------------
procedure TplContainerPanel.DeSelectAllCtrls;
var
  LCtrl   : TplBaseDragResize;
  LCtrlNo : Integer;
begin
  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LCtrlNo];
    LCtrl.Selected     := False;
    LCtrl.Mousethrough := False;
  end;
end;

//-----------------------------------------------------------------------------
//  指定インデックスの描画コントロールを最前面に移動
//  インデックスの指定がない場合は選択中の描画コントロールが対象
//
//  Mousethroughは複数の描画コントロールが選択状態の検出に使用している
//  MousethroughがTrueの描画コントロールが1つでもあると複数選択状態
//-----------------------------------------------------------------------------
procedure TplContainerPanel.BringToFrontCtrl(AIndex: Integer);
var
  LCtrlNo : Integer;
  LCtrl   : TplBaseDragResize;
begin
  if AIndex >= 0 then begin
    if AIndex < FCtrlList.Count then begin
      LCtrl := FCtrlList[AIndex];
      LCtrl.BringToFront;
      FCtrlList.Move(AIndex, FCtrlList.Count -1);
    end;
  end else begin
    for LCtrlNo := FCtrlList.Count - 1 downto 0 do begin
      LCtrl := FCtrlList[LCtrlNo];
      if (LCtrl.Selected) and (not LCtrl.Mousethrough) then begin
        LCtrl.BringToFront;
        FCtrlList.Move(LCtrlNo, FCtrlList.Count -1);
        break;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  指定インデックスの描画コントロールを最背面に移動
//  インデックスの指定がない場合は選択中の描画コントロールが対象
//
//  Mousethroughは複数の描画コントロールが選択状態の検出に使用している
//  MousethroughがTrueの描画コントロールが1つでもあると複数選択状態
//-----------------------------------------------------------------------------
procedure TplContainerPanel.SendToBackCtrl(AIndex: Integer);
var
  LCtrlNo : Integer;
  LCtrl   : TplBaseDragResize;
begin
  if AIndex >= 0 then begin
    if AIndex < FCtrlList.Count then begin
      LCtrl := FCtrlList[AIndex];
      LCtrl.SendToBack;
      FCtrlList.Move(AIndex, 0);
    end;
  end else begin
    for LCtrlNo := FCtrlList.Count - 1 downto 0 do begin
      LCtrl := FCtrlList[LCtrlNo];
      if (LCtrl.Selected) and (not LCtrl.Mousethrough) then begin
        LCtrl.SendToBack;
        FCtrlList.Move(LCtrlNo, 0);
        break;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  指定描画コントロールを指定Zオーダにする
//  第2引数の値がデフォルトの-1の時は最前面にする
//-----------------------------------------------------------------------------
procedure TplContainerPanel.SetZOrderCtrl(ACtrl: TplBaseDragResize;
  NewIndex: Integer);
var
  LOldIndex : Integer;
  LCtrlNo   : Integer;
begin
  if ACtrl = nil then exit;
  if (NewIndex < -1) or (NewIndex >= FCtrlList.Count) then exit;

  //引数のインデックスの描画コントロールのインスタンスを取得
  LOldIndex := FCtrlList.IndexOf(ACtrl);
  if NewIndex = -1 then NewIndex := FCtrlList.Count - 1;
  if LOldIndex = NewIndex then exit;

  FCtrlList.Move(LOldIndex, NewIndex);
  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    FCtrlList[LCtrlNo].BringToFront;
  end;
end;

//-----------------------------------------------------------------------------
//  指定インデックスの描画コントロールを指定Zオーダにする
//  第2引数の値がデフォルトの-1の時は最前面にする
//-----------------------------------------------------------------------------
procedure TplContainerPanel.SetZOrderCtrl(OldIndex, NewIndex: Integer);
var
  LCtrlNo : Integer;
begin
  if (OldIndex < 0)  or (OldIndex >= FCtrlList.Count) then exit;
  if (NewIndex < -1) or (NewIndex >= FCtrlList.Count) then exit;

  if NewIndex = -1 then NewIndex := FCtrlList.Count - 1;
  if OldIndex = NewIndex then exit;

  FCtrlList.Move(OldIndex, NewIndex);
  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    FCtrlList[LCtrlNo].BringToFront;
  end;
end;

//-----------------------------------------------------------------------------
//  選択中の描画コントロールの整列
//  左端揃え，上端揃え，右端揃え，下端揃え，左右中央揃え
//  alCustomを指定すると左右中央揃え
//-----------------------------------------------------------------------------
procedure TplContainerPanel.AlignSelectedCtrls(AType: TAlign);
var
  LSelRect  : TRect;
  LSelWidth : Integer;
  LNo       : Integer;
  LCtrl     : TplBaseDragResize;
  LExtend   : Integer;
begin
  //選択中のコントロールのTRectの値を取得
  LSelRect := SelectedCtrlsRect;

  case AType of
  alLeft:
    begin
      for LNo := 0 to FCtrlList.Count - 1 do begin
        LCtrl := FCtrlList[LNo];
        if (LCtrl.Selected) and (LCtrl.Visible) then begin
          if LCtrl is TplGPResizeLine then begin
            LExtend    := LCtrl.Left - TplGPResizeLine(LCtrl).ExtendLeft;
            LCtrl.Left := LSelRect.Left + LExtend;
          end else begin
            LCtrl.Left := LSelRect.Left;
          end;
        end;
      end;
    end;
  alTop:
    begin
      for LNo := 0 to FCtrlList.Count - 1 do begin
        LCtrl := FCtrlList[LNo];
        if (LCtrl.Selected) and (LCtrl.Visible) then begin
          if LCtrl is TplGPResizeLine then begin
            LExtend   := LCtrl.Top - TplGPResizeLine(LCtrl).ExtendTop;
            LCtrl.Top := LSelRect.Left + LExtend;
          end else begin
            LCtrl.Top := LSelRect.Top;
          end;
        end;
      end;
    end;
  alRight:
    begin
      for LNo := 0 to FCtrlList.Count - 1 do begin
        LCtrl := FCtrlList[LNo];
        if (LCtrl.Selected) and (LCtrl.Visible) then begin
          if LCtrl is TplGPResizeLine then begin
            LExtend    := LSelRect.Right - TplGPResizeLine(LCtrl).ExtendRight;
            LCtrl.Left := LCtrl.Left + LExtend;
          end else begin
            LCtrl.Left := LSelRect.Right - LCtrl.Width;
          end;
        end;
        Application.ProcessMessages;
        Sleep(1);
      end;
    end;
  alBottom:
    begin
      for LNo := 0 to FCtrlList.Count - 1 do begin
        LCtrl := FCtrlList[LNo];
        if (LCtrl.Selected) and (LCtrl.Visible) then begin
          if LCtrl is TplGPResizeLine then begin
            LExtend   := LSelRect.Bottom - TplGPResizeLine(LCtrl).ExtendBottom;
            LCtrl.Top := LCtrl.Top + LExtend;
          end else begin
            LCtrl.Top := LSelRect.Bottom - LCtrl.Height;
          end;
        end;
      end;
    end;
  alCustom:
    begin
      LSelWidth := LSelRect.Right - LSelRect.Left;
      for LNo := 0 to FCtrlList.Count - 1 do begin
        LCtrl := FCtrlList[LNo];
        if (LCtrl.Selected) and (LCtrl.Visible) then begin
          if LCtrl is TplGPResizeLine then begin
            LExtend    := TplGPResizeLine(LCtrl).ExtendWidth;
            LCtrl.Left := LSelRect.Left + (LSelWidth - LExtend) div 2;
          end else begin
            LCtrl.Left := LSelRect.Left + (LSelWidth - LCtrl.Width) div 2;
          end;
        end;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  選択中の描画コントロールをカスケード整列するメソッド
//  直線描画コントロールの拡張領域は考慮していない
//-----------------------------------------------------------------------------
procedure TplContainerPanel.CascadeSelectedCtrls(ADistance: Integer);
var
  LLeft  : Integer;
  LTop   : Integer;
  LNo    : Integer;
  LSelNo : Integer;
  LCtrl  : TplBaseDragResize;
begin
  LLeft  := 0;
  LTop   := 0;
  LSelNo := 1;

  for LNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LNo];
    if (LCtrl.Selected) and (LCtrl.Visible) then begin
      LCtrl.Left := LLeft + (LSelNo - 1) * ADistance;
      LCtrl.Top  := LTop  + (LSelNo - 1) * ADistance;
      inc(LSelNo);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  選択中の描画コントロールの描画を1つのTGPBitmapにする関数
//  表示サイズ(反転状態も含めて)の状態で取得する
//
//  呼び出し側ではTGPBimapを生成しなくてもよい
//  生成してもよいが，設定内容は破棄される
//  結果のTBitmapは呼出し側で解放，破棄する
//-----------------------------------------------------------------------------
function TplContainerPanel.GPBitmapFromSelectedCtrls:
  TGPBitmap;
var
  LCtrl      : TplBaseDragResize;
  LSelRect   : TRect;
  LNo        : Integer;
  LGPBitmap  : TGPBitmap;
  LSelWidth  : Integer;
  LselHeight : Integer;
  LSelLeft   : Integer;
  LSelTop    : Integer;
  LCtrlLeft  : Integer;
  LCtrlTop   : Integer;
begin
  LSelRect   := SelectedCtrlsRect;
  LSelWidth  := LSelRect.Right  - LSelRect.Left;
  LselHeight := LSelRect.Bottom - LSelRect.Top;
  LSelLeft   := LSelRect.Left;
  LSelTop    := LSelRect.Top;

  LGPBitmap := TGPBitmap.Create(LSelWidth, LselHeight);
  try
    for LNo := 0 to FCtrlList.Count - 1 do begin
      LCtrl := FCtrlList[LNo];

      if LCtrl.Visible then begin
        if (LCtrl.Selected) or (LCtrl.DispOnly) then begin
          if LCtrl is TplGPResizeLine then begin
            LCtrlLeft := TplGPResizeLine(LCtrl).ExtendLeft;
            LCtrlTop  := TplGPResizeLine(LCtrl).ExtendTop;
          end else begin
            LCtrlLeft := LCtrl.Left;
            LCtrlTop  := LCtrl.Top;
          end;
          LCtrl.DrawRoutine(nil, LGPBitmap, LCtrlLeft - LSelLeft, LCtrlTop - LSelTop);
        end;
      end;
    end;

    Result := TGPBitmap(LGPBitmap.Clone);
  finally
    FreeAndNil(LGPBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  選択中の描画コントロールの描画を1つのTBitmapにするメソッド
//  表示サイズ(反転状態も含めて)の状態で取得する
//
//  呼び出し側ではTBimapを生成しておくこと
//  解放，破棄も呼出し側で行う．使用方法がTGPBitmap取得の関数と違うので注意
//-----------------------------------------------------------------------------
procedure TplContainerPanel.BitmapFromSelectedCtrls(ABitmap: TBitmap);
var
  LGPBitmap  : TGPBitmap;
  LImgGUID   : TGUID;
  LMemStream : TMemoryStream;
begin
  LMemStream := TMemoryStream.Create;
  LGPBitmap  := GPBitmapFromSelectedCtrls;
  try
    if GetEncoderClsid('image/bmp', LImgGUID) >= 0 then begin
      LGPBitmap.Save(TStreamAdapter.Create(LMemStream), LImgGUID);
      LMemStream.Position := 0;
      ABitmap.LoadFromStream(LMemStream);
    end;
  finally
    FreeAndNil(LGPBitmap);
    FreeAndNil(LMemStream);
  end;
end;

//-----------------------------------------------------------------------------
//  拡大または縮小表示メソッド
//  アンチエイリアスの処理なしで表示
//  引数の値が100の時は元の表示倍率
//  1000の時は10倍，50の時は1/2の縮小表示
//
//  -1は新規に描画コントロールが追加された時に実行
//-----------------------------------------------------------------------------
procedure TplContainerPanel.SetZoomValue(AZoomValue: Integer);
var
  LCtrl    : TplBaseDragResize;
  LCtrlNo  : Integer;
  LStartNo : Integer;
  LTempInt : Integer;
begin
  if (AZoomValue > 1500) or ((AZoomValue < 20) and (AZoomValue <> -1)) then exit;


  if AZoomValue = 100 then begin
    if FZoomCurrensValue = FZoomOriginValue then exit;

    SetBounds(Left, Top, Width * 100 div FZoomValue, Height * 100 div FZoomValue);
    FZoomValue := 100;

    for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
      LCtrl := FCtrlList[LCtrlNo];

      TContainerCtrl(LCtrl).ScaleBy(FZoomOriginValue, FZoomCurrensValue);
      TBaseResizeCtrl(LCtrl).ZoomValue := FZoomValue;

      LCtrl.Left := Trunc(LCtrl.Left * FZoomOriginValue / FZoomCurrensValue);
      LCtrl.Top  := Trunc(LCtrl.Top  * FZoomOriginValue / FZoomCurrensValue);
    end;
    FZoomBeforeValue  := FZoomOriginValue;
    FZoomCurrensValue := FZoomOriginValue;
  end else begin
    if AZoomValue = -1 then begin
      LStartNo := FCtrlList.Count - 1;
      if FZoomOriginValue = FZoomCurrensValue then exit;
      FZoomBeforeValue := FZoomOriginValue;
    end else begin
      LStartNo := 0;
      LTempInt := FZoomCurrensValue div  FZoomBeforeValue * FZoomOriginValue;
      FZoomCurrensValue := LTempInt * AZoomValue div 100;
      if FZoomCurrensValue = FZoomBeforeValue then exit;
    end;

    FZoomValue := Trunc(FZoomCurrensValue / FZoomOriginValue * 100);
    if AZoomValue <> -1 then begin
      SetBounds(Left, Top, Trunc(Width * FZoomCurrensValue / FZoomBeforeValue),
                           Trunc(Height * FZoomCurrensValue / FZoomBeforeValue));
    end;

    for LCtrlNo := LStartNo to FCtrlList.Count - 1 do begin
      LCtrl := FCtrlList[LCtrlNo];

      TContainerCtrl(LCtrl).ScaleBy(FZoomCurrensValue, FZoomBeforeValue);

      LCtrl.Left := Trunc(LCtrl.Left * FZoomCurrensValue / FZoomBeforeValue);
      LCtrl.Top  := Trunc(LCtrl.Top  * FZoomCurrensValue / FZoomBeforeValue);
      TBaseResizeCtrl(LCtrl).ZoomValue := FZoomValue;

      if LCtrl.Selected then begin
        LCtrl.Selected := False;
        LCtrl.Selected := True;
      end;
    end;
    FZoomBeforeValue := FZoomCurrensValue;
  end;
end;

//=============================================================================
//  WM_GETDLGCODEメッセージ処理
//  KeyDownで特殊キーを検出するには，WM_GETDLGCODEメッセージの処理が必要
//  このコントロールが親フォームでActiveControlになっている必要がある
//=============================================================================
procedure TplContainerPanel.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  //DLGC_WANTARROWSを指定して，矢印キーを要求
  Message.Result := DLGC_WANTARROWS;
end;

//=============================================================================
//  KeyDownメソッド
//  [Shift]キーが押下されていない場合は1ドットづつの移動
//  [Shfit]キーが押下されていれば右端方向または下端方向へのリサイズ
//=============================================================================
procedure TplContainerPanel.KeyDown(var Key: Word; Shift: TShiftState);
var
  LdecX      : Integer;
  LdecY      : Integer;
  LdecW      : Integer;
  LdecH      : Integer;
  LZoomValue : Integer;
  LRect      : TRect;
  LLeft      : Integer;
  LTop       : Integer;
  LWidth     : Integer;
  LHeight    : Integer;
begin
  inherited;
  if FCtrlList.Count <= 0 then exit;

  //[ESC]で選択操作を強制終了
  if Key = VK_ESCAPE then begin
    FDragFlag   := False;
    if Assigned(FRubberShape) then FreeAndNil(FRubberShape);

    ClipCursor(nil);
    SetCaptureControl(nil);
    Screen.Cursor := crDefault;
    exit;
  end;
  if (Key < VK_LEFT) or (Key > VK_DOWN) then exit;

  LZoomValue := FZoomCurrensValue div 100;
  if LZoomValue < 0 then LZoomValue := 1;

  LdecX := 0;
  LdecY := 0;
  LdecW := 0;
  LdecH := 0;

  Screen.Cursor := crDefault;
  //[Shift\キーが押されている場合はリサイズ
  if (ssShift in Shift) then begin
    if Key = VK_LEFT  then LdecW := -LZoomValue;
    if Key = VK_RIGHT then LdecW := LZoomValue;
    if Key = VK_UP    then LdecH := -LZoomValue;
    if Key = VK_DOWN  then LdecH := LZoomValue;
  end else begin
    if Key = VK_LEFT  then LdecX := -LZoomValue;
    if Key = VK_RIGHT then LdecX := LZoomValue;
    if Key = VK_UP    then LdecY := -LZoomValue;
    if Key = VK_DOWN  then LdecY := LZoomValue;
  end;

  LRect := SelectedCtrlsRect;

  LLeft   := LRect.Left;
  LTop    := LRect.Top;
  LWidth  := Abs(LRect.Right  - LRect.Left);
  LHeight := Abs(LRect.Bottom - LRect.Top);

  MoveResizeControlByKey(LLeft, LTop, LWidth, LHeight, LdecX, LdecY, LdecW, LdecH);
end;

//-----------------------------------------------------------------------------
//  キー操作による移動リサイズ用のメソッド
//
//  引数の値によって描画用コントロールの位置とサイズを設定
//  リサイズはドット単位(比率ではない)
//-----------------------------------------------------------------------------
procedure TplContainerPanel.MoveResizeControlByKey(ALeft, ATop,
   AWidth, AHeight, AdecX, AdecY, AdecW, AdecH: Integer);
var
  LCtrlNo    : Integer;
  LCtrl      : TplBaseDragResize;
  LADecX     : Integer;
  LADecY     : Integer;
  LADecW     : Integer;
  LADecH     : Integer;
  LLeft      : Integer;
  LTop       : Integer;
  LWidth     : Integer;
  LHeight    : Integer;
  LZoomValue : Integer;
  LLimit     : Integer;
begin
  LZoomValue := FZoomCurrensValue div 100;
  if LZoomValue < 0 then LZoomValue := 1;

  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LCtrlNo];

    LADecX := AdecX;
    LADecY := AdecY;
    LADecW := AdecW;
    LADecH := AdecH;
    if LCtrl.DispOnly then begin
       LAdecX := 0;
       LAdecY := 0;
       LAdecW := 0;
       LAdecH := 0;
    end else
    if LCtrl.MoveOnly then begin
      LAdecW := 0;
      LAdecH := 0;
    end else
    if LCtrl.GrabHorzOnly then begin
      LAdecY := 0;
      LAdecH := 0;
    end else
    if LCtrl.GrabVertOnly then begin
      LAdecX := 0;
      LAdecW := 0;
    end;

    if LCtrl.Selected then begin
      if LAdecX < 0 then begin
        if (ALeft + AWidth - 10) < 0 then LAdecX := 0;
      end;
      if LAdecX > 0 then begin
        if ((ALeft + 30) > (Width)) then ScrollBy(-Abs(LAdecX), 0);
      end;
      LLeft := LCtrl.Left + LAdecX;

      if LAdecY < 0 then begin
        if (ATop + AHeight - 10) < 0 then LAdecY := 0;
      end;
      if LAdecY > 0 then begin
        if ((ATop + 30) > (Height)) then ScrollBy(0, -Abs(LAdecY));
      end;
      LTop  := LCtrl.Top  + LAdecY;

      LWidth  := LCtrl.Width  + LAdecW;
      LHeight := LCtrl.Height + LAdecH;

      //一定の値より小さい値にはできないようにする
      LLimit := 1;
      if LWidth  <= (LLimit * LZoomValue) then LWidth  := (LLimit * LZoomValue);
      if LHeight <= (LLimit * LZoomValue) then LHeight := (LLimit * LZoomValue);

      LCtrl.SetBounds(LLeft, LTop, LWidth, LHeight);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  選択中の描画コントロールの選択領域の位置とサイズを計算
//-----------------------------------------------------------------------------
function TplContainerPanel.SelectedCtrlsRect: TRect;
var
  LCtrlNo    : Integer;
  LCtrl      : TplBaseDragResize;
  LLeft      : Integer;
  LTop       : Integer;
  LRight     : Integer;
  LBottom    : Integer;
  LExendRect : TRect;
begin
  LLeft   := MaxInt;
  LTop    := MaxInt;
  LRight  := 0;
  LBottom := 0;

  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LCtrlNo];
    if (LCtrl.Selected) then begin
      if LCtrl is TplGPResizeLine then begin
        LExendRect := TplGPResizeLine(LCtrl).ExtendRect;
        //直線描画クラスは別扱い(描画領域が拡張されている)
        LLeft   := Min(LLeft,   LExendRect.Left);
        LTop    := Min(LTop,    LExendRect.Top);
        LRight  := Max(LRight,  LExendRect.Right);
        LBottom := Max(LBottom, LExendRect.Bottom);
      end else begin
        LLeft   := Min(LLeft,   LCtrl.Left);
        LTop    := Min(LTop,    LCtrl.Top);
        LRight  := Max(LRight,  LCtrl.Left + LCtrl.Width);
        LBottom := Max(LBottom, LCtrl.Top  + LCtrl.Height);
      end;
    end;
  end;
  Result := Rect(LLeft, LTop, LRight, LBottom);
end;

//-----------------------------------------------------------------------------
//  配置している描画コントロールを1つにした時の幅と高さを取得する
//  スクロールのRangeの値に相当する値
//-----------------------------------------------------------------------------
function TplContainerPanel.LocatedCtrlsRange: TPoint;
var
  LCtrlNo    : Integer;
  LCtrl      : TplBaseDragResize;
  LRight     : Integer;
  LBottom    : Integer;
  LExendRect : TRect;
begin
  LRight  := 0;
  LBottom := 0;

  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LCtrlNo];
    if LCtrl is TplGPResizeLine then begin
      //直線描画クラスは別扱い(描画領域が拡張されている)
      LExendRect := TplGPResizeLine(LCtrl).ExtendRect;
      LRight  := Max(LRight,  LExendRect.Right);
      LBottom := Max(LBottom, LExendRect.Bottom);
    end else begin
      LRight  := Max(LRight,  LCtrl.Left + LCtrl.Width);
      LBottom := Max(LBottom, LCtrl.Top  + LCtrl.Height);
    end;
  end;
  Result := Point(LRight, LBottom);
end;

//-----------------------------------------------------------------------------
//  マウスカーソル下に指定描画コントロールが存在するかを調べる関数
//-----------------------------------------------------------------------------
function TplContainerPanel.PtInResizeCtrl(X, Y: Integer;
  ACtrl: TplBaseDragResize): Boolean;
begin
  Result := (X >= ACtrl.Left) and (X <= (ACtrl.Left + ACtrl.Width));
  Result := Result and (Y >= ACtrl.Top) and (Y <= (ACtrl.Top + ACtrl.Height));;
end;

//-----------------------------------------------------------------------------
//  マウスカーソル下の描画コントロールを取得する関数
//-----------------------------------------------------------------------------
function TplContainerPanel.GetPtInResizeCtrl(X, Y: Integer): TplBaseDragResize;
var
  LNo   : Integer;
  LCtrl : TplBaseDragResize;
begin
  Result := nil;
  if FCtrlList.Count = 0 then exit;

  for LNo := FCtrlList.Count -1 downto 0  do begin
    LCtrl := FCtrlList[LNo];
    if PtInResizeCtrl(x, Y, LCtrl) then begin
      Result := LCtrl;
      break;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ExitMouseEventプロパティの設定用メソッド
//  Trueにするこのコントロール本来のマウスイベントは機能しなくなる
//  描画コントロールのマウスイベントも発生しなくなる
//  本コントロール継承クラスで独自のマウス操作コードを実装するのに利用可能
//-----------------------------------------------------------------------------
procedure TplContainerPanel.SetFExitMouseEvent(const Value: Boolean);
var
  LNo : Integer;
begin
  if FExitMouseEvent <> Value then begin
    FExitMouseEvent := Value;

    if FExitMouseEvent then begin
      for LNo := 0 to FCtrlList.Count - 1 do begin
        FCtrlList[LNo].Mousethrough := True;
        TBaseResizeCtrl(FCtrlList[LNo]).ExitMouseEvent := True;
      end;
    end else begin
      for LNo := 0 to FCtrlList.Count - 1 do begin
        FCtrlList[LNo].Mousethrough := False;
        TBaseResizeCtrl(FCtrlList[LNo]).ExitMouseEvent := False;
      end;
    end;
  end;
end;

//=============================================================================
//  MouseDownメソッド
//
//  以下のいずれかの操作
//  (1) 複数のコントロールの選択
//      [Ctrl]キーを押下した状態でマウスでラバーはバンドを描いて選択
//  (2) 選択中の複数の描画コントロールの移動
//  (3) 選択の解除
//      描画コントロール以外のところでマウスの左ボタン押下
//
//  SelectModeプロパティをTrueにするとFalseにするまで複数選択モードとなる
//  [Ctrl]+[マウス左ボタン]押下で複数の描画コントロールを選択できる
//  この機能は描画用の移動リサイズの基本クラスに実装している
//=============================================================================
procedure TplContainerPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  LCtrl        : TplBaseDragResize;
  LCtrlNo      : Integer;
  LMultiSelect : Boolean;
  LClipRect    : TRect;
  LForm        : TCustomForm;
begin
  inherited;

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


  LMultiSelect := False;
  for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
    LCtrl := FCtrlList[LCtrlNo];
    //1つでもマウスイベントが透過状態であれば複数の選択状態とみなす
    if  LCtrl.Mousethrough = True then begin
      LMultiSelect := True;
      Break;
    end;
  end;

  FPtInAnyCtrlRect := False;
  if LMultiSelect then begin
    for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
      LCtrl := FCtrlList[LCtrlNo];
      if PtInResizeCtrl(X, Y, LCtrl) then begin
        if LCtrl.Selected then begin
          FPtInAnyCtrlRect := True;
        end else begin
          FPtInAnyCtrlRect := True;
          DeSelectAllCtrls;
          LCtrl.Selected     := True;
          LCtrl.Mousethrough := False;
        end;
        Break;
      end;
    end;
  end;

  if not FPtInAnyCtrlRect then begin
    if (ssCtrl in Shift) or FSelectMode then begin
      GetWindowRect(Handle, LClipRect);
      ClipCursor(@LClipRect);

      FDragFlag   := True;
      FDragStartX := X;
      FDragStartY := Y;
    end else begin
      DeSelectAllCtrls;
    end;
  end else begin
    //移動開始
    GetWindowRect(Handle, LClipRect);
    ClipCursor(@LClipRect);
    Screen.Cursor := crSizeAll;

    FDragFlag   := True;
    FDragStartX := X;
    FDragStartY := Y;
  end;
end;

//=============================================================================
//  MouseMoveメソッド
//=============================================================================
procedure TplContainerPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  LCtrl    : TplBaseDragResize;
  LCtrlNo  : Integer;
  LIncX    : Integer;
  LIncY    : Integer;
  LLeft    : Integer;
  LTop     : Integer;
  LWidth   : Integer;
  LHeight  : Integer;
  LSumRect : TRect;
begin
  inherited;
  if FExitMouseEvent then exit;
  if not FDragFlag then exit;

  //ラバーバンドの描画
  if not FPtInAnyCtrlRect then begin
    if (X <> FDragStartX) or (Y <> FDragStartY) then begin
      if not Assigned(FRubberShape) then begin
        FRubberShape := TShape.Create(Self);
        FRubberShape.Parent      := Self;
        FRubberShape.Brush.Style := bsClear;
        FRubberShape.Pen.Width   := 2;
        FRubberShape.Pen.Style   := psDot;
      end;

      LLeft   := FDragStartX;
      LTop    := FDragStartY;
      LWidth  := X - FDragStartX;
      LHeight := Y - FDragStartY;

      if LWidth < 0 then begin
        LLeft := FDragStartX - Abs(LWidth);
      end;
      if LHeight < 0 then begin
        LTop := FDragStartY - Abs(LHeight);
      end;
      FRubberShape.SetBounds(LLeft,  LTop, Abs(LWidth), Abs(LHeight));
    end;
  end else begin
    //複数のコントロールの移動処理
    LIncX := X - FDragStartX;
    LIncY := Y - FDragStartY;

    LSumRect := SelectedCtrlsRect;

    //選択中のコントロールを移動する
    for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
      LCtrl := FCtrlList[LCtrlNo];
      if LCtrl.Selected then begin
        LLeft := LCtrl.Left + LIncX;
        LTop  := LCtrl.Top  + LIncY;
        LCtrl.SetBounds(LLeft, LTop, LCtrl.Width, LCtrl.Height);
      end;
    end;
    FDragStartX := X;
    FDragStartY := Y;
  end;
end;

//=============================================================================
//  MouseUpメソッド
//=============================================================================
procedure TplContainerPanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  LLeft       : Integer;
  LTop        : Integer;
  LWidth      : Integer;
  LHeight     : Integer;
  LSelectRect : TRect;
  LRect       : TRect;
  LOutRect    : TRect;
  LCtrl       : TplBaseDragResize;
  LCtrlNo     : Integer;
  LSetCnt     : Integer;
  LZoomValue  : Integer;
  LForm       : TCustomForm;
begin
  inherited;

  //親フォーム検出のこの方法は簡便法
  LForm := GetParentForm(Self);
  if LForm <> nil then begin
    LForm.ActiveControl := Self;
  end;
  if FExitMouseEvent then exit;
  if not FDragFlag then exit;


  LZoomValue := FZoomCurrensValue div FZoomOriginValue;
  if LZoomValue < 0 then LZoomValue := 1;

  FDragFlag := False;

  //ラバーバンド操作中
  //FPtInAnyCtrlRect(MouseDown時のマウスの位置が描画コントロール内)
  if not FPtInAnyCtrlRect then begin
    if Assigned(FRubberShape) then begin
      //ラバーバンド(TShape)の描画終了
      LLeft   := FRubberShape.Left;
      LTop    := FRubberShape.Top;
      LWidth  := FRubberShape.Width;
      LHeight := FRubberShape.Height;

      LSelectRect := Rect(LLeft, LTop,  LLeft + LWidth, LTop + LHeight);

      //コントロールの矩形領域の一部がTShapeの矩形内にあれば選択する
      LSetCnt := 0;
      for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
        LCtrl := FCtrlList[LCtrlNo];
        LRect := Rect(LCtrl.Left,
                      LCtrl.Top,
                      LCtrl.Left + LCtrl.Width,
                      LCtrl.Top  + LCtrl.Height);

        if IntersectRect(LOutRect, LSelectRect, LRect) then begin
          inc(LSetCnt);
          LCtrl.Selected := True;
        end else begin
          LCtrl.Selected     := False;
          LCtrl.Mousethrough := False;
        end;
      end;
      //選択した描画コントロールが2以上の時はそれらのマウス透過をTrueにする
      //マウス透過すとこの背景コントロールかマウスイベントを受け取る
      if LSetCnt >= 2 then begin
        for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
          LCtrl := FCtrlList[LCtrlNo];
          if LCtrl.Selected then begin
            LCtrl.Mousethrough := True;
          end;
        end;
      end;
    end;
    if Assigned(FRubberShape) then FreeAndNil(FRubberShape);
    ClipCursor(nil);
    SetCaptureControl(nil);
    Screen.Cursor := crDefault;
  end else begin
    //複数のコントロールの移動終了
    for LCtrlNo := 0 to FCtrlList.Count - 1 do begin
      LCtrl := FCtrlList[LCtrlNo];
      if LCtrl.Selected then begin
        LLeft := LCtrl.Left div LZoomValue * LZoomValue;
        LTop  := LCtrl.Top  div LZoomValue * LZoomValue;
        LCtrl.SetBounds(LLeft, LTop, LCtrl.Width, LCtrl.Height);
      end;
    end;

    ClipCursor(nil);
    SetCaptureControl(nil);
    Screen.Cursor := crDefault;
  end;
end;

{ TplCtrlList }

//=============================================================================
//  Clearメソッド
//  overrideではなく独自実装
//=============================================================================
procedure TplCtrlList.Clear;
begin
  FSelfBackControl.SetZoomValue();
  Count := 0;
  Capacity := 0;
end;

//=============================================================================
//  TListのItemの追加や削除の時に発生する通知メッセージ処理
//=============================================================================
procedure TplCtrlList.Notify(const Item: TplBaseDragResize;
  Action: TCollectionNotification);
var
  LCtrl   : TplBaseDragResize;
  LCtrlNo : Integer;
  LFlag   : Boolean;
begin
  inherited;

  LFlag := True;
  if Action = cnAdded then begin
    //外部でAddしてしまった場合の処置
    for LCtrlNo := Count - 2 downto 0 do begin
      LCtrl := Items[LCtrlNo];
      if LCtrl = Item then begin
        Extract(Item);
        LFlag := False;
        Break;
      end;
    end;
    //追加した描画コントロールを選択状態にする
    if LFlag then begin
      for LCtrlNo := 0 to Count - 2 do begin
        LCtrl := Items[LCtrlNo];
        LCtrl.Selected := False;
      end;
      Item.Selected := True;
    end;
  end else
  if Action = cnRemoved then begin
    if Item <> nil then begin
      LCtrl := Item;
      FreeAndNil(LCtrl);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  選択中の描画コントロールの数を返す関数
//-----------------------------------------------------------------------------
function TplCtrlList.SelCount: Integer;
var
  LCtrlNo : Integer;
  LSelCnt : Integer;
begin
  LSelCnt := 0;
  for LCtrlNo := 0 to Count - 1 do begin
    if Items[LCtrlNo].Selected then  Inc(LSelCnt);
  end;
  Result := LSelCnt;
end;

//-----------------------------------------------------------------------------
//  ItemIndexプロパティの設定用メソッド
//  選択する描画コントロールを指定する
//  このプロパティで設定すると他の全ての選択は解除される
//-----------------------------------------------------------------------------
procedure TplCtrlList.SetFItemIndex(const Value: Integer);
var
  LCtrlNo : Integer;
begin
  if (Value >= 0) and (Value < Count) then begin
    for LCtrlNo := 0 to Count - 1 do begin
      if Value = LCtrlNo then begin
        Items[LCtrlNo].Selected:= True;
      end else begin
        Items[LCtrlNo].Selected:= False;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ItemIndexプロパティの取得用メソッド
//  選択されていない時は-1を返す
//  複数選択時はZオーダの一番低い描画コントロールのインデックスを返す
//-----------------------------------------------------------------------------
function TplCtrlList.GetFItemIndex: Integer;
var
  LCtrlNo : Integer;
begin
  Result := -1;
  for LCtrlNo := 0 to Count - 1 do begin
    if Items[LCtrlNo].Selected then  begin
      Result := LCtrlNo;
      Break;
    end;
  end;
end;

end.