Ver Mensaje Individual
  #5 (permalink)  
Antiguo 18/11/2005, 06:31
fredy666
 
Fecha de Ingreso: enero-2005
Ubicación: Benifaió (Valencia)
Mensajes: 319
Antigüedad: 19 años, 3 meses
Puntos: 0
Aqui te paso todo el codigo de mi formulario Splash, espero que lo puedas aprovechar xD

Código PHP:

Imports System
.Data
Imports System
.Data.SqlClient

Public Class frmSplash
    Dim intBarra 
As Integer 0
    Dim dblTransparencia 
As Double 0.0


    
Private Sub cmdAceptar_Click(ByVal sender As System.ObjectByVal e As System.EventArgsHandles cmdAceptar.Click
        strUser 
Trim(txtusu.Text)
        
subBuscarCodigoUsuario()
        
frmInicio.Show()
        
Me.Hide()
    
End Sub
    
Private Sub frmSplash_Load(ByVal sender As System.ObjectByVal e As System.EventArgsHandles MyBase.Load
      
        
'user = System.Environment.UserName
        prgBarraProgreso.Text = "Bienvenido " & System.Environment.UserName & ". Espere a que se cargue la aplicación ..."

        ' 
Aplicar el efecto
        prgBarraProgreso
.Position 0
        Timer1
.Enabled True
        Timer1
.Interval 100
    End Sub
    
Private Sub cmdCancelar_Click(ByVal sender As System.ObjectByVal e As System.EventArgsHandles cmdCancelar.Click
        cargarsalir
()
    
End Sub
    
Private Sub Timer1_Tick(ByVal sender As System.ObjectByVal e As System.EventArgsHandles Timer1.Tick
        intBarra 
+= 10
        prgBarraProgreso
.Text "Cargando la aplicación, por favor espere."
        
prgBarraProgreso.Position intBarra
        ProgressBar1
.Value intBarra
        
If prgBarraProgreso.Position 100 Then
            Timer1
.Stop()
            
Timer1.Enabled False
            ComprobarConexion
()
        
End If

        
dblTransparencia += 0.1
        
If dblTransparencia <> 1 Then
            Me
.Opacity dblTransparencia
        End 
If
    
End Sub
    
Private Sub cmdEmail_Click(ByVal sender As System.ObjectByVal e As System.EventArgsHandles cmdEmail.Click
        frmEmailSoporte
.ShowDialog()
    
End Sub
    
Private Sub cargarsalir()
        
Application.Exit()
    
End Sub

    
Public Sub ComprobarConexion()
        
Timer1.Stop()
        
Timer1.Enabled False

        
Try

            
cnConexion = New Data.SqlClient.SqlConnection(strConexion)
            
cnConexion.Open() 'Abrimos la conexion
            cnConexion.Close()
            bolCargaOK = True
            prgBarraProgreso.Text = "Aplicación cargada con éxito."
            Me.Text = "Cargado OK"
        Catch ex As Exception
            ' 
MsgBox("Ha habido un problema con la conexión." vbCrLf "Póngase en contacto con el departamento DTI."MsgBoxStyle.Critical MsgBoxStyle.OkOnly"Error cargando.")
            
' bolCargaOK = False
            ' 
prgBarraProgreso.Text "Error al cargar la aplicación."
            ' prgBarraProgreso.ForeColor = Color.DarkRed
            MsgBox(ex.Message, MsgBoxStyle.Critical)
        End Try

        If bolCargaOK = True Then
            cmdAceptar.Visible = True
            cmdCancelar.Visible = True
        Else
            cmdAceptar.Visible = False
            cmdCancelar.Visible = True
            cmdEmail.Visible = True
        End If
        bolCargaOK = True

    End Sub
  
    Public Sub subBuscarCodigoUsuario()
        Try
            Dim myReader As SqlDataReader
            Dim miccommand As SqlCommand
            miccommand = New SqlCommand
            miccommand.Connection = strConexion1
            strConexion1.Open()
            miccommand.CommandText = "SELECT fkh_empleado from tblusuario where fldlogin='" & Trim(strUser) & "'"
            myReader = miccommand.ExecuteReader
            If myReader.Read Then '
Devuelve algo porque hay mensaje por leer
                intUser 
Trim(myReader("fkh_empleado"))
            
End If
            
strConexion1.Close()
        Catch 
ex As Exception

        End 
Try
    
End Sub
End 
Class 
Debe de estar el frmSplash como principal, es decir, que sea el primero en cargar.