日期3月9日時選中check1，如何保存check1的狀態，在下次選擇3月9日時 check1還是選中轉態
uj5u.com熱心網友回復：
將狀態記錄到檔案或者注冊表，下次使用提取出來設定到界面，原理就是這樣，代碼自己寫uj5u.com熱心網友回復：
msdn里搜索SaveSettingsuj5u.com熱心網友回復：
DEMO界面:
DEMO代碼:
需要添加參考"Microsoft Scripting Runtime".
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
DEMO下載:
鏈接：https://pan.baidu.com/s/1E7HybFLe7SUfgSRyNFoJpg
提取碼：ylem
uj5u.com熱心網友回復：
大神能加個QQ嗎uj5u.com熱心網友回復：
大神能加個QQ嗎uj5u.com熱心網友回復：
留下你的郵箱,我把QQ發給你.uj5u.com熱心網友回復：
[email protected]uj5u.com熱心網友回復：
這是保存成XML的代碼:
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/38750.html
標籤：VB基礎類