Novità

Mente da programmatore

si senza isnumeric , dopo vedremo come fare per fargli accettare solo numeri , c'è da sostituire il controllo seleziona numeri


a progetto chiusosostituisci il file
 
ok mi devi perdonare ma stamattina tra lavoro ew altre cose mi sto un po confondendo .. allora apri il modulo ctlSelezionaNumeri e sostituisci tutto con questo

Codice:
Imports System.Text
Public Class ctlSelezionaNumeri

    Private mQNumeriPerRiga As Integer = 9
    Private mQNumeri As Integer = 90
    Private mFontNumeri As Font = New Font("Arial", 8)
    Private mBackColorSelected As Color = Color.Red
    Private mForeColorSelected As Color = Color.White
    Private mAttivaSelezione As Boolean = True

    ' Private aColoreNumeri() As struct_colore_numeri
    Private aChk() As clsMyChkeBox


    Event OnChange(ByVal Num As Integer)
    Event OnCheckDoubleClick(ByVal Num As Integer)

    Public Overrides Property ForeColor() As System.Drawing.Color
        Get
            Return MyBase.ForeColor
        End Get
        Set(ByVal value As System.Drawing.Color)
            MyBase.ForeColor = value
            LoadPulsanti()
        End Set
    End Property
    Public Overrides Property BackColor() As System.Drawing.Color
        Get
            Return MyBase.BackColor
        End Get
        Set(ByVal value As System.Drawing.Color)
            MyBase.BackColor = value
            LoadPulsanti()
        End Set
    End Property

    Public Property AttivaSelezione() As Boolean
        Get
            Return mAttivaSelezione
        End Get
        Set(ByVal value As Boolean)
            mAttivaSelezione = value

        End Set
    End Property
    Public Property ForeColorSelected() As Color
        Get
            Return mForeColorSelected
        End Get
        Set(ByVal value As Color)
            mForeColorSelected = value
            LoadPulsanti()


        End Set
    End Property
    Public Property BackColorSelected() As Color
        Get
            Return mBackColorSelected
        End Get
        Set(ByVal value As Color)
            mBackColorSelected = value
            LoadPulsanti()


        End Set
    End Property
    Public ReadOnly Property QNumeriSelezionati() As Integer
        Get

            Dim q As Integer = 0
            For k As Integer = 1 To mQNumeri
                If aChk(k).Checked Then q += 1
            Next

            Return q
        End Get
    End Property
    Public Property FontNumeri() As Font
        Get
            Return mFontNumeri
        End Get
        Set(ByVal value As Font)
            mFontNumeri = value

            LoadPulsanti()

        End Set
    End Property
    Public Property QNumeri() As Integer
        Get
            Return mQNumeri
        End Get
        Set(ByVal value As Integer)
            If value > 0 And value <= 90 Then
                mQNumeri = value





                LoadPulsanti()
            End If


        End Set
    End Property
    Public Property QNumeriPerRiga() As Integer
        Get
            Return mQNumeriPerRiga
        End Get
        Set(ByVal value As Integer)
            If value > 0 And value <= 10 And mQNumeri Mod value = 0 Then
                mQNumeriPerRiga = value
                LoadPulsanti()
            End If

        End Set
    End Property

    Private Sub ctlSelezionaNumeri_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        LoadPulsanti()
    End Sub


    Private Sub LoadPulsante(ByVal Num As Integer, ByVal Value As Boolean, ByVal nIndex As Integer, ByVal nX As Integer, ByVal nY As Integer, ByVal nW As Integer, ByVal nH As Integer, ByVal nBackColor As Color, ByVal nForeColor As Color)




        aChk(Num) = New clsMyChkeBox


        aChk(Num).AutoSize = False
        aChk(Num).BorderStyle = Windows.Forms.BorderStyle.Fixed3D
        aChk(Num).Font = mFontNumeri
        aChk(Num).Top = nY
        aChk(Num).Left = nX
        aChk(Num).Width = nW
        aChk(Num).Height = nH
        aChk(Num).Parent = Me
        aChk(Num).Text = Num
        aChk(Num).Index = nIndex
        aChk(Num).BackColor = nBackColor
        aChk(Num).ForeColor = nForeColor
        aChk(Num).BackColorSelected = mBackColorSelected
        aChk(Num).ForeColorSelected = mForeColorSelected


        aChk(Num).TextAlign = ContentAlignment.MiddleCenter
        aChk(Num).Checked = Value
        aChk(Num).Visible = True

        AddHandler aChk(Num).Click, AddressOf CheckBox_CheckedChanged
        AddHandler aChk(Num).DoubleClick, AddressOf CheckBox_DoubleClik


    End Sub
    Private Sub CheckBox_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If mAttivaSelezione Then
            Dim c As clsMyChkeBox = DirectCast(sender, clsMyChkeBox)

            c.Checked = Not c.Checked


            RaiseEvent OnChange(DirectCast(sender, clsMyChkeBox).Index)
        End If

    End Sub
    Private Sub CheckBox_DoubleClik(ByVal sender As System.Object, ByVal e As System.EventArgs)



        RaiseEvent OnCheckDoubleClick(DirectCast(sender, clsMyChkeBox).Index)
    End Sub
    Private Sub LoadPulsanti()
        Dim N As Integer = 0
        Dim nX As Integer, nY As Integer, nH As Integer, nW As Integer

        Try


            Me.Controls.Clear()
            ReDim aChk(0)

            If mQNumeri > 0 AndAlso mQNumeriPerRiga > 0 Then
                ReDim aChk(mQNumeri)

                nW = (Me.Width / mQNumeriPerRiga)
                nH = (Me.ClientRectangle.Height / (mQNumeri / mQNumeriPerRiga))
                nX = 0
                nY = 0
                Do
                    nX = 0
                    For r As Integer = 1 To mQNumeriPerRiga
                        N += 1
                        LoadPulsante(N, False, N, nX, nY, nW, nH, Me.BackColor, Me.ForeColor)
                        nX += nW

                        If N >= mQNumeri Then Exit For
                    Next
                    nY += nH
                    If N >= mQNumeri Then Exit Do

                Loop
            End If
        Catch ex As Exception

        End Try
    End Sub
    Function GetStringaNumeri(Optional ByVal sChrSep As String = ",") As String
        Dim s As String = ""

        For k As Integer = 1 To mQNumeri
            If aChk(k).Checked Then
                s = s & k.ToString & sChrSep
            End If
        Next

        If s <> "" Then
            Return s.Substring(0, s.Length - 1)

        End If


    End Function
    Function GetValue(ByVal Num As Integer) As Boolean
        If Num > 0 AndAlso Num <= mQNumeri Then
            Return aChk(Num).Checked
        End If
    End Function
    Sub SetValue(ByVal Num As Integer, ByVal value As Boolean)

        If Num > 0 AndAlso Num <= mQNumeri Then

            aChk(Num).Checked = value
            RaiseEvent OnChange(Num)
        End If
    End Sub
    Sub SetValueFromStringaNum(ByVal sNumeri As String, Optional ByVal bValue As Boolean = True)
        Dim sValue As String = ""
        Dim sChr As String
        Dim n As Integer

        For k As Integer = 0 To sNumeri.Length - 1
            sChr = sNumeri.Substring(k, 1)
            If IsNumeric(sChr) Then
                sValue = sValue & sChr
            Else
                Try
                    n = Convert.ToInt32(sValue)
                    If n > 0 AndAlso n <= mQNumeri Then
                        SetValue(n, bValue)
                    End If
                    sValue = ""
                Catch ex As Exception

                End Try

            End If


        Next

        If sValue <> "" Then
            Try
                n = Convert.ToInt32(sValue)
                If n > 0 AndAlso n <= mQNumeri Then
                    SetValue(n, bValue)
                End If
            Catch ex As Exception

            End Try
        End If


    End Sub


    Sub SetColore(ByVal num As Integer, ByVal BackColor As Color, ByVal ForeColor As Color)

        If num > 0 AndAlso num <= mQNumeri Then

            aChk(num).BackColor = BackColor
            aChk(num).ForeColor = ForeColor
        End If

    End Sub
    Function GetColore(ByVal num As Integer, ByRef BackColor As Color, ByRef ForeColor As Color) As Boolean
        If num > 0 AndAlso num <= mQNumeri Then

            BackColor = aChk(num).BackColor
            ForeColor = aChk(num).ForeColor

            Return True
        End If

    End Function
    Function GetArrayNumSelezionati(ByRef aRetNum() As Integer) As Integer
        Dim q As Integer
        ReDim aRetNum(mQNumeri)

        For k As Integer = 1 To mQNumeri
            If aChk(k).Checked Then
                q = q + 1
                aRetNum(q) = k
            End If
        Next

        ReDim Preserve aRetNum(q)
        Return q

    End Function
    Function GetArrayNumSelezionati(ByRef aRetNum() As Boolean) As Integer
        Dim q As Integer
        ReDim aRetNum(mQNumeri)

        For k As Integer = 1 To mQNumeri
            If aChk(k).Checked Then
                q = q + 1
                aRetNum(k) = True
            End If
        Next


        Return q

    End Function

    Function GetArrayColoriWin32(ByRef aRetBackColor() As Integer, ByRef aRetForeColor() As Integer) As Boolean

        If mQNumeri > 0 Then
            ReDim aRetBackColor(mQNumeri)
            ReDim aRetForeColor(mQNumeri)

            For k As Integer = 1 To mQNumeri
                aRetBackColor(k) = System.Drawing.ColorTranslator.ToWin32(aChk(k).BackColor)
                aRetForeColor(k) = System.Drawing.ColorTranslator.ToWin32(aChk(k).ForeColor)

            Next
            Return True
        End If

    End Function
    Function SetArrayColoriWin32(ByVal aBackColor() As Integer, ByRef aForeColor() As Integer) As Boolean

        If mQNumeri > 0 Then
            Try
                For k As Integer = 1 To mQNumeri
                    aChk(k).BackColor = System.Drawing.ColorTranslator.FromWin32(aBackColor(k))
                    aChk(k).ForeColor = System.Drawing.ColorTranslator.FromWin32(aForeColor(k))

                Next
                Return True
            Catch ex As Exception

            End Try

        End If

    End Function

    Function GetStringaBackColorWin32(Optional ByVal sChrSep As Char = ";") As String
        Dim sb As New StringBuilder
        For k As Integer = 1 To mQNumeri
            sb.Append(System.Drawing.ColorTranslator.ToWin32(aChk(k).BackColor).ToString)
            sb.Append(sChrSep)
        Next
        sb.Remove(sb.Length - 1, 1)
        Return sb.ToString


    End Function
    Sub SetBackColorFromStringaColoriWin32(ByVal sColori As String, Optional ByVal sChrSep As Char = ";")
        Try


            If sColori.Trim <> "" Then
                Dim av() As String = sColori.Split(sChrSep)
                For k = 0 To UBound(av)
                    If (k + 1) <= mQNumeri Then
                        aChk(k + 1).BackColor = System.Drawing.ColorTranslator.FromWin32(Convert.ToInt32(av(k)))
                    End If

                Next
            End If

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Sub

    Function GetStringaForeColorWin32(Optional ByVal sChrSep As Char = ";") As String
        Dim sb As New StringBuilder
        For k As Integer = 1 To mQNumeri
            sb.Append(System.Drawing.ColorTranslator.ToWin32(aChk(k).ForeColor).ToString)
            sb.Append(sChrSep)
        Next
        sb.Remove(sb.Length - 1, 1)

        Return sb.ToString


    End Function

    Sub SetForeColorFromStringaColoriWin32(ByVal sColori As String, Optional ByVal sChrSep As Char = ";")
        Try
            If sColori.Trim <> "" Then
                Dim av() As String = sColori.Split(sChrSep)


                For k = 0 To UBound(av)
                    If (k + 1) <= mQNumeri Then
                        aChk(k + 1).ForeColor = System.Drawing.ColorTranslator.FromWin32(Convert.ToInt32(av(k)))
                    End If

                Next
            End If

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Sub

    Sub SelezionaTutto(Optional b As Boolean = True)
        For k As Integer = 1 To mQNumeri
            aChk(k).Checked = b
        Next
    End Sub




End Class
Public Class clsMyChkeBox
    Inherits Label
    Private mIndex As Integer


    Private mBackColorSelected As Color = Color.Red
    Private mForeColorSelected As Color = Color.White
    Private mBackColor As Color = SystemColors.Control
    Private mForeColor As Color = SystemColors.WindowText
    Private mChecked As Boolean

    Public Property Checked() As Boolean
        Get
            Return mChecked
        End Get
        Set(ByVal value As Boolean)
            mChecked = value
            If mChecked Then
                MyBase.BackColor = mBackColorSelected
                MyBase.ForeColor = mForeColorSelected
            Else
                MyBase.BackColor = mBackColor
                MyBase.ForeColor = mForeColor
            End If
        End Set
    End Property
    Public Overrides Property ForeColor() As Color
        Get
            Return MyBase.ForeColor
        End Get
        Set(ByVal value As Color)
            mForeColor = value
            MyBase.ForeColor = mForeColor
        End Set
    End Property
    Public Overrides Property BackColor() As Color
        Get
            Return MyBase.BackColor
        End Get
        Set(ByVal value As Color)
            mBackColor = value
            MyBase.BackColor = mBackColor
        End Set
    End Property
    Public Property ForeColorSelected() As Color
        Get
            Return mForeColorSelected
        End Get
        Set(ByVal value As Color)
            mForeColorSelected = value
        End Set
    End Property
    Public Property BackColorSelected() As Color
        Get
            Return mBackColorSelected
        End Get
        Set(ByVal value As Color)
            mBackColorSelected = value
        End Set
    End Property

    
    Public Property Index() As Integer
        Get
            Return mIndex
        End Get
        Set(ByVal value As Integer)
            mIndex = value
        End Set
    End Property
End Class
 
poi il pulsantino nel form selezionan umeri non è una bella idea facciamo che al change del campo testo si vadano a settare i numeri sul controllo , e facciamo anche che quando si settano i numeri sul controllo questi vengano trascritti nel campo testo

quindi all'evento textchanged del campo testo

Codice:
   CtlSelezionaNumeri1.Tag = "x"
        CtlSelezionaNumeri1.SelezionaTutto(False)
        CtlSelezionaNumeri1.SetValueFromStringaNum(TextBox1.Text)
        CtlSelezionaNumeri1.Tag = ""


facciamo un giochetto col tag per evitare che le fnzioni si richiamino a vicenda

nell'evento OnChangeDel controllo numeri

Codice:
 If CtlSelezionaNumeri1.Tag = "" Then
            Me.TextBox1.Text = CtlSelezionaNumeri1.GetStringaNumeri
        End If


poi ritesta tutto e dimmi se funziona
 
Ma vaaa anzi. Ogni qual volta c'è una modifica guardo il perchè e questo mi aiuta a ragionare ed a capire in realtà. :D
ok mi devi perdonare ma stamattina tra lavoro ew altre cose mi sto un po confondendo .. allora apri il modulo ctlSelezionaNumeri e sostituisci tutto con questo

Codice:
Imports System.Text
Public Class ctlSelezionaNumeri

    Private mQNumeriPerRiga As Integer = 9
    Private mQNumeri As Integer = 90
    Private mFontNumeri As Font = New Font("Arial", 8)
    Private mBackColorSelected As Color = Color.Red
    Private mForeColorSelected As Color = Color.White
    Private mAttivaSelezione As Boolean = True

    ' Private aColoreNumeri() As struct_colore_numeri
    Private aChk() As clsMyChkeBox


    Event OnChange(ByVal Num As Integer)
    Event OnCheckDoubleClick(ByVal Num As Integer)

    Public Overrides Property ForeColor() As System.Drawing.Color
        Get
            Return MyBase.ForeColor
        End Get
        Set(ByVal value As System.Drawing.Color)
            MyBase.ForeColor = value
            LoadPulsanti()
        End Set
    End Property
    Public Overrides Property BackColor() As System.Drawing.Color
        Get
            Return MyBase.BackColor
        End Get
        Set(ByVal value As System.Drawing.Color)
            MyBase.BackColor = value
            LoadPulsanti()
        End Set
    End Property

    Public Property AttivaSelezione() As Boolean
        Get
            Return mAttivaSelezione
        End Get
        Set(ByVal value As Boolean)
            mAttivaSelezione = value

        End Set
    End Property
    Public Property ForeColorSelected() As Color
        Get
            Return mForeColorSelected
        End Get
        Set(ByVal value As Color)
            mForeColorSelected = value
            LoadPulsanti()


        End Set
    End Property
    Public Property BackColorSelected() As Color
        Get
            Return mBackColorSelected
        End Get
        Set(ByVal value As Color)
            mBackColorSelected = value
            LoadPulsanti()


        End Set
    End Property
    Public ReadOnly Property QNumeriSelezionati() As Integer
        Get

            Dim q As Integer = 0
            For k As Integer = 1 To mQNumeri
                If aChk(k).Checked Then q += 1
            Next

            Return q
        End Get
    End Property
    Public Property FontNumeri() As Font
        Get
            Return mFontNumeri
        End Get
        Set(ByVal value As Font)
            mFontNumeri = value

            LoadPulsanti()

        End Set
    End Property
    Public Property QNumeri() As Integer
        Get
            Return mQNumeri
        End Get
        Set(ByVal value As Integer)
            If value > 0 And value <= 90 Then
                mQNumeri = value





                LoadPulsanti()
            End If


        End Set
    End Property
    Public Property QNumeriPerRiga() As Integer
        Get
            Return mQNumeriPerRiga
        End Get
        Set(ByVal value As Integer)
            If value > 0 And value <= 10 And mQNumeri Mod value = 0 Then
                mQNumeriPerRiga = value
                LoadPulsanti()
            End If

        End Set
    End Property

    Private Sub ctlSelezionaNumeri_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        LoadPulsanti()
    End Sub


    Private Sub LoadPulsante(ByVal Num As Integer, ByVal Value As Boolean, ByVal nIndex As Integer, ByVal nX As Integer, ByVal nY As Integer, ByVal nW As Integer, ByVal nH As Integer, ByVal nBackColor As Color, ByVal nForeColor As Color)




        aChk(Num) = New clsMyChkeBox


        aChk(Num).AutoSize = False
        aChk(Num).BorderStyle = Windows.Forms.BorderStyle.Fixed3D
        aChk(Num).Font = mFontNumeri
        aChk(Num).Top = nY
        aChk(Num).Left = nX
        aChk(Num).Width = nW
        aChk(Num).Height = nH
        aChk(Num).Parent = Me
        aChk(Num).Text = Num
        aChk(Num).Index = nIndex
        aChk(Num).BackColor = nBackColor
        aChk(Num).ForeColor = nForeColor
        aChk(Num).BackColorSelected = mBackColorSelected
        aChk(Num).ForeColorSelected = mForeColorSelected


        aChk(Num).TextAlign = ContentAlignment.MiddleCenter
        aChk(Num).Checked = Value
        aChk(Num).Visible = True

        AddHandler aChk(Num).Click, AddressOf CheckBox_CheckedChanged
        AddHandler aChk(Num).DoubleClick, AddressOf CheckBox_DoubleClik


    End Sub
    Private Sub CheckBox_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If mAttivaSelezione Then
            Dim c As clsMyChkeBox = DirectCast(sender, clsMyChkeBox)

            c.Checked = Not c.Checked


            RaiseEvent OnChange(DirectCast(sender, clsMyChkeBox).Index)
        End If

    End Sub
    Private Sub CheckBox_DoubleClik(ByVal sender As System.Object, ByVal e As System.EventArgs)



        RaiseEvent OnCheckDoubleClick(DirectCast(sender, clsMyChkeBox).Index)
    End Sub
    Private Sub LoadPulsanti()
        Dim N As Integer = 0
        Dim nX As Integer, nY As Integer, nH As Integer, nW As Integer

        Try


            Me.Controls.Clear()
            ReDim aChk(0)

            If mQNumeri > 0 AndAlso mQNumeriPerRiga > 0 Then
                ReDim aChk(mQNumeri)

                nW = (Me.Width / mQNumeriPerRiga)
                nH = (Me.ClientRectangle.Height / (mQNumeri / mQNumeriPerRiga))
                nX = 0
                nY = 0
                Do
                    nX = 0
                    For r As Integer = 1 To mQNumeriPerRiga
                        N += 1
                        LoadPulsante(N, False, N, nX, nY, nW, nH, Me.BackColor, Me.ForeColor)
                        nX += nW

                        If N >= mQNumeri Then Exit For
                    Next
                    nY += nH
                    If N >= mQNumeri Then Exit Do

                Loop
            End If
        Catch ex As Exception

        End Try
    End Sub
    Function GetStringaNumeri(Optional ByVal sChrSep As String = ",") As String
        Dim s As String = ""

        For k As Integer = 1 To mQNumeri
            If aChk(k).Checked Then
                s = s & k.ToString & sChrSep
            End If
        Next

        If s <> "" Then
            Return s.Substring(0, s.Length - 1)

        End If


    End Function
    Function GetValue(ByVal Num As Integer) As Boolean
        If Num > 0 AndAlso Num <= mQNumeri Then
            Return aChk(Num).Checked
        End If
    End Function
    Sub SetValue(ByVal Num As Integer, ByVal value As Boolean)

        If Num > 0 AndAlso Num <= mQNumeri Then

            aChk(Num).Checked = value
            RaiseEvent OnChange(Num)
        End If
    End Sub
    Sub SetValueFromStringaNum(ByVal sNumeri As String, Optional ByVal bValue As Boolean = True)
        Dim sValue As String = ""
        Dim sChr As String
        Dim n As Integer

        For k As Integer = 0 To sNumeri.Length - 1
            sChr = sNumeri.Substring(k, 1)
            If IsNumeric(sChr) Then
                sValue = sValue & sChr
            Else
                Try
                    n = Convert.ToInt32(sValue)
                    If n > 0 AndAlso n <= mQNumeri Then
                        SetValue(n, bValue)
                    End If
                    sValue = ""
                Catch ex As Exception

                End Try

            End If


        Next

        If sValue <> "" Then
            Try
                n = Convert.ToInt32(sValue)
                If n > 0 AndAlso n <= mQNumeri Then
                    SetValue(n, bValue)
                End If
            Catch ex As Exception

            End Try
        End If


    End Sub


    Sub SetColore(ByVal num As Integer, ByVal BackColor As Color, ByVal ForeColor As Color)

        If num > 0 AndAlso num <= mQNumeri Then

            aChk(num).BackColor = BackColor
            aChk(num).ForeColor = ForeColor
        End If

    End Sub
    Function GetColore(ByVal num As Integer, ByRef BackColor As Color, ByRef ForeColor As Color) As Boolean
        If num > 0 AndAlso num <= mQNumeri Then

            BackColor = aChk(num).BackColor
            ForeColor = aChk(num).ForeColor

            Return True
        End If

    End Function
    Function GetArrayNumSelezionati(ByRef aRetNum() As Integer) As Integer
        Dim q As Integer
        ReDim aRetNum(mQNumeri)

        For k As Integer = 1 To mQNumeri
            If aChk(k).Checked Then
                q = q + 1
                aRetNum(q) = k
            End If
        Next

        ReDim Preserve aRetNum(q)
        Return q

    End Function
    Function GetArrayNumSelezionati(ByRef aRetNum() As Boolean) As Integer
        Dim q As Integer
        ReDim aRetNum(mQNumeri)

        For k As Integer = 1 To mQNumeri
            If aChk(k).Checked Then
                q = q + 1
                aRetNum(k) = True
            End If
        Next


        Return q

    End Function

    Function GetArrayColoriWin32(ByRef aRetBackColor() As Integer, ByRef aRetForeColor() As Integer) As Boolean

        If mQNumeri > 0 Then
            ReDim aRetBackColor(mQNumeri)
            ReDim aRetForeColor(mQNumeri)

            For k As Integer = 1 To mQNumeri
                aRetBackColor(k) = System.Drawing.ColorTranslator.ToWin32(aChk(k).BackColor)
                aRetForeColor(k) = System.Drawing.ColorTranslator.ToWin32(aChk(k).ForeColor)

            Next
            Return True
        End If

    End Function
    Function SetArrayColoriWin32(ByVal aBackColor() As Integer, ByRef aForeColor() As Integer) As Boolean

        If mQNumeri > 0 Then
            Try
                For k As Integer = 1 To mQNumeri
                    aChk(k).BackColor = System.Drawing.ColorTranslator.FromWin32(aBackColor(k))
                    aChk(k).ForeColor = System.Drawing.ColorTranslator.FromWin32(aForeColor(k))

                Next
                Return True
            Catch ex As Exception

            End Try

        End If

    End Function

    Function GetStringaBackColorWin32(Optional ByVal sChrSep As Char = ";") As String
        Dim sb As New StringBuilder
        For k As Integer = 1 To mQNumeri
            sb.Append(System.Drawing.ColorTranslator.ToWin32(aChk(k).BackColor).ToString)
            sb.Append(sChrSep)
        Next
        sb.Remove(sb.Length - 1, 1)
        Return sb.ToString


    End Function
    Sub SetBackColorFromStringaColoriWin32(ByVal sColori As String, Optional ByVal sChrSep As Char = ";")
        Try


            If sColori.Trim <> "" Then
                Dim av() As String = sColori.Split(sChrSep)
                For k = 0 To UBound(av)
                    If (k + 1) <= mQNumeri Then
                        aChk(k + 1).BackColor = System.Drawing.ColorTranslator.FromWin32(Convert.ToInt32(av(k)))
                    End If

                Next
            End If

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Sub

    Function GetStringaForeColorWin32(Optional ByVal sChrSep As Char = ";") As String
        Dim sb As New StringBuilder
        For k As Integer = 1 To mQNumeri
            sb.Append(System.Drawing.ColorTranslator.ToWin32(aChk(k).ForeColor).ToString)
            sb.Append(sChrSep)
        Next
        sb.Remove(sb.Length - 1, 1)

        Return sb.ToString


    End Function

    Sub SetForeColorFromStringaColoriWin32(ByVal sColori As String, Optional ByVal sChrSep As Char = ";")
        Try
            If sColori.Trim <> "" Then
                Dim av() As String = sColori.Split(sChrSep)


                For k = 0 To UBound(av)
                    If (k + 1) <= mQNumeri Then
                        aChk(k + 1).ForeColor = System.Drawing.ColorTranslator.FromWin32(Convert.ToInt32(av(k)))
                    End If

                Next
            End If

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Sub

    Sub SelezionaTutto(Optional b As Boolean = True)
        For k As Integer = 1 To mQNumeri
            aChk(k).Checked = b
        Next
    End Sub




End Class
Public Class clsMyChkeBox
    Inherits Label
    Private mIndex As Integer


    Private mBackColorSelected As Color = Color.Red
    Private mForeColorSelected As Color = Color.White
    Private mBackColor As Color = SystemColors.Control
    Private mForeColor As Color = SystemColors.WindowText
    Private mChecked As Boolean

    Public Property Checked() As Boolean
        Get
            Return mChecked
        End Get
        Set(ByVal value As Boolean)
            mChecked = value
            If mChecked Then
                MyBase.BackColor = mBackColorSelected
                MyBase.ForeColor = mForeColorSelected
            Else
                MyBase.BackColor = mBackColor
                MyBase.ForeColor = mForeColor
            End If
        End Set
    End Property
    Public Overrides Property ForeColor() As Color
        Get
            Return MyBase.ForeColor
        End Get
        Set(ByVal value As Color)
            mForeColor = value
            MyBase.ForeColor = mForeColor
        End Set
    End Property
    Public Overrides Property BackColor() As Color
        Get
            Return MyBase.BackColor
        End Get
        Set(ByVal value As Color)
            mBackColor = value
            MyBase.BackColor = mBackColor
        End Set
    End Property
    Public Property ForeColorSelected() As Color
        Get
            Return mForeColorSelected
        End Get
        Set(ByVal value As Color)
            mForeColorSelected = value
        End Set
    End Property
    Public Property BackColorSelected() As Color
        Get
            Return mBackColorSelected
        End Get
        Set(ByVal value As Color)
            mBackColorSelected = value
        End Set
    End Property

   
    Public Property Index() As Integer
        Get
            Return mIndex
        End Get
        Set(ByVal value As Integer)
            mIndex = value
        End Set
    End Property
End Class
 
poi il pulsantino nel form selezionan umeri non è una bella idea facciamo che al change del campo testo si vadano a settare i numeri sul controllo , e facciamo anche che quando si settano i numeri sul controllo questi vengano trascritti nel campo testo

quindi all'evento textchanged del campo testo

Codice:
   CtlSelezionaNumeri1.Tag = "x"
        CtlSelezionaNumeri1.SelezionaTutto(False)
        CtlSelezionaNumeri1.SetValueFromStringaNum(TextBox1.Text)
        CtlSelezionaNumeri1.Tag = ""


facciamo un giochetto col tag per evitare che le fnzioni si richiamino a vicenda

nell'evento OnChangeDel controllo numeri

Codice:
 If CtlSelezionaNumeri1.Tag = "" Then
            Me.TextBox1.Text = CtlSelezionaNumeri1.GetStringaNumeri
        End If


poi ritesta tutto e dimmi se funziona
Funziona perfettamente
 
bene allora ora c'è da inserire questa funzione nel modulo assistente,poi dovrai richiamarla all'evento keydown dei campi testo dovesi inseriscono i numeri della lungetta passando il parametro e che ricevi dall'evento.


Codice:
 Sub SoloCaratteriPerInserimentoLunghette(e As KeyEventArgs)

        Dim b As Boolean

        Select Case e.KeyValue
            Case Keys.Delete, Keys.Back, Keys.Space, Keys.Oemcomma, Keys.Oemcomma, Keys.OemPeriod
                b = True
            Case Else
                If (e.KeyValue >= Keys.D0 And e.KeyValue <= Keys.D9) Or (e.KeyValue >= Keys.NumPad0 And e.KeyValue <= Keys.NumPad9) Then
                    b = True
                End If
        End Select

        If Not b Then e.SuppressKeyPress = True


    End Sub
 
ahah .grazie per il genio .. non è propriamente cosi :-) .. va be allora adesso crea una nuova cartella nei controlli chiamala LVOrdinabile , dentro ci inserisci una classe , poi nella classe cancelli tutto e incolli questo , compila il progetto poi chiudilo , vai a levare la listview dal form statistica e mett i questa che ti sara comparsa nelal toolbox



Codice:
Public Class ctlLvOrdinabile
    Inherits ListView

    Private cSortLv As CLvSorter
    Private m_SortingColumn As ColumnHeader


    Private Sub OrdinaLvFromColumn(ByVal lvRisultato As ListView, ByRef m_SortingColumn As ColumnHeader, ByVal e As System.Windows.Forms.ColumnClickEventArgs)
        Dim new_sorting_column As ColumnHeader = lvRisultato.Columns(e.Column)
        ' Figure out the new sorting order.  
        Dim sort_order As System.Windows.Forms.SortOrder
        If m_SortingColumn Is Nothing Then
            ' New column. Sort ascending.  
            sort_order = SortOrder.Ascending
        Else ' See if this is the same column.  
            If new_sorting_column.Equals(m_SortingColumn) Then
                ' Same column. Switch the sort order.  
                If m_SortingColumn.Text.StartsWith("> ") Then
                    sort_order = SortOrder.Descending
                Else
                    sort_order = SortOrder.Ascending
                End If
            Else
                ' New column. Sort ascending.  
                sort_order = SortOrder.Ascending
            End If
            ' Remove the old sort indicator.  
            m_SortingColumn.Text = m_SortingColumn.Text.Substring(2)
        End If
        ' Display the new sort order.  
        m_SortingColumn = new_sorting_column
        If sort_order = SortOrder.Ascending Then
            m_SortingColumn.Text = "> " & m_SortingColumn.Text
        Else
            m_SortingColumn.Text = "< " & m_SortingColumn.Text
        End If
        ' Create a comparer.  
        lvRisultato.ListViewItemSorter = New CLvSorter(e.Column, sort_order)
        ' Sort.  
        lvRisultato.Sort()
    End Sub
    Private Sub OrdinaLvFromColumn(ByVal lvRisultato As ListView, ByRef m_SortingColumn As ColumnHeader, ByVal new_sorting_column As ColumnHeader, ByVal sort_order As System.Windows.Forms.SortOrder)
        '   Dim new_sorting_column As ColumnHeader = lvRisultato.Columns(e.Column)
        ' Figure out the new sorting order.  
        ' Dim sort_order As System.Windows.Forms.SortOrder

        'If new_sorting_column.Equals(m_SortingColumn) Then
        '    ' Same column. Switch the sort order.  
        '    If m_SortingColumn.Text.StartsWith("> ") Then
        '        sort_order = SortOrder.Descending
        '    Else
        '        sort_order = SortOrder.Ascending
        '    End If
        'Else
        '    ' New column. Sort ascending.  
        '    sort_order = SortOrder.Ascending
        'End If
        ' Remove the old sort indicator.  
        m_SortingColumn.Text = m_SortingColumn.Text.Substring(2)

        ' Display the new sort order.  
        m_SortingColumn = new_sorting_column
        If sort_order = SortOrder.Ascending Then
            m_SortingColumn.Text = "> " & m_SortingColumn.Text
        Else
            m_SortingColumn.Text = "< " & m_SortingColumn.Text
        End If
        ' Create a comparer.  
        'lvRisultato.ListViewItemSorter = New CLvSorter(e.Column, sort_order)
        lvRisultato.ListViewItemSorter = New CLvSorter(new_sorting_column.Index, sort_order)

        ' Sort.  
        lvRisultato.Sort()
    End Sub
    Protected Overrides Sub OnColumnClick(ByVal e As System.Windows.Forms.ColumnClickEventArgs)
        MyBase.OnColumnClick(e)
        OrdinaLvFromColumn(Me, m_SortingColumn, e)

    End Sub
End Class
Public Class CLvSorter

    Implements IComparer
    Private m_ColumnNumber As Integer
    Private m_SortOrder As SortOrder




    Public Sub New(ByVal column_number As Integer, ByVal sort_order As SortOrder)
        m_ColumnNumber = column_number
        m_SortOrder = sort_order
    End Sub
    ' Compare the items in the appropriate column  
    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements System.Collections.IComparer.Compare
        Dim item_x As ListViewItem = DirectCast(x, ListViewItem)
        Dim item_y As ListViewItem = DirectCast(y, ListViewItem)
        ' Get the sub-item values.  
        Dim string_x As String
        If item_x.SubItems.Count <= m_ColumnNumber Then
            string_x = ""
        Else
            string_x = item_x.SubItems(m_ColumnNumber).Text
        End If
        Dim string_y As String
        If item_y.SubItems.Count <= m_ColumnNumber Then
            string_y = ""
        Else
            string_y = item_y.SubItems(m_ColumnNumber).Text
        End If
        ' Compare them.  
        If m_SortOrder = SortOrder.Ascending Then
            If IsNumeric(string_x) And IsNumeric(string_y) Then
                Return Val(string_x).CompareTo(Val(string_y))
            ElseIf IsDate(string_x) And IsDate(string_y) Then
                Return DateTime.Parse(string_x).CompareTo(DateTime.Parse(string_y))
            Else
                Return String.Compare(string_x, string_y)
            End If
        Else
            If IsNumeric(string_x) And IsNumeric(string_y) Then
                Return Val(string_y).CompareTo(Val(string_x))
            ElseIf IsDate(string_x) And IsDate(string_y) Then
                Return DateTime.Parse(string_y).CompareTo(DateTime.Parse(string_x))
            Else
                Return String.Compare(string_y, string_x)
            End If
        End If
    End Function




End Class
 
nel modulo strutture leva quelel di prima e metti queste

Codice:
 Public Structure struct_uscita  'serve per memorizzare le uscite passate dopo l'esecuzione della statistica formazione

        Dim IdEstr As Integer
        Dim Ruota As Integer
        Dim aPos() As Boolean

        Dim Ritardo As Integer
        Dim RitardoMax As Integer
        Dim Frequenza As Integer
        Dim Presenze As Integer
        Dim IncrRitMax As Integer


        Sub Dimensiona()
            ReDim aPos(5)
        End Sub
    End Structure

    Public Structure struct_formazione ' definisce una lunghetta da sottoporre all'analisi statistica 
        Dim Inizio As Integer
        Dim Fine As Integer


        Dim Numeri As StrNumeri
        Dim aPosizioni() As Boolean
        Dim aRuote() As Boolean
        Dim Sorte As Integer

        Dim Ritardo As Integer
        Dim RitardoMax As Integer
        Dim Frequenza As Integer
        Dim Presenze As Integer
        Dim IncrRitMax As Integer


        Dim aUscite() As struct_uscita
        Dim UBoundaUscite As Integer
        Dim UBoundaUsciteCur As Integer

        Dim EstrEsam As Integer

        Sub Inizializza(aNumeri() As Integer, aRuoteUsate() As Integer, nSorte As Integer, RangeIni As Integer, RangeFin As Integer, Optional aPos() As Boolean = Nothing)
            Dim qNumeri As Integer = aNumeri.GetUpperBound(0)

            Inizio = RangeIni
            Fine = RangeFin
            Sorte = nSorte

            ReDim aPosizioni(5)
            If IsNothing(aPos) Then
                For k As Integer = 1 To 5
                    aPosizioni(k) = True
                Next
            Else
                For k As Integer = 1 To 5
                    aPosizioni(k) = aPos(k)
                Next
            End If

            ReDim aRuote(11)
            For k As Integer = 1 To aRuoteUsate.GetUpperBound(0)
                aRuote(aRuoteUsate(k)) = True
            Next

            Numeri.Dimensiona(qNumeri)
            For k As Integer = 1 To qNumeri
                Numeri.SetNumero(aNumeri(k), k)
            Next

            Ritardo = 0
            RitardoMax = 0
            Frequenza = 0
            Presenze = 0
            EstrEsam = 0
            IncrRitMax = 0

            UBoundaUscite = 100
            UBoundaUsciteCur = 0
            ReDim aUscite(UBoundaUscite)
        End Sub
        Sub AddUscita(Ritardo As Integer, RitardoMax As Integer, Frequenza As Integer, Presenze As Integer, IncrRitMax As Integer, IdEstr As Integer, Ruota As Integer, Optional aPos() As Boolean = Nothing)

            aUscite(UBoundaUsciteCur).IdEstr = IdEstr
            aUscite(UBoundaUsciteCur).Ritardo = Ritardo
            aUscite(UBoundaUsciteCur).RitardoMax = RitardoMax
            aUscite(UBoundaUsciteCur).Presenze = Presenze
            aUscite(UBoundaUsciteCur).Frequenza = Frequenza
            aUscite(UBoundaUsciteCur).IncrRitMax = IncrRitMax




            aUscite(UBoundaUsciteCur).Ruota = Ruota
            aUscite(UBoundaUsciteCur).Dimensiona()

            If Not IsNothing(aPos) Then
                For e = 1 To 5
                    aUscite(UBoundaUsciteCur).aPos(e) = aPos(e)
                Next
            End If

            UBoundaUsciteCur += 1

            If UBoundaUsciteCur = UBoundaUscite Then
                UBoundaUscite += 100
                ReDim Preserve aUscite(UBoundaUscite)
            End If
        End Sub
        Function GetQuantitaUscite() As Integer
            Return UBoundaUsciteCur - 1
        End Function

        Function GetQuantitaNumeri() As Integer
            Return Numeri.Estratto.GetUpperBound(0)

        End Function

        Sub ComprimiUscite()
            Dim x As Integer = GetQuantitaUscite()
            If x > 0 Then
                ReDim Preserve aUscite(GetQuantitaUscite)
            End If

        End Sub
    End Structure
 
bene ora nel form statistica ci vuole un pulsante che lanci la statistica della formazione scritta nella text box , percio mettilo.
Dentro all'evento clik devi istanziare una sub che gestisca la statistica , li dentro devi dichiarare una variabile

Dim frz As New struct_formazione

poi devi lanciare la sua funzione inizializza

frz.Inizializza(aNumeri, aRuote, nSorte, inizio, fine)

chiaramente devi vedere come ottenere i parametri da passargili , fatto questo mettiamo la statistca
 
aNumeri lo devi ottenere dal campo testo
aRuote dal controllo ruote del form mdi
nSorte da quanto hai selezionato nellla combobox sorte
inizio e fine dal controllo range che sta sul form mdi
aPosizioni dal controll odelle posizioni
 
Quindi una cosa del genere:

Codice:
Public Class frmStatLung
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles ButtonScegliNumeri.Click
        SelezionaNumeri(TextBox1.Text)
    End Sub

    Private Sub frmStatLung_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        LoadComboSorte(cmbsorte)
    End Sub

    Private Sub ButtonFlash_Click(sender As Object, e As EventArgs) Handles ButtonFlash.Click
        LanciaStatistica()
    End Sub
    Sub LanciaStatistica()
        Dim frz As New struct_formazione
        Dim aNumeri() As Integer
        Dim aRuote() As Integer
        Dim nSorte As Integer
        Dim Inizio As Integer
        Dim fine As Integer
        GetArrayNumeriFromString(TextBox1.Text, aNumeri)
        frmSchermataPrincipale.CltSelRuote1.GetCheckSelezionate(aRuote)
        nSorte = Me.cmbsorte.SelectedItem
        Inizio = frmSchermataPrincipale.CtlRangeEstrazioni1.Inizio
        fine = frmSchermataPrincipale.CtlRangeEstrazioni1.Fine
        frz.Inizializza(aNumeri, aRuote, nSorte, Inizio, fine)

    End Sub
End Class
 
si dovrebbe andare ad ogni modo proviamo , nellla classe archivio inserisci questa funzione

Codice:
Friend Function StatFormazione(ByRef frz As struct_formazione) As Boolean
        Dim nPunti As Integer, nPuntiMax As Integer

        Dim aRetPosUscita() As Boolean
        Dim bNumPresenti As Boolean
        Dim nEstrTot As Integer = Estrazioni.GetUpperBound(0)
        Try

            If frz.Fine > nEstrTot Or frz.Fine <= 0 Then frz.Fine = nEstrTot
            If frz.Inizio <= 0 Then frz.Inizio = 1

            If frz.Inizio <= frz.Fine AndAlso nEstrTot > 0 AndAlso frz.GetQuantitaNumeri >= frz.Sorte Then
                For idEstr As Integer = frz.Inizio To frz.Fine


                    nPuntiMax = 0
                    bNumPresenti = False

                    For r As Integer = 1 To 11
                        If frz.aRuote(r) Then
                            nPunti = 0
                            ReDim aRetPosUscita(5)
                            If NumeroValido(Estrazioni(idEstr).Ruote(r).Estratto(1)) Then
                                bNumPresenti = True
                            End If
                            For e As Integer = 1 To 5
                                If frz.aPosizioni(e) Then
                                    If frz.Numeri.bEstratto(Estrazioni(idEstr).Ruote(r).Estratto(e)) Then
                                        nPunti += 1
                                        aRetPosUscita(e) = True

                                    End If
                                End If

                            Next
                            If nPunti > nPuntiMax Then
                                nPuntiMax = nPunti
                            End If
                            If nPunti >= frz.Sorte Then
                                frz.AddUscita(frz.Ritardo, frz.RitardoMax, frz.Frequenza, frz.Presenze, frz.IncrRitMax, idEstr, r, aRetPosUscita)
                            End If
                        End If
                    Next

                    If nPuntiMax >= frz.Sorte Then
                        If frz.Ritardo > frz.RitardoMax Then
                            frz.RitardoMax = frz.Ritardo
                        End If
                        frz.Ritardo = 0
                        frz.Presenze += 1
                        frz.Frequenza += Combinazioni(nPuntiMax, frz.Sorte)
                        frz.IncrRitMax = 0
                    Else
                        frz.Ritardo += 1
                        If frz.Ritardo > frz.RitardoMax Then
                            frz.IncrRitMax += 1
                        End If
                    End If

                    If bNumPresenti Then
                        frz.EstrEsam += 1
                    End If


                Next

                frz.ComprimiUscite()
                Return frz.EstrEsam > 0
            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try

        Return False


    End Function


nel modulo assistente queste altre 2

Codice:
    Function Combinazioni(ByVal N As Integer, ByVal k As Integer) As Double

        Dim N_Fatt As Double
        Dim K_Fatt As Double
        Dim N_K_Fatt As Double



        If N >= k Then
            N_Fatt = Fattoriale(N)


            K_Fatt = Fattoriale(k)

            N_K_Fatt = IIf(N - k > 0, Fattoriale(N - k), 1)
            If K_Fatt > 0 Then

                Return (N_Fatt / (K_Fatt * N_K_Fatt))
            Else
                Return 0
            End If
        Else
            Return 0
        End If

    End Function

    Private Function Fattoriale(ByVal n As Integer)

        If (n = 0) Then
            Return 1
        Else
            Return n * Fattoriale(n - 1)
        End If

    End Function
 
nella procedura che lancia la statistica metti

If cArchivio.StatFormazione(frz) Then

End If

poi metti un breakpoint a end sub evai in run , lancia la statistica e valuta la variabile frz dimm ise contiene dati
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 11 gennaio 2025
    Bari
    73
    43
    01
    58
    81
    Cagliari
    69
    60
    18
    02
    10
    Firenze
    25
    32
    18
    55
    54
    Genova
    48
    05
    40
    34
    69
    Milano
    10
    07
    70
    44
    79
    Napoli
    11
    89
    01
    34
    80
    Palermo
    37
    80
    82
    44
    77
    Roma
    78
    04
    38
    39
    56
    Torino
    08
    13
    30
    27
    24
    Venezia
    56
    75
    36
    18
    70
    Nazionale
    63
    83
    19
    31
    80
    Estrazione Simbolotto
    Bari
    35
    34
    12
    23
    20
Indietro
Alto