Buenas!.
En este caso he añadido el evento mousemove y he activado la propiedad Tracking del ScrollArea.
Al principio el primer problema que me encontré es que me mostraba en el DrawingArea las barras de desplazamiento
del ScrollArea, luego lo solucioné.
Código:
Private unaimagen As Image
Public Sub Form_Open()
unaimagen = Image.Load("Politica-historia-Roma.jpg")
With ScrollArea1
.AutoResize = False
.ScrollBar = Scroll.Both
.ResizeContents(unaimagen.W, unaimagen.H)
.Tracking = True
.Refresh
End With
End
Public Sub DibujarImagen()
Paint.Translate(-ScrollArea1.ScrollX, -ScrollArea1.ScrollY)
Paint.DrawImage(unaimagen, 0, 0)
End
Public Sub ScrollArea1_Draw()
DibujarImagen
DrawingArea1.Refresh
End
Public Sub DrawingArea1_Draw()
Dim otraimagen As New Image
Dim hbrush As PaintBrush
If unaimagen Then
'Si se activa esta línea y se desactiva la siguiente, se muestran las barras de desplazamiento del ScrollArea en el DrawingArea
'otraimagen = Desktop.Screenshot(ScrollArea1.ScreenX, ScrollArea1.ScreenY, ScrollArea1.Width, ScrollArea1.Height).Image
otraimagen = Desktop.Screenshot(ScrollArea1.ScreenX, ScrollArea1.ScreenY, ScrollArea1.ClientWidth, ScrollArea1.ClientHeight).Image
hbrush = Paint.Image(otraimagen)
hbrush.Scale(DrawingArea1.W / otraimagen.W, DrawingArea1.H / otraimagen.H)
Paint.Brush = hbrush
Paint.Rectangle(0, 0, DrawingArea1.W, DrawingArea1.H)
Paint.Fill
Endif
End
Public Sub ScrollArea1_MouseMove()
ScrollArea1.Scroll(Mouse.X, Mouse.y)
End
Puede que sea interesante añadirle zoom.
Aún así, no funciona del todo. Lo sé por que donde salgo yo, no se muestra, llegaba tarde al senado..je, es deformación profesional.
Fijaros con la barra se ven los dos senadores en la parte inferior derecha del dibujo, en cambio con el ratón no se puede.
Saludos