Option Explicit
Type TDropListBoxInfo
DropListBoxArrayNames As String
DropListBoxArrayValues As String
NameCount As Long
End Type
Const pi = 3.14159265358979
Const SepStr = ";"
Const ToolVarName = "Tool"
Global script_name As String
Global language_file As String
Global StringFormDateiName As String
Global TLFResult As Integer
Global DialogCaption As Variant
Global ToolSLNo As Long
Global Toollists$()
Global CBNameListNo As Long
Global CBSituationListNo As Long
Global bmppath As Variant
Global PDFpath As Variant
Global DLBFilePath As Variant
Global ReturnButton As Long
Global DropListBoxCount As Long
Global DropListBoxInfos() As TDropListBoxInfo
Global DropListBoxArray0$()
Global DropListBoxArray1$()
Global DropListBoxArray2$()
Global DropListBoxArray3$()
Global DropListBoxArray4$()
Global DropListBoxArray5$()
Global DropListBoxArray6$()
Global DropListBoxArray7$()
Global DropListBoxArray8$()
Global DropListBoxArray9$()
Global DropListBoxArray10$()
Global DropListBoxArray11$()
Global DropListBoxArray12$()
Global DropListBoxArray13$()
Global DropListBoxArray14$()
Global DropListBoxArray15$()
Global DropListBoxArray16$()
Global DropListBoxArray17$()
Global DropListBoxArray18$()
Global DropListBoxArray19$()
Global DropListBoxArray20$()
Global DropListBoxArray21$()
Global DropListBoxArray22$()
Global DropListBoxArray23$()
Global DropListBoxArray24$()
Global DropListBoxArray25$()
Global DropListBoxNRCount As Long
Global DropListBoxNRInfos() As Long
Global DropListBoxNRArray0$()
Global DropListBoxNRArray1$()
Global DropListBoxNRArray2$()
Global DropListBoxNRArray3$()
Global DropListBoxNRArray4$()
Global DropListBoxNRArray5$()
Global DropListBoxNRArray6$()
Global DropListBoxNRArray7$()
Global DropListBoxNRArray8$()
Global DropListBoxNRArray9$()
Global DropListBoxNRArray10$()
Global DropListBoxNRArray11$()
Global DropListBoxNRArray12$()
Global DropListBoxNRArray13$()
Global DropListBoxNRArray14$()
Global DropListBoxNRArray15$()
Global DropListBoxNRArray16$()
Global DropListBoxNRArray17$()
Global DropListBoxNRArray18$()
Global DropListBoxNRArray19$()
Global DropListBoxNRArray20$()
Global DropListBoxNRArray21$()
Global DropListBoxNRArray22$()
Global DropListBoxNRArray23$()
Global DropListBoxNRArray24$()
Global DropListBoxNRArray25$()
Global DropListBoxStrCount As Long
Global DropListBoxStrInfos() As Long
Global DropListBoxStrArray0$()
Global DropListBoxStrArray1$()
Global DropListBoxStrArray2$()
Global DropListBoxStrArray3$()
Global DropListBoxStrArray4$()
Global DropListBoxStrArray5$()
Global DropListBoxStrArray6$()
Global DropListBoxStrArray7$()
Global DropListBoxStrArray8$()
Global DropListBoxStrArray9$()
Global DropListBoxStrArray10$()
Global DropListBoxStrArray11$()
Global DropListBoxStrArray12$()
Global DropListBoxStrArray13$()
Global DropListBoxStrArray14$()
Global DropListBoxStrArray15$()
Global DropListBoxStrArray16$()
Global DropListBoxStrArray17$()
Global DropListBoxStrArray18$()
Global DropListBoxStrArray19$()
Global DropListBoxStrArray20$()
Global DropListBoxStrArray21$()
Global DropListBoxStrArray22$()
Global DropListBoxStrArray23$()
Global DropListBoxStrArray24$()
Global DropListBoxStrArray25$()
Function MapA(A)
MapA = A
If A < 0 Then
MapA = A + 360
End If
If equal(A, 360) Or A > 360 Then
MapA = A - 360
End If
End Function
Function equal(W1, W2)
equal = Abs(W1 - W2) < 0.00001
End Function
Function IsToolDropListbox(index)
IsToolDropListbox = (DlgName(index) = "VAR_" + ToolVarName) And ((DlgType(index) = "DropListBox"))
End Function
Function IsDropDownListbox(index)
IsDropDownListbox = (InStr(AUppercase(DlgName(index)), "VARDDLB_") = 1) And (DlgType(index) = "DropListBox")
End Function
Function IsDropDownListboxNR(index)
IsDropDownListboxNR = (InStr(AUppercase(DlgName(index)), "VARDDLBNR_") = 1) And (DlgType(index) = "DropListBox")
End Function
Function IsDropDownListboxStr(index)
IsDropDownListboxStr = (InStr(AUppercase(DlgName(index)), "VARDDLBSTR_") = 1) And (DlgType(index) = "DropListBox")
End Function
Function IsComboboxListboxStr(index)
IsComboboxListboxStr = (InStr(AUppercase(DlgName(index)), "VARDDLBSTR_") = 1) And (DlgType(index) = "ComboBox")
End Function
Function ISVarInput(VarName)
ISVarInput = (InStr(AUppercase(VarName), "VAR_") = 1) Or (InStr(AUppercase(VarName), "VARDDLB_") = 1) Or (InStr(AUppercase(VarName), "VARDDLBNR_") = 1) Or (InStr(AUppercase(VarName), "VARDDLBSTR_") = 1) Or (InStr(AUppercase(VarName), "VARSTR_") = 1) Or (InStr(AUppercase(VarName), "VARSTRNEW_") = 1)
End Function
Function ISVarInputText(VarName, VarTyp)
ISVarInputText = (VarTyp = "TextBox") And (InStr(AUppercase(VarName), "VAR_") = 1)
End Function
Function ISVarInputTextStr(VarName, VarTyp)
ISVarInputTextStr = (VarTyp = "TextBox") And (InStr(AUppercase(VarName), "VARSTR_") = 1)
End Function
Function ISVarInputTextStrNew(VarName, VarTyp)
ISVarInputTextStrNew = (VarTyp = "TextBox") And (InStr(AUppercase(VarName), "VARSTRNEW_") = 1)
End Function
Function GetBoxNo(ToolStr)
Dim i As Long
GetBoxNo = ""
For i = 1 To Len(ToolStr)
If Mid(ToolStr, i, 1) = " " Then
Exit For
Else
GetBoxNo = GetBoxNo + Mid(ToolStr, i, 1)
End If
Next i
End Function
Sub SetDDLBValue(Value, index, DDLBIndex, NotCheck)
Dim i As Long
Dim pos As Long
Dim DLBInfo As TDropListBoxInfo
Dim Info As String
pos = -1
DLBInfo = DropListBoxInfos(DDLBIndex)
DLBInfo.NameCount = ParamCount(DLBInfo.DropListBoxArrayNames)
If (DLBInfo.NameCount > 0) And ((DlgValue(index) < 0) Or NotCheck) Then
For i = 0 To DLBInfo.NameCount - 1 Step 1
Info = Param(i + 1, DLBInfo.DropListBoxArrayValues)
If (AUppercase(Info) = AUppercase(Value)) Then
pos = i
Exit For
End If
Next i
End If
If ((DlgValue(index) < 0) Or NotCheck) Then
DlgValue(index,pos)
End If
End Sub
Function GetDDLBValue(index, DDLBIndex)
Dim i As Long
Dim DLBInfo As TDropListBoxInfo
GetDDLBValue = 0
DLBInfo = DropListBoxInfos(index)
DLBInfo.NameCount = ParamCount(DLBInfo.DropListBoxArrayNames)
If (DDLBIndex >= 0) And (DDLBIndex < DLBInfo.NameCount) Then
GetDDLBValue = Param(DDLBIndex + 1, DLBInfo.DropListBoxArrayValues)
End If
End Function
Sub SetDDLBNRValue(Value, index, DDLBIndex, NotCheck)
Dim i As Long
Dim DLBNRArray$()
Dim pos As Long
Dim Count As Long
Dim Info As String
pos = -1
Count = DropListBoxNRInfos(DDLBIndex)
Call GetDropListBoxNRArray(DDLBIndex,DLBNRArray)
If (Count > 0) And ((DlgValue(index) < 0) Or NotCheck) Then
For i = 0 To Count - 1 Step 1
Info = Param(2, DLBNRArray(i))
If (AUppercase(Info) = AUppercase(Value)) Then
pos = i
Exit For
End If
Next i
End If
If ((DlgValue(index) < 0) Or NotCheck) Then
DlgValue(index,pos)
End If
End Sub
Function GetDDLBNRValue(index, DDLBIndex)
Dim i As Long
Dim Count As Long
Dim DLBNRArray$()
GetDDLBNRValue = 0
Count = DropListBoxNRInfos(index)
Call GetDropListBoxNRArray(index,DLBNRArray)
If (DDLBIndex >= 0) And (DDLBIndex < Count) Then
GetDDLBNRValue = Param(2, DLBNRArray(DDLBIndex))
End If
End Function
Sub SetDDLBStrValue(Value, index, DDLBIndex, NotCheck)
Dim i As Long
Dim DLBStrArray$()
Dim pos As Long
Dim Count As Long
Dim Info As String
pos = -1
Value=DeleteCharBegin_End("'",Value)
Count = DropListBoxStrInfos(DDLBIndex)
Call GetDropListBoxStrArray(DDLBIndex,DLBStrArray)
If (Count > 0) And ((DlgValue(index) < 0) Or NotCheck) Then
For i = 0 To Count - 1 Step 1
Info = DLBStrArray(i)
If (AUppercase(Info) = AUppercase(Value)) Then
pos = i
Exit For
End If
Next i
End If
If ((DlgValue(index) < 0) Or NotCheck) Then
DlgValue(index,pos)
End If
End Sub
Function GetDDLBStrValue(index, DDLBIndex)
Dim i As Long
Dim Count As Long
Dim DLBStrArray$()
GetDDLBStrValue = ""
Count = DropListBoxStrInfos(index)
Call GetDropListBoxStrArray(index,DLBStrArray)
If (DDLBIndex >= 0) And (DDLBIndex < Count) Then
GetDDLBStrValue = DLBStrArray(DDLBIndex)
End If
GetDDLBStrValue="'"+GetDDLBStrValue+"'"
End Function
Function delete(S, index, Count)
Dim ns As String
Dim N As Integer
Dim indexpluscount As Integer
ns = ""
indexpluscount = index + Count - 1
For N = 1 To Len(S) Step 1
If Not ((N >= index) And (N <= indexpluscount)) Then
ns = ns + Mid(S, N, 1)
End If
Next N
delete = ns
End Function
Function ParamCount(S)
Dim N As Integer
Dim Count As Integer
ParamCount = 0
Count = 0
S = Trim(S)
If Len(S) > 0 Then
For N = 1 To Len(S) Step 1
If Mid(S, N, 1) = SepStr Then
Count = Count + 1
End If
Next N
ParamCount = Count + 1
End If
End Function
Function Param(NR, S)
Dim Count As Integer
Dim N As Integer
Dim p As Integer
Dim SSave As String
Count = ParamCount(S)
If (NR > Count) Or (NR < 1) Then
Param = ""
Exit Function
End If
If Count = 1 Then
Param = Trim(S)
Exit Function
End If
If NR = 1 Then
p = InStr(S, SepStr)
Param = Trim(Mid(S, 1, p - 1))
ElseIf NR < Count Then
SSave = S
For N = 1 To NR - 1 Step 1
SSave = delete(SSave, 1, InStr(SSave, SepStr))
Next N
p = InStr(SSave, SepStr)
Param = Trim(Mid(SSave, 1, p - 1))
ElseIf NR = Count Then
p = InStrRev(S, SepStr)
Param = Trim(Mid(S, p + 1, Len(S) - p))
End If
End Function
Function TrimSpecial(chars)
Dim i As Integer
TrimSpecial = ""
For i = 1 To Len(chars) Step 1
If Mid(chars, i, 1) = Chr(0) Then
Exit For
Else
TrimSpecial = TrimSpecial + Mid(chars, i, 1)
End If
Next i
End Function
Function ChangeBackSashToSlash(chars)
Dim i As Integer
ChangeBackSashToSlash = ""
For i = 1 To Len(chars) Step 1
If Mid(chars, i, 1) = "\" Then
ChangeBackSashToSlash = ChangeBackSashToSlash + "/"
Else
ChangeBackSashToSlash = ChangeBackSashToSlash + Mid(chars, i, 1)
End If
Next i
End Function
Function GetStringFormDateiName()
GetStringFormDateiName = IniFileReadStr("Hops.ini", "HOPS", "StrFormDatei", "c:\Hops\StrFormDatei.ini")
End Function
Function GetStringFormDateiName_Dialogscripts()
GetStringFormDateiName_Dialogscripts = IniFileReadStr("Hops.ini", "LANGUAGE", "LanguageScriptFile", "c:\hops\ScriptLanguage.ini")
End Function
Function GetStringDateiName()
GetStringDateiName = IniFileReadStr("Hops.ini", "HOPS", "StrDatei", "c:\Hops\StrDatei.ini")
End Function
Function GetOKString()
GetOKString = IniFileReadStr(StringFormDateiName, "FSP_pas", "0", "OK")
End Function
Function GetCancelString()
GetCancelString = IniFileReadStr(StringFormDateiName, "FSP_pas", "1", "Cancel")
End Function
Function GetDefaultString()
GetDefaultString = IniFileReadStr(StringFormDateiName, "FSP_pas", "2", "Defaultl")
End Function
Function GetAddString()
GetAddString = IniFileReadStr(StringFormDateiName, "FSP_pas", "3", "Add")
End Function
Function GetInsertString()
GetInsertString = IniFileReadStr(StringFormDateiName, "FSP_pas", "4", "Insert")
End Function
Function GetIncorrect_MSG()
GetIncorrect_MSG = IniFileReadStr(GetStringDateiName, "Fehlermeldung_pas", "9", "Wrong input") + vbCrLf + IniFileReadStr(GetStringDateiName, "Fehlermeldung_pas", "10", "Correct please")
End Function
Function GetIncorrectTextStr()
GetIncorrectTextStr = IniFileReadStr(GetStringDateiName, "FEinst_pas", "0", "Wrong input") + " (; , ' " + Chr(34) + ")"
End Function
Function GetActualToolDataName()
GetActualToolDataName = DialogInfo_GetActualToolData
End Function
Function GetVarName(VarName)
GetVarName = Mid(VarName, 5, Len(VarName) - 4)
End Function
Function GetVarNameTextStr(VarName)
GetVarNameTextStr = Mid(VarName, 8, Len(VarName) - 7)
End Function
Function GetVarNameTextStrNew(VarName)
GetVarNameTextStrNew = Mid(VarName, 11, Len(VarName) - 10)
End Function
Function GetVarNameDDLB(VarName)
Dim NR As String
GetVarNameDDLB = Mid(VarName, 9, Len(VarName) - 8)
NR = GetDDLBIndex(VarName)
GetVarNameDDLB = Mid(GetVarNameDDLB, Len(NR) + 2, Len(VarName) - (Len(NR) + 2))
End Function
Function GetVarNameDDLBNR(VarName)
Dim NR As String
GetVarNameDDLBNR = Mid(VarName, 11, Len(VarName) - 10)
NR = GetDDLBNRIndex(VarName)
GetVarNameDDLBNR = Mid(GetVarNameDDLBNR, Len(NR) + 2, Len(VarName) - (Len(NR) + 2))
End Function
Function GetVarNameDDLBStr(VarName)
Dim NR As String
GetVarNameDDLBStr = Mid(VarName, 12, Len(VarName) - 11)
NR = GetDDLBStrIndex(VarName)
GetVarNameDDLBStr = Mid(GetVarNameDDLBStr, Len(NR) + 2, Len(VarName) - (Len(NR) + 2))
End Function
Function GetDDLBIndex(VarName)
Dim i As Integer
Dim SPosi As String
Dim SSS As String
GetDDLBIndex = ""
SSS = Mid(VarName, 9, Len(VarName) - 8)
For i = 1 To Len(SSS) Step 1
SPosi = AUppercase(Mid(SSS, i, 1))
If (SPosi = "1") Or (SPosi = "2") Or (SPosi = "3") Or (SPosi = "4") Or (SPosi = "5") Or (SPosi = "6") Or (SPosi = "7") Or (SPosi = "8") Or (SPosi = "9") Or (SPosi = "0") Then
GetDDLBIndex = GetDDLBIndex + SPosi
Else
Exit For
End If
Next i
If GetDDLBIndex = "" Then
GetDDLBIndex = "-1"
End If
End Function
Function GetDDLBNRIndex(VarName)
Dim i As Integer
Dim SPosi As String
Dim SSS As String
GetDDLBNRIndex = ""
SSS = Mid(VarName, 11, Len(VarName) - 10)
For i = 1 To Len(SSS) Step 1
SPosi = AUppercase(Mid(SSS, i, 1))
If (SPosi = "1") Or (SPosi = "2") Or (SPosi = "3") Or (SPosi = "4") Or (SPosi = "5") Or (SPosi = "6") Or (SPosi = "7") Or (SPosi = "8") Or (SPosi = "9") Or (SPosi = "0") Then
GetDDLBNRIndex = GetDDLBNRIndex + SPosi
Else
Exit For
End If
Next i
If GetDDLBNRIndex = "" Then
GetDDLBNRIndex = "-1"
End If
End Function
Function GetDDLBStrIndex(VarName)
Dim i As Integer
Dim SPosi As String
Dim SSS As String
GetDDLBStrIndex = ""
SSS = Mid(VarName, 12, Len(VarName) - 11)
For i = 1 To Len(SSS) Step 1
SPosi = AUppercase(Mid(SSS, i, 1))
If (SPosi = "1") Or (SPosi = "2") Or (SPosi = "3") Or (SPosi = "4") Or (SPosi = "5") Or (SPosi = "6") Or (SPosi = "7") Or (SPosi = "8") Or (SPosi = "9") Or (SPosi = "0") Then
GetDDLBStrIndex = GetDDLBStrIndex + SPosi
Else
Exit For
End If
Next i
If GetDDLBStrIndex = "" Then
GetDDLBStrIndex = "-1"
End If
End Function
Function DeleteCharBegin_End(Char, ByVal Strin)
DeleteCharBegin_End = Strin
If Len(Strin) > 1 Then
If Mid(Strin, 1, 1) = Char Then
Strin = Mid(Strin, 2, Len(Strin) - 1)
End If
If Mid(Strin, Len(Strin), 1) = Char Then
Strin = Mid(Strin, 1, Len(Strin) - 1)
End If
DeleteCharBegin_End = Strin
End If
End Function
Function AddCharBegin_End(Char, Strin)
AddCharBegin_End = Char + Strin + Char
End Function
Function IsCorrectInputTextStr(Strin)
Dim i As Integer
Dim SPosi As String
IsCorrectInputTextStr = True
For i = 1 To Len(Strin) Step 1
SPosi = AUppercase(Mid(Strin, i, 1))
If (SPosi = ";") Or (SPosi = ",") Or (SPosi = "'") Or (SPosi = Chr(34)) Then
IsCorrectInputTextStr = False
End If
Next i
End Function
Function GetVarNameStr()
GetVarNameStr = IniFileReadStr(GetStringDateiName, "SpestrGr_pas", "0", "Varname")
End Function
Function GetValueStr()
GetValueStr = IniFileReadStr(GetStringDateiName, "SpestrGr_pas", "1", "Value")
End Function
Function GetColorString(No)
GetColorString = IniFileReadStr(language_file, "Colors", IntToS(No), "No definition In language file")
End Function
Function GetWrongParaStr()
GetWrongParaStr = IniFileReadStr(GetStringDateiName, "ScriptDialogs", "0", "")
If GetWrongParaStr = "" Then
GetWrongParaStr = "Wrong parameter value"
IniFileWriteStr(GetStringDateiName,"ScriptDialogs","0",GetWrongParaStr)
End If
End Function
Function FToS(w)
Dim N As Integer
Dim FToSSave As String
FToS = ""
FToSSave = Format$(w, "0.000")
For N = 1 To Len(FToSSave) Step 1
If Mid(FToSSave, N, 1) = "," Then
FToS = FToS + "."
Else
FToS = FToS + Mid(FToSSave, N, 1)
End If
Next N
End Function
Function IntToS(w)
IntToS = Trim(Str(w))
End Function
Sub InitializeDialog()
If Not DialogInfo_GetIsDLLRun Then
Debugfinish
DebugInit
End If
InitializeTooldatabase
InitializeDropListBoxInfosSize
InitializeDropListBoxNRInfosSize
InitializeDropListBoxStrInfosSize
SetReturnButton
bmppath = GetDialogScriptspath + "Pictures\"
If Not FolderExists(bmppath) Then
CreateFolder (bmppath)
End If
PDFpath = GetDialogScriptspath + "PDF\"
If Not FolderExists(PDFpath) Then
CreateFolder (PDFpath)
End If
DLBFilePath = GetDialogScriptspath + "Data\"
If Not FolderExists(DLBFilePath) Then
CreateFolder (DLBFilePath)
End If
language_file = GetStringFormDateiName_Dialogscripts
StringFormDateiName = GetStringFormDateiName
script_name = DialogInfo_GetMacroName
If script_name = "" Then
script_name = "NotDefined"
End If
DialogCaption = "NC-HOPS 6.x"
End Sub
Sub InitializeDropListBoxInfosSizeSubForm()
If DropListBoxCount > 0 Then
ReDim Preserve DropListBoxInfos(DropListBoxCount - 1)
End If
End Sub
Sub InitializeDropListBoxNRInfosSizeSubForm()
If DropListBoxNRCount > 0 Then
ReDim Preserve DropListBoxNRInfos(DropListBoxNRCount - 1)
End If
End Sub
Sub InitializeDialogSubForm()
InitializeDropListBoxInfosSizeSubForm
InitializeDropListBoxNRInfosSizeSubForm
End Sub
Sub InitializeTooldatabase()
Dim i As Integer
Dim Count As Long
Dim ToolInfo As Variant
If LoadDatabase(GetActualToolDataName) Then
ToolSLNo = StringListCreate
ReadToolStringsFromDatabase (ToolSLNo)
Count = StringListCount(ToolSLNo)
If Count<>0 Then
ReDim Toollists$(Count - 1)
For i = 0 To Count - 1 Step 1
ToolInfo = StringListStrings(ToolSLNo, i)
Toollists$(i) = ToolInfo
Next i
End If
End If
End Sub
Sub InitializeDropListBoxInfosSize()
If DropListBoxCount > 0 Then
ReDim DropListBoxInfos(DropListBoxCount - 1)
End If
End Sub
Sub InitializeDropListBoxNRInfosSize()
If DropListBoxNRCount > 0 Then
ReDim DropListBoxNRInfos(DropListBoxNRCount - 1)
End If
End Sub
Sub InitializeDropListBoxStrInfosSize()
If DropListBoxStrCount > 0 Then
ReDim DropListBoxStrInfos(DropListBoxStrCount - 1)
End If
End Sub
Sub InitializeDropListBoxInfo(index, Names, Values)
Dim i As Integer
Dim Info As String
Dim DLBInfo As TDropListBoxInfo
If (index <= (DropListBoxCount - 1)) And (index >= 0) Then
DLBInfo.DropListBoxArrayNames = Names
DLBInfo.DropListBoxArrayValues = Values
DLBInfo.NameCount = ParamCount(DLBInfo.DropListBoxArrayNames)
If ParamCount(DLBInfo.DropListBoxArrayValues) < DLBInfo.NameCount Then
DLBInfo.NameCount = ParamCount(DLBInfo.DropListBoxArrayValues)
End If
If DLBInfo.NameCount > 0 Then
Call ReDimDropListBoxArray(index, DLBInfo.NameCount)
For i = 0 To DLBInfo.NameCount - 1 Step 1
Info = Param(i + 1, DLBInfo.DropListBoxArrayNames)
Call SetDropListBoxArrayName(index, i, Info)
Next i
End If
DropListBoxInfos(index) = DLBInfo
End If
End Sub
Sub InitializeDropListBoxNRInfo(index,Filename)
Dim i As Integer
Dim Info As String
Dim SLNR As Integer
Dim DLBName As String
Dim DLBName1 As String
Dim DLBName2 As String
Dim DLBName3 As String
Dim Char As String
Dim PChar As Integer
SLNR = StringListCreate
If StringListLoadFromFile(SLNR,DLBFilePath+Filename)>=0 Then
If (index <= (DropListBoxNRCount - 1)) And (index >= 0) Then
Call ReDimDropListBoxNRArray(index,StringListCount(SLNR))
For i = 0 To StringListCount(SLNR) - 1 Step 1
DLBName=StringListStrings(SLNR,i)
PChar=InStr(DLBName,SepStr)
DLBName1=Mid(DLBName,1,PChar-1)
DLBName=Mid(DLBName,PChar+1,Len(DLBName)-PChar)
PChar=InStr(DLBName,";")
DLBName2=Mid(DLBName,1,PChar-1)
DLBName=Mid(DLBName,PChar+1,Len(DLBName)-PChar)
DLBName=DLBName2+SepStr+DLBName1+SepStr+DLBName
Call SetDropListBoxNrArrayName(index, i,DLBName)
Next i
End If
End If
DropListBoxNRInfos(index) = StringListCount(SLNR)
StringListDestroy(SLNR)
End Sub
Sub GetSectionValues(SLNR,SLNRSec,Section)
Dim DLBName As String
Dim Gefunden As Boolean
Dim i As Integer
Gefunden= False
For i = 0 To StringListCount(SLNR) - 1 Step 1
DLBName=StringListStrings(SLNR,i)
If Gefunden Then
If Not (InStr(DLBName,"]")>InStr(DLBName,"[")) Then
If Trim(DLBName)<>"" Then
StringListAdd(SLNRSec,DLBName)
End If
Else
Exit Sub
End If
End If
If InStr(AUppercase(DLBName),"["+AUppercase(Section)+"]") Then
Gefunden= True
End If
Next i
End Sub
Sub InitializeDropListBoxStrInfo(index,Section,Filename)
Dim i As Integer
Dim Info As String
Dim SLNR As Integer
Dim SLNRSec As Integer
Dim DLBName As String
SLNR = StringListCreate
SLNRSec = StringListCreate
If FileExist(DLBFilePath+Filename) Then
StringListLoadFromFile(SLNR,DLBFilePath+Filename)
Call GetSectionValues(SLNR,SLNRSec,Section)
If (index <= (DropListBoxStrCount - 1)) And (index >= 0) Then
Call ReDimDropListBoxStrArray(index,StringListCount(SLNRSec))
For i = 0 To StringListCount(SLNRSec) - 1 Step 1
DLBName=StringListStrings(SLNRSec,i)
Call SetDropListBoxStrArrayName(index, i,DLBName)
Next i
End If
DropListBoxStrInfos(index) = StringListCount(SLNRSec)
End If
StringListDestroy(SLNR)
StringListDestroy(SLNRSec)
End Sub
Sub SetDropListBoxArrayName(index, i, Info)
Select Case index
Case 0
DropListBoxArray0(i) = Info
Case 1
DropListBoxArray1(i) = Info
Case 2
DropListBoxArray2(i) = Info
Case 3
DropListBoxArray3(i) = Info
Case 4
DropListBoxArray4(i) = Info
Case 5
DropListBoxArray5(i) = Info
Case 6
DropListBoxArray6(i) = Info
Case 7
DropListBoxArray7(i) = Info
Case 8
DropListBoxArray8(i) = Info
Case 9
DropListBoxArray9(i) = Info
Case 10
DropListBoxArray10(i) = Info
Case 11
DropListBoxArray11(i) = Info
Case 12
DropListBoxArray12(i) = Info
Case 13
DropListBoxArray13(i) = Info
Case 14
DropListBoxArray14(i) = Info
Case 15
DropListBoxArray15(i) = Info
Case 16
DropListBoxArray16(i) = Info
Case 17
DropListBoxArray17(i) = Info
Case 18
DropListBoxArray18(i) = Info
Case 19
DropListBoxArray19(i) = Info
Case 20
DropListBoxArray20(i) = Info
Case 21
DropListBoxArray21(i) = Info
Case 22
DropListBoxArray22(i) = Info
Case 23
DropListBoxArray23(i) = Info
Case 24
DropListBoxArray24(i) = Info
Case 25
DropListBoxArray25(i) = Info
End Select
End Sub
Sub ReDimDropListBoxArray(index, NameCount)
Select Case index
Case 0
ReDim DropListBoxArray0(NameCount - 1)
Case 1
ReDim DropListBoxArray1(NameCount - 1)
Case 2
ReDim DropListBoxArray2(NameCount - 1)
Case 3
ReDim DropListBoxArray3(NameCount - 1)
Case 4
ReDim DropListBoxArray4(NameCount - 1)
Case 5
ReDim DropListBoxArray5(NameCount - 1)
Case 6
ReDim DropListBoxArray6(NameCount - 1)
Case 7
ReDim DropListBoxArray7(NameCount - 1)
Case 8
ReDim DropListBoxArray8(NameCount - 1)
Case 9
ReDim DropListBoxArray9(NameCount - 1)
Case 10
ReDim DropListBoxArray10(NameCount - 1)
Case 11
ReDim DropListBoxArray11(NameCount - 1)
Case 12
ReDim DropListBoxArray12(NameCount - 1)
Case 13
ReDim DropListBoxArray13(NameCount - 1)
Case 14
ReDim DropListBoxArray14(NameCount - 1)
Case 15
ReDim DropListBoxArray15(NameCount - 1)
Case 16
ReDim DropListBoxArray16(NameCount - 1)
Case 17
ReDim DropListBoxArray17(NameCount - 1)
Case 18
ReDim DropListBoxArray18(NameCount - 1)
Case 19
ReDim DropListBoxArray19(NameCount - 1)
Case 20
ReDim DropListBoxArray20(NameCount - 1)
Case 21
ReDim DropListBoxArray21(NameCount - 1)
Case 22
ReDim DropListBoxArray22(NameCount - 1)
Case 23
ReDim DropListBoxArray23(NameCount - 1)
Case 24
ReDim DropListBoxArray24(NameCount - 1)
Case 25
ReDim DropListBoxArray25(NameCount - 1)
End Select
End Sub
Sub SetDropListBoxNrArrayName(index, i, Info)
Select Case index
Case 0
DropListBoxNRArray0(i) = Info
Case 1
DropListBoxNRArray1(i) = Info
Case 2
DropListBoxNRArray2(i) = Info
Case 3
DropListBoxNRArray3(i) = Info
Case 4
DropListBoxNRArray4(i) = Info
Case 5
DropListBoxNRArray5(i) = Info
Case 6
DropListBoxNRArray6(i) = Info
Case 7
DropListBoxNRArray7(i) = Info
Case 8
DropListBoxNRArray8(i) = Info
Case 9
DropListBoxNRArray9(i) = Info
Case 10
DropListBoxNRArray10(i) = Info
Case 11
DropListBoxNRArray11(i) = Info
Case 12
DropListBoxNRArray12(i) = Info
Case 13
DropListBoxNRArray13(i) = Info
Case 14
DropListBoxNRArray14(i) = Info
Case 15
DropListBoxNRArray15(i) = Info
Case 16
DropListBoxNRArray16(i) = Info
Case 17
DropListBoxNRArray17(i) = Info
Case 18
DropListBoxNRArray18(i) = Info
Case 19
DropListBoxNRArray19(i) = Info
Case 20
DropListBoxNRArray20(i) = Info
Case 21
DropListBoxNRArray21(i) = Info
Case 22
DropListBoxNRArray22(i) = Info
Case 23
DropListBoxNRArray23(i) = Info
Case 24
DropListBoxNRArray24(i) = Info
Case 25
DropListBoxNRArray25(i) = Info
End Select
End Sub
Sub ReDimDropListBoxNRArray(index, NameCount)
Select Case index
Case 0
ReDim DropListBoxNRArray0(NameCount - 1)
Case 1
ReDim DropListBoxNRArray1(NameCount - 1)
Case 2
ReDim DropListBoxNRArray2(NameCount - 1)
Case 3
ReDim DropListBoxNRArray3(NameCount - 1)
Case 4
ReDim DropListBoxNRArray4(NameCount - 1)
Case 5
ReDim DropListBoxNRArray5(NameCount - 1)
Case 6
ReDim DropListBoxNRArray6(NameCount - 1)
Case 7
ReDim DropListBoxNRArray7(NameCount - 1)
Case 8
ReDim DropListBoxNRArray8(NameCount - 1)
Case 9
ReDim DropListBoxNRArray9(NameCount - 1)
Case 10
ReDim DropListBoxNRArray10(NameCount - 1)
Case 11
ReDim DropListBoxNRArray11(NameCount - 1)
Case 12
ReDim DropListBoxNRArray12(NameCount - 1)
Case 13
ReDim DropListBoxNRArray13(NameCount - 1)
Case 14
ReDim DropListBoxNRArray14(NameCount - 1)
Case 15
ReDim DropListBoxNRArray15(NameCount - 1)
Case 16
ReDim DropListBoxNRArray16(NameCount - 1)
Case 17
ReDim DropListBoxNRArray17(NameCount - 1)
Case 18
ReDim DropListBoxNRArray18(NameCount - 1)
Case 19
ReDim DropListBoxNRArray19(NameCount - 1)
Case 20
ReDim DropListBoxNRArray20(NameCount - 1)
Case 21
ReDim DropListBoxNRArray21(NameCount - 1)
Case 22
ReDim DropListBoxNRArray22(NameCount - 1)
Case 23
ReDim DropListBoxNRArray23(NameCount - 1)
Case 24
ReDim DropListBoxNRArray24(NameCount - 1)
Case 25
ReDim DropListBoxNRArray25(NameCount - 1)
End Select
End Sub
Sub GetDropListBoxNRArray(index,DLBNRArray$())
Select Case index
Case 0
DLBNRArray = DropListBoxNRArray0
Case 1
DLBNRArray = DropListBoxNRArray1
Case 2
DLBNRArray = DropListBoxNRArray2
Case 3
DLBNRArray = DropListBoxNRArray3
Case 4
DLBNRArray = DropListBoxNRArray4
Case 5
DLBNRArray = DropListBoxNRArray5
Case 6
DLBNRArray = DropListBoxNRArray6
Case 7
DLBNRArray = DropListBoxNRArray7
Case 8
DLBNRArray = DropListBoxNRArray8
Case 9
DLBNRArray = DropListBoxNRArray9
Case 10
DLBNRArray = DropListBoxNRArray10
Case 11
DLBNRArray = DropListBoxNRArray11
Case 12
DLBNRArray = DropListBoxNRArray12
Case 13
DLBNRArray = DropListBoxNRArray13
Case 14
DLBNRArray = DropListBoxNRArray14
Case 15
DLBNRArray = DropListBoxNRArray15
Case 16
DLBNRArray = DropListBoxNRArray16
Case 17
DLBNRArray = DropListBoxNRArray17
Case 18
DLBNRArray = DropListBoxNRArray18
Case 19
DLBNRArray = DropListBoxNRArray19
Case 20
DLBNRArray = DropListBoxNRArray20
Case 21
DLBNRArray = DropListBoxNRArray21
Case 22
DLBNRArray = DropListBoxNRArray22
Case 23
DLBNRArray = DropListBoxNRArray23
Case 24
DLBNRArray = DropListBoxNRArray24
Case 25
DLBNRArray = DropListBoxNRArray25
End Select
End Sub
Sub SetDropListBoxStrArrayName(index, i, Info)
Select Case index
Case 0
DropListBoxStrArray0(i) = Info
Case 1
DropListBoxStrArray1(i) = Info
Case 2
DropListBoxStrArray2(i) = Info
Case 3
DropListBoxStrArray3(i) = Info
Case 4
DropListBoxStrArray4(i) = Info
Case 5
DropListBoxStrArray5(i) = Info
Case 6
DropListBoxStrArray6(i) = Info
Case 7
DropListBoxStrArray7(i) = Info
Case 8
DropListBoxStrArray8(i) = Info
Case 9
DropListBoxStrArray9(i) = Info
Case 10
DropListBoxStrArray10(i) = Info
Case 11
DropListBoxStrArray11(i) = Info
Case 12
DropListBoxStrArray12(i) = Info
Case 13
DropListBoxStrArray13(i) = Info
Case 14
DropListBoxStrArray14(i) = Info
Case 15
DropListBoxStrArray15(i) = Info
Case 16
DropListBoxStrArray16(i) = Info
Case 17
DropListBoxStrArray17(i) = Info
Case 18
DropListBoxStrArray18(i) = Info
Case 19
DropListBoxStrArray19(i) = Info
Case 20
DropListBoxStrArray20(i) = Info
Case 21
DropListBoxStrArray21(i) = Info
Case 22
DropListBoxStrArray22(i) = Info
Case 23
DropListBoxStrArray23(i) = Info
Case 24
DropListBoxStrArray24(i) = Info
Case 25
DropListBoxStrArray25(i) = Info
End Select
End Sub
Sub ReDimDropListBoxStrArray(index, NameCount)
If NameCount<>0 Then
Select Case index
Case 0
ReDim DropListBoxStrArray0(NameCount - 1)
Case 1
ReDim DropListBoxStrArray1(NameCount - 1)
Case 2
ReDim DropListBoxStrArray2(NameCount - 1)
Case 3
ReDim DropListBoxStrArray3(NameCount - 1)
Case 4
ReDim DropListBoxStrArray4(NameCount - 1)
Case 5
ReDim DropListBoxStrArray5(NameCount - 1)
Case 6
ReDim DropListBoxStrArray6(NameCount - 1)
Case 7
ReDim DropListBoxStrArray7(NameCount - 1)
Case 8
ReDim DropListBoxStrArray8(NameCount - 1)
Case 9
ReDim DropListBoxStrArray9(NameCount - 1)
Case 10
ReDim DropListBoxStrArray10(NameCount - 1)
Case 11
ReDim DropListBoxStrArray11(NameCount - 1)
Case 12
ReDim DropListBoxStrArray12(NameCount - 1)
Case 13
ReDim DropListBoxStrArray13(NameCount - 1)
Case 14
ReDim DropListBoxStrArray14(NameCount - 1)
Case 15
ReDim DropListBoxStrArray15(NameCount - 1)
Case 16
ReDim DropListBoxStrArray16(NameCount - 1)
Case 17
ReDim DropListBoxStrArray17(NameCount - 1)
Case 18
ReDim DropListBoxStrArray18(NameCount - 1)
Case 19
ReDim DropListBoxStrArray19(NameCount - 1)
Case 20
ReDim DropListBoxStrArray20(NameCount - 1)
Case 21
ReDim DropListBoxStrArray21(NameCount - 1)
Case 22
ReDim DropListBoxStrArray22(NameCount - 1)
Case 23
ReDim DropListBoxStrArray23(NameCount - 1)
Case 24
ReDim DropListBoxStrArray24(NameCount - 1)
Case 25
ReDim DropListBoxStrArray25(NameCount - 1)
End Select
End If
End Sub
Sub GetDropListBoxStrArray(index,DLBStrArray$())
Select Case index
Case 0
DLBStrArray = DropListBoxStrArray0
Case 1
DLBStrArray = DropListBoxStrArray1
Case 2
DLBStrArray = DropListBoxStrArray2
Case 3
DLBStrArray = DropListBoxStrArray3
Case 4
DLBStrArray = DropListBoxStrArray4
Case 5
DLBStrArray = DropListBoxStrArray5
Case 6
DLBStrArray = DropListBoxStrArray6
Case 7
DLBStrArray = DropListBoxStrArray7
Case 8
DLBStrArray = DropListBoxStrArray8
Case 9
DLBStrArray = DropListBoxStrArray9
Case 10
DLBStrArray = DropListBoxStrArray10
Case 11
DLBStrArray = DropListBoxStrArray11
Case 12
DLBStrArray = DropListBoxStrArray12
Case 13
DLBStrArray = DropListBoxStrArray13
Case 14
DLBStrArray = DropListBoxStrArray14
Case 15
DLBStrArray = DropListBoxStrArray15
Case 16
DLBStrArray = DropListBoxStrArray16
Case 17
DLBStrArray = DropListBoxStrArray17
Case 18
DLBStrArray = DropListBoxStrArray18
Case 19
DLBStrArray = DropListBoxStrArray19
Case 20
DLBStrArray = DropListBoxStrArray20
Case 21
DLBStrArray = DropListBoxStrArray21
Case 22
DLBStrArray = DropListBoxStrArray22
Case 23
DLBStrArray = DropListBoxStrArray23
Case 24
DLBStrArray = DropListBoxStrArray24
Case 25
DLBStrArray = DropListBoxStrArray25
End Select
End Sub
Sub InitializeDialogDlgFunctionStandard()
InitializeButtons
InitializeOptionGroup
InitializeToolListBox
InitializeDropDownListbox
InitializeDropDownListboxNR
InitializeDropDownListboxStr
InitializeComboboxListboxStr
InitializeCheckbox
End Sub
Sub InitializeButtons()
DlgText("OKPB",GetOKString)
DlgText("AddPB",GetAddString)
DlgText("DefaultPB",GetDefaultString)
DlgText("CancelPB",GetCancelString)
DlgText("InsertPB",GetInsertString)
If DialogInfo_GetIsLastLine Then
DlgVisible("AddPB",False)
DlgVisible("InsertPB",False)
DlgVisible("OKPB",True)
Else
DlgVisible("OKPB",False)
DlgVisible("AddPB",True)
DlgVisible("InsertPB",True)
End If
DlgVisible("OKPBModal",False)
End Sub
Sub SetReturnButton()
If DialogInfo_GetIsLastLine Then
ReturnButton = 1
Else
ReturnButton = 3
End If
End Sub
Sub InitializeOptionGroup()
Dim i As Long
For i = 0 To DlgCount() - 1
If ISVarInput(DlgName(i)) Then
If DlgType(i) = "OptionGroup" Then
DlgValue(i,-1)
End If
End If
Next i
End Sub
Sub InitializeCheckbox()
Dim i As Long
CBNameListNo = StringListCreate
CBSituationListNo = StringListCreate
For i = 0 To DlgCount() - 1
If ISVarInput(DlgName(i)) Then
If DlgType(i) = "CheckBox" Then
StringListAdd(CBNameListNo,DlgName(i))
StringListAdd(CBSituationListNo,"-1")
End If
End If
Next i
End Sub
Sub InitializeToolListBox()
Dim i As Long
For i = 0 To DlgCount() - 1
If IsToolDropListbox(i) Then
DlgValue(i,-1)
End If
Next i
End Sub
Sub InitializeDropDownListbox()
Dim i As Long
For i = 0 To DlgCount() - 1
If IsDropDownListbox(i) Then
DlgValue(i,-1)
End If
Next i
End Sub
Sub InitializeDropDownListboxNR()
Dim i As Long
For i = 0 To DlgCount() - 1
If IsDropDownListboxNR(i) Then
DlgValue(i,-1)
End If
Next i
End Sub
Sub InitializeDropDownListboxStr()
Dim i As Long
For i = 0 To DlgCount() - 1
If IsDropDownListboxStr(i) Then
DlgValue(i,-1)
End If
Next i
End Sub
Sub InitializeComboboxListboxStr()
Dim i As Long
For i = 0 To DlgCount() - 1
If IsComboboxListboxStr(i) Then
DlgValue(i,-1)
End If
Next i
End Sub
Function dialogfuncStandard(DlgItem$, Action%, SuppValue&)
Dim Lindex As Long
dialogfuncStandard = False
Select Case Action%
Case 5
ResetDialogSystemMenue
Case 6
If SuppValue=1 Then
CallHelp
End If
Case 1
InitializeDialogDlgFunctionStandard
If Not DialogInfo_GetValueListIsEmpty Then
SetStartVarValuesStandard
Else
SetDefaultVarValuesStandard
SetDefaultVarValuesExtented
End If
Case 2
Select Case DlgItem
Case "InsertPB"
dialogfuncStandard = Not OKButtonClick
DialogInfo_SetIsLastLine (False)
Case "CancelPB"
DialogInfo_SetOKClick (False)
Case "DefaultPB"
DefaultButtonClick
dialogfuncStandard = True
Case "AddPB"
dialogfuncStandard = Not OKButtonClick
DialogInfo_SetIsLastLine (True)
Case "OKPB"
dialogfuncStandard = Not OKButtonClick
Case "HelpPB"
CallHelp
dialogfuncStandard=True
Case "FlagButton"
FlagValue = DlgText("VAR_TLF")
If isnummeric(FlagValue) Then
If ShowFlagDialog Then
DlgText("VAR_TLF",FlagValue)
End If
DlgFocus ("VAR_TLF")
Else
MsgBox ("Variable: """ + FlagValue + """ kann nicht ausgewertet werden !")
End If
dialogfuncStandard = True
Case Else
Lindex = StringListIndexOf(CBNameListNo, DlgItem)
If (Lindex >= 0) Then
StringListSetString(CBSituationListNo,Lindex,"0")
End If
End Select
End Select
End Function
Sub CallHelp
Dim PDFFile As String
PDFFile= DialogInfo_GetMacroName+".pdf"
Help_Name(PDFFile)
End Sub
Sub DefaultButtonClick()
SetBackVarValuesStandard(True)
End Sub
Sub SetDefaultVarValuesStandard
Dim i As Long
For i = 0 To DlgCount() - 1
If ISVarInput(DlgName(i)) Then
If ISVarInputText(DlgName(i), DlgType(i)) Then
Call SetDefaultVarValuesTextBox(GetVarName(DlgName(i)), i)
End If
If ISVarInputTextStr(DlgName(i), DlgType(i)) Then
Call SetDefaultVarValuesTextBoxStr(GetVarNameTextStr(DlgName(i)), i)
End If
If ISVarInputTextStrNew(DlgName(i), DlgType(i)) Then
Call SetDefaultVarValuesTextBoxStrNew(GetVarNameTextStrNew(DlgName(i)), i)
End If
If DlgType(i) = "OptionGroup" Then
Call SetDefaultVarValuesOptionGroup(GetVarName(DlgName(i)), i)
End If
If DlgType(i) = "CheckBox" Then
Call SetDefaultVarValuesCheckBox(GetVarName(DlgName(i)), i)
End If
If IsToolDropListbox(i) Then
Call SetDefaultVarValuesToolListBox(i)
End If
If IsDropDownListbox(i) Then
Call SetDefaultVarValuesDropDownListBox(GetVarNameDDLB(DlgName(i)), i, GetDDLBIndex(DlgName(i)))
End If
If IsDropDownListboxNR(i) Then
Call SetDefaultVarValuesDropDownListBoxNR(GetVarNameDDLBNR(DlgName(i)), i, GetDDLBNRIndex(DlgName(i)))
End If
If IsDropDownListboxStr(i) Then
Call SetDefaultVarValuesDropDownListBoxStr(GetVarNameDDLBStr(DlgName(i)), i, GetDDLBStrIndex(DlgName(i)))
End If
If IsComboboxListboxStr(i) Then
Call SetDefaultVarValuesComboboxListBoxStr(GetVarNameDDLBStr(DlgName(i)), i, GetDDLBStrIndex(DlgName(i)))
End If
End If
Next i
End Sub
Sub SetDefaultVarValuesTextBox(VarName, index)
Dim defaultStr As Variant
If Trim(DlgText(index)) = "" Then
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
DlgText(index,defaultStr)
End If
End Sub
Sub SetDefaultVarValuesTextBoxStr(VarName, index)
Dim defaultStr As Variant
If Trim(DlgText(index)) = "" Then
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
DlgText(index,DeleteCharBegin_End(Chr(34),defaultStr))
End If
End Sub
Sub SetDefaultVarValuesTextBoxStrNew(VarName, index)
Dim defaultStr As Variant
If Trim(DlgText(index)) = "" Then
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
DlgText(index,DeleteCharBegin_End("'",defaultStr))
End If
End Sub
Sub SetDefaultVarValuesOptionGroup(VarName, index)
Dim defaultStr As Variant
Dim w As Integer
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
w = GetOptionGroupStandardIndex(index, defaultStr)
On Error GoTo Problem
DlgValue(index,w)
Exit Sub
Problem:
MsgBox GetWrongParaStr + vbCrLf + GetVarNameStr + ": " + VarName + vbCrLf + GetValueStr + ": " + IntToS(w)
End Sub
Sub SetDefaultVarValuesCheckBox(VarName, index)
Dim defaultStr As Variant
Dim w As Integer
Dim Lindex As Long
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
w = StringToInt(defaultStr)
If w <> 0 Then
w = 1
End If
Lindex = StringListIndexOf(CBNameListNo, DlgName(index))
If (Lindex >= 0) And (StringListStrings(CBSituationListNo, Lindex) = "-1") Then
StringListSetString(CBSituationListNo,Lindex,"0")
DlgValue(index,w)
End If
End Sub
Sub SetDefaultVarValuesToolListBox(index)
Dim defaultStr As Variant
Dim i As Long
defaultStr = DialogInfo_GetVarDefaultValue_Name("Tool") + " "
For i = 0 To (StringListCount(ToolSLNo) - 1)
If InStr(Toollists$(i), defaultStr) = 1 Then
If DlgValue(index) < 0 Then
DlgValue(index,i)
End If
End If
Next i
End Sub
Sub SetDefaultVarValuesDropDownListBox(VarName, index, DDLBIndex)
Dim defaultStr As Variant
If (DDLBIndex <= (DropListBoxCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
Call SetDDLBValue(defaultStr, index, DDLBIndex, False)
End If
End Sub
Sub SetDefaultVarValuesDropDownListBoxNR(VarName, index, DDLBIndex)
Dim defaultStr As Variant
If (DDLBIndex <= (DropListBoxNRCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
Call SetDDLBNRValue(defaultStr, index, DDLBIndex, False)
End If
End Sub
Sub SetDefaultVarValuesDropDownListBoxStr(VarName, index, DDLBIndex)
Dim defaultStr As Variant
If (DDLBIndex <= (DropListBoxStrCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
Call SetDDLBStrValue(defaultStr, index, DDLBIndex, False)
End If
End Sub
Sub SetDefaultVarValuesComboboxListBoxStr(VarName,index, DDLBIndex)
Dim defaultStr As Variant
If Trim(DlgText(index)) = "" Then
If (DDLBIndex <= (DropListBoxStrCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
Call SetDDLBStrValue(defaultStr, index, DDLBIndex, False)
Else
defaultStr = DialogInfo_GetVarDefaultValue_Name(VarName)
DlgText(index,DeleteCharBegin_End("'",defaultStr))
End If
End If
End Sub
Sub SetBackVarValues()
SetBackVarValuesStandard(False)
SetBackVarValuesExtented
End Sub
Sub SetBackVarValuesStandard(AsDefault)
Dim i As Long
For i = 0 To DlgCount() - 1
If ISVarInput(DlgName(i)) Then
If ISVarInputText(DlgName(i), DlgType(i)) Then
Call SetBackVarValuesTextBox(GetVarName(DlgName(i)), DlgText(i),AsDefault)
End If
If ISVarInputTextStr(DlgName(i), DlgType(i)) Then
Call SetBackVarValuesTextBoxStr(GetVarNameTextStr(DlgName(i)), DlgText(i),AsDefault)
End If
If ISVarInputTextStrNew(DlgName(i), DlgType(i)) Then
Call SetBackVarValuesTextBoxStrNew(GetVarNameTextStrNew(DlgName(i)), DlgText(i),AsDefault)
End If
If DlgType(i) = "OptionGroup" Then
Call SetBackVarValuesInteger(GetVarName(DlgName(i)), DlgValue(i),AsDefault)
End If
If DlgType(i) = "CheckBox" Then
Call SetBackVarValuesInteger(GetVarName(DlgName(i)), DlgValue(i),AsDefault)
End If
If IsToolDropListbox(i) Then
Call SetBackVarValuesToolListBox(GetVarName(DlgName(i)), DlgValue(i),AsDefault)
End If
If IsDropDownListbox(i) Then
Call SetBackVarValuesDropDownListBox(GetVarNameDDLB(DlgName(i)), GetDDLBIndex(DlgName(i)), DlgValue(i),AsDefault)
End If
If IsDropDownListboxNR(i) Then
Call SetBackVarValuesDropDownListBoxNR(GetVarNameDDLBNR(DlgName(i)), GetDDLBNRIndex(DlgName(i)), DlgValue(i),AsDefault)
End If
If IsDropDownListboxStr(i) Then
Call SetBackVarValuesDropDownListBoxStr(GetVarNameDDLBStr(DlgName(i)), GetDDLBStrIndex(DlgName(i)), DlgValue(i),AsDefault)
End If
If IsComboboxListboxStr(i) Then
Call SetBackVarValuesComboboxListBoxStr(GetVarNameDDLBStr(DlgName(i)), GetDDLBStrIndex(DlgName(i)),DlgText(i),DlgValue(i),AsDefault)
End If
End If
Next i
If AsDefault And FileExist(HopMacro.Filename) Then
HopMacro.SaveAlways(HopMacro.Filename)
End If
End Sub
Function SetVarValueDefault(VarName,VarValue)
Dim HV As HopVar
Set HV = HopMacro.VarList.GetExpHopVar_Name(VarName)
If Not HV Is Nothing Then
HV.Value=VarValue
End If
End Function
Sub SetBackVarValuesTextBox(VarName, VarValue,AsDefault)
If Trim(VarValue) = "" Then
VarValue = DialogInfo_GetVarDefaultValue_Name(VarName)
End If
If Trim(VarValue) = "" Then
VarValue = "0"
End If
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,VarValue)
Else
SetVarValueDefault(VarName,VarValue)
End If
End Sub
Sub SetBackVarValuesTextBoxStr(VarName, VarValue,AsDefault)
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,AddCharBegin_End(Chr(34),VarValue))
Else
SetVarValueDefault(VarName,AddCharBegin_End(Chr(34),VarValue))
End If
End Sub
Sub SetBackVarValuesTextBoxStrNew(VarName, VarValue,AsDefault)
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,AddCharBegin_End("'",VarValue))
Else
SetVarValueDefault(VarName,AddCharBegin_End("'",VarValue))
End If
End Sub
Sub SetBackVarValuesInteger(VarName, VarValue,AsDefault)
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,IntToS(VarValue))
Else
SetVarValueDefault(VarName,IntToS(VarValue))
End If
End Sub
Sub SetBackVarValuesToolListBox(VarName, VarValue,AsDefault)
Dim ToolStr As Variant
ToolStr = StringListStrings(ToolSLNo, VarValue)
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,GetBoxNo(ToolStr))
Else
SetVarValueDefault(VarName,GetBoxNo(ToolStr))
End If
End Sub
Sub SetBackVarValuesDropDownListBox(VarName, index, VarValue,AsDefault)
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,GetDDLBValue(index,VarValue))
Else
SetVarValueDefault(VarName,GetDDLBValue(index,VarValue))
End If
End Sub
Sub SetBackVarValuesDropDownListBoxNR(VarName, index, VarValue,AsDefault)
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,GetDDLBNRValue(index,VarValue))
Else
SetVarValueDefault(VarName,GetDDLBNRValue(index,VarValue))
End If
End Sub
Sub SetBackVarValuesDropDownListBoxStr(VarName, index, VarValue,AsDefault)
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,GetDDLBStrValue(index,VarValue))
Else
SetVarValueDefault(VarName,GetDDLBStrValue(index,VarValue))
End If
End Sub
Sub SetBackVarValuesComboboxListBoxStr(VarName, index,VarValueStr,VarValue,AsDefault)
Dim ListName As String
ListName = GetDDLBStrValue(index,VarValue)
If Len(ListName)>2 Then
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,AddCharBegin_End("'",VarValueStr))
Else
SetVarValueDefault(VarName,AddCharBegin_End("'",VarValueStr))
End If
Else
If Not AsDefault Then
DialogInfo_SetVarValue_Name(VarName,VarValueStr)
Else
SetVarValueDefault(VarName,VarValueStr)
End If
End If
End Sub
Sub SetStartVarValuesStandard()
Dim i As Long
For i = 0 To DlgCount() - 1
If ISVarInput(DlgName(i)) Then
If ISVarInputText(DlgName(i), DlgType(i)) Then
Call SetStartVarValuesTextBox(GetVarName(DlgName(i)), i)
End If
If ISVarInputTextStr(DlgName(i), DlgType(i)) Then
Call SetStartVarValuesTextBoxStr(GetVarNameTextStr(DlgName(i)), i)
End If
If ISVarInputTextStrNew(DlgName(i), DlgType(i)) Then
Call SetStartVarValuesTextBoxStrNew(GetVarNameTextStrNew(DlgName(i)), i)
End If
If DlgType(i) = "OptionGroup" Then
Call SetStartVarValuesOptionGroup(GetVarName(DlgName(i)), i)
End If
If DlgType(i) = "CheckBox" Then
Call SetStartVarValuesCheckBox(GetVarName(DlgName(i)), i)
End If
If IsToolDropListbox(i) Then
Call SetStartVarValuesToolListBox(i)
End If
If IsDropDownListbox(i) Then
Call SetStartVarValuesDropDownListBox(GetVarNameDDLB(DlgName(i)), i, GetDDLBIndex(DlgName(i)))
End If
If IsDropDownListboxNR(i) Then
Call SetStartVarValuesDropDownListBoxNR(GetVarNameDDLBNR(DlgName(i)), i, GetDDLBNRIndex(DlgName(i)))
End If
If IsDropDownListboxStr(i) Then
Call SetStartVarValuesDropDownListBoxStr(GetVarNameDDLBStr(DlgName(i)), i, GetDDLBStrIndex(DlgName(i)))
End If
If IsComboboxListboxStr(i) Then
Call SetStartVarValuesComboboxListBoxStr(GetVarNameDDLBStr(DlgName(i)),i, GetDDLBStrIndex(DlgName(i)))
End If
End If
Next i
End Sub
Sub SetStartVarValuesTextBox(VarName, index)
Dim defaultStr As Variant
defaultStr = DialogInfo_GetVarValue_Name(VarName)
DlgText(index,defaultStr)
End Sub
Sub SetStartVarValuesTextBoxStr(VarName, index)
Dim defaultStr As Variant
defaultStr = DialogInfo_GetVarValue_Name(VarName)
DlgText(index,DeleteCharBegin_End(Chr(34),defaultStr))
End Sub
Sub SetStartVarValuesTextBoxStrNew(VarName, index)
Dim defaultStr As Variant
defaultStr = DialogInfo_GetVarValue_Name(VarName)
DlgText(index,DeleteCharBegin_End("'",defaultStr))
End Sub
Function GetOptionGroupStandardIndex(index, Value)
GetOptionGroupStandardIndex = DlgValue(index)
If GetOptionGroupStandardIndex < 0 Then
GetOptionGroupStandardIndex = StringToInt(Value)
End If
End Function
Sub SetStartVarValuesOptionGroup(VarName, index)
Dim defaultStr As Variant
Dim w As Integer
defaultStr = DialogInfo_GetVarValue_Name(VarName)
w = GetOptionGroupStandardIndex(index, defaultStr)
On Error GoTo Problem
DlgValue(index,w)
Exit Sub
Problem:
MsgBox GetWrongParaStr + vbCrLf + GetVarNameStr + ": " + VarName + vbCrLf + GetValueStr + ": " + IntToS(w)
End Sub
Sub SetStartVarValuesCheckBox(VarName, index)
Dim defaultStr As Variant
Dim w As Integer
Dim Lindex As Integer
defaultStr = DialogInfo_GetVarValue_Name(VarName)
w = StringToInt(defaultStr)
If w <> 0 Then
w = 1
End If
DlgValue(index,w)
Lindex = StringListIndexOf(CBNameListNo,"VAR_"+VarName)
If (Lindex >= 0) Then
StringListSetString(CBSituationListNo,Lindex,"0")
End If
End Sub
Sub SetStartVarValuesToolListBox(index)
Dim defaultStr As Variant
Dim i As Long
defaultStr = DialogInfo_GetVarValue_Name("Tool") + " "
For i = 0 To (StringListCount(ToolSLNo) - 1)
If InStr(Toollists$(i), defaultStr) = 1 Then
If DlgValue(index) < 0 Then
DlgValue(index,i)
End If
End If
Next i
End Sub
Sub SetStartVarValuesDropDownListBox(VarName, index, DDLBIndex)
Dim defaultStr As Variant
If (DDLBIndex <= (DropListBoxCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarValue_Name(VarName)
Call SetDDLBValue(defaultStr, index, DDLBIndex, True)
End If
End Sub
Sub SetStartVarValuesDropDownListBoxNR(VarName, index, DDLBIndex)
Dim defaultStr As Variant
If (DDLBIndex <= (DropListBoxNRCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarValue_Name(VarName)
Call SetDDLBNRValue(defaultStr, index, DDLBIndex, True)
End If
End Sub
Sub SetStartVarValuesDropDownListBoxStr(VarName, index, DDLBIndex)
Dim defaultStr As Variant
If (DDLBIndex <= (DropListBoxStrCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarValue_Name(VarName)
Call SetDDLBStrValue(defaultStr, index, DDLBIndex, True)
End If
End Sub
Sub SetStartVarValuesComboboxListBoxStr(VarName, index, DDLBIndex)
Dim defaultStr As Variant
If (DDLBIndex <= (DropListBoxStrCount - 1)) And (DDLBIndex >= 0) Then
defaultStr = DialogInfo_GetVarValue_Name(VarName)
Call SetDDLBStrValue(defaultStr, index, DDLBIndex, True)
If (DlgValue(index) < 0) Then
DlgText(index,DeleteCharBegin_End("'",defaultStr))
End If
Else
defaultStr = DialogInfo_GetVarValue_Name(VarName)
DlgText(index,DeleteCharBegin_End("'",defaultStr))
End If
End Sub
Function OKButtonClick()
OKButtonClick = AllDialogInputsOKStandard
If OKButtonClick Then
OKButtonClick = AllDialogInputsOKExtented
If OKButtonClick Then
DialogInfo_SetOKClick (True)
SetBackVarValues
End If
End If
End Function
Function AllDialogInputsOKStandard()
Dim i As Long
AllDialogInputsOKStandard = True
For i = 0 To DlgCount() - 1
If ISVarInput(DlgName(i)) Then
If ISVarInputText(DlgName(i), DlgType(i)) Or IsComboboxListboxStr(i) Then
If DlgEnable(i) Then
If Not IsCorrectInputStr(DlgText(i)) Then
AllDialogInputsOKStandard = False
MsgBox (GetIncorrect_MSG)
DlgFocus (i)
Exit For
End If
End If
End If
If ISVarInputTextStr(DlgName(i), DlgType(i)) Or ISVarInputTextStrNew(DlgName(i), DlgType(i)) Then
If DlgEnable(i) Then
If Not IsCorrectInputTextStr(DlgText(i)) Then
AllDialogInputsOKStandard = False
MsgBox (GetIncorrectTextStr)
DlgFocus (i)
Exit For
End If
End If
End If
If (DlgType(i) = "OptionGroup") Or IsToolDropListbox(i) Or IsDropDownListbox(i) Or IsDropDownListboxNR(i) Or IsDropDownListboxStr(i) Then
If DlgEnable(i) Then
If DlgValue(i) < 0 Then
AllDialogInputsOKStandard = False
MsgBox (GetIncorrect_MSG)
DlgFocus (i)
Exit For
End If
End If
End If
End If
Next i
End Function
Sub FinializeDialog()
StringListDestroy (ToolSLNo)
StringListDestroy (CBNameListNo)
StringListDestroy (CBSituationListNo)
If Not DialogInfo_GetIsDLLRun Then
Debugfinish
End If
End Sub
Sub Debugfinish()
DialogInfo_DeleteVars
End Sub
Global FlagValue As String
Global DrillingTypArray$()
Global FlagArray$()
Sub Init()
ReDim DrillingTypArray(4)
DrillingTypArray(0) = IniFileReadStr(language_file, "__bohrzyklen", "2", "no definition in language file")
DrillingTypArray(1) = IniFileReadStr(language_file, "__bohrzyklen", "3", "no definition in language file")
DrillingTypArray(2) = IniFileReadStr(language_file, "__bohrzyklen", "4", "no definition in language file")
DrillingTypArray(3) = IniFileReadStr(language_file, "__bohrzyklen", "5", "no definition in language file")
ReDim FlagArray(9)
FlagArray(0) = IniFileReadStr(language_file, "__bohrzyklen", "6", "no definition in language file")
FlagArray(1) = IniFileReadStr(language_file, "__bohrzyklen", "7", "no definition in language file")
FlagArray(2) = IniFileReadStr(language_file, "__bohrzyklen", "8", "no definition in language file")
FlagArray(3) = IniFileReadStr(language_file, "__bohrzyklen", "9", "no definition in language file")
FlagArray(4) = IniFileReadStr(language_file, "__bohrzyklen", "10", "no definition in language file")
FlagArray(5) = IniFileReadStr(language_file, "__bohrzyklen", "11", "no definition in language file")
FlagArray(6) = IniFileReadStr(language_file, "__bohrzyklen", "12", "no definition in language file")
FlagArray(7) = IniFileReadStr(language_file, "__bohrzyklen", "13", "no definition in language file")
FlagArray(8) = IniFileReadStr(language_file, "__bohrzyklen", "14", "no definition in language file")
FlagArray(9) = IniFileReadStr(language_file, "__bohrzyklen", "15", "no definition in language file")
End Sub
Function ShowFlagDialog()
Init
Begin Dialog UserDialog 520,252,IniFileReadStr(language_file,"__bohrzyklen","0","no definition in language file"),.Flagdialogfunc
GroupBox 20, 7, 480, 196, IniFileReadStr(language_file, "__bohrzyklen", "1", "no definition in language file"), .GroupBox1
PushButton 130, 224, 90, 21, GetOKString, .OKPB
PushButton 300, 224, 90, 21, GetCancelString, .CancelPB
DropListBox 40, 35, 180, 154, DrillingTypArray(), .DrillingTypDDLB
DropListBox 240, 35, 100, 154, FlagArray(), .FlagDDLB
Picture 350, 49, 140, 126, bmppath + "_Bohr_Durchgang.bmp", 0, .Picture1
OKButton 60, 224, 30, 21, .OKModal
End Dialog
Dim dlg As UserDialog
TLFResult = 0
Dialog dlg
ShowFlagDialog = (TLFResult = -1)
End Function
Function GetTypIndex(FlagValue)
Dim Typ As String
GetTypIndex = 0
If Len(FlagValue) = 2 Then
Typ = Mid(FlagValue, 1, 1)
GetTypIndex = StringToInt(Typ)
End If
End Function
Function GetFlagIndex(FlagValue)
Dim Typ As String
GetFlagIndex = 0
If Len(FlagValue) = 1 Then
Typ = Mid(FlagValue, 1, 1)
GetFlagIndex = StringToInt(Typ)
End If
If Len(FlagValue) = 2 Then
Typ = Mid(FlagValue, 2, 1)
GetFlagIndex = StringToInt(Typ)
End If
End Function
Rem See DialogFunc help topic for more information.
Private Function Flagdialogfunc(DlgItem$, Action%, SuppValue&) As Boolean
Select Case Action%
Case 1
DlgValue("DrillingTypDDLB",GetTypIndex(FlagValue))
DlgValue("FlagDDLB",GetFlagIndex(FlagValue))
DlgVisible("OKModal",False)
switch_picture_Typ
Case 2
Rem Flagdialogfunc = True
Select Case DlgItem
Case "OKPB"
TLFResult = -1
FlagValue = IntToS(DlgValue("DrillingTypDDLB") * 10 + DlgValue("FlagDDLB"))
Case "CancelPB"
TLFResult = 0
End Select
If UCase(DlgItem) = "DRILLINGTYPDDLB" Then
switch_picture_Typ
End If
Case 3
Case 4
Case 5
Rem Flagdialogfunc = True
Case 6
End Select
End Function
Function switch_picture_Typ()
Dim i As Integer
i = DlgValue("DrillingTypDDLB")
If i = 0 Then
DlgSetPicture("Picture1",bmppath+"_Bohr_Leer.bmp",0)
End If
If i = 1 Then
DlgSetPicture("Picture1",bmppath+"_Bohr_Flach.bmp",0)
End If
If i = 2 Then
DlgSetPicture("Picture1",bmppath+"_Bohr_Durchgang.bmp",0)
End If
If i = 3 Then
DlgSetPicture("Picture1",bmppath+"_Bohr_Topf.bmp",0)
End If
End Function
Function isnummeric(stri) As Boolean
Dim i As Integer
Dim suchchar As String
isnummeric = True
For i = 1 To Len(stri)
suchchar = Mid(stri, i, 1)
If (suchchar = "0") Or (suchchar = "1") Or (suchchar = "2") Or (suchchar = "3") Or (suchchar = "4") Or (suchchar = "5") _
Or (suchchar = "6") Or (suchchar = "7") Or (suchchar = "8") Or (suchchar = "9") Then
Else
isnummeric = False
End If
Next
End Function
Function gs(i As Integer) As String
gs = IniFileReadStr(language_file, script_name, IntToS(i), "no definition in language file")
End Function