• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

NuGuN

[VB6] Calcular Anos Bisextos

5 mensagens neste tópico

Aqui a uns dias atraz precisei de saber quais os anos que eram bisextos, e entao andei a pesquisar e deois fiz istu  ;)

Private Function AnoBisexto(ValAno As Single) As Boolean
If (ValAno Mod 4 = 0) And ((ValAno Mod 100 <> 0) Or (ValAno Mod 400 = 0)) Then
    AnoBisexto = True
    Else
        AnoBisexto = False
End If
End Function

Depois para utilizar basta colocarem estas linhas num botão ou algo do genero

If AnoBisexto(2006) Then
    MsgBox "Ano Bisexto"
    Else
        MsgBox "Ano Normal!"
End If

Cumps

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Boas!

De facto esse é um problema bastante tipico em trabalhos de introdução à programação ;)

O facto de a divisão do ano por 4 ter de dar resto zero é fácil de deduzir porquê, no entanto convinha teres explicar o resto ;) Não é tão intuitivo.

Mas a titulo de exemplo, vejamos o caso do ano 1300, o resto da divisão por 4 de facto dá zero, no entanto não foi bi-sexto, daí o requisito de não poder ser divisivel por 100 :( Em contrapartida o ano 1200 já foi bi-sexto e é divisivel por 100 também..., então temos o caso de ter de ser dívisivel por 400.

Código bacano :D

abraços, HecKel

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Experimentem este código e obterão todos os anos bissextos contidos num intervalo "Ano1" e "Ano2"

Dim Ano As Variant
Dim Ano1 As Integer
Dim ModAno As Integer
Dim ModAnoSeculo As Integer
Dim ModAnoQuadrienio As Integer

Private Sub CmdAjuda_Click(Index As Integer)
MsgBox "Este programa permite determinar quais os anos bissextos" _
& Chr(13) & "no intervalo definido pelo Ano 1 e o Ano 2." _
& Chr(13) & "No caso dos resultados não estarem todos visíveis na janela" _
& Chr(13) & "use o scrollbar vertical para ver tudo.", , "Atenção"

End Sub

Private Sub CmdCalcular_Click(Index As Integer)
If TxtAno1 > TxtAno Then
If TxtAno > 1582 Then
If Len(TxtAno) = 4 And Len(TxtAno1) = 4 Then
Ano = TxtAno
Ano1 = TxtAno1
Mensagem = ""
For Numero = Ano To Ano1 Step 1
ModAno = Numero Mod 4
ModAnoSeculo = Numero Mod 100
ModAnoQuadrienio = Numero Mod 400
If ModAno = 0 And ModAnoSeculo <> 0 Then
Ano = Numero
ElseIf ModAnoSeculo = 0 And ModAnoQuadrienio = 0 Then
Ano = Numero
Else
Ano = ""
End If
Mensagem = Mensagem & " " & Ano
Next Numero
TxtSaida = Mensagem
Else
MsgBox "O Ano tem de ter obrigatóriamente 4 dígitos", , "Atenção"
End If
Else
MsgBox "O Ano 1 tem de ser posterior a 1582," & Chr(13) & "ano da imposição do calendário Gregoriano", , "Atenção"
End If
Else
MsgBox "O Ano 2 terá obviamente de ser posterior ao Ano 1", , "Atenção"
End If
TxtAno.SetFocus
End Sub

Private Sub CmdImprimir_Click(Index As Integer)
    Dim Msg
    On Error GoTo Trata_Erro
    
    If TxtSaida <> "" Then
    PrintForm 'Imprimir o formulário actual
    Exit Sub
    Else
Trata_Erro:
    Msg = "O formulário não pode ser impresso!" & Chr(13) & _
    "Não há dados para imprimir!"
    MsgBox Msg
    End If
End Sub

Private Sub CmdSaberMais_Click(Index As Integer)
FrmAnoBissexto.Hide
FrmSaberMais.Show

End Sub

Private Sub CmdSair_Click(Index As Integer)
End
End Sub

Private Sub CmdVoltar_Click(Index As Integer)
FrmAnoBissexto.Hide
TxtAno = Clear
TxtAno1 = Clear
TxtSaida = Clear
FrmMenu.Show
End Sub

Private Sub TxtAno_Change()
TxtSaida = Clear
End Sub

Private Sub TxtAno_KeyPress(KeyAscii As Integer)
If KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Or KeyAscii = vbKeyBack Then
vbKey = vbKey
Else
KeyAscii = False
End If
End Sub

Private Sub TxtAno1_Change()
TxtSaida = Clear
End Sub

Private Sub TxtAno1_KeyPress(KeyAscii As Integer)
If KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Or KeyAscii = vbKeyBack Then
vbKey = vbKey
Else
KeyAscii = False
End If
End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Agradecimentos por parte da turma 1º e do iefp do seixal.

Por ajuda com o codigo

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

santos, o teu código podia ser optimizado se o step do ciclo fosse 4..

isto é:

AnoBi=primeiroanobissextodepoisdeAno

For Numero=AnoBi To Ano1 Step 4
...

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora