VBでPDFライクに画像を動かすには？

解決

ASD 2004-09-17 07:06:05 No: 85617

VBでPDFファイルのように、マウスでクリックしながら動かすと内容が自由に動くようにしたいのですが、どうすればよいか見当もつかないのですが、よい方法がありますか。？

りっとっと 2004-09-17 22:24:27 No: 85618

簡単な方法とすれば、
ピクチャーボックスの中にピクチャーボックスをいれて
中のピクチャーボックスを動かすというものでしょうか。

'中のピクチャーボックスをPicture2としたサンプル
Private mX As Long
Private mY As Long
Private mState As Long

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mState = 1
    'マウスが押されたときの座標を保存
    mX = X
    mY = Y
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mState = 1 Then
        '押されたときの座標との差分移動
        Picture2.Move X - p1X + Picture2.Left, Y - p1Y + Picture2.Top
    End If
End Sub

Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mState = 0
End Sub

ASD 2004-09-18 01:35:04 No: 85619

りっとっとさん、ありがとうございます。チップ集の中にコントロールをマウスで動かす方法がかかれていましたので、フレームの中にピクチャーボックスを置いて動かすようにプログラムしてみました。また、マウスアイコンをイメージボックスに収納してマウスを押すとつかむアイコンを呼び出すようにしてみました。

ただ、これですと、ピクチャーボックスの動かせる範囲が制限できず、ピクチャーボックスの裏の部分も見えてしまうので、なんとか制限する方法はないかと考えています。

'■SendMessage
'指定のウインドウにメッセージを送る

'<引数＞
'hWnd     ウインドウのハンドル
'wMsg：   定数(WM_××参照）
'wParam:  定数 (HTCAPTION)
'lParam:  常に0

'<戻り値>
'通常使わない

'定数はこれ以外にもある=>APIビューワー参照

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'■ReleaseCapture
'マウスキャプチャを解放

Private Declare Sub ReleaseCapture Lib "user32" ()

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Private Sub Picture8_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim Ret As Long

      If Button = 1 Then

          Picture8.MouseIcon = Image6(1).Picture
          Picture8.MousePointer = 99

          'マウスキャプチャを解放する
          ReleaseCapture

          'Form1をドラッグせよという命令を送る
          Ret = SendMessage(Picture8.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)

End If

End Sub

Private Sub Picture8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Picture8.MouseIcon = Image6(0).Picture
    Picture8.MousePointer = 99

End Sub

りっとっと 2004-09-18 05:16:24 No: 85620

（さっきのサンプルちょっと間違ってましたね。mouse_moveイベントでp1Xとp1YはそれぞれmXとmYです）
ピクチャーボックスを入れているコンテナコントロールの領域内で移動を制限したい場合もほとんど変わりません。
ピクチャーボックスの位置を見ればよく、
左上の座標（Left,Top)がいずれも０以下かどうか、
および、コンテナコントロールの（表示領域の）幅とピクチャーボックス
の幅の差以上であるかをみて
幅の差＜＝左上座標＜＝０
の範囲に制限すればいいことになります。

'コンテナコントロールをPicture1とした場合のmouse_moveイベント
'また、ReleaseCaptureを使用した方法でも考え方は同じでいけると思います。
    Dim pX As Long
    Dim pY As Long
    If Picture1.Width < Picture2.Width Then
        pX = X - mX + Picture2.Left
        If pX > 0 Then pX = 0
        If pX < Picture1.ScaleWidth - Picture2.Width Then pX = Picture1.ScaleWidth - Picture2.Width + 1
    Else
        pX = 0
    End If
    If Picture1.Height < Picture2.Height Then
        pY = Y - mY + Picture2.Top
        If pY > 0 Then pY = 0
        If pY < Picture1.ScaleHeight - Picture2.Height Then pY = Picture1.ScaleHeight - Picture2.Height + 1
    Else
        pY = 0
    End If
    If mState = 1 Then
        '押されたときの座標との差分移動
        Picture2.Move pX, pY
    End If

ASD 2004-09-25 02:26:52 No: 85621

いろいろ試してようやく解決しました。マウスムーブでスクロールバーを動かし、スクロールバーに連動させてピクチャーボックスを動かせば、範囲内でのみ動かすことができるようになりました。いかにそのプログラムを紹介します。

'画面をPDFライクに動かす方法
'フォーム上にPicture1、HScroll1、VScroll1を配置
'
Dim x2 As Integer 'Picture1の横の座標
Dim y2 As Integer 'Picture1の縦の座標
Dim b102 As Boolean 'Picture1が押されているかを知る

Private Sub Form_Load()

    'Picture1に適当に線を引く
    Picture1.Top = 0
    Picture1.Left = 0
    Picture1.Width = 10000
    Picture1.Height = 10000
    Picture1.AutoRedraw = True
    Picture1.ForeColor = &H565656
    Picture1.Line (0, 0)-(10000, 10000)
    Picture1.Line (500, 3000)-(4000, 5000), , BF


End Sub

Private Sub スクロールバー()

'スクローバーを配置する

    HScroll1.Left = 0
    VScroll1.Top = 0
    If Picture1.Width > Me.Width Then
        HScroll1.Top = Me.ScaleHeight - HScroll1.Height
    Else
        HScroll1.Top = Me.ScaleHeight
    End If
    If Picture1.Height > HScroll1.Top Then
        VScroll1.Left = Me.ScaleWidth - VScroll1.Width
        If Picture1.Width > VScroll1.Left Then
            HScroll1.Top = Me.ScaleHeight - HScroll1.Height
        End If
    Else
        VScroll1.Left = Me.ScaleWidth
    End If
    HScroll1.Width = Me.ScaleWidth
    If HScroll1.Top > 0 Then VScroll1.Height = HScroll1.Top
    'スクロールバーの範囲を設定
    HScroll1.Max = Picture1.Width - VScroll1.Left
    VScroll1.Max = Picture1.Height - HScroll1.Top


    HScroll1.SmallChange = Abs(HScroll1.Max \ 16) + 1
    HScroll1.LargeChange = Abs(HScroll1.Max \ 4) + 1
    VScroll1.SmallChange = Abs(VScroll1.Max \ 16) + 1
    VScroll1.LargeChange = Abs(VScroll1.Max \ 4) + 1
    HScroll1.ZOrder 0
    VScroll1.ZOrder 0
    b102 = False

End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    'クリックしたところの座標を格納して、クリックしていることを示すためにb102をTrueにする
    If Button = 1 Then
        x2 = X
        y2 = Y
        b102 = True
    End If

End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

'クリックしていないことを示すためにb102をFalseにする
b102 = False

End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    'Picture1をクリックしたままであるときにのみ動かす。
    If b102 = True Then

        '有効範囲内のときにのみスクロールバーを動かす
        '横のスクロールバー
        If HScroll1.Value - (Val(X) - x2) > HScroll1.Max Or HScroll1.Value - (Val(X) - x2) < 1 Then

        Else

            Me.HScroll1.Value = HScroll1.Value - (Val(X) - x2)

        End If
        '縦のスクロールバー
        If VScroll1.Value - (Val(Y) - y2) > VScroll1.Max Or VScroll1.Value - (Val(Y) - y2) < 1 Then

        Else
            Me.VScroll1.Value = VScroll1.Value - (Val(Y) - y2)
        End If

    Else

    End If
End Sub

Private Sub VScroll1_Change()
    '縦スクロールバーにあわせてPicture1を上下に動かす
    Picture1.Top = -VScroll1.Value

End Sub

Private Sub HScroll1_Change()
    '横スクロールバーにあわせてPicture1を左右に動かす
    Picture1.Left = -HScroll1.Value

End Sub
Private Sub Form_Resize()
    'フォームの大きさに合わせてスクロールバーをセットする
    スクロールバー

End Sub

ASD 2004-09-25 02:41:51 No: 85622

りっとっとさんの方法でもうまく動きました。スクロールバーをつけないならりっとっとさんのほうが簡単でいいと思います。