flyt image rundt

Hvis vi antager, at dit picture hedder Picture1, virker følgende kode:

Option Explicit
  Dim StartX 'Global variabel
  Dim StartY 'Global variabel

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StartX = X
  StartY = Y
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Picture1.Left = Picture1.Left + (X - StartX)
  Picture1.Top = Picture1.Top + (Y - StartY)
End Sub

Du kan forbedre det ved at skifte cursortypen når du rykker rundt på billedet ved at bruge MousePointer:

Option Explicit
Dim StartX
Dim StartY


Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  MousePointer = 15 '<-- NY LINIE
  StartX = X
  StartY = Y
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Picture1.Left = Picture1.Left + (X - StartX)
  Picture1.Top = Picture1.Top + (Y - StartY)
  MousePointer = 0 '<-- NY LINIE
End Sub

tak men vil du ikke lave sådan at musen forsvinder når man klikker på billede!

Skjul cursor er beskrevet i www.eksperten.dk/spm/42631

ha ha det kan også laves med lidt API :-)


Option Explicit

Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long

Public Sub hWndMove(ByVal lnghWnd As Long)
  Call ReleaseCapture
  Call SendMessage(lnghWnd, &HA1, 2, 0&)
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then
    Call hWndMove(Picture1.hwnd) '<-- Flytter Picture1
  End If
End Sub



'--- Her er lige et par stykker mere :-) ---
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then
    Call hWndMove(Me.hwnd) '<-- Flytter Form1
  End If
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton And Check1.Value = 1 Then '<-- Check1
    Call hWndMove(Command1.hwnd) '<-- Flytter Command1
      Else
    MsgBox "Du trykker på " & Command1.Name
  End If
End Sub
'--- Her er lige et par stykker mere :-) ---