FORMATAR HORAS

PROGRAMADORVB6 26/02/2010 12:06:05
#335456
Olá pessoal.
Este código foi retirado do exemplo do Capitão garcia, contudo descobri um erro que não consigo resolver.
A função deste código é formatar as horas á medida que se vai escrevendo.
O problema que me deparei, quando escrevi 21:58 e quis apagar o 2 subtituindo por 1, o cursor ia para a posição final retirando o 1º valor e o último , ficando assim : 1:5
Além disso quando se encontra assim 1:5 ao acrescentar um 3 para ficar assim 31:5 ele deveria negar a introdução do nº 3 como faz de inicio, pois não é hora válida.

- Textbox : TxtHora ; Text1

Deixo-vos aqui o código :

No form :


Código:

Option Explicit
Private bDozeHoras As Boolean
Private bComSegundos As Boolean

Private Sub txthora_Change()
With TxtHora
If bDozeHoras Then
If Len(.Text) = 1 And .Text > [Ô]1[Ô] Then .Text = [Ô][Ô]: .SelStart = Len(.Text)
If Len(.Text) = 2 And Mid(.Text, 2, 1) > [Ô]2[Ô] Then .Text = Left(.Text, 1): .SelStart = Len(.Text)
Else
If Len(.Text) = 1 And .Text > [Ô]2[Ô] Then .Text = [Ô][Ô]: .SelStart = Len(.Text)
End If

If Len(.Text) = 2 And Mid(.Text, 1, 1) = [Ô]2[Ô] And Mid(.Text, 2, 1) > [Ô]4[Ô] Then .Text = Left(.Text, 1): .SelStart = Len(.Text)

If Len(.Text) = 4 And Mid(.Text, 4, 1) > [Ô]5[Ô] Then .Text = Left(.Text, 3): .SelStart = Len(.Text)

If bComSegundos Then
If Len(.Text) = 7 And Mid(.Text, 7, 1) > [Ô]5[Ô] Then .Text = Left(.Text, 6): .SelStart = Len(.Text)
End If

[ô]Me.Caption = Len(.Text)
End With
End Sub

Private Sub txthora_GotFocus()
If bComSegundos Then
TxtHora.MaxLength = 8
Else
TxtHora.MaxLength = 5
End If

Screen.ActiveControl.SelStart = 0: Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text)
End Sub

Private Sub txthora_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Or KeyAscii = 8 Then
If Len(TxtHora.Text) = 4 Then TxtHora.Text = Left(TxtHora.Text, 3): TxtHora.SelStart = Len(TxtHora.Text)
If Len(TxtHora.Text) = 7 Then TxtHora.Text = Left(TxtHora.Text, 6): TxtHora.SelStart = Len(TxtHora.Text)

If KeyAscii <> 8 Then
If ValidarHoras(TxtHora.Text) = False Then
MsgBox [Ô]hora invalida![Ô]
TxtHora.SetFocus
Exit Sub
End If
End If
If ValidarHoras(TxtHora.Text) = True Then
If KeyAscii <> 8 Then
If Len(Text1.Text) = 0 Then
TxtHora.SetFocus
Exit Sub
End If

If Len(TxtHora.Text) = 5 Then
Text1.SetFocus
End If
Exit Sub
End If
End If
Else
If Not IsNumeric(Chr(KeyAscii)) Then
KeyAscii = 0
Else
If Len(TxtHora.Text) = 2 Then TxtHora.Text = TxtHora.Text & [Ô]:[Ô]: TxtHora.SelStart = Len(TxtHora.Text)
If bComSegundos Then
If Len(TxtHora.Text) = 5 Then TxtHora.Text = TxtHora.Text & [Ô]:[Ô]: TxtHora.SelStart = Len(TxtHora.Text)
End If
End If
End If
End Sub


No Módulo :


Código:

[ô]---------------------------------------------------------------------------------------
[ô] Função : ValidarHoras
[ô] Data/Hora : 27-09-2009 18:34
[ô] Autor : Morpheus
[ô] Descrição : Verifica se a Hora é válida
[ô]---------------------------------------------------------------------------------------
[ô]

Public Function ValidarHoras(DizHoras As String) As Boolean
If IsDate(DizHoras) Then
ValidarHoras = True
Else
ValidarHoras = False
End If

End Function


Desde já agradeço a vossa atenção e disponibilidade.
DAVERSON 01/03/2010 23:18:59
#335733
Resposta escolhida
FUNÇÃO ADICIONAL PARA O TRATAMENTO DE HORAS

Private Function CalculaSeg(HoraIni As String, HoraFim As String) As String
Dim Sec1 As Integer, Sec2 As Integer
Sec1 = 0: Sec2 = 0: sDelimiter = 0
If Len(HoraIni) > 5 Then _
Sec1 = Mid(HoraIni, InStrRev(HoraIni, [Ô]:[Ô]) + 1)
If Len(HoraFim) > 5 Then _
Sec2 = Mid(HoraFim, InStrRev(HoraFim, [Ô]:[Ô]) + 1)
If Sec1 > Sec2 Then Sec1 = Sec1 - 60: sDelimiter = 1
CalculaSeg = (Sec1 - Sec2)
CalculaSeg = [Ô]:[Ô] & Format(SomenteNumeros(CalculaSeg), [Ô]00[Ô])
End Function

[ô]FUNÇÃO ADICIONAL PARA O TRATAMENTO DE HORAS

Private Function TransformaTempo(cTempo As String) As String
For i = 0 To 23
If Int(Mid(cTempo, 1, 2)) = i Then _
TransformaTempo = i + 24 & Mid(cTempo, 3, 3)
Next
If Len(cTempo) > 5 Then _
TransformaTempo = TransformaTempo & [Ô]:00[Ô]
End Function

[ô]FUNÇÃO ADICIONAL PARA O TRATAMENTO DE HORAS

Private Function SomenteNumeros(iText As String) As String
Dim i As Integer, j As String
For i = 1 To Len(iText)
If Asc(Mid(iText, i, 1)) < 48 Or _
Asc(Mid(iText, i, 1)) > 57 Then
Else
j = j & Mid(iText, i, 1)
End If
SomenteNumeros = j
Next
End Function

[ô]CALCULA DIFERENÇA DE HORAS
[ô]CRIADA POR JOSEFH HENNYERE SANTOS MIRANDA
[ô]01/01/2007

Public Function DiferencaHoras(HoraIni As String, HoraFim As String) As String
Dim sSec As String
sSec = CalculaSeg(HoraIni, HoraFim)
If SomenteNumeros(HoraIni) > SomenteNumeros(HoraFim) Then
HoraFim = TransformaTempo(HoraFim)
DiferencaHoras = SomenteNumeros(TransformMinutes(HoraFim)) - SomenteNumeros(TransformMinutes(HoraIni))
Else
DiferencaHoras = SomenteNumeros(TransformMinutes(HoraIni)) - SomenteNumeros(TransformMinutes(HoraFim))
End If
DiferencaHoras = SomenteNumeros(DiferencaHoras) - sDelimiter
DiferencaHoras = TransformHour(DiferencaHoras) & sSec
End Function

[ô]TRANSFORMA HORAS EM MINUTOS
[ô]CRIADA POR JOSEFH HENNYERE SANTOS MIRANDA
[ô]01/01/2007

Function TransformMinutes(Horas As String) As Double
Dim h As Integer, m As Integer
h = Mid(Horas, 1, 2) * 60
m = Mid(Horas, InStr(Horas, [Ô]:[Ô]) + 1, 2)
TransformMinutes = h + m
End Function

[ô]TRANSFORMA MINUTOS EM HORAS
[ô]CRIADA POR JOSEFH HENNYERE SANTOS MIRANDA
[ô]01/01/2007

Public Function TransformHour(Minutos As String) As String
On Error GoTo errHandler
Dim h As Integer, m As Integer, s As Integer, j As Integer, i As Integer
For j = 1 To Minutos
For i = 1 To 60
s = i
If s > 59 Then
s = 0
m = m + 1
End If
If m > 59 Then
m = 0
h = h + 1
End If
Next
Next
TransformHour = h & [Ô]:[Ô] & Format(m, [Ô]00[Ô])
TransformHour = IIf(Mid(TransformHour, 2, 1) = [Ô]:[Ô], _
[Ô]0[Ô] & TransformHour, TransformHour)
Exit Function
errHandler:
TransformHour = Minutos
End Function



Private Sub Command1_Click()
[ô]HORA INICIAL MENOR QUE A HORA FINAL
Dim sMsg(0 To 3) As String
sMsg(0) = [Ô]HORA INICIAL(04:00:15) MENOR QUE A HORA FINAL(04:00:30) é IGUAL A UM INTERVALO DE: [Ô] & DiferencaHoras([Ô]04:00:15[Ô], [Ô]04:00:30[Ô]) & vbCrLf & vbCrLf
sMsg(1) = [Ô]HORA INICIAL(04:00:15) MAIOR QUE A HORA FINAL(04:00:00) é IGUAL A UM INTERVALO DE: [Ô] & DiferencaHoras([Ô]04:00:15[Ô], [Ô]04:00:00[Ô]) & vbCrLf & vbCrLf
sMsg(2) = [Ô]TRANSFORMADO A HORA 04:00:00 EM MINUTOS FICARIA: [Ô] & TransformMinutes([Ô]04:00:15[Ô]) & [Ô] MINUTOS[Ô] & vbCrLf & vbCrLf
sMsg(3) = [Ô]TRANSFORMADO 478 MINUTOS EM HORAS FICARIA: [Ô] & TransformHour([Ô]478[Ô]) & [Ô] HORAS[Ô] & vbCrLf & vbCrLf
[ô]
MsgBox sMsg(0) + sMsg(1) + sMsg(2) + sMsg(3), vbExclamation, [Ô]::. CÁLCULO DE HORAS[Ô]

End Sub

Espero que ajude...
Tópico encerrado , respostas não são mais permitidas