• Najnowsze pytania
  • Bez odpowiedzi
  • Zadaj pytanie
  • Kategorie
  • Tagi
  • Zdobyte punkty
  • Ekipa ninja
  • IRC
  • FAQ
  • Regulamin
  • Książki warte uwagi

Czas w Visual Basic

Object Storage Arubacloud
+1 głos
175 wizyt
pytanie zadane 3 września 2020 w Visual Basic przez Laurencjusz Kocik Użytkownik (540 p.)
Witam,

Co zrobić, aby np. za miesiąc wartość tekxtbox wzrosła o 1? (Visual Basic)

Dziękuję za pomoc.
komentarz 4 września 2020 przez VBService Ekspert (252,740 p.)
A może być kod w VB.Net?
komentarz 4 września 2020 przez Laurencjusz Kocik Użytkownik (540 p.)
oczywiście

1 odpowiedź

0 głosów
odpowiedź 5 września 2020 przez VBService Ekspert (252,740 p.)
wybrane 5 września 2020 przez Laurencjusz Kocik
 
Najlepsza

Może to wyglądać mniej więcej tak wink, z zapisem stanu do pliku xml (który jest tworzony przy pierwszym uruchomieniu): 

Imports System.IO
Imports System.Text
Imports System.Xml
Imports WindowsApplication1.ApplicationDataXml

Public Class Form1

    Public Sub New()

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        SetValueMonthly(TextBox1) ' Wartość domyslnie wzrośnie o 1 np.: TextBox1.Text += 1
        ' TextBox1.Name = Amount
        ' SetValueMonthly(Amount) ' itp.
        ' SetValueMonthly(TextBox1, 3) ' Wartość wzrośnie o 3 np.: TextBox1.text += 3
    End Sub

    Private Sub SetValueMonthly(ByRef TextBox As TextBox, Optional ByVal value As Integer = 1)
        Try
            Dim value_from_xml, value_date_from_xml As String
            value_from_xml = GetValueFromXmlFile("monthly-value", "value")
            value_date_from_xml = GetValueFromXmlFile("monthly-value", "date")

            If String.IsNullOrEmpty(value_from_xml) Or String.IsNullOrEmpty(value_date_from_xml) Then
                Throw New System.Exception("Nie mogę ustawić prawidłowej wartości dla: " & TextBox.Name)
            Else
                Dim textbox_value As Integer = Int32.Parse(value_from_xml)
                Dim check_date As DateTime = Date.Parse(value_date_from_xml)
                Dim check_date_interval As DateTime = check_date.AddMonths(1)
                Dim check_date_today As DateTime = Today.ToString("d")
                Dim date_compare As Integer = DateTime.Compare(check_date_today, check_date_interval)

                If date_compare >= 0 Then ' Minął miesiąc
                    Dim textbox_value_computed As Integer = textbox_value + value
                    ' Zapisanie nowych wartości do pliku xml
                    SetValueToXmlFile("monthly-value", "value", textbox_value_computed)
                    SetValueToXmlFile("monthly-value", "date", check_date_today)
                    TextBox.Text = textbox_value_computed
                Else ' Nie minął miesiąc
                    TextBox.Text = textbox_value
                End If
            End If
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")
        End Try
    End Sub

End Class

Module ApplicationDataXml

    Private Const APP_DATA_FILE_NAME = "data.xml"
    Private APP_PATH As String = Application.StartupPath()
    Private APP_DATA_FILE_PATH As String = Path.Combine(APP_PATH, APP_DATA_FILE_NAME)

    Public Function GetValueFromXmlFile(ByVal node_name As String, ByVal value_name As String) As String
        Try
            Dim return_value As String = String.Empty

            If CreateAppDataXmlFile() Then
                Dim oXMLDoc As New XmlDocument()
                oXMLDoc.Load(APP_DATA_FILE_PATH)
                Dim oNodes As XmlNodeList = oXMLDoc.DocumentElement.SelectNodes(node_name)

                For Each oNode As XmlNode In oNodes
                    return_value = oNode.SelectSingleNode(value_name).InnerText
                Next
            End If

            If String.IsNullOrEmpty(return_value) Then
                Throw New System.Exception("Wartość o nazwie: " & value_name & " nie istnieje.")
            End If

            Return return_value
        Catch ex As Exception
            MsgBox("Nie mogę wczytać wartości: " & node_name & vbCrLf & _
                   "Z pliku: " & APP_DATA_FILE_NAME & vbCrLf & ex.Message,
                   MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")

            Return String.Empty
        End Try
    End Function

    Public Function SetValueToXmlFile(ByVal node_name As String, ByVal value_name As String, ByVal value As String) As Boolean
        Try
            If CreateAppDataXmlFile() Then
                Dim oXMLDoc As New XmlDocument()
                oXMLDoc.Load(APP_DATA_FILE_PATH)
                Dim oNodes As XmlNodeList = oXMLDoc.DocumentElement.SelectNodes(node_name)

                For Each oNode As XmlNode In oNodes
                    oNode.SelectSingleNode(value_name).InnerText = value
                Next

                oXMLDoc.Save(APP_DATA_FILE_PATH)
            End If

            Return True
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")
            Return False
        End Try
    End Function

    Private Function CreateAppDataXmlFile(Optional ByVal overwrite As Boolean = False) As Boolean
        Try
            If Not File.Exists(APP_DATA_FILE_PATH) Or overwrite = True Then
                ' Pierwsze uruchomienie programu tworzenie pliku: APP_DATA_FILE_NAME
                ' Z począkowymi danymi.
                Dim oXMLWriter As New XmlTextWriter(APP_DATA_FILE_PATH, Encoding.UTF8)

                With oXMLWriter
                    .WriteStartDocument(True)
                    .Formatting = Formatting.Indented
                    .Indentation = 2
                    .WriteStartElement("root")

                    .WriteStartElement("monthly-value")

                    .WriteStartElement("value")
                    .WriteString("0") ' Wartość domyślna początkowa
                    .WriteEndElement()

                    .WriteStartElement("date")
                    .WriteString(Today.ToString("d")) ' Data w formie: 05.09.2020
                    .WriteEndElement()

                    .WriteEndElement() ' "/monthly-value"

                    .WriteFullEndElement()
                    .WriteEndDocument()
                    .Close()

                    ' Zostaje zapisany plik xml o takiej strukturze
                    ' <?xml version="1.0" encoding="utf-8" standalone="yes"?>
                    ' <root>
                    '   <monthly-value>
                    '       <value>0</value>
                    '       <date>05.09.2020</date>
                    '   </monthly-value>
                    ' </root>

                End With
            End If

            ' Przy kolejnych uruchomieniach, gdy plik istnieje ...
            Return True ' ... można odczytać dane
        Catch ex As Exception
            MsgBox("Nie mogę utworzyć pliku: " & APP_DATA_FILE_NAME & vbCrLf & _
                   "W lokalizacji: " & APP_PATH, MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "Wystąpił błąd")

            Return False
        End Try
    End Function

End Module

data.xml - widok

<?xml version="1.0" encoding="utf-8" standalone="yes"?>
<root>
  <monthly-value>
    <value>0</value>
    <date>05.09.2020</date>
  </monthly-value>
</root>

Podobne pytania

+1 głos
1 odpowiedź 120 wizyt
0 głosów
1 odpowiedź 125 wizyt
+1 głos
1 odpowiedź 256 wizyt

92,552 zapytań

141,400 odpowiedzi

319,531 komentarzy

61,938 pasjonatów

Motyw:

Akcja Pajacyk

Pajacyk od wielu lat dożywia dzieci. Pomóż klikając w zielony brzuszek na stronie. Dziękujemy! ♡

Oto polecana książka warta uwagi.
Pełną listę książek znajdziesz tutaj.

Akademia Sekuraka

Kolejna edycja największej imprezy hakerskiej w Polsce, czyli Mega Sekurak Hacking Party odbędzie się już 20 maja 2024r. Z tej okazji mamy dla Was kod: pasjamshp - jeżeli wpiszecie go w koszyku, to wówczas otrzymacie 40% zniżki na bilet w wersji standard!

Więcej informacji na temat imprezy znajdziecie tutaj. Dziękujemy ekipie Sekuraka za taką fajną zniżkę dla wszystkich Pasjonatów!

Akademia Sekuraka

Niedawno wystartował dodruk tej świetnej, rozchwytywanej książki (około 940 stron). Mamy dla Was kod: pasja (wpiszcie go w koszyku), dzięki któremu otrzymujemy 10% zniżki - dziękujemy zaprzyjaźnionej ekipie Sekuraka za taki bonus dla Pasjonatów! Książka to pierwszy tom z serii o ITsec, który łagodnie wprowadzi w świat bezpieczeństwa IT każdą osobę - warto, polecamy!

...