laatzen/Pruef2000/source/CLanguage.cls

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

'<27>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