Initial commit 3
This commit is contained in:
Rowlander
@@ -0,0 +1,367 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CLanguage"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
||||
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
||||
Option Explicit
|
||||
|
||||
Private m_DB As CDBAccess
|
||||
Private m_bInitialized As Boolean
|
||||
|
||||
Private Type TextTyp
|
||||
TextID As String
|
||||
TextValue As String
|
||||
End Type
|
||||
|
||||
Private m_GlobalText() As TextTyp
|
||||
|
||||
'lokale Variable(n) zum Zuweisen der Eigenschaft(en)
|
||||
Private mvarSprache As String 'lokale Kopie
|
||||
Private mvarAppName As String 'lokale Kopie
|
||||
Private mvarCompanyName As String 'lokale Kopie
|
||||
Private mvarAppDescription As String 'lokale Kopie
|
||||
|
||||
Private mvarSprachen As Collection 'lokale Kopie
|
||||
Public Sprachen As Collection
|
||||
|
||||
|
||||
Public Property Get AppDescription() As String
|
||||
'wird beim Ermitteln eines Eigenschaftswertes auf der rechten Seite einer Zuweisung verwendet.
|
||||
'Syntax: Debug.Print X.AppDescription
|
||||
AppDescription = mvarAppDescription
|
||||
End Property
|
||||
|
||||
|
||||
Public Property Get CompanyName() As String
|
||||
'wird beim Ermitteln eines Eigenschaftswertes auf der rechten Seite einer Zuweisung verwendet.
|
||||
'Syntax: Debug.Print X.CompanyName
|
||||
CompanyName = mvarCompanyName
|
||||
End Property
|
||||
|
||||
|
||||
Public Property Get AppName() As String
|
||||
'wird beim Ermitteln eines Eigenschaftswertes auf der rechten Seite einer Zuweisung verwendet.
|
||||
'Syntax: Debug.Print X.AppName
|
||||
AppName = mvarAppName
|
||||
End Property
|
||||
|
||||
|
||||
Public Function IsInitialized() As Boolean
|
||||
IsInitialized = m_bInitialized
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Public Property Let Sprache(ByVal vData As String)
|
||||
'wird beim Zuweisen eines Werts zu der Eigenschaft auf der linken Seite einer Zuweisung verwendet.
|
||||
'Syntax: X.Sprache = 5
|
||||
mvarSprache = vData
|
||||
End Property
|
||||
|
||||
Public Property Get Sprache() As String
|
||||
'wird beim Ermitteln eines Eigenschaftswertes auf der rechten Seite einer Zuweisung verwendet.
|
||||
'Syntax: Debug.Print X.Sprache
|
||||
Sprache = mvarSprache
|
||||
End Property
|
||||
|
||||
Public Function init(sSprachID As String) As Boolean
|
||||
|
||||
Dim sPath As String
|
||||
mvarSprache = sSprachID
|
||||
|
||||
Erase m_GlobalText
|
||||
|
||||
Set m_DB = New CDBAccess
|
||||
|
||||
If Right(App.Path, 1) = "\" Then
|
||||
sPath = App.Path
|
||||
Else
|
||||
sPath = App.Path & "\"
|
||||
End If
|
||||
|
||||
|
||||
If Not m_DB.connect("", "mylng", sPath & "Pruef2000.mdb", "") Then
|
||||
GoTo initExit
|
||||
End If
|
||||
|
||||
If Not LoadPossibleLanguages(mvarSprache) Then
|
||||
GoTo initExit
|
||||
End If
|
||||
|
||||
If Not LoadAppData(mvarSprache) Then
|
||||
GoTo initExit
|
||||
End If
|
||||
|
||||
If Not LoadGlobalText(mvarSprache) Then
|
||||
GoTo initExit
|
||||
End If
|
||||
|
||||
m_bInitialized = True
|
||||
init = True
|
||||
|
||||
initExit:
|
||||
Exit Function
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
' Name : MsgInsertValue
|
||||
' Purpose :
|
||||
' Parameters :
|
||||
' Return val :
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private Sub MsgInsertValue(ByRef MsgText As String, value As Variant)
|
||||
|
||||
Dim i As Long
|
||||
Dim k As Long
|
||||
Dim Nr As Long
|
||||
|
||||
On Error GoTo ErrHnd
|
||||
i = 1
|
||||
Do
|
||||
i = InStr(i, MsgText, "%VALUE", vbTextCompare)
|
||||
If i > 0 Then
|
||||
|
||||
k = InStr(i + 6, MsgText, "%")
|
||||
If k > 0 Then
|
||||
If IsArray(value) Then
|
||||
Nr = Val(Mid$(MsgText, i + 6, k - i - 6))
|
||||
MsgText = Left$(MsgText, i - 1) & value(Nr) & Mid$(MsgText, k + 1)
|
||||
Else
|
||||
MsgText = Left$(MsgText, i - 1) & value & Mid$(MsgText, k + 1)
|
||||
End If
|
||||
Else
|
||||
i = i + 6
|
||||
End If
|
||||
End If
|
||||
Loop While i > 0
|
||||
|
||||
Exit Sub
|
||||
ErrHnd:
|
||||
On Error GoTo 0
|
||||
End Sub
|
||||
|
||||
|
||||
Private Function LoadAppData(sSprachID As String) As Boolean
|
||||
|
||||
Dim rs As CRecordset
|
||||
Dim sSQL As String
|
||||
Dim l As Long
|
||||
|
||||
mvarAppDescription = ""
|
||||
mvarAppName = ""
|
||||
mvarCompanyName = ""
|
||||
|
||||
sSQL = "SELECT TextID, " & sSprachID & " FROM Texte WHERE Kategorie=0;"
|
||||
|
||||
Set rs = New CRecordset
|
||||
rs.setDB m_DB
|
||||
If Not rs.openRS(sSQL, True) Then Exit Function
|
||||
If rs.EOF() Then Exit Function
|
||||
|
||||
Do While Not rs.EOF
|
||||
Select Case UCase$(rs.getStringValue("TextID"))
|
||||
|
||||
Case UCase$("Anwendungsname"): mvarAppName = rs.getStringValue(sSprachID)
|
||||
Case UCase$("Company"): mvarCompanyName = rs.getStringValue(sSprachID)
|
||||
Case UCase$("Programmbeschreibung"): mvarAppDescription = rs.getStringValue(sSprachID)
|
||||
|
||||
End Select
|
||||
rs.MoveNext
|
||||
Loop
|
||||
|
||||
|
||||
LoadAppData = True
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
Private Function LoadGlobalText(sSprachID As String) As Boolean
|
||||
|
||||
Dim rs As CRecordset
|
||||
Dim sSQL As String
|
||||
Dim l As Long
|
||||
|
||||
sSQL = "SELECT TextID, " & sSprachID & " FROM Texte WHERE Kategorie>=2;"
|
||||
|
||||
Set rs = New CRecordset
|
||||
rs.setDB m_DB
|
||||
If Not rs.openRS(sSQL) Then Exit Function
|
||||
If rs.EOF() Then Exit Function
|
||||
|
||||
ReDim m_GlobalText(0 To rs.RecordCount - 1)
|
||||
|
||||
For l = 0 To rs.RecordCount - 1
|
||||
m_GlobalText(l).TextID = UCase$(Trim$(rs.getStringValue("TextID")))
|
||||
m_GlobalText(l).TextValue = rs.getStringValue(sSprachID)
|
||||
rs.MoveNext
|
||||
Next
|
||||
|
||||
LoadGlobalText = True
|
||||
|
||||
End Function
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
mvarSprache = "D"
|
||||
End Sub
|
||||
|
||||
'Holt anhand der TextID den entsprechenden
|
||||
'Text aus der Datenbank und füllt bei Bedarf
|
||||
'Variablen innerhalb des Textes, die mit %VALUE% gekennzeichnet sind
|
||||
'mit optionalen Variablen
|
||||
Public Function GetText(MyTextID As String, Optional Value1, Optional Value2, Optional Value3, Optional Value4, Optional Value5) As String
|
||||
|
||||
Dim l As Long
|
||||
Dim myValue() As String
|
||||
Dim myValueCount As Byte
|
||||
Dim sTemp As String
|
||||
ReDim myValue(1 To 1)
|
||||
myValueCount = 0
|
||||
|
||||
If Not IsMissing(Value1) Then
|
||||
myValueCount = myValueCount + 1
|
||||
ReDim Preserve myValue(1 To myValueCount)
|
||||
myValue(myValueCount) = Value1
|
||||
End If
|
||||
|
||||
If Not IsMissing(Value2) Then
|
||||
myValueCount = myValueCount + 1
|
||||
ReDim Preserve myValue(1 To myValueCount)
|
||||
myValue(myValueCount) = Value2
|
||||
End If
|
||||
|
||||
If Not IsMissing(Value3) Then
|
||||
myValueCount = myValueCount + 1
|
||||
ReDim Preserve myValue(1 To myValueCount)
|
||||
myValue(myValueCount) = Value3
|
||||
End If
|
||||
|
||||
If Not IsMissing(Value4) Then
|
||||
myValueCount = myValueCount + 1
|
||||
ReDim Preserve myValue(1 To myValueCount)
|
||||
myValue(myValueCount) = Value4
|
||||
End If
|
||||
|
||||
If Not IsMissing(Value5) Then
|
||||
myValueCount = myValueCount + 1
|
||||
ReDim Preserve myValue(1 To myValueCount)
|
||||
myValue(myValueCount) = Value5
|
||||
End If
|
||||
|
||||
|
||||
GetText = ""
|
||||
|
||||
For l = 0 To UBound(m_GlobalText)
|
||||
If UCase$(Trim$(MyTextID)) = m_GlobalText(l).TextID Then
|
||||
sTemp = m_GlobalText(l).TextValue
|
||||
If myValueCount > 0 Then Call MsgInsertValue(sTemp, myValue)
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
GetText = sTemp
|
||||
|
||||
End Function
|
||||
|
||||
'Übersetzt ganze Forms anhand der Tag-Inhalte
|
||||
'des Forms und der Controls
|
||||
Public Sub TranslateForm(myForm As Object)
|
||||
|
||||
Dim i As Integer
|
||||
Dim myControl As Control
|
||||
Dim sTemp As String
|
||||
|
||||
If Not TypeOf myForm Is Form Then Exit Sub
|
||||
|
||||
|
||||
If Trim(myForm.Tag) <> "" Then
|
||||
myForm.caption = GetText(myForm.Tag)
|
||||
End If
|
||||
|
||||
For i = 0 To myForm.Controls.Count - 1
|
||||
Set myControl = myForm.Controls(i)
|
||||
If Trim(myControl.Tag) <> "" Then
|
||||
|
||||
sTemp = UCase$(Left$(Trim$(myControl.Tag), 3))
|
||||
If sTemp = "TXT" Or sTemp = "FRM" Or sTemp = "MSG" Then
|
||||
|
||||
If TypeOf myControl Is Label Then
|
||||
myControl.caption = GetText(myControl.Tag)
|
||||
|
||||
ElseIf TypeOf myControl Is TextBox Then
|
||||
myControl.text = GetText(myControl.Tag)
|
||||
|
||||
ElseIf TypeOf myControl Is CommandButton Then
|
||||
myControl.caption = GetText(myControl.Tag)
|
||||
|
||||
ElseIf TypeOf myControl Is frame Then
|
||||
myControl.caption = GetText(myControl.Tag)
|
||||
|
||||
ElseIf TypeOf myControl Is CheckBox Then
|
||||
myControl.caption = GetText(myControl.Tag)
|
||||
|
||||
ElseIf TypeOf myControl Is OptionButton Then
|
||||
myControl.caption = GetText(myControl.Tag)
|
||||
|
||||
End If
|
||||
|
||||
End If 'TXT,MSG,FRM
|
||||
End If '<>""
|
||||
Next 'Control
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub TranslateAllForms()
|
||||
Dim i As Integer
|
||||
For i = 0 To Forms.Count - 1
|
||||
TranslateForm Forms(i)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Private Function LoadPossibleLanguages(mySp As String) As Boolean
|
||||
|
||||
Dim rs As CRecordset
|
||||
Dim sSQL As String
|
||||
Dim l As Long
|
||||
Dim Num As Long
|
||||
Dim MyCollection As New Collection
|
||||
|
||||
sSQL = "SELECT * FROM Texte;"
|
||||
|
||||
Set rs = New CRecordset
|
||||
rs.setDB m_DB
|
||||
If Not rs.openRS(sSQL) Then Exit Function
|
||||
If rs.EOF() Then Exit Function
|
||||
|
||||
Num = 0
|
||||
For l = 0 To rs.FieldsCount - 1
|
||||
|
||||
If UCase$(rs.FieldName(l)) <> UCase$("Kategorie") And UCase$(rs.FieldName(l)) <> UCase$("TextID") Then
|
||||
|
||||
Num = Num + 1
|
||||
Dim mvarSprachen As New Collection
|
||||
MyCollection.Add rs.FieldName(l)
|
||||
|
||||
End If
|
||||
|
||||
Next
|
||||
LoadPossibleLanguages = True
|
||||
|
||||
Set Sprachen = MyCollection
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Reference in New Issue
Block a user