• Regolamento Macrocategoria DEV
    Prima di aprire un topic nella Macrocategoria DEV, è bene leggerne il suo regolamento. Sei un'azienda o un hosting/provider? Qui sono anche contenute informazioni per collaborare con Sciax2 ed ottenere l'accredito nella nostra community!

[GUIDA]creare orologio e calendario in vb6

cocacola95

Utente Assiduo
Autore del topic
8 Maggio 2008
954
0
Miglior risposta
0
Orologio analogico

Per prima cosa aggiungiamo i controlli Picture1, label 1, Timer1 al nuovo progetto, tralasciamo per ora i pulsanti di regolazione dell' orologio



Cominciamo con il load del form
Private Sub Form_Load()
' valori iniziali per angolatura secondi,minuti,ore

secondi = Second(Now())
minuti = Minute(Now())
ore = Hour(Now()) * 5
angolosecondi = 90 - secondi * 6
angolominuti = 90 - minuti * 6
angoloore = 90 - ore * 6 - 30 * minuti / 60


End Sub

Le prime funzioni già le conosciamo; ci restituiscono secondi ,minuti, ore attuali. Le lancette di minuti e secondi hanno però un angolo iniziale; quando sono a zero formano un angolo di 90° con l'asse delle x, ed ogni secondo decrementano di 6° (infatti 360° corrispondono a 60 secondi o minuti). Differente è il discorso per per le ore; se ci pensate un pò su capirete la corrispondenza nella formula descritta. Ora per aggiornare la posizione delle lancette, usiamo l'evento timer che scatta ad ogni secondo:
Private Sub Timer1_Timer()
Label1.Caption = Format(Now(), "hh.mm.ss")' qui visualizziamo l'ora nella label
If angolosecondi = -270 Then
angolosecondi = 90
angolominuti = angolominuti - 6
End If
angolosecondi = angolosecondi - 6 ' ad ogni secondo l'angolo diminuisce di 6°
minuti = Minute(Now())
ore = Hour(Now()) * 5
angoloore = 90 - ore * 6 - 30 * minuti / 60

Call disegna(angolosecondi, angolominuti, angoloore)
Picture1.Visible = True
End Sub
l' angolo secondi decrementa di 6° ad ogni secondo; differente è il discorso per i minuti che scattano di 6° ogniqualvolta la lancetta compie un giro completo, cioè parte da 90° e arriva a -270°. Adesso non basta che disegnare le lancette, usando la funzione Call disegna(angolosecondi, angolominuti, angoloore) c he come vedete accetta in ingresso i tre angoli delle tre lancette. Per disegnare le lancette usiamo il metodo line del controllo picture che disegna una retta:
Picture1.Line (X1, Y1)-(X2, Y2), colore

dove x1,y1 - x2,y2 sono le coordinate dei due punti della retta, nel sistema di coordinate che ha come origine l'angolo superiore sinistro della Picture.

Attenzione: le x vanno da sinistra verso destra, mentre le y vanno dall'alto verso il basso. Disegniamo ora le tre lancette:

Public Function disegna(gradi, minuti, ore)
Picture1.Cls

disegnaorologio ' disegna la parte fissa dell'orologio
Dim a, b, c, d, e, f As Double


pgreco = 3.14
a = 1200 * Sin(gradi * pgreco / 180)
b = 1200 * Cos(gradi * pgreco / 180)
Picture1.DrawWidth = 1
Picture1.Line (1250, 1250)-(1250 + b, 1250 - a), vbBlack 'l ancetta secondi
c = 1150 * Sin(angolominuti * pgreco / 180)
d = 1150 * Cos(angolominuti * pgreco / 180)
Picture1.DrawWidth = 3
Picture1.Line (1250, 1250)-(1250 + d, 1250 - c), &H808000 'lancetta minuti
e = 850 * Sin(angoloore * pgreco / 180)
f = 850 * Cos(angoloore * pgreco / 180)
Picture1.DrawWidth = 5
Picture1.Line (1250, 1250)-(1250 + f, 1250 - e), &H808000 ' lancetta ore
Picture1.DrawWidth = 8
Picture1.PSet (1250, 1250), vbBlack
End Function
Tralasciamo per ora la funzione disegna orologio che disegna le tacche dell'orologio, e soffermiamo la nostra attenzione sul disegno delle lancette
Usiamo le funzioni sin e cos (seno e coseno) del Vb che però devono avere l'argomento in radianti: per questo usiamo la conversione * pgreco / 180 ; La proprietà DrawWidth ci permette invece di dare dimensione diversa alle lancette dove abbiamo anche specificato colori differenti. Per ultimo la funzione Picture1.PSet ci permette di disegnare un punto per il centro dell' orologio. Dobbiamo inoltre con il metodo Picture1.Cls cancellare la posizione precedente delle lancette . Analizziamo anche la funzione disegnaorologio:
Public Sub disegnaorologio()
Dim i
Dim x As Double
Dim y As Double
Dim r
For i = 1 To 360 Step 6
x = 1250 * Cos(i * pgreco / 180)
y = 1250 * Sin(i * pgreco / 180)
r = i Mod 5
If r = 1 Then
Picture1.DrawWidth = 4 ' dimensione del punto
Picture1.PSet (1250 + x, 1250 - y), &H808000 ' verde chiaro
Else
Picture1.DrawWidth = 2 ' dimensione del punto
Picture1.PSet (1250 + x, 1250 - y), vbWhite 'Bianco
End If

Next i
End Sub
Qui usiamo anche la funzione i Mod 5 che mi restituisce 1 ogni 5 minuti per disegnare di verde le tacche dei minuti (è il resto della divisione per 5)
Regolazione dell 'ora
La funzione time che restituisce l'ora di sistema, funziona anche all'incontrario, cioè serve anche per l'assegnazione. Per incrementare i secondi usiamo allora un pulsante con il seguente codice:

Dim s As Integer
Dim t
t = Time
s = Second(Time)
Time = Hour(t) & "." & Minute(t) & "." & (s + 1) Mod 60
Label1.Caption = Format(Now(), "hh.mm.ss")
secondi = Second(Now())

angolosecondi = 90 - secondi * 6
Come vedete leggiamo i secondi e li incrementiamo ad ogni click del pulsante, mantenendo costanti ore e minuti. Passiamo inoltre il nuovo angolo per la lancetta. Analogamente procediamo per modificare minuti e ore
Private Sub Command4_Click()
Dim m As Integer
Dim t
t = Time
m = Minute(Time)
Time = Hour(t) & "." & (m + 1) Mod 60 & "." & Second(Time)
Label1.Caption = Format(Now(), "hh.mm.ss")
minuti = Minute(Now())

angolominuti = 90 - minuti * 6
End Sub
'--------------------------------------------------
Private Sub Command5_Click()
Dim h As Integer
Dim t
t = Time
h = Hour(Time)
Time = (h + 1) Mod 24 & "." & Minute(t) & "." & Second(t)
Label1.Caption = Format(Now(), "hh.mm.ss")
secondi = Second(Now())

ore = Hour(Now()) * 5
minuti = Minute(Time)
angoloore = 90 - ore * 6 - 30 * minuti / 60
End Sub
2) Calendario perpetuo​

Per creare il calendario usiamo un concetto molto interessante, che è quello della matrice di controlli. Ormai sappiamo disegnare una label in ambiente di progettazione, ma come disegnare tutti i quadratini del calendario in esecuzione? E' infatti impensabile stare lì a disegnare decine e decine di quadratini. Creiamo allora una label di nome label e nella proprietà index scriviamo 0; abbiamo così creato una matrice di label (label(i)) ora le carichiamo all' avvio del programma, mettendo nel load del form la seguente funzione:
Public Sub caricacalendario()
Dim i As Integer

Dim r As Integer
Dim stpx As Integer
stpx = 300
r = 1
Dim IND As Integer
For r = 1 To 7

For i = 1 To 7
IND = i + (r - 1) * 7
Load Label(IND)

With Label(IND)

.Left = (i + 1) * stpx + 20

.Top = Label(0).Top * r + 20

.Visible = True
.BorderStyle = 1
.Caption = ""
End With


Next i
Next r
For i = 1 To 7
Label(i).BackColor = &H808080
Label(i).ForeColor = vbWhite
Next i

Label(1).Caption = "L"
Label(2).Caption = "M"
Label(3).Caption = "M"
Label(4).Caption = "G"
Label(5).Caption = "V"
Label(6).Caption = "S"
Label(7).Caption = "D"

For i = 8 To 49
Label(i).BackColor = vbWhite
Next i

End Sub
La funzione Load Label(IND) carica nel form la label di indice IND ; ora possiamo modificare proprietà e caption delle label accedendovi semplicemente con dei cicli for sull 'indice: per esempio nel ciclo for:
For i = 1 To 7
Label(i).BackColor = &H808080
Label(i).ForeColor = vbWhite
Next i

cambiamo il colore dei giorni della settimana facendoli apparire bianchi su sfondo grigio scuro. Una volta caricato il calendario, bisogna disegnarlo inserendo i giorni nel giusto posto della settimana:

Public Sub disegnacalendario(data_i As Date)

Dim g
Dim m
Dim a
Dim data As Date
If Month(data_i) < "10" Then
m = "0" & Month(Date)
Else
m = Month(data_i)
End If
Dim giornoattuale As Integer
giornoattuale = Day(data_i)
data = "01/" & m & "/" & Year(data_i)


Dim t
t = Weekday(data) ' trova il giorno della settimana
Select Case t
Case 1 'domenica
g = 7
Case 2 ' lunedì
g = 1
Case 3 'martedì
g = 2
Case 4 'mercoledì
g = 3
Case 5 ' giovedì
g = 4
Case 6 'venerdì
g = 5
Case 7 'sabato
g = 6
End Select
Dim i
For i = 8 To 49
Label(i).Caption = ""
Label(i).ForeColor = vbBlack
Label(i).BackColor = vbWhite
Next i

For i = 1 To numerogiorni(data)

Label(i + 8 + g - 2).Caption = i
If i = giornoattuale Then
Label(i + 8 + g - 2).BackColor = &HC00000
Label(i + 8 + g - 2).ForeColor = vbWhite
Else
Label(i + 8 + g - 2).BackColor = vbWhite
Label(i + 8 + g - 2).ForeColor = vbBlack


End If
Next i
End Sub
La funzione Weekday(data) restituisce il giorno della settimana (lunedì, martedi, ecc) sotto forma numerica; nella istruzione select vediamo la corrispondenza, e riusciamo a scrivere nella posizione giusta il primo giorno del mese; per sapere quanti giorni ha un mese usiamo la funzione numerogiorni(data):
Public Function numerogiorni(data) As Integer
Dim giorno As Date
Dim f As Integer
Dim m As Integer
m = Month(data)
f = 0

Do
giorno = data + f

If Month(giorno) <> m Then
numerogiorni = f
Exit Do
End If
f = f + 1
Loop
End Function
Partendo dal primo giorno del mese incrementiamo il giorno finché non cambia anche il mese; in f troviamo il numero di giorni e la assegniamo alla funzione; Con l'istruzione condizionale::
If i = giornoattuale Then
Label(i + 8 + g - 2).BackColor = &HC00000
Label(i + 8 + g - 2).ForeColor = vbWhite

assegniamo al giorno attuale ( giornoattuale = Day(data_i) ) il colore Blue
fonte : giorgio tave
 
Ultima modifica da un moderatore:
allora calendario fonte google e orologio fonte : mia lo sto studiando a scuola
 
cocacola dì la verità -.- dì il sito originale,tanto NON è Hacking.
Nessuno dei 2 è FONTE TUA,hai cercato su google si,ma QUALE SITO ESATTAMENTE ?
l'ho trovato ma nn lo posto -.- dì la verità.
lo hai copiato PARI PARI da un sito web -.-
 
Ultima modifica:
su google cerkate calendiario e mi è uscito e lo skarikato invece l'orologio spiegato da me e codici dal libro di scuola mio
 
senti ho trovato la guida UGUALE PRECISA su un sito,stessi codici e spiegazioni.
Sai dirmi il perchè
E cmq quale picture1 -.- sul sito c'è l'immagine,qui nn l'hai postata :S ti 6 fregato da solo ._.
 
e la seconda guida che nn metto la fonte nn ne metterò + scusate
 
io manko lo riesco a fare l'orolorgio in vb6 mi blokko a come creare le lancette