Foro de elhacker.net

Programación => 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:




Código:
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
  1. VERSION 5.00
  2. Begin VB.Form Form1
  3.   Caption         =   "Form1"
  4.   ClientHeight    =   9495
  5.   ClientLeft      =   165
  6.   ClientTop       =   450
  7.   ClientWidth     =   12345
  8.   LinkTopic       =   "Form1"
  9.   ScaleHeight     =   9495
  10.   ScaleWidth      =   12345
  11.   StartUpPosition =   2  'CenterScreen
  12.   Begin VB.Timer Timer1
  13.      Enabled         =   0   'False
  14.      Interval        =   1000
  15.      Left            =   960
  16.      Top             =   3480
  17.   End
  18.   Begin VB.Label lblPause
  19.      Alignment       =   2  'Center
  20.      AutoSize        =   -1  'True
  21.      BackStyle       =   0  'Transparent
  22.      Caption         =   "PAUSADO"
  23.      BeginProperty Font
  24.         Name            =   "Arial"
  25.         Size            =   8.25
  26.         Charset         =   0
  27.         Weight          =   700
  28.         Underline       =   0   'False
  29.         Italic          =   0   'False
  30.         Strikethrough   =   0   'False
  31.      EndProperty
  32.      ForeColor       =   &H000000FF&
  33.      Height          =   210
  34.      Left            =   3210
  35.      TabIndex        =   2
  36.      Top             =   3720
  37.      Width           =   795
  38.   End
  39.   Begin VB.Label lblNegras
  40.      Alignment       =   2  'Center
  41.      BackColor       =   &H00000000&
  42.      Caption         =   "00:00"
  43.      BeginProperty Font
  44.         Name            =   "Arial"
  45.         Size            =   8.25
  46.         Charset         =   0
  47.         Weight          =   700
  48.         Underline       =   0   'False
  49.         Italic          =   0   'False
  50.         Strikethrough   =   0   'False
  51.      EndProperty
  52.      ForeColor       =   &H00FFFFFF&
  53.      Height          =   1155
  54.      Left            =   780
  55.      TabIndex        =   1
  56.      Top             =   1980
  57.      Width           =   3795
  58.   End
  59.   Begin VB.Label lblBlancas
  60.      Alignment       =   2  'Center
  61.      BackColor       =   &H00FFFFFF&
  62.      Caption         =   "00:00"
  63.      BeginProperty Font
  64.         Name            =   "Arial"
  65.         Size            =   8.25
  66.         Charset         =   0
  67.         Weight          =   700
  68.         Underline       =   0   'False
  69.         Italic          =   0   'False
  70.         Strikethrough   =   0   'False
  71.      EndProperty
  72.      ForeColor       =   &H00000000&
  73.      Height          =   1035
  74.      Left            =   720
  75.      TabIndex        =   0
  76.      Top             =   480
  77.      Width           =   4335
  78.   End
  79.   Begin VB.Menu mnuArchivo
  80.      Caption         =   "&Archivo"
  81.      Begin VB.Menu mnuArchivoTiempo
  82.         Caption         =   "Tiempo"
  83.         Shortcut        =   ^T
  84.      End
  85.      Begin VB.Menu sep1
  86.         Caption         =   "-"
  87.      End
  88.      Begin VB.Menu mnuArchivoSalir
  89.         Caption         =   "Salir"
  90.         Shortcut        =   ^Q
  91.      End
  92.   End
  93. End
  94. Attribute VB_Name = "Form1"
  95. Attribute VB_GlobalNameSpace = False
  96. Attribute VB_Creatable = False
  97. Attribute VB_PredeclaredId = True
  98. Attribute VB_Exposed = False
  99. Option Explicit
  100.  
  101. Dim TurnoBlancas As Boolean
  102. Dim UnSeg As Date
  103. Dim Listo As Boolean
  104. Dim Iniciado As Boolean
  105. Dim Terminado As Boolean
  106.  
  107. Private Sub Form_KeyPress(KeyAscii As Integer)
  108. If Terminado Then
  109.    Exit Sub
  110. End If
  111. If Not Iniciado Then
  112.    Iniciado = True
  113.    Exit Sub
  114. End If
  115. If UCase(Chr(KeyAscii)) = "P" Then
  116.    Timer1.Enabled = Not Timer1.Enabled
  117.    lblPause.Visible = Not lblPause.Visible
  118.    Exit Sub
  119. End If
  120. TurnoBlancas = Not TurnoBlancas
  121. End Sub
  122.  
  123. Private Sub Form_Load()
  124. Me.Caption = "Chess Clock v" & App.Major & "." & App.Minor & "." & App.Revision
  125.  
  126. UnSeg = CDate(CDate("00:00:02") - CDate("00:00:01"))
  127. Listo = False
  128. TurnoBlancas = False
  129. Terminado = True
  130. lblPause.Visible = False
  131. Timer1.Enabled = False
  132. End Sub
  133.  
  134. Private Sub Form_Resize()
  135. Dim Tam As Long
  136.  
  137. If Me.WindowState = vbMinimized Then Exit Sub
  138.  
  139. lblBlancas.Width = Me.ScaleWidth
  140. lblBlancas.Height = Me.ScaleHeight / 2
  141. lblBlancas.Top = 0
  142. lblBlancas.Left = 0
  143.  
  144. lblNegras.Width = Me.ScaleWidth
  145. lblNegras.Height = Me.ScaleHeight / 2
  146. lblNegras.Top = lblBlancas.Height
  147. lblNegras.Left = 0
  148.  
  149. Tam = Me.ScaleY(lblBlancas.Height, vbTwips, vbPixels)
  150. Tam = Tam - ((Tam * 35) \ 100)
  151.  
  152. lblBlancas.Font.Size = Tam
  153. lblNegras.Font.Size = Tam
  154.  
  155. Tam = Tam - ((Tam * 30) \ 100)
  156. lblPause.Font.Size = Tam
  157. lblPause.Top = lblBlancas.Height - (lblPause.Height / 2)
  158. lblPause.Left = (lblNegras.Width / 2) - (lblPause.Width / 2)
  159. End Sub
  160.  
  161. Private Sub mnuArchivoSalir_Click()
  162. Timer1.Enabled = False
  163. Unload Me
  164. End Sub
  165.  
  166. Private Sub mnuArchivoTiempo_Click()
  167. Dim Tiempo As String
  168. Dim strAux As String
  169.  
  170. Reponer:
  171.  
  172. strAux = InputBox("Ingresar la cantidad de tiempo en minutos (solo numeros enteros. Maximo 59 minutos). ", "Definir Cantidad de Tiempo", "15")
  173. strAux = Trim(strAux)
  174. If strAux = "" Then
  175.    Exit Sub
  176. End If
  177. If Not IsNumeric(strAux) Then
  178.    MsgBox "Ingrese solo numeros enteros"
  179.    GoTo Reponer
  180. End If
  181. If Len(strAux) > 2 Then
  182.    MsgBox "Numero muy grande!"
  183.    GoTo Reponer
  184. End If
  185. If CLng(strAux) > 59 Then
  186.    MsgBox "Numero muy grande!"
  187.    GoTo Reponer
  188. End If
  189. SetStart (CLng(strAux))
  190. End Sub
  191.  
  192. Private Sub SetStart(Tiempo As Long)
  193. lblPause.Visible = False
  194. Terminado = False
  195. Iniciado = False
  196. lblBlancas.Caption = IIf(Tiempo < 10, "0" & Tiempo, Tiempo) & ":00"
  197. lblNegras.Caption = IIf(Tiempo < 10, "0" & Tiempo, Tiempo) & ":00"
  198. Timer1.Enabled = True
  199. End Sub
  200.  
  201. Private Sub Timer1_Timer()
  202. Dim T As Date
  203. Dim strAux As String
  204.  
  205. If Not Iniciado Then Exit Sub
  206.  
  207. If TurnoBlancas Then
  208.    T = CDate("00:" + lblBlancas.Caption) - UnSeg
  209.    strAux = Format(T, "HH:mm:ss")
  210.    lblBlancas.Caption = Mid(strAux, 4, 5)
  211.    If (Second(T) = 0) And (Minute(T) = 0) Then
  212.        Timer1.Enabled = False
  213.        lblNegras.ForeColor = vbRed
  214.        Terminado = True
  215.    End If
  216. Else
  217.    T = CDate("00:" + lblNegras.Caption) - UnSeg
  218.    strAux = Format(T, "HH:mm:ss")
  219.    lblNegras.Caption = Mid(strAux, 4, 5)
  220.    If (Second(T) = 0) And (Minute(T) = 0) Then
  221.        Timer1.Enabled = False
  222.        lblNegras.ForeColor = vbRed
  223.        Terminado = True
  224.    End If
  225. End If
  226. End Sub
  227.  

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