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