更改显示语言的2个函数,只是个思路...

'降控件更改语言版本
'针对各个窗体读取控件信息写入控件信息

Public Function manageVer(strVer As String, Optional frmName As String)
'不传参数所以窗体全部改变版本
On Error Resume Next
Dim rs As New ADODB.Recordset

Dim i, k, ctl As Control, l
For i = 0 To Forms.Count - 1
DoEvents
For Each ctl In Forms(i).Controls
DoEvents

If "FrmMIDmain" = Left(Forms(i).Caption, Len("FrmMIDmain")) Then
k = 1
frmName = "FrmMIDmain"
End If
If IsMissing(frmName) Then
If Forms(i).Caption = frmName Then
k = 1
End If
Else
l = 1
End If
If k = 1 Then
Set rs = mysql("tblver", "ver", strVer, "frm", frmName, "ctlName", Trim(ctl.Name))
Else
Set rs = mysql("tblver", "ver", strVer, "frm", Forms(i).Caption, "ctlName", Trim(ctl.Name))
End If
With rs
If k = 1 Or l = 1 Then

If rs.RecordCount = 1 Then
'If Trim(!ctlName) = Trim(ctl.Name) Then
ctl.Caption = !ctlCaption
' ctl.TabIndex = !ctlTabIndex
' ctl.ToopTiptext = !ctlToopTiptext
' ctl.Visible = !ctlVisible
' ctl.Enabled = !ctlEnabled
' ctl.Width = !ctlWidth
' ctl.Height = !ctlHeight
' ctl.Top = !ctltop
' ctl.Left = !ctlleft

End If

' .MoveNext
' Wend
.MoveFirst
End If
End With
Next
k = 0
Next
Set rs = Nothing
End Function

Public Function WriteControlInfo(ver As String, Optional frmName1 As String, Optional info As String)
'不传窗体名列举打开的所以窗体
'写入版本信息
'可以写入特定信息相关
On Error Resume Next
Dim rs2 As New ADODB.Recordset
Dim strFrmName
'!ctlType = ""
' End If
Dim i, n, k, l
Dim ctl As Control
Set rs2 = mysql(consttblVer)
For i = 0 To Forms.Count - 1
For Each ctl In Forms(i).Controls
With rs2

If IsMissing(frmName1) Then
If Forms(i).Caption = frmName1 Then
strFrmName = ctl.Name
k = 1
End If
Else
l = 1
End If
If k = 1 Or l = 1 Then '符合条件窗体
If TypeOf ctl Is TextBox Then
!ctlType = "TextBox"
n = 1
End If
If TypeOf ctl Is Label Then
!ctlType = "Label"
End If
If TypeOf ctl Is Form Then
strFrmName = ctl.Caption
!ctlType = "Form"
End If
If TypeOf ctl Is MDIForm Then
strFrmName = ctl.Name
!ctlType = "MDIForm"
End If
If TypeOf ctl Is ComboBox Then
!ctlType = "ComboBox"
n = 1
End If
If TypeOf ctl Is ListBox Then
!ctlType = "ListBox"
n = 1
End If
If TypeOf ctl Is CheckBox Then
!ctlType = "CheckBox"
End If
If TypeOf ctl Is CommandButton Then
!ctlType = "CommandButton"
End If
If TypeOf ctl Is OptionButton Then
!ctlType = "OptionButton"
End If
If TypeOf ctl Is Frame Then
!ctlType = "Frame"
End If
If TypeOf ctl Is Toolbar Then
!ctlType = "Toolbar"
End If

.AddNew
!frm = strFrmName
!ver = ver
!ctlName = ctl.Name
If n = 1 Then
!ctlCaption = ctl.Text
n = 0
Else
!ctlCaption = ctl.Caption
End If
If Not IsMissing(info) Then
!info = info
End If
!ctlEnabled = ctl.Enabled
!ctlTabIndex = ctl.TabIndex
!ctlToopTiptext = ctl.ToopTiptext
!ctlVisible = ctl.Visible
!ctlWidth = ctl.Width
!ctlHeight = ctl.Height
!ctltop = ctl.Top
!ctlleft = ctl.Left
!ver = ver
.Update
End If
End With
Next
Next
Set rs2 = Nothing
rs2.Close
End Function

Published At
Categories with Web编程
Tagged with
comments powered by Disqus