お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"GrabHandleサイズ変更用の黒いハンドル" 


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

#00297　凛              さん　RE:GrabHandleサイズ変更用の黒いハンドル

#00306　凛              さん　RE:GrabHandleサイズ変更用の黒いハンドル





{Drawソフト等でおなじみのオブジェクトをリサイズする際にコーナーと
辺の中点に出てくる小さな■　本名はGrabHandleらしいです。　ＴＮさんから頂
いたヒントをもとに作りました。そのうちコンポーネント化するかもしれません
がこれで結構使いやすいように思うのでUpしておきます。オブジェクトそのもの
を移動するのは別途コーディング要です。}

{本サンプルはForm上にTmemoを一つは位置した状態です。}
unit grabHandles;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs,ExtCtrls, StdCtrls;
type
  TmyGrabHandle=Class
     private
        moving:boolean;
        myOwner:TControl;
        fcolor:TColor;
        offset:integer;
        hokuros:array[0..7] of TPanel;
        fhokurosize,fleft,ftop,fright,fbottom:integer;
        FOnResize,FOnBeginMoving,FOnEndMoving: TNotifyEvent;
        procedure setLeft(theLeft:integer);
        procedure setRight(theRight:integer);
        procedure setTop(theTop:integer);
        procedure setBottom(theBottom:integer);
        procedure hokuroMouseMove
　　　　　　(Sender: TObject; Shift: TShiftState; X,Y: Integer);
        procedure hokuroMouseUp
　　　　　　(Sender: TObject;
             Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
        procedure hokuroMouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure setHokurosize(size:integer);
     public
        procedure show;
        procedure hide;
        procedure AlignTo(target:TControl);
        procedure setAt(L,T,R,B:Integer);
        constructor create(Aowner:TControl);
        destructor destroy;
        property left:integer read fLeft write setLeft;
        property right:integer read fRight write setRight;
        property top:integer read fTop write setTop;
        property bottom:integer read fbottom write setBottom;
        property OnBeginMoving: TNotifyEvent read FOnBeginMoving 
                                             write FOnBeginMoving;
        property OnEndMoving: TNotifyEvent read FOnEndMoving 
                                           write FOnEndMoving;
        property OnResize: TNotifyEvent read FOnResize write FOnResize;
        property hokurosize:integer read fhokurosize 
                                    write setHokurosize default 6;
        property color:TColor read fColor write fColor;
  end;
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure Memo1Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    { Private 宣言 }
    myHOkuro:TmyGrabHandle;
    procedure resizing(sender:TObject);
    procedure hidememo(sender:TObject);
    procedure showmemo(sender:TObject);
  public
    { Public 宣言 }
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TMyGrabHandle.hokuroMouseUp(Sender: TObject; Button: 
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   moving:=false;
   if Assigned(fOnEndMoving) then fOnEndMoving(nil);
end;
procedure TMyGrabHandle.hokuroMouseDown (Sender: TObject; Button:
           TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
   moving:=True;
   if Assigned(fOnBeginMoving) then fOnBeginMoving(nil);
end;
procedure TMyGrabHandle.hokuroMouseMove
 (Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
   currPos:TPoint;
begin
   GetCursorPos(currPos);
   currPos.X:=CurrPos.x-myOwner.ClientOrigin.x-3;
   currPos.Y:=CurrPos.Y-myOwner.ClientOrigin.Y-3;
   if moving then begin
      if sender=hokuros[1] then setTop(currPos.Y);
      if sender=hokuros[3] then setRight(currPos.X);
      if sender=hokuros[5] then setBottom(currPos.Y);
      if sender=hokuros[7] then setLeft(currPos.X);
      if sender=hokuros[0] then begin
         setLeft(currPos.X);
         setTop(currPos.Y);
      end;
      if sender=hokuros[2] then begin
         setRight(currPos.X);
         setTop(currPos.Y);
      end;
      if sender=hokuros[4] then begin
         setRight(currPos.X);
         setBottom(currPos.Y);
      end;
      if sender=hokuros[6] then begin
         setLeft(currPos.X);
         setBottom(currPos.Y);
      end;
      if Assigned(fOnResize) then fOnResize(nil);
   end;
end;
procedure TMyGrabHandle.hide;
var
   i:integer;
begin
   for i:=0 to 7 do begin
      hokuros[i].visible:=false;
   end;
end;
procedure TMyGrabHandle.AlignTo(target:TControl);
begin
   left:=target.left;
   Right:=target.Left+target.Width;
   Top:=target.Top;
   Bottom:=target.Top+target.height;
end;
procedure TMyGrabHandle.setAt(L,T,R,B:Integer);
begin
   Left:=L;
   Right:=R;
   Top:=T;
   Bottom:=B;
   hokurosize:=fhokurosize;
end;
procedure TMyGrabHandle.show;
var
   i:integer;
begin
   for i:=0 to 7 do hokuros[i].visible:=True;
end;
procedure TMyGrabHandle.setHokurosize(size:integer);
var
   i:integer;
begin
   if (size>=4) and (size<16) then
   begin
      for i:= 0 to 7 do begin
         hokuros[i].width:=size;
         hokuros[i].height:=size;
      end;
      offset:=Trunc(size/2);
      setTop(ftop);
      setRight(fRight);
      setBottom(fBottom);
      setLeft(fLeft);
   end;
end;
constructor TMyGrabHandle.create(Aowner:TControl);
var
   i:integer;
begin
   myOwner:=AOwner;
   fhokurosize:=6;
   offset:=3;
   for i:=0 to 7 do
   begin
      hokuros[i]:=TPanel.Create(myOwner);
      with hokuros[i] do begin
         parent:=TWinControl(myOwner);
         width:=fhokurosize;
         height:=fhokurosize;
         color:=clBlack;
         OnMouseMove:=hokuroMouseMove;
         OnMouseDown:=hokuroMouseDown;
         OnMouseUp:=hokuroMouseUp;
         Visible:=false;
         BevelOuter:=bvNone;
         case i of
            0,4:cursor:=crSizeNWSE;
            1,5:cursor:=crSizeNS;
            2,6:cursor:=crSizeNESW;
            3,7:cursor:=crSizeWE;
         end;
      end;
   end;
end;
destructor TMyGrabHandle.destroy;
var
   i:integer;
begin
   for i:=0 to 7 do begin
      hokuros[i].free;
   end;
   inherited Destroy;
end;
procedure TMyGrabHandle.setLeft(theLeft:integer);
begin
   if moving and (theLeft>=Right) then Exit;
   hokuros[0].left:=theLeft-offset;
   hokuros[7].left:=theLeft-offset;
   hokuros[6].left:=theLeft-offset;
   hokuros[1].left:=Trunc((hokuros[0].Left+hokuros[2].Left)/2);
   hokuros[5].left:=hokuros[1].Left;
   fLeft:=theLeft;
end;
procedure TMyGrabHandle.setRight(theRight:integer);
begin
   if moving and (theRight<=Left) then Exit;
   hokuros[2].left:=theRight-offset;
   hokuros[3].left:=theRight-offset;
   hokuros[4].left:=theRight-offset;
   hokuros[1].left:=Trunc((hokuros[0].Left+hokuros[2].Left)/2);
   hokuros[5].left:=hokuros[1].Left;
   fRight:=theRight;
end;
procedure TMyGrabHandle.setTop(theTop:integer);
begin
   if moving and (theTop>=Bottom) then Exit;
   hokuros[0].top:=theTop-offset;
   hokuros[1].Top:=theTop-offset;
   hokuros[2].TOp:=theTop-offset;
   hokuros[3].Top:=Trunc((hokuros[2].Top+Hokuros[4].Top)/2);
   hokuros[7].Top:=hokuros[3].Top;
   fTop:=theTop;
end;
procedure TMyGrabHandle.setBottom(theBottom:integer);
begin
   if moving and (theBottom<=Top) then Exit;
   hokuros[4].Top:=theBottom-offset;
   hokuros[5].Top:=theBottom-offset;
   hokuros[6].Top:=theBottom-offset;
   hokuros[3].Top:=Trunc((hokuros[2].Top+Hokuros[4].Top)/2);
   hokuros[7].Top:=hokuros[3].Top;
   fBottom:=theBottom;
end;
//*******ここからは使用例*************
procedure TForm1.resizing;
begin//フルドラッグ時使用例
{   memo1.left:=myHokuro.left;
   memo1.top:=myhokuro.Top;
   memo1.width:=ABS(myHokuro.Right-myHokuro.Left);
   memo1.Height:=ABS(myHokuro.Bottom-myHokuro.Top);}
end;
procedure TForm1.hidememo(sender:TObject);
begin//もし、何かやりたいなら、、一応例として書きました。
//   memo1.visible:=false;
end;
procedure TForm1.showmemo(sender:TObject);
begin
//   memo1.visible:=True;
   memo1.left:=myHokuro.left;
   memo1.top:=myhokuro.Top;
   memo1.width:=ABS(myHokuro.Right-myHokuro.Left);
   memo1.Height:=ABS(myHokuro.Bottom-myHokuro.Top);
end;
procedure TForm1.Memo1Click(Sender: TObject);
begin
   if myHokuro=nil then begin
      myHokuro:=TmyGrabHandle.create(Form1);
//      myHokuro.OnResize:=resizing; //必要なときのみで可
//      myHokuro.OnBeginMoving:=hidememo;//必要なときのみで可
      myHokuro.OnEndMoving:=showmemo;
   end;
   myHokuro.alignTo(memo1);
   myHokuro.show;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
   if myHokuro<>nil then myHokuro.Hide;
end;
end.
☆☆☆　わからないときサンプル蔵　わかったときサンプル蔵　☆☆☆
                                 97/12/17(水) 16:38 凛(MXB01744)

Original document by 凛              氏 ID:(MXB01744)

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