Jump to content

[Dispondo] Mover e Redimensionar Objectos em modo de Execução


Johnny Mercy
 Share

Recommended Posts

Boas..

Desta vez trago-vos um código fresquinho do VB iMaster!

Com ele podem redimensionar e mover objectos enquanto o programa está a correr. Antes de mostrar qualquer código devo dizer como funciona na verdade (testem primeiro com picturebox's pois foi optimizado para tal).

Se clicarem por cima do objecto desejado com o botão direito (sempre pressionado) do rato e  o moverem, o objecto vai redimensionar.

Se clicarem por cima do objecto desejado com o botão esquerdo (sempre pressionado) do rato e o moverem. o objecto vai se mover.

Este código tem as funções todas e pode ser inserido em qualquer lugar desde que seja fora de qualquer rotina ou função:

#Region "Código Necessário"

    Dim WithEvents SelectedDragObject As Object

    Dim LastMousePositionX As Integer
    Dim LastMousePositionY As Integer
    Dim RealMousePositionX As Integer
    Dim RealMousePositionY As Integer
    Dim SaveX As Integer
    Dim SaveY As Integer

    Dim AreaDown As Boolean = False
    Dim AreaResize As Boolean = False

    Private Sub DragObject()

        Dim newLocationX As Integer = RealMousePositionX - (SaveX)
        Dim newLocationY As Integer = RealMousePositionY - (SaveY)

        SelectedDragObject.Location = New Point(newLocationX, newLocationY)
        SelectedDragObject.Select()

    End Sub

    Private Sub ResizeObject()

        Try
            SelectedDragObject.SizeMode = PictureBoxSizeMode.StretchImage
        Catch ex As Exception

        End Try

        If (RealMousePositionX > LastMousePositionX) Then

            SelectedDragObject.Size = New Size(SelectedDragObject.Width + 4, SelectedDragObject.Height)

        ElseIf (RealMousePositionX < LastMousePositionX) Then

            SelectedDragObject.Size = New Size(SelectedDragObject.Width - 4, SelectedDragObject.Height)

        End If

        If (RealMousePositionY > LastMousePositionY) Then

            SelectedDragObject.Size = New Size(SelectedDragObject.Width, SelectedDragObject.Height + 4)

        ElseIf (RealMousePositionY < LastMousePositionY) Then

            SelectedDragObject.Size = New Size(SelectedDragObject.Width, SelectedDragObject.Height - 4)

        End If

        LastMousePositionY = RealMousePositionY
        LastMousePositionX = RealMousePositionX

    End Sub

    Private Sub TimerDrag_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimerDrag.Tick

        RealMousePositionX = MousePosition.X - Me.Location.X
        RealMousePositionY = MousePosition.Y - Me.Location.Y

        If (AreaDown = True) Then

            DragObject()

        ElseIf (AreaResize = True) Then

            ResizeObject()

        End If

    End Sub

    Private Sub DelObjCache()

        SelectedDragObject = Nothing

        AreaResize = False
        AreaDown = False

    End Sub

#End Region

Após colocares o código cria um timer com as seguintes propriedades:

  • Name: TimerDrag
  • Interval: 1
  • Enabled: True

Feito isto agora é fácil, para dar o efeito apenas basta colocarem 2 eventos para cada Objecto (MouseDown e MouseUp) e atribuír

o seguinte código, respectivamente:

        SelectedDragObject = sender
        If e.Button = Windows.Forms.MouseButtons.Right Then
            AreaResize = True
        ElseIf e.Button = Windows.Forms.MouseButtons.Left Then
            SaveX = RealMousePositionX - SelectedDragObject.Location.X
            SaveY = RealMousePositionY - SelectedDragObject.Location.Y
            AreaDown = True
        End If

       DelObjCache()

Exemplo:

Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown

        SelectedDragObject = sender
        If e.Button = Windows.Forms.MouseButtons.Right Then
            AreaResize = True
        ElseIf e.Button = Windows.Forms.MouseButtons.Left Then
            SaveX = RealMousePositionX - SelectedDragObject.Location.X
            SaveY = RealMousePositionY - SelectedDragObject.Location.Y
            AreaDown = True
        End If

    End Sub

    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp

        DelObjCache()

    End Sub

Download do Projecto [VB 2008] -> Clique aqui para iniciar o download

É tudo! Espero que gostem.

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.