Albacete
Aquí tenéis el control "esperador". Es un control que hace lo mismo que el proyecto de julio, pero en forma de control, claro.
La ventaja es que se integra en el IDE, con lo que lo podéis incluir en cualquier formulario... las veces que queráis.
El proyecto en sí lleva los iconos del niño corredor de Julio. Los podéis sustituir por los que queráis, siempre que se llamen número.png.
De todas formas le he puesto una propiedad DirPictures que debe ser el camino a una carpeta que contenga una serie de imágenes que se llame también así (numero.png) El control se adapta a la cantidad de imágenes que existan en la carpeta.
Éste es el código fuente:
' gambas class file
Export
Public Const _Properties As String = "*,DirPictures"
Public Const _Group As String = "View"
Public Const _Similar As String = "PictureBox"
Public Const _drawWith As String = "esperador"
Inherits UserControl
Property DirPictures As String
Private $path As String
Private $ciclos As Integer
Private $pic As PictureBox
Private $nImages As Integer
Public Sub _new()
$pic = New PictureBox(Me)
$pic.Stretch = True
Me.Proxy = $pic
End
Public Sub reDraw()
$ciclos += 1
If $ciclos <= 4 Then
$pic.Picture = Picture.Load($path &/ Str($ciclos) & ".png")
Wait 0.1
Else
$ciclos = 0
Endif
End
Public Sub Stop()
$pic.Picture = Null
End
Private Function DirPictures_Read() As String
Return $path
End
Private Sub DirPictures_Write(Value As String)
$path = Value
$nImages = Dir(Value).Count
End
Export
Public Const _Properties As String = "*,DirPictures"
Public Const _Group As String = "View"
Public Const _Similar As String = "PictureBox"
Public Const _drawWith As String = "esperador"
Inherits UserControl
Property DirPictures As String
Private $path As String
Private $ciclos As Integer
Private $pic As PictureBox
Private $nImages As Integer
Public Sub _new()
$pic = New PictureBox(Me)
$pic.Stretch = True
Me.Proxy = $pic
End
Public Sub reDraw()
$ciclos += 1
If $ciclos <= 4 Then
$pic.Picture = Picture.Load($path &/ Str($ciclos) & ".png")
Wait 0.1
Else
$ciclos = 0
Endif
End
Public Sub Stop()
$pic.Picture = Null
End
Private Function DirPictures_Read() As String
Return $path
End
Private Sub DirPictures_Write(Value As String)
$path = Value
$nImages = Dir(Value).Count
End
Como veis, el control tiene un método ReDraw() que es el que cambia la imagen del control. En el formulario sólo tenéis que llamarlo.
Este es el código del formulario:
Public Sub Button1_Click()
Dim prsbatch As Process
prsbatch = Shell "sleep 10" 'proceso externo que tarda 10 segundos
While prsbatch.state = prsBatch.running
Try esperador1.reDraw() 'Si cierras el form antes de que termine la tarea del shell, la tarea y el ciclo de eventos continuarán pero el objeto esperador ya no existirá cuando el shell devuelva el control al ciclo de eventos.
If Error Then Break
Wend
End
Dim prsbatch As Process
prsbatch = Shell "sleep 10" 'proceso externo que tarda 10 segundos
While prsbatch.state = prsBatch.running
Try esperador1.reDraw() 'Si cierras el form antes de que termine la tarea del shell, la tarea y el ciclo de eventos continuarán pero el objeto esperador ya no existirá cuando el shell devuelva el control al ciclo de eventos.
If Error Then Break
Wend
End
Lo he subido a la Granja de software de gambas con el nombre "waiter". Camarero en inglés pero, literalmente, "esperador". Espero que entiendan el chiste...
Aquí tenéis el código fuente.
| waiter-0.1.1.tar.gz | ||
| Descripción: |  Descargar |
|
| Nombre del archivo: | waiter-0.1.1.tar.gz | |
| Tamaño: | 28.58 KB | |
| Descargado: | 26 veces | |
| waiter-0.1.1.tar.gz | ||
| Descripción: | Descargar |
|
| Nombre del archivo: | waiter-0.1.1.tar.gz | |
| Tamaño: | 28.58 KB | |
| Descargado: | 26 veces | |
| waiter-0.1.1.tar.gz | ||
| Descripción: | Descargar |
|
| Nombre del archivo: | waiter-0.1.1.tar.gz | |
| Tamaño: | 28.58 KB | |
| Descargado: | 26 veces | |
Uruguay
