Test Foro de elhacker.net SMF 2.1

Programación => .NET (C#, VB.NET, ASP) => Programación General => Programación Visual Basic => Mensaje iniciado por: Demereth en 27 Marzo 2013, 20:58 PM

Título: Cuenta regresiva
Publicado por: Demereth en 27 Marzo 2013, 20:58 PM
Hola, necesito hacer un programa muy sencillo en el que haga una cuenta regresiva,y al terminarla haga un sonido de alarma y comienze nuevamente, tambien quiero que sea siempre visible y que se active con Av Pag o Supr.
ALGO ASI QUIERO: http://babilonia.jimdo.com/app/download/302514513/5153511b%2F2115afa03029c949e494d5c906b3a5e30b397d6d%2FVaquita.zip?t=1224601309 (http://babilonia.jimdo.com/app/download/302514513/5153511b%2F2115afa03029c949e494d5c906b3a5e30b397d6d%2FVaquita.zip?t=1224601309) pero que vos elijas los segundos de la cuenta regresiva.
La cuenta regresiva ya esta hecha, lo que no pude hacer es que comienze de nuevo al terminar, y que haga la alarma, lo de que sea siempre visible y se inicie con una tecla debe ser sencillo.
Yo se que es muy simple pero no se de vb6.
aca el codigo del contador:




Private Sub Command1_Click()
Label2.Caption = "00:00:" & Text1.Text
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Label2.Caption = Format(CDate(Label2.Caption) - CDate("00:00:01"), "hh:mm:ss")
If Label2.Caption = "00:00:00" Then
Timer1.Enabled = False
End If
End Sub


Gracias.

EDITO: YA LOGRE QUE SEA SIEMPRE VISIBLE Y SE INICIE CON UNA TECLA, LO QUE ME FALTA ES QUE AL TERMINAR HAGA UN SONIDO Y COMIENZE DE NUEVO.
Título: Re: Cuenta regresiva
Publicado por: MCKSys Argentina en 27 Marzo 2013, 21:11 PM
Te dejo el codigo de un "reloj de ajedrez" que hice hace un tiempo. Tiene la cuenta regresiva que pides y agunas cosillas mas (es el form completo).

Código (vb) [Seleccionar]

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   9495
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   12345
   LinkTopic       =   "Form1"
   ScaleHeight     =   9495
   ScaleWidth      =   12345
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   960
      Top             =   3480
   End
   Begin VB.Label lblPause
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "PAUSADO"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   210
      Left            =   3210
      TabIndex        =   2
      Top             =   3720
      Width           =   795
   End
   Begin VB.Label lblNegras
      Alignment       =   2  'Center
      BackColor       =   &H00000000&
      Caption         =   "00:00"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   1155
      Left            =   780
      TabIndex        =   1
      Top             =   1980
      Width           =   3795
   End
   Begin VB.Label lblBlancas
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "00:00"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   1035
      Left            =   720
      TabIndex        =   0
      Top             =   480
      Width           =   4335
   End
   Begin VB.Menu mnuArchivo
      Caption         =   "&Archivo"
      Begin VB.Menu mnuArchivoTiempo
         Caption         =   "Tiempo"
         Shortcut        =   ^T
      End
      Begin VB.Menu sep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuArchivoSalir
         Caption         =   "Salir"
         Shortcut        =   ^Q
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim TurnoBlancas As Boolean
Dim UnSeg As Date
Dim Listo As Boolean
Dim Iniciado As Boolean
Dim Terminado As Boolean

Private Sub Form_KeyPress(KeyAscii As Integer)
If Terminado Then
    Exit Sub
End If
If Not Iniciado Then
    Iniciado = True
    Exit Sub
End If
If UCase(Chr(KeyAscii)) = "P" Then
    Timer1.Enabled = Not Timer1.Enabled
    lblPause.Visible = Not lblPause.Visible
    Exit Sub
End If
TurnoBlancas = Not TurnoBlancas
End Sub

Private Sub Form_Load()
Me.Caption = "Chess Clock v" & App.Major & "." & App.Minor & "." & App.Revision

UnSeg = CDate(CDate("00:00:02") - CDate("00:00:01"))
Listo = False
TurnoBlancas = False
Terminado = True
lblPause.Visible = False
Timer1.Enabled = False
End Sub

Private Sub Form_Resize()
Dim Tam As Long

If Me.WindowState = vbMinimized Then Exit Sub

lblBlancas.Width = Me.ScaleWidth
lblBlancas.Height = Me.ScaleHeight / 2
lblBlancas.Top = 0
lblBlancas.Left = 0

lblNegras.Width = Me.ScaleWidth
lblNegras.Height = Me.ScaleHeight / 2
lblNegras.Top = lblBlancas.Height
lblNegras.Left = 0

Tam = Me.ScaleY(lblBlancas.Height, vbTwips, vbPixels)
Tam = Tam - ((Tam * 35) \ 100)

lblBlancas.Font.Size = Tam
lblNegras.Font.Size = Tam

Tam = Tam - ((Tam * 30) \ 100)
lblPause.Font.Size = Tam
lblPause.Top = lblBlancas.Height - (lblPause.Height / 2)
lblPause.Left = (lblNegras.Width / 2) - (lblPause.Width / 2)
End Sub

Private Sub mnuArchivoSalir_Click()
Timer1.Enabled = False
Unload Me
End Sub

Private Sub mnuArchivoTiempo_Click()
Dim Tiempo As String
Dim strAux As String

Reponer:

strAux = InputBox("Ingresar la cantidad de tiempo en minutos (solo numeros enteros. Maximo 59 minutos). ", "Definir Cantidad de Tiempo", "15")
strAux = Trim(strAux)
If strAux = "" Then
    Exit Sub
End If
If Not IsNumeric(strAux) Then
    MsgBox "Ingrese solo numeros enteros"
    GoTo Reponer
End If
If Len(strAux) > 2 Then
    MsgBox "Numero muy grande!"
    GoTo Reponer
End If
If CLng(strAux) > 59 Then
    MsgBox "Numero muy grande!"
    GoTo Reponer
End If
SetStart (CLng(strAux))
End Sub

Private Sub SetStart(Tiempo As Long)
lblPause.Visible = False
Terminado = False
Iniciado = False
lblBlancas.Caption = IIf(Tiempo < 10, "0" & Tiempo, Tiempo) & ":00"
lblNegras.Caption = IIf(Tiempo < 10, "0" & Tiempo, Tiempo) & ":00"
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Dim T As Date
Dim strAux As String

If Not Iniciado Then Exit Sub

If TurnoBlancas Then
    T = CDate("00:" + lblBlancas.Caption) - UnSeg
    strAux = Format(T, "HH:mm:ss")
    lblBlancas.Caption = Mid(strAux, 4, 5)
    If (Second(T) = 0) And (Minute(T) = 0) Then
        Timer1.Enabled = False
        lblNegras.ForeColor = vbRed
        Terminado = True
    End If
Else
    T = CDate("00:" + lblNegras.Caption) - UnSeg
    strAux = Format(T, "HH:mm:ss")
    lblNegras.Caption = Mid(strAux, 4, 5)
    If (Second(T) = 0) And (Minute(T) = 0) Then
        Timer1.Enabled = False
        lblNegras.ForeColor = vbRed
        Terminado = True
    End If
End If
End Sub


Espero te sirva...

Saludos!
Título: Re: Cuenta regresiva
Publicado por: Demereth en 28 Marzo 2013, 00:36 AM
Gracias por la ayuda, pero ya empeze el mio, un sencillo exe que vos pones una cifra en un text, pones start y empieza la cuenta regresiva, lo que quiero hacer y no puedo es que cuando termine, reproduzca un sonido cortito y comienze de nuevo, y asi sucesivamente.
Saludos
Título: Re: Cuenta regresiva
Publicado por: Demereth en 28 Marzo 2013, 16:47 PM
Ya lo pude hacer lo solucione con este simple cambio:

Private Sub Timer1_Timer()
    Label2.Caption = Format(CDate(Label2.Caption) - CDate("00:00:01"), "hh:mm:ss")
    If Label2.Caption = "00:00:00" Then
       Beep
       Label2.Caption = "00:00:" & Text1.Text
    End If
End Sub
SOLUCIONADO