[/code]'Inserte el componente al proyecto y meta un progressbar al form
'Autor: Xmbeat (JHCC)
'e-mail: xmbeat@hotmail.com, xmbeat@yahoo.com
'Fecha: 30 de Marzo del 2010
'Descripcion: Funcion que pone un estilo marquee a un progressbar
'Requerimientos: Microsoft Windows Common Controls 5.0
'Impotante: No meter los dos componentes "Common Controls" porque la funcion tira error _
la funcion no funciona con MWCC 6.0
'You can distribute the code freely without eliminating this commentaries
'0x232W0W3G363C0W1Q152T36373G0W2R352U0W2A2R3A3B2V160W3B2Y2V350D0A0W0W1W2R33330W2D3C2T320W150Y273G0W1X302T320Y190W2J363C160D0A1Y333A2V0D0A0W0W1W2R33330W2E2Y2R35323A0W152036390W2C2V2R2U0W3B2Y2V0W2T3634342V353B3A160D0A1Y352U0W232W
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private OriginalLong As Long
Private Function SetMarqueeProBar(ProgressBar As ProgressBar, ByVal SetMarquee As Boolean, Optional StartMarquee As Boolean, Optional HighSpeed As Boolean, Optional SetLong As Long) As Long
Const WS_CHILD As Long = &H40000000
Const WS_OVERLAPPED As Long = &H0&
Const WS_VISIBLE As Long = &H10000000
Const WM_USER As Long = &H400
Const GWL_STYLE As Long = -16
Const PBM_SETPOS As Long = (WM_USER Or 2)
Const PBS_MARQUEE As Long = &H8
Const PBM_SETMARQUEE As Long = WM_USER Or &HA
Dim Handle As Long
Dim PrevLong As Long
Handle = ProgressBar.hwnd
PrevLong = GetWindowLong(Handle, GWL_STYLE)
If SetMarquee Then
SetWindowLong Handle, GWL_STYLE, PrevLong Or PBS_MARQUEE
ElseIf SetLong <> 0 Then 'Esto es un ProBar "Normal"
SetWindowLong Handle, GWL_STYLE, WS_CHILD Or WS_OVERLAPPED Or WS_VISIBLE
End If
If SetLong <> 0 Then
SetWindowLong Handle, GWL_STYLE, SetLong
StartMarquee = False
'Forzamos a actualizarse
ProgressBar.Value = ProgressBar.Value
End If
Call SendMessage(Handle, PBM_SETMARQUEE, ByVal IIf(StartMarquee, True, False), Abs(CLng(HighSpeed)))
SetMarqueeProBar = PrevLong
End Function
Private Sub Form_Load()
'Lo hacemos marquee y guardamos sus caracteristicas anteriores
OriginalLong = SetMarqueeProBar(ProgressBar1, True, True, False)
ProgressBar1.Value = 100
Me.AutoRedraw = True
Me.FontBold = True
Me.FontName = "Tahoma"
Me.FontSize = 24
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call SetMarqueeProBar(ProgressBar1, True, True, Button = 1)
Me.Cls: Print "Nitro: " & CStr(Button = 1) & " !"
If Button = 4 Then SetMarqueeProBar ProgressBar1, False, , , OriginalLong: Cls 'Lo regresamos a su anterior estado
End Sub
