ラバーバンド（マウスドラッグデザインパターン) delphiy用

//ラバーバンドを制御するためのデザインパターンです
TDRAG を継承して

   Tdrawline = class(TDRAG)
draging:Boolean;
dp:tpoint;
function beginovertest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;override;
function begintest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;override;
function overtest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;override;
function droptest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;override;
end;

{ Tdrawline }

function Tdrawline.beginovertest(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; _me: MOUSEEV): Boolean;
begin

end;

function Tdrawline.begintest(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; _me: MOUSEEV): Boolean;
var
dfrom:tform2;

begin

dfrom := tform2(sender);

selflag := false;
Result := false;
dp.x := x;
dp.y := y;




//dfrom.memo1.Lines.Add('aaaa');


    if dfrom.ToolButton3.Down then
begin
    Result := True;

    dp.X := x;
    dp.Y := y;



end;
end;

function Tdrawline.droptest(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; _me: MOUSEEV): Boolean;
begin

end;

function Tdrawline.overtest(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; _me: MOUSEEV): Boolean;
var
dfrom:tform2;

begin

dfrom := tform2(sender);




if ssRight in Shift  then
begin
dfrom.mainbase.bit4.Canvas.Pen.Color := clwhite;
  dfrom.mainbase.bit4.Canvas.Pen.Width := 10;
end else begin
dfrom.mainbase.bit4.Canvas.Pen.Color := dfrom.Panel2.Color;
  dfrom.mainbase.bit4.Canvas.Pen.Width := 4;
end;



dfrom.mainbase.bit4.Canvas.MoveTo(dp.x+dfrom.wo.X,dp.y+dfrom.wo.Y);


                    
dfrom.mainbase.bit4.Canvas.LineTo(x+dfrom.wo.X,y+dfrom.wo.Y);

//再描画
dfrom.DubBPaintBox1Paint(sender);

dp.x := x;
dp.y := y;
end;

FormCreateフォームを初期化する関数あたりでこうします


procedure TForm2.FormCreate(Sender: TObject);
begin


    menz := TDRAGSTATEMNZ.Create;


          menz.draglist.Add(Tidoview.Create);// ドラッグドロップ操作で一番目にbegintestされる
//begentestにてtrueを返すと 2番目のTmovebitpapのbegentestは実行されずにドロップ操作が終わるまで
//このオブジェクトが機能するようになります

      //

     menz.draglist.Add(Tmovebitpap.Create);

    menz.draglist.Add(Tdrawline.Create);// 3番目にテストして begintestにてtrueになったばあいそのオブジェクトの
//自動的にドラッグアンドドロップ操作で  overtest-> droptest となり　ウインドウのドラッグ操作について
//制御しやすい（？？？）オブジェクトデザインパターンになっています。

     //

    menz.draglist.Add(Tseldrag.Create);
      //
     menz.draglist.Add(Tdrowline2.Create);
あん

TDRAGSTATEMNZのdraglistに追加しますそうしますと
delphiならば formの
mousedown
mousemove
mouseup
にて
procedure TForm2.DubBPaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
menz.MouseStateBoerdCast(
self,Button,Shift,X, Y,MEDOWN
) ;
end;

procedure TForm2.DubBPaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
    Button: TMouseButton;
begin
menz.MouseStateBoerdCast(
self,Button,Shift,X, Y,MEMOVE
) ;
end;

procedure TForm2.DubBPaintBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  menz.MouseStateBoerdCast(
self,Button,Shift,X, Y,MEUP
) ;
end;

このようにすると







unit dragmngunit;

interface
uses Controls,Classes,math,Windows;
type
MOUSEEV = (MEDOWN,MEMOVE,MEUP);

TDRAG = class(TOBJECT)
draging:Boolean;
function beginovertest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;virtual;abstract;
function begintest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;virtual;abstract;
function overtest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;virtual;abstract;
function droptest(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):Boolean;virtual;abstract;
end;


   TDRAGSTATEMNZ = class(TOBJECT)

draglist:Tlist;
nuldrag:TDRAG;
statedrag:TDRAG;

  nonslectMove:Tdrag;


  Senderdata1,senderdata2:integer;
function MouseStateBoerdCast(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV):TDRAG;
  function MouseStateBoerdCastwithdata(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer;_me:MOUSEEV;data1,data2:integer):TDRAG;

constructor Create;
destructor Destroy;override;


end;

function MyIntersectRect(var lprcDst: TRect;
const lprcSrc1: TRect;
const lprcSrc2: TRect): Boolean;

function getIntersectRect(
const lprcSrc1: TRect;
const lprcSrc2: TRect): Boolean;

  function ispointformrect(pt:tpoint;r:trect):Boolean;

implementation

function ispointformrect(pt:tpoint;r:trect):Boolean;
begin

Result := false;



if (r.Left <= pt.x) and
(r.top <= pt.y) and
(r.Right >= pt.x) and
(r.Bottom >= pt.y)
then
begin


Result := true;

end;





end;




function getIntersectRect(
const lprcSrc1: TRect;
const lprcSrc2: TRect): Boolean;
begin
Result := False;
if (lprcSrc1.Right >= lprcSrc2.Left) and
(lprcSrc2.Right >= lprcSrc1.Left) and
(lprcSrc1.Bottom >= lprcSrc2.Top) and
(lprcSrc2.Bottom >= lprcSrc1.Top) then
begin
Result := True;
end;
end;



function MyIntersectRect(var lprcDst: TRect;
const lprcSrc1: TRect;
const lprcSrc2: TRect): Boolean;
begin
Result := False;
if (lprcSrc1.Right >= lprcSrc2.Left) and
(lprcSrc2.Right >= lprcSrc1.Left) and
(lprcSrc1.Bottom >= lprcSrc2.Top) and
(lprcSrc2.Bottom >= lprcSrc1.Top) then
begin
lprcDst.Left := Max(lprcSrc1.Left, lprcSrc2.Left);
lprcDst.Right := Min(lprcSrc1.Right, lprcSrc2.Right);
lprcDst.Top := Max(lprcSrc1.Top, lprcSrc2.Top);
lprcDst.Bottom := Min(lprcSrc1.Bottom, lprcSrc2.Bottom);
Result := True;
end;
end;
constructor TDRAGSTATEMNZ.Create;
begin
draglist := TList.Create;
  nonslectMove := nil;
end;

destructor TDRAGSTATEMNZ.Destroy;
begin
draglist.Free;
inherited;
end;



function TDRAGSTATEMNZ.MouseStateBoerdCast(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer;
_me: MOUSEEV): TDRAG;
var
castdrag:Tdrag;

i:integer;
begin

if statedrag <> nil then
begin

if _me = MEMOVE then
begin

statedrag.overtest(Sender,Button,Shift,X, Y,_me);
end else if _me = MEUP then
begin

statedrag.droptest(Sender,Button,Shift,X, Y,_me);
statedrag := nil;
end;

exit;
end else if (_me = MEMOVE) or (_me = MEUP) then
begin

  if nil <> nonslectMove then
  begin

    nonslectMove.beginovertest(Sender,Button,Shift,X, Y,_me)
  end;


exit;
end;




for i := 0 to draglist.Count -1 do
begin

castdrag := Tdrag(draglist.Items[i]);

if castdrag.begintest(Sender,Button,Shift,X, Y,_me) then
begin

statedrag := castdrag;
break;
end;



end;

end;

function TDRAGSTATEMNZ.MouseStateBoerdCastwithdata(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer; _me: MOUSEEV;
  data1, data2: integer): TDRAG;
begin

Senderdata1 :=  data1;
senderdata2 :=  data2;



  MouseStateBoerdCast(
  Sender,Button,Shift,X, Y,_me

  );
  

end;

end.










///
//
//
//
/// このオブジェクトパターンを使えばかなり手軽にマウスドラッグドロップ操作をマネジメントできます
//windows などのguiプログラムで意外と（かなり？？）このマウスドラッグドロップはわけがわからなくなる（？）かもしれない
//場合になんとかするデザインパターンだと思います
//
//別にこのままプログラムしてもいいし、自分なりのやりかたで改良、またブラッシュアップしていけばいいんじゃないかな（？）
//このコンセプトを洗練したり、別につくるのもおｋでしょう！！！
//コードは怪しくてすいません（^^;
//
//
//