L
LuigiB
Guest
bhe come minimo dovevi gestire anche la riapertura del file .. non mi dire che sei pure andato a dormire stanotte...Ho Gestito anche l'abilitazione button salva
stringbuilder.clear ti stava antipatico ?
Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
bhe come minimo dovevi gestire anche la riapertura del file .. non mi dire che sei pure andato a dormire stanotte...Ho Gestito anche l'abilitazione button salva
Function SelezionaNumeriRuoteESorte(ByRef sRetNumeri As String, ByRef sRetRuote As String, ByRef sRetSorte As String, ByRef sRetPos As String) As Integer
Dim frm As New FrmSelNumeri
Dim aRuote() As Boolean = Nothing
Dim aPos() As Boolean = Nothing
frm.ImpostaModalitaNumeriRuoteESelezione()
If sRetNumeri.Trim <> "" Then
Dim aRetNumeri() As Integer = Nothing
GetArrayNumeriFromString(sRetNumeri, aRetNumeri)
For k = 1 To aRetNumeri.GetUpperBound(0)
frm.CtlSelezionaNumeri1.SetValue(aRetNumeri(k), True)
Next
End If
If sRetRuote <> "" Then
aRuote = StringaRuoteToBool(sRetRuote, ".")
frm.CltSelRuote1.SetCheckSelezionate(aRuote)
End If
If sRetSorte <> "" Then
Call SelezionaItemCombo(frm.cmbSorte, sRetSorte)
End If
If sRetPos <> "" Then
StringaNumeriToArray(sRetPos, aPos, 5)
frm.CtlSelPosizione1.SetCheckSelezionate(aPos)
End If
frm.ShowDialog()
If frm.Tag = "Ok" Then
sRetNumeri = frm.CtlSelezionaNumeri1.GetStringaNumeri()
frm.CltSelRuote1.GetCheckSelezionate(aRuote)
sRetRuote = RuoteBToString(aRuote)
sRetSorte = frm.cmbSorte.Text
frm.CtlSelPosizione1.GetCheckSelezionate(aPos)
sRetPos = ArrayNumeriToString(aPos)
If sRetNumeri <> "" AndAlso sRetRuote <> "" AndAlso sRetSorte <> "" AndAlso sRetPos <> "" Then
SelezionaNumeriRuoteESorte = frm.CtlSelezionaNumeri1.QNumeriSelezionati
frm.Close()
frm.Dispose()
Else
MessageBox.Show("Dati mancanti", "Errore", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End If
Else
SelezionaNumeriRuoteESorte = 0
frm.Close()
frm.Dispose()
End If
End Function
Private Sub CtlLvOrdinabile1_DoubleClick(sender As Object, e As EventArgs) Handles CtlLvOrdinabile1.DoubleClick
If CtlLvOrdinabile1.SelectedItems.Count Then
Dim itmSel As ListViewItem = CtlLvOrdinabile1.SelectedItems(0)
Dim sNumeri As String = itmSel.Text
Dim sRuote As String = itmSel.SubItems(1).Text
Dim sSorte As String = itmSel.SubItems(2).Text
Dim sPos As String = itmSel.SubItems(10).Text
If SelezionaNumeriRuoteESorte(sNumeri, sRuote, sSorte, sPos) Then
itmSel.Text = sNumeri
itmSel.SubItems(1).Text = sRuote
itmSel.SubItems(2).Text = sSorte
itmSel.SubItems(10).Text = sPos
' call aggiornaStatistica ( itmsel) questa la devi implementare tu deve aggiornare la statistica di questo item con i nuovi parametri
End If
End If
End Sub
Private Sub ButtonSalva_Click(sender As Object, e As EventArgs) Handles ButtonSalva.Click
Dim NameFile As String
CreaFolderFileDefault(GetDirFormazioni)
If LvLunghette.Items.Count > 0 Then
If MessageBox.Show("Desideri salvare le formazioni?", "Salvataggio", MessageBoxButtons.YesNo, MessageBoxIcon.Information) = DialogResult.Yes Then
NameFile = InputBox("Indicare nome del file", "Formazioni")
If VerificaCaratteriNonConsentiti(NameFile) = True Then
SalvaFormazioni(LvLunghette, GetDirFormazioni() & NameFile & ".csv")
Else
MessageBox.Show("Si prega di non inserire caratteri speciali come ~ # % & : < > ? \ / { } |", "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End If
Else
MessageBox.Show("Nessuna formazione da salvare presente", "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
Private Function SalvaFormazioni(LvOrd As ctlLvOrdinabile, DirFile As String)
Dim SB As New StringBuilder
Dim i As Integer
Dim strmW As New StreamWriter(DirFile)
For Each itm In LvOrd.Items
i = 0
SB.Clear()
For Each ch As ColumnHeader In LvOrd.Columns
i += 1
SB.Append(itm.subitems(i - 1).text)
SB.Append(";")
Next
strmW.WriteLine(SB.Remove(SB.Length - 1, 1))
Next
strmW.Close()
End Function
Function VerificaCaratteriNonConsentiti(sDaVerificare As String) As Boolean
Dim CaratteriNonConsentiti() As String = {"~", "#", "%", "&", ":", "<", ">", "?", "\", "/", "{", "}", "|"}
For k As Integer = 0 To sDaVerificare.Length - 1
For y As Integer = 0 To UBound(CaratteriNonConsentiti)
If sDaVerificare(k) = CaratteriNonConsentiti(y) Then
Return False
End If
Next
Next
End Function
Private Sub LvLunghette_DoubleClick(sender As Object, e As EventArgs) Handles LvLunghette.DoubleClick
If LvLunghette.SelectedItems.Count Then
Dim itmSel As ListViewItem = LvLunghette.SelectedItems(0)
Dim sNumeri As String = itmSel.Text
Dim sRuote As String = itmSel.SubItems(1).Text
Dim sSorte As String = itmSel.SubItems(2).Text
Dim sPos As String = itmSel.SubItems(10).Text
If SelezionaNumeriRuoteESorte(sNumeri, sRuote, sSorte, sPos) Then
itmSel.Text = sNumeri
itmSel.SubItems(1).Text = sRuote
itmSel.SubItems(2).Text = sSorte
itmSel.SubItems(10).Text = sPos
AggiornaStatistica(itmSel)
End If
End If
End Sub
Sub AggiornaStatistica(ItemSel As ListViewItem)
Dim frz As New struct_formazione
Dim aNumeri() As Integer = Nothing
Dim aRuote() As Boolean = Nothing
Dim aPos() As Boolean = Nothing
Dim nSorte As Integer
Dim Inizio As Integer
Dim fine As Integer
ItemSel.Remove()
GetArrayNumeriFromString(ItemSel.Text, aNumeri)
aRuote = StringaRuoteToBool(ItemSel.SubItems(1).Text)
nSorte = ConvertToInt(ItemSel.SubItems(2).Text)
StringaNumeriToArray(ItemSel.SubItems(10).Text, aPos, 5)
Inizio = frmMain.CtlRangeEstrazioni1.Inizio
fine = frmMain.CtlRangeEstrazioni1.Fine
If frz.Inizializza(aNumeri, aRuote, nSorte, Inizio, fine, aPos) Then
cArchivio.StatFormazione(frz)
Dim itm As ListViewItem = LvLunghette.Items.Add(ArrayNumeriToString(aNumeri))
itm.SubItems.Add(RuoteBToString(aRuote))
itm.SubItems.Add(frz.Sorte)
itm.SubItems.Add(frz.Ritardo)
itm.SubItems.Add(frz.RitardoMax)
itm.SubItems.Add(frz.IncrRitMax)
itm.SubItems.Add(frz.Frequenza)
itm.SubItems.Add(frz.Presenze)
itm.SubItems.Add(frz.Inizio)
itm.SubItems.Add(frz.Fine)
itm.SubItems.Add(ArrayNumeriToString(frz.aPosizioni))
End If
End Sub
ahime .. purtroppo mi sono dimenticato di predisporre anche range inizio e fine nella funzione SelezinaNumeriRuoteSorte ... quindi dovrai farlo tudevo fare solo per la riapertura e la selezione del file
Private Sub LvLunghette_DoubleClick(sender As Object, e As EventArgs) Handles LvLunghette.DoubleClick
If LvLunghette.SelectedItems.Count Then
Dim itmSel As ListViewItem = LvLunghette.SelectedItems(0)
Dim sNumeri As String = itmSel.Text
Dim sRuote As String = itmSel.SubItems(1).Text
Dim sSorte As String = itmSel.SubItems(2).Text
Dim sInizio As String = itmSel.SubItems(8).Text
Dim sFine As String = itmSel.SubItems(9).Text
Dim sPos As String = itmSel.SubItems(10).Text
If SelezionaNumeriRuoteESorte(sNumeri, sRuote, sSorte, sInizio, sFine, sPos) Then
itmSel.Text = sNumeri
itmSel.SubItems(1).Text = sRuote
itmSel.SubItems(2).Text = sSorte
itmSel.SubItems(8).Text = sInizio
itmSel.SubItems(9).Text = sFine
itmSel.SubItems(10).Text = sPos
AggiornaStatistica(itmSel)
End If
End If
End Sub
Sub AggiornaStatistica(ItemSel As ListViewItem)
Dim frz As New struct_formazione
Dim aNumeri() As Integer = Nothing
Dim aRuote() As Boolean = Nothing
Dim aPos() As Boolean = Nothing
Dim nSorte As Integer
Dim Inizio As Integer
Dim fine As Integer
ItemSel.Remove()
GetArrayNumeriFromString(ItemSel.Text, aNumeri)
aRuote = StringaRuoteToBool(ItemSel.SubItems(1).Text)
nSorte = ConvertToInt(ItemSel.SubItems(2).Text)
StringaNumeriToArray(ItemSel.SubItems(10).Text, aPos, 5)
Inizio = ConvertToInt(ItemSel.SubItems(8).Text)
fine = ConvertToInt(ItemSel.SubItems(9).Text)
If frz.Inizializza(aNumeri, aRuote, nSorte, Inizio, fine, aPos) Then
cArchivio.StatFormazione(frz)
Dim itm As ListViewItem = LvLunghette.Items.Add(ArrayNumeriToString(aNumeri))
itm.SubItems.Add(RuoteBToString(aRuote))
itm.SubItems.Add(frz.Sorte)
itm.SubItems.Add(frz.Ritardo)
itm.SubItems.Add(frz.RitardoMax)
itm.SubItems.Add(frz.IncrRitMax)
itm.SubItems.Add(frz.Frequenza)
itm.SubItems.Add(frz.Presenze)
itm.SubItems.Add(frz.Inizio)
itm.SubItems.Add(frz.Fine)
itm.SubItems.Add(ArrayNumeriToString(frz.aPosizioni))
End If
End Sub
Public Class FrmSelNumeri
Sub New()
' La chiamata è richiesta dalla finestra di progettazione.
InitializeComponent()
CtlSelezionaNumeri1.BackColorSelected = Color.FromName(GetValoreCfg(eValoriAppConfig.SfondoColoreNumEvidenziato))
CtlSelezionaNumeri1.ForeColorSelected = Color.FromName(GetValoreCfg(eValoriAppConfig.ForeColorNumEvidenziato))
CtlSelezionaNumeri1.SetBackColorFromStringaColoriWin32(GetValoreCfg(eValoriAppConfig.SfondoColoreNumeri))
CtlSelezionaNumeri1.SetForeColorFromStringaColoriWin32(GetValoreCfg(eValoriAppConfig.ForeColorNumeri))
CaricaItemCombo()
ImpostaLimitiScrollBar()
Init()
' Aggiungere le eventuali istruzioni di inizializzazione dopo la chiamata a InitializeComponent().
End Sub
Sub ImpostaModalitaNumeriRuoteESelezione()
TextBox1.Height = FrameRuoteSorte.Top - TextBox1.Top - 5
FrameRuoteSorte.Visible = True
End Sub
Private Sub ButtonOk_Click(sender As Object, e As EventArgs) Handles ButtonOK.Click
Me.Tag = "OK"
Me.Hide()
End Sub
Private Sub ButtonAnnulla_Click(sender As Object, e As EventArgs) Handles ButtonAnnulla.Click
Me.Tag = ""
Me.Hide()
End Sub
Sub CaricaItemCombo()
Dim FileInPath() As String
FileInPath = GetAllFileInPath(GetDirPreselezioni, "*.csv")
Dim cComb As ClsItemPreselezione
For k = 0 To UBound(FileInPath)
cComb = New ClsItemPreselezione(FileInPath(k))
ComboBox1.Items.Add(cComb)
Next
cmbSorte.Items.Clear()
For k As Integer = 1 To 5
cmbSorte.Items.Add(k.ToString)
Next
End Sub
Private Sub ComboBox1_SelectedValueChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedValueChanged
If Not IsNothing(ComboBox1.SelectedItem) Then
Dim c As ClsItemPreselezione = DirectCast(ComboBox1.SelectedItem, ClsItemPreselezione)
CtlSelezionaNumeri1.SetValueFromStringaNum(c.Tag)
End If
End Sub
Private Sub ButtonPulisci_Click(sender As Object, e As EventArgs) Handles ButtonPulisci.Click
For k = 1 To 90
CtlSelezionaNumeri1.SetValue(k, 0)
Next
TextBox1.Text = ""
End Sub
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
CtlSelezionaNumeri1.Tag = "x"
CtlSelezionaNumeri1.SelezionaTutto(False)
CtlSelezionaNumeri1.SetValueFromStringaNum(TextBox1.Text)
CtlSelezionaNumeri1.Tag = ""
End Sub
Private Sub CtlSelezionaNumeri1_OnChange(Num As Integer) Handles CtlSelezionaNumeri1.OnChange
If CtlSelezionaNumeri1.Tag = "" Then
Me.TextBox1.Text = CtlSelezionaNumeri1.GetStringaNumeri
End If
End Sub
Private Sub TextBox1_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyDown
SoloCaratteriPerInserimentoLunghette(e)
End Sub
Sub ImpostaLimitiScrollBar()
ScrollBarInizio.Minimum = 1
ScrollBarInizio.Maximum = cArchivio.QuantitaEstrazioni
ScrollBarInizio.Value = 1
ScrollBarFine.Minimum = 1
ScrollBarFine.Maximum = cArchivio.QuantitaEstrazioni
ScrollBarFine.Value = ScrollBarFine.Maximum
End Sub
Sub Init()
LabEstrS1.Text = cArchivio.GetInfoEstrazione(ScrollBarInizio.Value)
LabEstrS2.Text = cArchivio.GetInfoEstrazione(ScrollBarFine.Value)
End Sub
Sub GestioneRangeInizio()
If ScrollBarInizio.Minimum > 0 And ScrollBarFine.Minimum > 0 Then
If ScrollBarInizio.Value <= ScrollBarFine.Value Then
LabEstrS1.Text = cArchivio.GetInfoEstrazione(ScrollBarInizio.Value)
Else
ScrollBarInizio.Value = ScrollBarFine.Value
End If
End If
End Sub
Sub GestioneRangeFine()
If ScrollBarInizio.Minimum > 0 And ScrollBarFine.Minimum > 0 Then
If ScrollBarFine.Value >= ScrollBarInizio.Value Then
LabEstrS2.Text = cArchivio.GetInfoEstrazione(ScrollBarFine.Value)
Else
ScrollBarFine.Value = ScrollBarInizio.Value
End If
End If
End Sub
Private Sub ScrollBarFine_ValueChanged(sender As Object, e As EventArgs) Handles ScrollBarFine.ValueChanged
GestioneRangeFine()
End Sub
Private Sub ScrollBarInizio_ValueChanged(sender As Object, e As EventArgs) Handles ScrollBarInizio.ValueChanged
GestioneRangeInizio()
End Sub
End Class
Function SelezionaNumeriRuoteESorte(ByRef sRetNumeri As String, ByRef sRetRuote As String, ByRef sRetSorte As String, ByRef sInizio As String, ByRef sFine As String, ByRef sRetPos As String) As Integer
Dim frm As New FrmSelNumeri
Dim aRuote() As Boolean = Nothing
Dim aPos() As Boolean = Nothing
frm.ImpostaModalitaNumeriRuoteESelezione()
If sRetNumeri.Trim <> "" Then
Dim aRetNumeri() As Integer = Nothing
GetArrayNumeriFromString(sRetNumeri, aRetNumeri)
For k = 1 To aRetNumeri.GetUpperBound(0)
frm.CtlSelezionaNumeri1.SetValue(aRetNumeri(k), True)
Next
End If
If sRetRuote <> "" Then
aRuote = StringaRuoteToBool(sRetRuote, ".")
frm.CltSelRuote1.SetCheckSelezionate(aRuote)
End If
If sRetSorte <> "" Then
Call SelezionaItemCombo(frm.cmbSorte, sRetSorte)
End If
If sInizio <> "" Then
frm.ScrollBarInizio.Value = ConvertToInt(sInizio)
End If
If sFine <> "" Then
frm.ScrollBarFine.Value = ConvertToInt(sFine)
End If
If sRetPos <> "" Then
StringaNumeriToArray(sRetPos, aPos, 5)
frm.CtlSelPosizione1.SetCheckSelezionate(aPos)
End If
frm.ShowDialog()
If frm.Tag = "Ok" Then
sRetNumeri = frm.CtlSelezionaNumeri1.GetStringaNumeri()
frm.CltSelRuote1.GetCheckSelezionate(aRuote)
sRetRuote = RuoteBToString(aRuote)
sRetSorte = frm.cmbSorte.Text
sInizio = frm.ScrollBarInizio.Value.ToString
sFine = frm.ScrollBarFine.Value.ToString
frm.CtlSelPosizione1.GetCheckSelezionate(aPos)
sRetPos = ArrayNumeriToString(aPos)
If sRetNumeri <> "" AndAlso sRetRuote <> "" AndAlso sRetSorte <> "" AndAlso sInizio <> "" AndAlso sFine <> "" AndAlso sRetPos <> "" Then
SelezionaNumeriRuoteESorte = frm.CtlSelezionaNumeri1.QNumeriSelezionati
frm.Close()
frm.Dispose()
Else
MessageBox.Show("Dati mancanti", "Errore", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End If
Else
SelezionaNumeriRuoteESorte = 0
frm.Close()
frm.Dispose()
End If
End Function
Function ScegliFileFormazioni(sFilePercorso As String, Optional Estensione As String = "*.csv") As String
Dim frm As New frmApriFileFormazioni
Dim Ext As String = Estensione.TrimStart("*")
Dim AllFile() As String = GetAllFileInPath(sFilePercorso, Estensione)
For k = 0 To UBound(AllFile)
frm.ListBox1.Items.Add(GetNomeFileSenzaEstensione(AllFile(k)))
Next
frm.ShowDialog()
If frm.Tag = "OK" Then
ScegliFileFormazioni = sFilePercorso & frm.ListBox1.SelectedItem.ToString & Ext
frm.Close()
frm.Dispose()
Else
ScegliFileFormazioni = ""
frm.Close()
frm.Dispose()
End If
End Function
Private Sub ButtonApriFile_Click(sender As Object, e As EventArgs) Handles ButtonApriFile.Click
ScegliFileFormazioni(GetDirFormazioni)
End Sub
Funziona tutto tranne ApriFileFormazioni (ritorna il percorso del file certo ma poi si ferma li)bene , funziona ?
Function ScegliFileFormazioni(sFilePercorso As String, Optional Estensione As String = "*.csv") As String
Dim frm As New frmApriFileFormazioni
Dim Ext As String = Estensione.TrimStart("*")
Dim AllFile() As String = GetAllFileInPath(sFilePercorso, Estensione)
Dim cItm As ClsItemCombo
For k = 1 To UBound(AllFile)
cItm = New ClsItemCombo
cItm.Text = GetNomeFileSenzaEstensione(AllFile(k))
cItm.Tag = AllFile(k)
frm.ListBox1.Items.Add(cItm)
Next
frm.ShowDialog()
If frm.Tag = "OK" Then
If frm.ListBox1.SelectedItems.Count Then
cItm = DirectCast(frm.ListBox1.SelectedItem, ClsItemCombo)
ScegliFileFormazioni = cItm.Tag
frm.Close()
frm.Dispose()
End If
Else
ScegliFileFormazioni = ""
frm.Close()
frm.Dispose()
End If
End Function
Private Sub ButtonApriFile_Click(sender As Object, e As EventArgs) Handles ButtonApriFile.Click
Dim sFile As String
sFile = ScegliFileFormazioni(GetDirFormazioni)
If FileExist(sFile) Then
lvScomposizione.Items.Clear()
Dim SR As New StreamReader(sFile)
Dim sline As String
Dim sRecord() As String
sline = SR.ReadLine
sRecord = sline.Split(";")
Dim itm As ListViewItem = LvLunghette.Items.Add(sRecord(0))
itm.SubItems.Add(sRecord(1))
itm.SubItems.Add(sRecord(2))
itm.SubItems.Add(sRecord(3))
itm.SubItems.Add(sRecord(4))
itm.SubItems.Add(sRecord(5))
itm.SubItems.Add(sRecord(6))
itm.SubItems.Add(sRecord(7))
itm.SubItems.Add(sRecord(8))
itm.SubItems.Add(sRecord(9))
itm.SubItems.Add(sRecord(10))
End If
End Sub
Perfetto ho corretto tutto. Anche un un'altro bug di piccolo conto. La funzione scegli file non trovava il primo file in lista. Ho fatto partire il ciclo dall'indice 0 "For k = 0 To UBound(AllFile)"Devi correggere la funzione che veridfica i caratteri perche non torna mai tru e non consente di salvare dice che il nome è sbagliato.
poi devi correggere e fare cosi la funzione
poi al pulsante che la chiama farai
sFile = ScegliFileFormazioni
if fileexist(sFile ) then
' svuota lista
' apre streamreader
' ciclo che legge le linee e aggiunge gli item alla listvieew
chiud stream
end if
Codice:Function ScegliFileFormazioni(sFilePercorso As String, Optional Estensione As String = "*.csv") As String Dim frm As New frmApriFileFormazioni Dim Ext As String = Estensione.TrimStart("*") Dim AllFile() As String = GetAllFileInPath(sFilePercorso, Estensione) Dim cItm As ClsItemCombo For k = 1 To UBound(AllFile) cItm = New ClsItemCombo cItm.Text = GetNomeFileSenzaEstensione(AllFile(k)) cItm.Tag = AllFile(k) frm.ListBox1.Items.Add(cItm) Next frm.ShowDialog() If frm.Tag = "OK" Then If frm.ListBox1.SelectedItems.Count Then cItm = DirectCast(frm.ListBox1.SelectedItem, ClsItemCombo) ScegliFileFormazioni = cItm.Tag frm.Close() frm.Dispose() End If Else ScegliFileFormazioni = "" frm.Close() frm.Dispose() End If End Function
Public Class frmApriFileFormazioni
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Me.Tag = "OK"
Me.Hide()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Me.Tag = ""
Me.Hide()
End Sub
Private Sub ButtonCancella_Click(sender As Object, e As EventArgs) Handles ButtonCancella.Click
If ListBox1.SelectedIndex >= 0 Then
If MessageBox.Show("Vuoi eliminare la formazione selezionata?", "Elimina formazione", MessageBoxButtons.YesNo, MessageBoxIcon.Information) = DialogResult.Yes Then
DeleteFile(GetDirFormazioni() & ListBox1.SelectedItem.ToString & ".csv")
Me.Close()
End If
Else
MessageBox.Show("Nessuno formazione selezionata", "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
End Class