Scroll de Imagenes?

Iniciado por z3nth10n, 31 Mayo 2013, 20:38 PM

0 Miembros y 1 Visitante están viendo este tema.

Eleкtro

Esto ya está mejor, aunque la parte "alternativa" no está pulida, la parte "progresiva" está sin bugs:

[youtube=640,360]http://www.youtube.com/watch?v=-ctGY1k8M34&feature=youtu.be[/youtube]

Código (vbnet) [Seleccionar]
Public Class Form1

    Dim Scroll_Position As Int32 = 0
    Dim Button_Down_Is_Pressed As Boolean = False
    Dim Button_Up_Is_Pressed As Boolean = False
    Dim WithEvents Progressive_Scroll_Timer As New Timer
    Dim SmallChange As Int32 = 10
    Dim Largechange As Int32 = 20
    Dim Maximum As Int64 = 0

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Panel1.AutoScroll = True
        Maximum = Panel1.VerticalScroll.Maximum
        Panel1.AutoScroll = False
        Panel1.VerticalScroll.Maximum = Maximum / 2
        Progressive_Scroll_Timer.Interval = 50
        Panel1.BackColor = Color.FromArgb(150, 0, 0, 0)

        For Each PicBox As PictureBox In Panel1.Controls
            AddHandler PicBox.MouseHover, AddressOf Panel_MouseHover
        Next

    End Sub

    Private Sub Panel_MouseHover(sender As Object, e As EventArgs) Handles Panel1.MouseHover
        sender.select()
        sender.focus()
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Progressive_Scroll_Timer.Tick
        If Button_Down_Is_Pressed Then
            Scroll_Down(SmallChange)
        ElseIf Button_Up_Is_Pressed Then
            Scroll_Up(SmallChange)
        Else
            sender.stop()
        End If
    End Sub

    Private Sub Scroll_Up(ByVal Change As Int32)
        Scroll_Position -= Change
        Try
            Panel1.VerticalScroll.Value = Scroll_Position
        Catch
            Scroll_Position = 0
        End Try
    End Sub

    Private Sub Scroll_Down(ByVal Change As Int32)
        Scroll_Position += Change
        Try
            Panel1.VerticalScroll.Value = Scroll_Position
        Catch
            Scroll_Position -= Change
        End Try
    End Sub

    Private Sub Button_Down_MouseDown(sender As Object, e As MouseEventArgs) Handles Button2.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Button_Down_Is_Pressed = True
            Progressive_Scroll_Timer.Start()
        End If
    End Sub

    Private Sub Button_Up_MouseDown(sender As Object, e As MouseEventArgs) Handles Button1.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Button_Up_Is_Pressed = True
            Progressive_Scroll_Timer.Start()
        End If
    End Sub

    Private Sub Button_Down_MouseUp(sender As Object, e As MouseEventArgs) Handles Button2.MouseUp
        Button_Down_Is_Pressed = False
    End Sub

    Private Sub Button_Up_MouseUp(sender As Object, e As MouseEventArgs) Handles Button1.MouseUp
        Button_Up_Is_Pressed = False
    End Sub

    Private Sub Form_MouseWheel(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Panel1.MouseWheel
        Select Case Math.Sign(e.Delta)
            Case Is > 0 : Scroll_Up(Largechange)
            Case Is < 0 : Scroll_Down(Largechange)
        End Select
    End Sub



    ' Versión alternativa:
    Dim PictureBoxes_Height As Int64 = 100 ' La altura de cada picturebox

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        Scroll_Position -= PictureBoxes_Height
        Try
            Panel1.VerticalScroll.Value = Scroll_Position
        Catch
            Panel1.VerticalScroll.Value = 1
            Scroll_Position += PictureBoxes_Height
        End Try
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        Scroll_Position += PictureBoxes_Height
        Try
            Panel1.VerticalScroll.Value = Scroll_Position
        Catch

            Scroll_Position -= PictureBoxes_Height
        End Try
    End Sub
    ' Fin de versión alternativa

End Class


Código (vbnet) [Seleccionar]
Public Class DoubleBufferedPanel
    Inherits Panel

    Public Sub New()
        DoubleBuffered = True
        ResumeLayout(False)
    End Sub

    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim cp As CreateParams = MyBase.CreateParams
            cp.ExStyle = cp.ExStyle Or &H2000000
            Return cp
        End Get
    End Property

End Class








z3nth10n

Con pulir a que te refieres?

Por cierto, necesito una ultima cosa si no es mucho pedir... Un loop infinito, es decir cuando termine las imagenes vuelve a mostrarse el inicio... Se puede hacer? :silbar:

Interesados hablad por Discord.

Eleкtro

#12
Cita de: Ikillnukes en  5 Junio 2013, 21:15 PM
Con pulir a que te refieres?

Me refería a que no está sin bugs, da un pequeño problema al sobrepasar el tope del margen del scroll hacia arriba o hacia abajo, solo me he preocupado en perfeccionar el scroll progresivo, porque es como a mi me gusta xD.

Cita de: Ikillnukes en  5 Junio 2013, 21:15 PMPor cierto, necesito una ultima cosa si no es mucho pedir... Un loop infinito, es decir cuando termine las imagenes vuelve a mostrarse el inicio... Se puede hacer? :silbar:

Mira, iba a mandarte a la ***** por tanto pedir y que te lo hicieras tu solo, sincéramente xD,
pero me ha gustado la idea del loop infinito, creo que voy a desarrollar un panel heredado desde 0 con lo que ya llevo hecho y le añadiré una propiedad pública que se llame "Loop" para habilitar/deshabilitar el loop del scroll.

Poder, se puede hacer, solo hay que reiniciar los valores del scroll... lo podrías hacer tu mismo.

Salu2!








z3nth10n

Ya pero no se.  ;D

PD: Ya se que soy un poco cabroncete. xD
PDS: El scroll de Black lo tiene...  :silbar:

Un saludo y perdon por ser un incordio xD
PDSS:
Te recompensaré con dubstep  >:D

Interesados hablad por Discord.

Eleкtro

#14
Mi panel extendido tiene una propiedad para activar el "Scroll Loop" (el cual solo funciona con la propiedad AutoScroll activada).

Para hacer un "Scroll Loop" inteligente sin AutoScroll, ya te lo he dicho, resetea los valores del "Me.VerticalScroll.Value" al sobrepasar "X" valor, hazlo como quieras.

Código (vbnet) [Seleccionar]
'
'  /*               *\
' |#* Panel Elektro *#|
'  \*               */
'
' // By Elektro H@cker
'
'   Properties:
'   ...........
' · Disable_Flickering
' · Double_Buffer
' · Opaccity
' · Scroll_Loop

Public Class Panel_Elektro
    Inherits Panel

    Private _Opaccity As Int16 = 100
    Private _Diable_Flickering As Boolean = True
    Private _Scroll_Loop As Boolean = False

    Dim Scroll_Range As Int64 = 0

    Public Sub New()
        Me.Name = "Panel_Elektro"
        ' Me.AutoScroll = True
        ' ResumeLayout(False)
    End Sub

#Region " Properties "

    ''' <summary>
    ''' Enable/Disable any flickering effect on the panel.
    ''' </summary>
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            If _Diable_Flickering Then
                Dim cp As CreateParams = MyBase.CreateParams
                cp.ExStyle = cp.ExStyle Or &H2000000
                Return cp
            Else
                Return MyBase.CreateParams
            End If
        End Get
    End Property

    ''' <summary>
    ''' Set the Double Buffer.
    ''' </summary>
    Public Property Double_Buffer() As Boolean
        Get
            Return Me.DoubleBuffered
        End Get
        Set(ByVal Value As Boolean)
            Me.DoubleBuffered = Value
        End Set
    End Property

    ''' <summary>
    ''' Set the transparency for this panel.
    ''' </summary>
    Public Property Opaccity() As Short
        Get
            Return _Opaccity
        End Get
        Set(ByVal Value As Short)
            If Value > 100 Then Throw New Exception("Opaccity range is from 0 to 100")
            If Value < 0 Then Throw New Exception("Opaccity range is from 0 to 100")
            Me._Opaccity = Value
            Make_Opaccity(Value, Me.BackColor)
        End Set
    End Property

    ''' <summary>
    ''' Enable/Disable the flickering effects on this panel.
    '''
    ''' This property turns off any Flicker effect on the panel
    ''' ...but also reduces the performance (speed) of the panel about 30% slower.
    ''' This don't affect to the performance of the application itself, only to the performance of this control.
    ''' </summary>
    Public Property Diable_Flickering() As Boolean
        Get
            Return _Diable_Flickering
        End Get
        Set(ByVal Value As Boolean)
            Me._Diable_Flickering = Value
        End Set
    End Property

    ''' <summary>
    ''' Enable/Disable the scroll loop effect.
    ''' Only when AutoScroll option is set to "True".
    ''' </summary>
    Public Property Scroll_Loop() As Boolean
        Get
            Return _Scroll_Loop
        End Get
        Set(ByVal Value As Boolean)
            Me._Scroll_Loop = Value
        End Set
    End Property

#End Region

#Region " Event handlers "

    ' Scroll
    Private Sub Infinite_Scroll_Button(sender As Object, e As ScrollEventArgs) Handles Me.Scroll

        If _Scroll_Loop AndAlso Me.AutoScroll Then

            Set_Scroll_Range()

            If Me.VerticalScroll.Value >= Scroll_Range - 4 Then ' Button Down
                Me.VerticalScroll.Value = 1
            ElseIf Me.VerticalScroll.Value <= 0 Then ' Button Up
                Me.VerticalScroll.Value = Scroll_Range
            End If

        End If

    End Sub

    ' MouseWheel (Scroll)
    Private Sub Infinite_Scroll_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel

        If _Scroll_Loop AndAlso Me.AutoScroll Then

            Set_Scroll_Range()

            If e.Delta < 0 AndAlso Me.VerticalScroll.Value >= Scroll_Range - 4 Then ' MouseWheel Down
                Me.VerticalScroll.Value = 1
            ElseIf e.Delta > 0 AndAlso Me.VerticalScroll.Value <= 0 Then ' MouseWheel Up
                Me.VerticalScroll.Value = Scroll_Range
            End If

        End If

    End Sub

#End Region

#Region " Methods / Functions "

    ''' <summary>
    ''' Changes the transparency of this panel.
    ''' </summary>
    Private Sub Make_Opaccity(ByVal Percent As Short, ByVal colour As Color)
        Me.BackColor = Color.FromArgb(Percent * 255 / 100, colour.R, colour.G, colour.B)
    End Sub

    ''' <summary>
    ''' Set the VerticalScrollBar Range.
    ''' </summary>
    Private Sub Set_Scroll_Range()
        Scroll_Range = Me.VerticalScroll.Maximum - Me.VerticalScroll.LargeChange + Me.VerticalScroll.SmallChange
    End Sub

#End Region

End Class








BlackM4ster

Cita de: Ikillnukes en  5 Junio 2013, 21:15 PM
Con pulir a que te refieres?

Por cierto, necesito una ultima cosa si no es mucho pedir... Un loop infinito, es decir cuando termine las imagenes vuelve a mostrarse el inicio... Se puede hacer? :silbar:

Oye, mi código ya hace eso...  :-\
- Pásate por mi web -
https://codeisc.com

z3nth10n

Ya lo sé, no te mosquees, voy a probar los dos y el que más me guste me lo quedo.. xD

Por cierto, ayudame con lo del botón y ya está. :P

El code de leer los inis ya lo tienes  :silbar:

Interesados hablad por Discord.

BlackM4ster

Cita de: Ikillnukes en  6 Junio 2013, 18:51 PM
Ya lo sé, no te mosquees, voy a probar los dos y el que más me guste me lo quedo.. xD

Por cierto, ayudame con lo del botón y ya está. :P

El code de leer los inis ya lo tienes  :silbar:

El modulo que lee inis si lo tengo, el source del boton ya te lo pasé
Skype
- Pásate por mi web -
https://codeisc.com

z3nth10n

#18
Okeys, ehm, tengo un problemi, y es que no se adaptar tu code del infiloop... Si fueras tan amable de decirme mañana como es... Gracias! :D

PD: Ya he estado probando, pero ahora el scroll no baja, por no decir que aun ni le he puesto el infiloop xD

Interesados hablad por Discord.

z3nth10n

A ver aquí dejo un vídeo mostrando lo que me pasa con el Scroll

[youtube=640,360]http://www.youtube.com/watch?v=gnb6oNmF0f8[/youtube]

Si necesitas el proyecto Elektro por MP te lo mando. ;)

Interesados hablad por Discord.