この発言に対し以下のコメントが寄せられています

#01314　アイクビー      さん　サイズ変更ハンドル(2/2)






Delphiの設計時のフォーム上のコントロールとか、PowerPointの図形のようなも
のを作ることができます。行数が多いので、残りはこの発言のコメントとしてア
ップロードしておきます。

TShapeのPenとかBrushのプロパティをいろいろ試しているうちに、面倒なので実
行時にメニューで変えられるようにしてみました。背景も変えたいのですが、だ
ったらTShapeを移動できるようにしたほうが早いです。で、サイズ変更ハンドル
作りました。汎用的に作ってます。

以下のTHControlToolをCreateして、ControlプロパティにTShapeとかTEditを設
定すると、設定されたコントロールの回りに細い帯と、四隅と四辺に小さな四角
形が出てきます。帯をドラッグすると、コントロールといっしょに移動し、四角
形をドラッグするとコントロールといっしょに大きさが変わります。

// (ここから)

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

type
//   *******************************************************************
//   THControlTool: TControlのプロパティー ツール
//   *******************************************************************
     THControlToolKnob = class(TCustomControl)
     protected
          procedure Paint; override;

     public
          property  Canvas;

          property  OnMouseDown;
          property  OnMouseMove;
          property  OnMouseUp;
     end;

     THControlTool = class(TShape)
     private
          FfControl:     TControl;
          FfDrag:        Boolean;
          FfEdit:        Boolean;
          FiGap:         Integer;
          FfHint:        THintWindow;
          FfKnobs:  array[0..7] of THControlToolKnob;
          FiMergin:      Integer;
          FiSize:        Integer;
          FiX:           Integer;
          FiY:           Integer;

          FfOnMouseDown: TMouseEvent;
          FfOnMouseMove: TMouseMoveEvent;
          FfOnMouseUp:   TMouseEvent;

          procedure HideKnobs;
          procedure Move(
               fSender:  TObject;
               iX, iY:   Integer
          );
          procedure MoveKnobs;
          procedure ShowKnobs;

     protected
          procedure DoMouseDown(
               fSender:  TObject;
               fButton:  TMouseButton;
               fShift:   TShiftState;
               iX, iY:   Integer
          );
          procedure DoMouseMove(
               fSender:  TObject;
               fShift:   TShiftState;
               iX, iY:   Integer
          );
          procedure DoMouseUp(
               fSender:  TObject;
               fButton:  TMouseButton;
               fShift:   TShiftState;
               iX, iY:   Integer
          );
          procedure SetControl(
               V:   TControl
          ); virtual;
          procedure SetParent(
               V:   TWinControl
          ); override;

     public
          constructor    Create(
               fOwner:   TComponent
          ); override;
          destructor     Destroy; override;

     published
          property  Control:  TControl
               read      FfControl
               write     SetControl;

          property  OnMouseDown:   TMouseEvent
               read      FfOnMouseDown
               write     FfOnMouseDown;
          property  OnMouseMove:   TMouseMoveEvent
               read      FfOnMouseMove
               write     FfOnMouseMove;
          property  OnMouseUp:     TMouseEvent
               read      FfOnMouseUp
               write     FfOnMouseUp;
     end;

  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Edit1: TEdit;
    Shape1: TShape;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
     C:   TList;
     F:   THControlTool;
     i:   Integer;

begin
     C    := TList.Create();
     try
          for i := 0 to ControlCount - 1 do begin
               C.Add(Controls[i]);
          end;
          for i := 0 to C.Count - 1 do begin
               F    := THControlTool.Create(Self);
               F.Control := TControl(C[i]);
          end;

     finally
          C.Free();
     end;
end;

//**********************************************************************
//   THControlTool: TControlのプロパティー ツール
//**********************************************************************

//   -X-Y  -Y  -Y+X
//     ■−■−■
//     ｜      ｜
//   -X■      ■+X
//     ｜      ｜
//     ■−■−■
//   -X+Y  +Y  +Y+X

//**********************************************************************
//   THControlTool: インスタンスの生成
//**********************************************************************
constructor    THControlTool.Create(
     fOwner:   TComponent
);
const
     fNC: array[0..7] of TCursor = (
          crSizeNWSE,
          crSizeNESW,
          crSizeNS,
          crSizeNESW,
          crSizeNWSE,
          crSizeNS,
          crSizeWE,
          crSizeWE
     );

var
     i:   0..7;

begin
     inherited Create(fOwner);

     FfControl := nil;
     FfDrag    := False;
     FfEdit    := True;
     FiGap     := 5;
     FiMergin  := 5;
     FiSize    := 5;

     FfOnMouseDown  := nil;
     FfOnMouseMove  := nil;
     FfOnMouseUp    := nil;

     Brush.Color    := clSilver;
     Brush.Style    := bsSolid;
     Height    := 0;
     Left      := 0;
     Pen.Color      := clGray;
     Pen.Mode       := pmMask;
     Pen.Style      := psDot;
     Pen.Width      := 1;
     Shape     := stRectangle;
     Tag       := 8;
     Top       := 0;
     Visible   := False;
     Width     := 0;

     inherited OnMouseDown    := DoMouseDown;
     inherited OnMouseMove    := DoMouseMove;
     inherited OnMouseUp      := DoMouseUp;

     FfHint    := THintWindow.Create(Self);
     with FfHint do begin
          Brush.Color    := clInfoBk;
          ActivateHint(Rect(0, 0, 0, 0), '');
     end;

     for i := 0 to 7 do begin
          FfKnobs[i]     := THControlToolKnob.Create(Self);
          with FfKnobs[i] do begin
               Canvas.Brush.Color  := clBlack;
               Canvas.Brush.Style  := bsSolid;
               Canvas.Pen.Color    := clNone;
               Canvas.Pen.Mode     := pmCopy;
               Canvas.Pen.Style    := psClear;
               Canvas.Pen.Width    := 0;
               Cursor    := fNC[i];
               Height    := FiSize;
               Left      := 0;
               Tag       := i;
               Top       := 0;
               Visible   := False;
               Width     := FiSize;

               OnMouseDown    := DoMouseDown;
               OnMouseMove    := DoMouseMove;
               OnMouseUp      := DoMouseUp;
          end;
     end;

     FfEdit    := False;
end;

//**********************************************************************
//   THControlTool: インスタンスの破棄
//**********************************************************************
destructor     THControlTool.Destroy;
begin
     FfHint.ReleaseHandle();
     FfHint.Free();

     inherited Destroy();
end;

// (続く)

アイクビー
 


Original document by アイクビー      氏 ID:(KHB01350)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。