１６．ドラッグ＆ドロップ への返答
投稿で使用できる特殊コードの説明。(別タブで開きます。)
以下の返答は逆順(新しい順)に並んでいます。
投稿者 cupid (社会人)
投稿日時
2008/12/16 08:35:05
書き込もうと思ったら管理人様より既に書き込まれてありました。
しかしながら、私も一応以前のソース見て思い出したので、書き込ませ
てもらいます。済みません、やりかかったものですから。
前提として、PictureBox1.Image に画像が設定済みとします。
出来るだけソースをはしょって書いていますが、下記で比較的スムー
ズに動くでしょう。
Dim PicSx As Long, PicSy As Long
Private Sub PictureBox1_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
PicSx = X
PicSy = Y
End If
End Sub
Private Sub PictureBox1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
PictureBox1.Left = PictureBox1.Left + X - PicSx
PictureBox1.Top = PictureBox1.Top + Y - PicSy
End If
End Sub
しかしながら、私も一応以前のソース見て思い出したので、書き込ませ
てもらいます。済みません、やりかかったものですから。
前提として、PictureBox1.Image に画像が設定済みとします。
出来るだけソースをはしょって書いていますが、下記で比較的スムー
ズに動くでしょう。
Dim PicSx As Long, PicSy As Long
Private Sub PictureBox1_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
PicSx = X
PicSy = Y
End If
End Sub
Private Sub PictureBox1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
PictureBox1.Left = PictureBox1.Left + X - PicSx
PictureBox1.Top = PictureBox1.Top + Y - PicSy
End If
End Sub
投稿者 るきお(管理者) (社会人)
投稿日時
2008/12/15 22:30:26
こんにちは。
おっしゃっているのはここのことですね？
http://homepage1.nifty.com/rucio/main/technique/tec16_DragDrop.htm
最後にダウンロードできる副笑いを試してみましたが確かに環境によっては大分ちらつくようですね。
私のローカル環境ではちらつかなかったと思いますが…。
コントロールをドラッグしている以上この問題の回避はできないのではないかと思います。
アプローチを代えてすべてのグラフィックを自前で処理すればなんとかなるはずです。
一例として簡単なものを作ってみましたが、このような方法ではいかがでしょうか？
(これですべてのちらつきが消えるというものでもありませんが)
フォームに大きめにPictureBoxを１つ配置して試してください。
細部は作りこんでいません。たとえば、ドラッグしたままでPictureBoxの外にマウスを動かすと少しおかしなことになります。
おっしゃっているのはここのことですね？
http://homepage1.nifty.com/rucio/main/technique/tec16_DragDrop.htm
最後にダウンロードできる副笑いを試してみましたが確かに環境によっては大分ちらつくようですね。
私のローカル環境ではちらつかなかったと思いますが…。
コントロールをドラッグしている以上この問題の回避はできないのではないかと思います。
アプローチを代えてすべてのグラフィックを自前で処理すればなんとかなるはずです。
一例として簡単なものを作ってみましたが、このような方法ではいかがでしょうか？
(これですべてのちらつきが消えるというものでもありませんが)
フォームに大きめにPictureBoxを１つ配置して試してください。
細部は作りこんでいません。たとえば、ドラッグしたままでPictureBoxの外にマウスを動かすと少しおかしなことになります。
Option Explicit
Private IsDragging As Boolean '現在ドラッグ中か
Private curX As Integer '現在の図形の左上のX座標
Private curY As Integer '現在の図形の左上のY座標
Private diffX As Integer 'ドラッグ開始時点のcurXとマウスX座標の差
Private diffY As Integer 'ドラッグ開始時点のcurYとマウスY座標の差
Private Sub Form_Load()
Picture1.BackColor = vbWhite
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
curX = 10
curY = 10
Call Draw(10, 10)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'ドラッグ開始時点の図形とマウス位置の差を保存
diffX = curX - CInt(X)
diffY = curY - CInt(Y)
'無条件でドラッグ開始としているが、
'本来は対象図形上にマウスがあればドラッグ開始といった条件が必要
IsDragging = True
Me.Caption = "ドラッグ中 - " & Me.Caption
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If IsDragging Then
Call Draw(CInt(X) + diffX, CInt(Y) + diffY)
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
IsDragging = False
Me.Caption = Replace(Me.Caption, "ドラッグ中 - ", "")
curX = CInt(X) + diffX
curY = CInt(Y) + diffY
End Sub
Private Sub Draw(posX As Integer, posY As Integer)
Picture1.Cls
Picture1.Line (posX, posY)-(posX + 50, posY + 50), vbRed, BF
End Sub
投稿者 おじん (その他)
投稿日時
2008/12/13 19:17:15
ここにある１６．ドラッグ＆ドロップ（フォーム内）をコピーしてやったのですが、
ドラッグする度に画像がチカチカして目障りです。チカチカしないようにするには
どうしたらよいのでしょうか。サンプルプログラムでも同様の現象がおこります。
よろしくご指導ください。
windowsXP,VB6(SP6)
具体的には、PictureBox上にImage画像をおいて、Image画像をドラッグする。
ドラッグする度に画像がチカチカして目障りです。チカチカしないようにするには
どうしたらよいのでしょうか。サンプルプログラムでも同様の現象がおこります。
よろしくご指導ください。
windowsXP,VB6(SP6)
具体的には、PictureBox上にImage画像をおいて、Image画像をドラッグする。
仕方がないとのこと、仕方がないです。
るしお様の方法、思いつきもしませんでした。
cupid様の例は、PictureBox1.imageとありVB6ではないような気がします。
VB6に直してみました。
真似させていただきます。ありがとうございました。