Zetrix
Advanced Premium Member
Codice:
Option Explicit
Class clsCerchioCiclometrico
Dim aPos(90,2) ' memorizza le coordinate relative ai 90 numeri
Private CollCorde
Sub DisegnaCerchioCiclometricoX(aNumeri,aCorde)
Dim nRaggio ' raggio ddel cerchio
Dim cX,cY ' centro del cerchio x e y
Dim Base,Altezza ' dimensioni area disegno
Dim Angolo ' gestisce il ciclo per disegnare il cerchio
Dim pi ' pigreco
Dim x1,y1,x2,y2 ' coordinate generiche pr i segmenti
Dim cLung ' distanza per stampare i gradi
Dim k ' ciclo generico
Dim n
Dim z
Call PicClear
Set CollCorde = GetNewCollection
cLung = 2.2
pi = 3.14
Base = 150
Altezza = 150
nRaggio = 60
' preimposto le dimensioni dell'area
Call PicSetDimensioni(Base,Altezza,Base,Altezza)
' calcolo il centro del cerchio
cX = Base / 2
cY = Altezza / 2
Call PicCerchio(cX,cY,nRaggio)
Angolo = 360
n = 91
' ciclo per disegnare i semiraggi
For z = 90 To 540 Step 4
Angolo = FuoriX(z,360)
' calcolo cordinate per il segmento raggio
x1 = cX +((nRaggio) * Cos(- Angolo *(pi / 180)))
y1 = cY +((nRaggio) * Sin(- Angolo *(pi / 180)))
' memorizzo nell'array globale le coordinate appena calcolate
' cosi potranno essere riusate per disegnare le corde
n = n - 1
aPos(n,1) = x1
aPos(n,2) = y1
'If n Mod 10 = 0 Then
If n Mod 4 = 1 Then '<------------------------------sequenza4 inizia da 1
'If n Mod 3 = 2 Then '-->scrivi numero distanzanziale esempio 10
'If n Mod 3 = 3 Then '-->scrivi numero distanzanziale esempio 10
' ogni 5 gradi disegno un semiraggio un po' piu lungo
' e stampo i gradi in corripondenza
x2 = cX +((nRaggio + cLung*3) * Cos(- Angolo *(pi / 180)))
y2 = cY +((nRaggio + cLung*3) * Sin(- Angolo *(pi / 180)))
Call PicLinea(x1,y1,x2,y2)
x2 = cX +((nRaggio + cLung*4) * Cos(-(Angolo + 2) *(pi / 180)))
y2 = cY +((nRaggio + cLung*4) * Sin(-(Angolo + 2) *(pi / 180)))
Call PicStampaTestoRT(x2,y2,n,Angolo)
Else
' disegno il semiraggio
x2 = cX +((nRaggio + cLung) * Cos(- Angolo *(pi / 180)))
y2 = cY +((nRaggio + cLung) * Sin(- Angolo *(pi / 180)))
Call PicLinea(x1,y1,x2,y2)
x2 = cX +((nRaggio + cLung) * Cos(-(Angolo + 2) *(pi / 180)))
y2 = cY +((nRaggio + cLung) * Sin(-(Angolo + 2) *(pi / 180)))
Call PicStampaTestoRT(x2,y2,n,Angolo)
End If
If n = 0 Then Exit For
Next
Call DisegnaFigura(aNumeri)
Call DisegnaDistanze(aCorde)
' mostro la figura in output
Call PicEsegui
End Sub
Private Sub DisegnaFigura(aNum)
Dim k
For k = 1 To UBound(aNum)
Call DisegnaCorda(aNum(k),aNum(FuoriX(k + 1,UBound(aNum))),vbRed,True,False)
Next
End Sub
Private Sub DisegnaDistanze(aCorde)
Dim k
For k = 1 To UBound(aCorde)
Call DisegnaCorda(aCorde(k,1),aCorde(k,2),vbBlue,True,True)
Next
End Sub
Private Sub DisegnaCorda(p1,p2,colore,bDisegnaDist,bLineaTratt)
Dim nX,nY,sDist
' p1 e p2 sono i gradi a cui si riferiscono inizio e fine della corda
'Call PicLineaTratteggiata(aPos(p1,1),aPos(p1,2),aPos(p2,1),aPos(p2,2),colore)
If AddCorda(p1,p2) Then
If bLineaTratt Then
Call PicLineaTratteggiata(aPos(p1,1),aPos(p1,2),aPos(p2,1),aPos(p2,2),colore)
Else
Call PicLinea(aPos(p1,1),aPos(p1,2),aPos(p2,1),aPos(p2,2),colore)
End If
Call PicPunto(aPos(p1,1),aPos(p1,2),6,colore)
Call PicPunto(aPos(p2,1),aPos(p2,2),6,colore)
If bDisegnaDist Then
If aPos(p1,1) > aPos(p2,1) Then
nX =(aPos(p1,1) - aPos(p2,1)) / 2 + aPos(p2,1)
Else
nX =(aPos(p2,1) - aPos(p1,1)) / 2 + aPos(p1,1)
End If
If aPos(p1,2) > aPos(p2,2)Then
nY =(aPos(p1,2) - aPos(p2,2)) / 2 + aPos(p2,2)
Else
nY =(aPos(p2,2) - aPos(p1,2)) / 2 + aPos(p1,2)
End If
Call PicCerchio(nX,nY,3,vbWhite,,True,vbWhite)
nX = nX - 1.5
nY = nY - 1.5
sDist = Format2(Distanza(p1,p2))
Call PicStampaTesto(nX,nY,sDist)
End If
End If
End Sub
Private Function AddCorda(n1,n2)
Dim sKey
If n1 <= n2 Then
sKey = "k" & Format2(n1) & Format2(n2)
Else
sKey = "k" & Format2(n2) & Format2(n1)
End If
On Error Resume Next
CollCorde.Add sKey,sKey
If Err = 0 Then
AddCorda = True
End If
End Function
End Class
Sub Main
Dim clsCerchio
Dim k,v,x,qt
Dim aCorde
'v = InputBox("Quale ruota vuoi controllare?",,0)
x = InputBox("Quante estrazioni vuoi controllare?",,0)
For v = 1 To 12
If v = 11 Then v = 12 End If ' con numeri
' prendo i numeri dell'ultima estrazione di bari
' disegno cerchio ciclometrico , figura dei numeri estratti , diagonali con distanze
ReDim aNum(0)
Call GetArrayNumeriRuota(EstrazioneFin - x,v,aNum)' ---->ruota 1
'qt = ScegliNumeri(aNum)
Call OrdinaMatrice(aNum,1)
'qt = UBound(aNum)
' le corde sono le distanze interne e sono
' considerate tutte le coppie di vertici
aCorde = SviluppoIntegrale(aNum,2)
Set clsCerchio = New clsCerchioCiclometrico
Call clsCerchio.DisegnaCerchioCiclometricoX(aNum,aCorde)
Scrivi DataEstrazione((EstrazioneFin - x),1) & " ",0,1,7,4,3
Scrivi
Scrivi SiglaRuota(v) & " " & StringaNumeri(aNum),0,1,4,7,3
Scrivi
' II° Esempio
' dissegno una figura arbitraria
Next
End Subquesto script disegna la formula 1.5.9 che non a niente a che vedere con le formule
di Fabarri con la 1.4.7/2.5.8/3.6.9/
questa formula 1.5.9 e potente se riuscite a calcolare una figura nel cerchio..
oste(2) = 1
