VB6 ドラッグ&ドロップでImage1をPicture1に移動する方法

このQ&Aのポイント
  • VB6でImage1をPicture1にドラッグ&ドロップするプログラムを作成する方法について解説します。
  • Image1の絵と外枠を一緒にドラッグできるようにする方法について説明します。
  • ドロップする場所がPicture1以外の場合でもImage1を画面上に残す方法について説明します。
回答を見る
  • ベストアンサー

VB6 ドラッグ&ドロップ

Image1をPicture1(正方形)にドラッグ&ドロップするプログラム を作りたいと思っています。 このプログラムだとImage1全体がドラッグされるのではなく、 Image1の絵はその位置に残ってImage1の外枠だけがドラッグされてしまいます。 外枠だけでなくImage1の絵も一緒にドラッグできるようにするにはどうすればいいのでしょうか? また、このプログラムだとドロップする場所(Picture1_)以外で ドロップしてしまった場合でも画面上からImage1の絵と外枠が消えてしまいます。 ドロップする場所(Picture1_)以外でドロップしてしまった場合は、 Image1全体を画面上に残しておきたいのですがどうすればいいのでしょうか? Option Explicit Dim dx As Single, dy As Single Private Sub Form_Load() Image1.Picture = LoadPicture(App.Path & "picture.jpg") Image1.Stretch = True End Sub Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single) Source.Move X - dx, Y - dy End Sub Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Image1.Drag 1 dx = X: dy = Y 'マウスダウン位置 End Sub Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single) Source.Visible = False 'ドロップオブジェクトを非表示にする Picture1.BackColor = RGB(255, 255, 255) End Sub Private Sub Picture1_DragOver(Source As Control, X As Single, Y As Single, _ State As Integer) If State = 0 Then Picture1.BackColor = RGB(0, 0, 255) If State = 1 Then Picture1.BackColor = RGB(255, 255, 255) End Sub

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

Dim dx As Single, dy As Single ↑の使用目的がわからないので削除しました。 Option Explicit Private Sub Form_Load() Image1.Stretch = True Image1.Picture = LoadPicture(App.Path & "picture.jpg") End Sub Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Image1.Drag 1 End Sub Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single) Source.Visible = False 'ドロップオブジェクトを非表示にする Picture1.BackColor = RGB(255, 255, 255) Picture1.Picture = Source.Picture End Sub Private Sub Picture1_DragOver(Source As Control, X As Single, Y As Single, _ State As Integer) If State = 0 Then Picture1.BackColor = RGB(0, 0, 255) If State = 1 Then Picture1.BackColor = RGB(255, 255, 255) Picture1.Refresh End Sub

sisuado
質問者

お礼

回答ありがとうございます。 うまくできました!

関連するQ&A

  • 「右クリック でドラッグ&ドロップ」で縦横の移動できるようにしたいです。

    お世話になります。 VB6で質問です。   form [ 1000*1000 ] << A picturebox [300*300 ] << B [A]の真中に[B]を配置して、[B]を「右クリック でドラッグ&ドロップ」で縦横の移動できるようにしたいです。 下記のようにしたところ、マウスのみで動いてしまい「右クリック」が関連しません。 Private Sub picturebox_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)  picturebox.Top = Y End Sub  この場合のプログラムを教えて欲しいです。

  • ボールが壁に当たって跳ね返るプログラムを・・

    スタートボタンを押すと一個のボールが現れ、 picture1の中を動き回り、壁に当たると跳ね返る、 スクリーンセイバーのようなプログラムを作って いるのですが「ボールが壁に当たって跳ね返る」 部分がどうしても上手くいきません。この部分を どなたか教えてください。お願いしますm(_ _)m (見やすいように線を引きました。最後の方が「跳ね返りの部分です。それ以外の部分は、文の長さ制限にひっかかるため省いてあるところがあります。) Private Sub Command1_Click() x = Int(Rnd * 3900) y = Int(Rnd * 3900) r = 100 c = vbRed Timer1.Enabled = True Timer1.Interval = 200 Picture1.Circle (x, y), r, vbRed End Sub ----------------------------------------- Private Sub Timer1_Timer() Picture1.FillColor = Picture1.BackColor Picture1.Circle (x, y), r, Picture1.BackColor dx = 100 dy = dx x = x + dx If x < 0 Then x = 0 And dx = 0 - dx If x > Picture1.Width Then x = Picture1.Width And dx = 0 - dx End If End If y = y + dy If y < 0 Then y = 0 And dy = 0 - dy If y > Picture1.Height Then y = Picture1.Height And dy = 0 - dy End If End If Picture1.FillColor = vbRed Picture1.Circle (x, y), r, vbRed End Sub

  • 同じコマンドボタンからマウスカーソルがはなれたら

    フォーム上のコマンドボタンにマウスカーソルが触れたら色を付ける、 同じコマンドボタンからマウスカーソルがはなれたら 、また色を変える、 という動きをvbaで行いたいのですが、 Private Sub cmd_test_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.cmd_test.BackColor = RGB(255, 180, 200) End Sub で、マウスカーソルが触れたら色を付けることはできたのですが、 マウスカーソルがそのコマンドボタンから離れたら色を変えるという動きができません。 Private Sub cmd_test_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Me.cmd_test.BackColor = RGB(255, 255, 255) End Sub Private Sub cmd_test_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.cmd_test.BackColor = RGB(255, 255, 255) End Sub Private Sub cmd_test_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.cmd_test.BackColor = RGB(255, 255, 255) End Sub をしても、マウスカーソルが離れても色が白になりませんでした。

  • VB6 Form内のDragDrop

    VB6でForm内にCommandButtonがいくつか有ります。 各CommandButtonはClickするとShellオブジェクトでファイルを開く様になっています。 やりたいことは 2つのCommandButton間をDragDrop?によりCaptionを入れ替えたいです。 (CommandButton間をマウスDragDropでCaption名入れ替え) MouseDownとDragDropイベントで何とかなると思いましたがうまくいきません。 Dim dd As Integer Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then dd = 1 'CommandボタンNo, End If End Sub Private Sub Command2_DragDrop(Source As Control, X As Single, Y As Single) Dim cn As String cn = Command2.Caption Command2.Caption = Controls("Command" & dd).Caption Controls("Command" & dd).Caption = cn End Sub CommandButtonプロパティでDragModeを自動にするとShellオブジェクトでファイルが開かないし サイトで調べたところファイルの移動やコマンド自体の移動などで分かりませんでした。 ご教授お願い致します。

  • OLEDragDropで フォームとSSTABの違いがわからない。

    VisualBasicを使っています。 OLEDragDropを使おうとしていますが、フォームの方は正しく動作しましたが、 SSTABの方はファイルをドロップさせても無反応でした。 使い方を間違えているのでしょうか? Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) Call PicConvert(Data) End Sub Private Sub SSTab1_OLEDragDrop(Data As TabDlg.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) Call PicConvert(Data) End Sub

  • VB6.0で、LSetの動作がわからない

    よろしくお願いします。 LSetのサンプルを検索していて以下のコードを見つけました。 Option Explicit Private Type B4 B(3) As Byte End Type Private Type S1 S As Single End Type Private Sub Form_Load() Dim X As B4 Dim Y As S1 X.B(0) = 37 X.B(1) = 82 X.B(2) = 154 X.B(3) = 68 LSet Y = X Debug.Print Y.S End Sub このコードを実行するとデバッグウィンドウに 1234.567 と表示されます。 このコードではいったい何が起こっているのでしょうか? X.Bとして4つの配列変数が用意され、それがY.Sという配列ではない通常の変数に代入されているのはわかるのですが、 どうして結果が1234.567になるのかわかりません。

  • 実行時のコントロール移動について

    実行時にデザイン時と同じようにコントロール移動をおこないたいのですが、コードを忘れてしまいました。もしご存知の方ご教授お願いします。下記にしめしたものが少しだけ覚えているものです。したがってうまく起動できていません。よろしくお願いしたいます。VB6です。w2k Private Sub cmd_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) x1 = X y1 = Y End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then cmd.Left = (X - x1) + x1 cmd.Top = (Y - y1) + y1 End If End Sub

  • VB2008 Formドラッグ時の描画を早くしたいです..

     こんばんは,質問させていただきます. どうぞよろしくお願いたします.  Formが4つあるアプリを作成しております.いずれをドラッグされた際も これらが一緒に動くように,下のように方法でコーディングいたしました. が,コントロールの数が多いせいか,カクカク動いてしまいます.  (↓Form3をドラッグした際のコードでございます)   Private mousePoint As Point   Private Sub Form3_MouseDown(ByVal sender As Object, _     ByVal e As System.Windows.Forms.MouseEventArgs) _     Handles MyBase.MouseDown     If (e.Button And MouseButtons.Left) = MouseButtons.Left Then       mousePoint = New Point(e.X, e.Y) '位置を記憶     End If   End Sub   Private Sub Form3_MouseMove(ByVal sender As Object, _     ByVal e As System.Windows.Forms.MouseEventArgs) _     Handles MyBase.MouseMove 'マウスが動いたとき     If (e.Button And MouseButtons.Left) = MouseButtons.Left Then       Me.Left += e.X - mousePoint.X       Me.Top += e.Y - mousePoint.Y       Form1.Left += e.X - mousePoint.X       Form1.Top += e.Y - mousePoint.Y       Form2.Left += e.X - mousePoint.X       Form2.Top += e.Y - mousePoint.Y       Form4.Left += e.X - mousePoint.X       Form4.Top += e.Y - mousePoint.Y     End If   End Sub  VBでFormの動きを早くする方法というのは,単純にコントロール数を 減らすか,またはPCのスペックを上げるしか無いのでしょうか・・・?  もしお詳しい方がいらっしゃいましたら,是非とも何かアドバイスを いただきたくお願い申し上げます. どうぞよろしくお願いいたします.

  • ビジュアルベーシックのお絵かき掲示板

    まったくの初心者です。初歩的な質問で申し訳ありません。 カラーのところでクリックが実行できません。 なぜなのかよくわかりません。お暇なときご教授下さい。  そしてもう一つ質問ですが以下のコードを追加したいの ですがどこに挿入すればいいのですか。 →private sub image_click() ccolor = 7 end sub ここまでのコードを追加したいです。 ーーーーーーーーーーーーーーーーーーーーーーーーーー Private Sub Command1_Click() Form1.Cls End Sub Private Sub Command2_Click() End End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Form1.DrawWidth = 3 If Button = 1 Then PSet (X, Y), QBColor(ccolor) End If End Sub Private Sub Label1_Click() cccolor = 14 End Sub Private Sub lavel2_click() cccolor = 0 End Sub Private Sub label3_click() ccolor = 9 End Sub Private Sub label4_click() ccolor = 12 End Sub Private Sub label5_click() ccolor = 10 End Sub

  • ドラッグ&ドロップの対象をフォルダに限定したい

    こんばんは。 テキストボックスにドラッグ&ドロップされたフォルダのパスを取得させたいのですがドラッグの対象をフォルダに限定させたい、もしくはファイルがドラッグ&ドロップされたらそのファイルのカレントディレクトリまでのパスを取得させたいのですが、下記のコードでは取得までは出来るのですがファイルがきた場合にファイルまでのパスが取得されてしまいまいます。 よろしくお願いします。 Dim ddpath As String Private Sub TxtPath_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles TxtPath.DragEnter If e.Data.GetDataPresent(DataFormats.FileDrop) Then e.Effect = DragDropEffects.Copy Else e.Effect = DragDropEffects.None End If End Sub Private Sub TxtPath_DragDrop(ByVal sender As Object, ByVal e As _System.Windows.Forms.DragEventArgs) Handles TxtPath.DragDrop ddpath = e.Data.GetData(DataFormats.FileDrop)(0) If Dir(ddpath, FileAttribute.Directory) <> "" Then TxtPath.Text = ddpath End If End Sub

専門家に質問してみよう