VB中窗体控件的值自动保存到INI文件中.

 资源地址:http://d.download.csdn.net/down/681083/MSTOP

第一次运行,在窗体的控件中输入不同的值.然后退出.

再运行,你输入的值将会自动读到相应的控件中.

  1. '//窗体
  2. Private Sub Form_Load()
  3.     On Error Resume Next
  4.     Call GetIniToFrmControl(Me"C:/TEST.ini"Me.Caption)
  5. End Sub
  6. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  7.     Call SaveFrmControlToIni(Me"C:/TEST.ini"Me.Caption)
  8. End Sub
  9. '//模块,建议封装成类.
  10. Private Declare Function WritePrivateProfileString _
  11. Lib "kernel32" Alias "WritePrivateProfileStringA" _
  12. (ByVal lpApplicationname As StringByVal _
  13. lpKeyName As Any, ByVal lsString As Any, _
  14. ByVal lplFilename As StringAs Long
  15. Private Declare Function GetPrivateProfileString Lib _
  16. "kernel32" Alias "GetPrivateProfileStringA" _
  17. (ByVal lpApplicationname As StringByVal _
  18. lpKeyName As StringByVal lpDefault As _
  19. StringByVal lpReturnedString As String, _
  20. ByVal nSize As LongByVal lpFileName As _
  21. StringAs Long
  22. '//********************************************************
  23. '//将窗体中控件的值保存到一个INI文件
  24. '//********************************************************
  25. Public Function SaveFrmControlToIni(Frm As Object, IniFileName As String, AppName As String)
  26.             
  27.             Dim FrmCtr As Control
  28.             Dim CtrValue As String
  29.             Dim CtrName As String
  30.             Dim EfficValue As String  '//有效的属性.
  31.             
  32.             For Each FrmCtr In Frm.Controls
  33.                 CtrName = UCase$(FrmCtr.Name)
  34.                 If Len(CtrName) >= 5 Then
  35.                     If Mid$(CtrName, 4, 1) = "R" Or Mid$(CtrName, 4, 1) = "W" Then
  36.                         EfficValue = GetControlEfficValue(FrmCtr)
  37.                         CtrValue = VBA.CallByName(FrmCtr, EfficValue, VbGet)
  38.                         WriteIniStr AppName, CtrName, CtrValue, IniFileName
  39.                     End If
  40.                 End If
  41.             Next
  42.             
  43.             Set FileCtr = Nothing
  44.             
  45. End Function
  46. '//********************************************************
  47. '//从INI文件中读取值到窗体控件中.
  48. '//********************************************************
  49. Public Function GetIniToFrmControl(Frm As Object, IniFileName As String, AppName As String)
  50.             
  51.             Dim FrmCtr As Control
  52.             Dim CtrValue As String
  53.             Dim CtrName As String
  54.             Dim EfficValue As String  '//有效的属性.
  55.             
  56.             For Each FrmCtr In Frm.Controls
  57.                 CtrName = UCase$(FrmCtr.Name)
  58.                 If Len(CtrName) >= 5 Then
  59.                     If Mid$(CtrName, 4, 1) = "R" Or Mid$(CtrName, 4, 1) = "W" Then
  60.                         
  61.                         EfficValue = GetControlEfficValue(FrmCtr)
  62.                         CtrValue = GetIniStr(AppName, CtrName, IniFileName)
  63.                         Call VBA.CallByName(FrmCtr, EfficValue, VbLet, CtrValue)
  64.                     End If
  65.                 End If
  66.             Next
  67.             
  68.             Set FileCtr = Nothing
  69.             
  70. End Function
  71. '
  72. Public Function GetControlEfficValue(Ctr As ObjectAs String
  73.         
  74.         On Error Resume Next
  75.         
  76.         Dim RevValue As String
  77.         
  78.         RevValue = Ctr.Value
  79.         If Err.Number <> 0 Then
  80.            Err.Clear
  81.            RevValue = Ctr.Text
  82.            If Err.Number <> 0 Then
  83.               Err.Clear
  84.               RevValue = Ctr.Caption
  85.               RevValue = "Caption"
  86.            Else
  87.               RevValue = "Text"
  88.            End If
  89.         Else
  90.            RevValue = "Value"
  91.         End If
  92.         
  93.         GetControlEfficValue = RevValue
  94.         
  95. End Function
  96. '
  97. '读INI文件.
  98. '函数:GetIniStr
  99. '参数:AppName 项目名.In_Key 键名,sFileName 文件名
  100. '返回值:成功:对应的键值.失败或不存在:""
  101. Public Function GetIniStr(ByVal AppName As StringByVal In_Key As StringByVal sFileName As StringAs String
  102.     
  103.     On Error GoTo GetIniStrErr
  104.     
  105.     If VBA.Trim$(In_Key) = "" Then
  106.        GoTo GetIniStrErr
  107.     End If
  108.     Dim GetStr As String
  109.     GetStr = VBA.String(128, 0)
  110.     GetPrivateProfileString AppName, In_Key, "", GetStr, 256, sFileName
  111.     GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
  112.     If GetStr = "" Then
  113.        GoTo GetIniStrErr
  114.     Else
  115.        GetIniStr = GetStr
  116.        GetStr = ""
  117.     End If
  118.     Exit Function
  119. GetIniStrErr:
  120.        Err.Clear
  121.        GetIniStr = ""
  122.        GetStr = ""
  123. End Function
  124. '
  125. '写INI文件.
  126. '函数:WriteIniStr
  127. '参数:AppName 项目名.In_Key 键名,In_Data 键值,sFileName 文件名
  128. '返回值:成功=TRUE.失败=FALSE
  129. Public Function WriteIniStr(ByVal AppName As StringByVal In_Key As StringByVal in_data As StringByVal sFileName As StringAs Boolean
  130.     On Error GoTo WriteIniStrErr
  131.     WriteIniStr = True
  132.     If VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
  133.        GoTo WriteIniStrErr
  134.     Else
  135.      WritePrivateProfileString AppName, In_Key, in_data, sFileName
  136.     End If
  137.     Exit Function
  138.     
  139. WriteIniStrErr:
  140.        Err.Clear
  141.        WriteIniStr = False
  142. End Function
发布了25 篇原创文章 · 获赞 4 · 访问量 6万+
展开阅读全文

没有更多推荐了,返回首页

©️2019 CSDN 皮肤主题: 大白 设计师: CSDN官方博客

分享到微信朋友圈

×

扫一扫,手机浏览