Autor
Tema: Scroll de Imagenes? (Leído 28,683 veces)
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.885
Esto ya está mejor, aunque la parte "alternativa" no está pulida, la parte "progresiva" está sin bugs:
VIDEO 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
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
En línea
z3nth10n
Desconectado
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
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?
En línea
⏩
Interesados hablad por Discord.
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.885
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.
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?
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!
« Última modificación: 5 Junio 2013, 21:25 pm por EleKtro H@cker »
En línea
z3nth10n
Desconectado
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
Ya pero no se.
PD: Ya se que soy un poco cabroncete. xD
PDS: El scroll de Black lo tiene...
Un saludo y perdon por ser un incordio xD PDSS: Te recompensaré con dubstep
En línea
⏩
Interesados hablad por Discord.
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.885
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.
'
' /* *\
' |#* 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
« Última modificación: 6 Junio 2013, 02:26 am por EleKtro H@cker »
En línea
BlackM4ster
Desconectado
Mensajes: 499
Error, el teclado no funciona. Pulse F1 para continuar
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?
Oye, mi código ya hace eso...
En línea
z3nth10n
Desconectado
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
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á.
El code de leer los inis ya lo tienes
En línea
⏩
Interesados hablad por Discord.
BlackM4ster
Desconectado
Mensajes: 499
Error, el teclado no funciona. Pulse F1 para continuar
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á.
El code de leer los inis ya lo tienes
El modulo que lee inis si lo tengo, el source del boton ya te lo pasé
Skype
En línea
z3nth10n
Desconectado
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
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!
PD: Ya he estado probando, pero ahora el scroll no baja, por no decir que aun ni le he puesto el infiloop xD
« Última modificación: 7 Junio 2013, 07:54 am por Ikillnukes »
En línea
⏩
Interesados hablad por Discord.
z3nth10n
Desconectado
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
A ver aquí dejo un vídeo mostrando lo que me pasa con el Scroll
VIDEO Si necesitas el proyecto Elektro por MP te lo mando.
En línea
⏩
Interesados hablad por Discord.