canvasに書いた線をドラッグ＆ドロップさせるには？ (ID：263)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

そのアプリケーションの仕様がわからないと、コメントしにくいのですが、線をドラッグするのでなく、点をドラッグするのなら結構簡単です。

パネルを４つ用意します。大きさは、５ｘ５くらいでよいです。
このうち２つ(Panel1,Panel2とします)の、BevelInner,BevelOuterをbvNoneに、ColorをclBlackに、CursorをcrSizeAllにします。
残りの２つ(Panel3,Panel4とします)の、BevelInner,BevelOuterをbvNoneに、ColorをclBlack(これは何でもよいですが)に、VisibleをFalseにします。

フォーム(Form1とします)のprivate宣言に、
b1, b2: boolean; // マウスがおされている
px1, py1: integer; // パネル１が押されたときの差分
px2, py2: integer; // パネル２が押されたときの差分
を宣言します。

あとは、Panel1,Panel2のMouseDown,MouseMove,MouseUpイベントと、FormPaintイベントを用意すればOKです。

こんな感じです。
あとはいろいろ試してみてください。
やり方はたくさんあります。
ちなみに、このままだと、マウスダウン状態でAlt+TABすると、他のアプリケーションがアクティブになりますが、マウスアップ処理が動かないため変な動作になります。

procedure TForm1.FormPaint(Sender: TObject);
var
  pt1, pt2: TPoint;
begin
  if b1 then
  begin
    pt1.x := Panel3.Left;
    pt1.y := Panel3.Top;
  end
  else
  begin
    pt1.x := Panel1.Left;
    pt1.y := Panel1.Top;
  end;
  if b2 then
  begin
    pt2.x := Panel4.Left;
    pt2.y := Panel4.Top;
  end
  else
  begin
    pt2.x := Panel2.Left;
    pt2.y := Panel2.Top;
  end;
  Canvas.MoveTo(pt1.x + 2, pt1.y + 2);
  Canvas.LineTo(pt2.x + 2, pt2.y + 2);
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  px1 := X;
  py1 := Y;
  Panel3.Left := Panel1.Left;
  Panel3.Top  := Panel1.Top;
  Panel3.Visible := True;
  b1 := true;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not b1 then Exit;
  Panel3.Left := Panel1.Left + X - px1;
  Panel3.Top  := Panel1.Top  + Y - py1;
  Refresh;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if b1 then
  begin
    Panel1.Left := Panel3.Left;
    Panel1.Top  := Panel3.Top;
    Panel3.Visible := False;
  end;
  b1 := false;
end;

procedure TForm1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  px2 := X;
  py2 := Y;
  Panel4.Left := Panel2.Left;
  Panel4.Top  := Panel2.Top;
  Panel4.Visible := True;
  b2 := true;
end;

procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not b2 then Exit;
  Panel4.Left := Panel2.Left + X - px2;
  Panel4.Top  := Panel2.Top  + Y - py2;
  Refresh;
end;

procedure TForm1.Panel2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if b2 then
  begin
    Panel2.Left := Panel4.Left;
    Panel2.Top  := Panel4.Top;
    Panel4.Visible := False;
  end;
  b2 := false;
end;

←解決時は質問者本人がここをチェックしてください。

戻る