368 lines
9.3 KiB
OpenEdge ABL
368 lines
9.3 KiB
OpenEdge ABL
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
|
||
|
||
|