7,763
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Private mdctChecks As New Dictionary
Private Sub UpdateMemory(ByVal chk As CheckBox)
mdctChecks.Item(chk.Name).Item(DTPicker1.Value) = chk.Value
End Sub
Private Sub Command1_Click()
UpdateMemory Check1
UpdateMemory Check2
End Sub
Private Sub Command2_Click()
UpdateMemory Check3
UpdateMemory Check4
End Sub
Private Sub Command3_Click()
UpdateMemory Check5
UpdateMemory Check6
End Sub
Private Sub UpdateScreen()
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeOf ctrl Is CheckBox Then
If mdctChecks.Item(ctrl.Name).Exists(DTPicker1.Value) Then
ctrl.Value = mdctChecks.Item(ctrl.Name).Item(DTPicker1.Value)
Else
ctrl.Value = vbUnchecked
End If
End If
Next
End Sub
Private Sub DTPicker1_Change()
UpdateScreen
End Sub
Private Property Get XmlPath() As String
XmlPath = App.Path & "\" & App.EXEName & ".xml" '这里可以改成网络路径.
End Property
Private Sub Form_Load()
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeOf ctrl Is CheckBox Then
mdctChecks.Add ctrl.Name, New Dictionary
End If
Next
Dim objXmlDoc As New DOMDocument
objXmlDoc.Load XmlPath
Dim varKey As Variant
For Each varKey In mdctChecks
Dim objElem As IXMLDOMElement
Set objElem = objXmlDoc.selectSingleNode("/checks/check[@name='" & varKey & "']")
If Not objElem Is Nothing Then
Dim objElem2 As IXMLDOMElement
For Each objElem2 In objElem.childNodes
mdctChecks.Item(varKey).Item(CDate(objElem2.getAttribute("date"))) = objElem2.getAttribute("value")
Next
End If
Next
UpdateScreen
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim objXmlDoc As New DOMDocument
objXmlDoc.appendChild objXmlDoc.createProcessingInstruction("xml", "version=""1.0""")
Set objXmlDoc.documentElement = objXmlDoc.createElement("checks")
Dim varKey As Variant
For Each varKey In mdctChecks
Dim objElem As IXMLDOMElement
Set objElem = objXmlDoc.createElement("check")
objElem.setAttribute "name", varKey
objXmlDoc.documentElement.appendChild objElem
Dim strData As String
strData = ""
Dim varKey2 As Variant
For Each varKey2 In mdctChecks.Item(varKey)
Dim objElem2 As IXMLDOMElement
Set objElem2 = objXmlDoc.createElement("data")
objElem2.setAttribute "date", varKey2
objElem2.setAttribute "value", mdctChecks.Item(varKey).Item(varKey2)
objElem.appendChild objElem2
Next
objXmlDoc.save XmlPath
Next
End Sub
Option Explicit
Private mdctChecks As New Dictionary
Private Sub UpdateMemory(ByVal chk As CheckBox)
mdctChecks.Item(chk.Name).Item(DTPicker1.Value) = chk.Value
End Sub
Private Sub Command1_Click()
UpdateMemory Check1
UpdateMemory Check2
End Sub
Private Sub Command2_Click()
UpdateMemory Check3
UpdateMemory Check4
End Sub
Private Sub Command3_Click()
UpdateMemory Check5
UpdateMemory Check6
End Sub
Private Sub UpdateScreen()
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeOf ctrl Is CheckBox Then
If mdctChecks.Item(ctrl.Name).Exists(DTPicker1.Value) Then
ctrl.Value = mdctChecks.Item(ctrl.Name).Item(DTPicker1.Value)
Else
ctrl.Value = vbUnchecked
End If
End If
Next
End Sub
Private Sub DTPicker1_Change()
UpdateScreen
End Sub
Private Sub Form_Load()
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeOf ctrl Is CheckBox Then
mdctChecks.Add ctrl.Name, New Dictionary
End If
Next
Dim varKey As Variant
For Each varKey In mdctChecks
Dim strData As String
strData = GetSetting(App.EXEName, "Section", varKey, "")
Dim arrData() As String
arrData = Split(strData, ",")
Dim i As Integer
For i = LBound(arrData) To UBound(arrData)
Dim arrData2() As String
arrData2 = Split(arrData(i), "=")
mdctChecks.Item(varKey).Item(CDate(arrData2(0))) = arrData2(1)
Next
Next
UpdateScreen
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim varKey As Variant
For Each varKey In mdctChecks
Dim strData As String
strData = ""
Dim varKey2 As Variant
For Each varKey2 In mdctChecks.Item(varKey)
strData = strData & varKey2 & "=" & mdctChecks.Item(varKey).Item(varKey2) & ","
Next
If Right(strData, 1) = "," Then
strData = Left(strData, Len(strData) - 1)
End If
SaveSetting App.EXEName, "Section", varKey, strData
Next
End Sub