|
Hallo Community!
Also ich bin ein absoluter anfänger was VBA angeht. Ich habe zwar vor jahren mit HTML und PHP herum experimentiert aber das war es auch schon. Also zu meinem Problem ich Arbeite als CNC Techniker in einer Tischlerei. CNC Mschiene: BIESSE ROVER C9.65, Mit dem Prog. NC Hops 6,x.
Ich habe herrausgefunden dass ich mit dem SCRIPTDIALOGEDITOR ( Der bei Nc Hops mitgelifert wurde ) Dialoge ertsllen kann mit dem ich eine Eingabemaske für die Geschrieben Makros für meine CNC Maschiene erstellen kann.
Soweit so gut. Grösstenteils habe ich es auch hinbekommen :) doch sind doch einige fehler drinn die ich einfach nicht hinbekomme...
z.b. Wenn ich bei der DROPBOX "Bänder" TECTUS 340 3D auswähle sollen rechts 4 Textfelder erscheinen damit ich die 4 bandpositionen benutzen kann. Funktioniert auch doch wenn ich dann z.b. einen Opion button benutze verschwinden die textfelder wieder und ich muss bei der Dropbox erneut TECTUS 340 3d auswählen... Nja hier die codes Ich hoffe mir kann jemand helfen !
p.s. Die Global.bas ist schon vorgefertigt was genau die beinhaltet kann ich als "leie" nicht beureteilen^^
VIELEN DANK!
######################################################################################################################
TUEREN.bas
######################################################################################################################
Option Explicit
'#uses "globalDialog.bas"
Sub Main
Dim tuerart$(5)
tuerart$(0)="Innentür ÖNORM"
tuerart$(1)="Schallschutz ÖNORM"
tuerart$(2)="Brandschutz ÖNORM"
tuerart$(3)="Stahlzarge ÖNORM"
tuerart$(4)="Stahlzarge Peneder"
tuerart$(5)="Bündig Tür ÖNORM"
Dim schlosskasten$(2)
schlosskasten$(0)="ÖNORM"
schlosskasten$(1)="Keycard XS4"
schlosskasten$(2)="PHINX"
Dim baendersys$(4)
baendersys$(0)="SFS 2Stk"
baendersys$(1)="SFS 3Stk"
baendersys$(2)="SFS 4Stk"
baendersys$(3)="Stahlzarge"
baendersys$(4)="Tectus 340 3D"
Dim schlo_fraeser$(1)
schlo_fraeser$(0)="14mm"
schlo_fraeser$(1)="16mm"
Dim bohrer$(1)
bohrer$(0)="ANUBA16"
bohrer$(1)="ANUBA18"
Dim brandschutzstreifen$(2)
brandschutzstreifen$(0)="Keinen"
brandschutzstreifen$(1)="10mm"
brandschutzstreifen$(2)="18mm"
InitializeDialog
Begin Dialog UserDialog 1232,432,"Türen-Editor 2013",.dialogfunc ' %GRID:4,4,1,1
GroupBox 20,288,548,80,"Zusätze",.GroupBox5
GroupBox 20,224,548,60,"Bänder",.GroupBox4
GroupBox 16,8,552,96,"Tür Format",.GroupBox3
GroupBox 20,104,548,116,"Schlosskasten",.GroupBox2
GroupBox 584,224,284,68,"Tectus 340 3D",.GroupBox1
Text 576,416,116,16,"..::Version 1.0::..",.Text4
Text 1072,416,156,12,"Created by D.Stubenvoll",.Text15
Text 352,132,24,16,"mm",.Text19
Text 476,60,24,16,"mm",.Text17
Text 28,32,144,68,"Türen Art:",.Text1
Text 168,128,96,16,"Drückerhöhe:",.Text2
Text 168,152,80,16,"Dornmaß:",.Text3
Text 232,236,84,16,"Abstand:",.Text5
Text 236,256,48,16,"Bohrer:",.Text7
Text 152,56,48,16,"Länge:",.Text11
Text 152,80,44,16,"Breite:",.Text12
Text 316,80,52,16,"+48mm",.Text14
Text 372,56,44,16,"Dicke:",.Text13
Text 352,156,24,12,"mm",.Text16
Text 168,176,92,16,"Fräser:",.Text9
Text 28,56,92,16,"Stocklichte:",.Text10
Text 316,56,48,16,"+20mm",.Text6
Text 592,248,56,16,"Band 1:",.Text8
Text 592,272,52,16,"Band 2:",.Text18
Text 728,248,52,16,"Band 3:",.Text20
Text 728,272,52,16,"Band 4:",.Text21
TextBox 264,124,84,20,.VAR_dh
TextBox 264,148,84,20,.VAR_dm
TextBox 424,52,48,20,.VAR_Dicke
TextBox 216,52,96,20,.VAR_Laenge
TextBox 216,76,96,20,.VAR_Breite
TextBox 648,244,76,20,.VAR_tec3403d_1
TextBox 648,268,76,20,.VAR_tec3403d_2
TextBox 784,244,76,20,.VAR_tec3403d_3
TextBox 784,268,76,20,.VAR_tec3403d_4
DropListBox 104,28,252,20,tuerart(),.VAR_tuerart
DropListBox 44,128,120,20,schlosskasten(),.VAR_Schlosskasten
DropListBox 36,248,176,20,baendersys(),.VAR_Baendersys
DropListBox 264,172,84,20,schlo_fraeser(),.VAR_schlo_fraeser
DropListBox 292,252,116,20,bohrer(),.VAR_bohrer
DropListBox 196,344,80,20,brandschutzstreifen(),.VAR_Brandschutzstreifen
Picture 960,8,264,192,bmppath+"schall_brand_falz.bmp",0,.Picture1
CheckBox 44,308,100,16,"Fasen",.VAR_fasen
CheckBox 44,324,84,20,"Schallex",.VAR_schallex
CheckBox 44,192,140,16,"Rosetten Bohrung",.VAR_ros
CheckBox 44,344,152,16,"Brandschutzstreifen",.VAR_brandstreifen
OptionGroup .VAR_ohwcbbpz
OptionButton 44,168,60,16,"WC",.WC
OptionButton 44,148,68,20,"PZ/BB",.PZ
OptionGroup .VAR_streif_anschlag
OptionButton 368,28,72,16,"Streiftür",.Streif
OptionButton 444,28,100,16,"Anschlagtür",.Anschlag
OptionGroup .VAR_oben_unten
OptionButton 384,124,64,16,"Unten",.Unten
OptionButton 452,124,60,16,"Oben",.Oben
OptionGroup .VAR_band_abst
OptionButton 296,236,64,12,"32mm",.abst32
OptionButton 368,236,68,12,"47mm",.abst47
OptionGroup .VAR_reli
OptionButton 376,84,68,16,"Rechts",.OptionButton1
OptionButton 452,84,60,16,"Links",.Links
OKButton 552,388,56,24,.OKPBModal 'For esc and Alt+F4 function
PushButton 12,384,120,32,"OKPB",.OKPB
PushButton 344,388,100,24,"AddPB",.AddPB
PushButton 448,388,100,24,"InsertPB",.InsertPB
PushButton 136,388,100,24,"CancelPB",.CancelPB
PushButton 240,388,100,24,"DefaultPB",.DefaultPB
End Dialog
Dim dlg As UserDialog
Dialog dlg,ReturnButton
FinializeDialog
End Sub
'Call in Sub main if you don't use DLL call (for testing)
Sub DebugInit
DialogInfo_AddVar("dX;0;;;")
'Set Insertposition in Editor
DialogInfo_SetIsLastLine(False)
'Set input parameter empty or not new macro or edit a macro
DialogInfo_SetValueListIsEmpty(False)
'Picture for dialog
DialogInfo_SetDialogPicture("")
'Info for Dialog
DialogInfo_SetDialogInfo("Haube")
End Sub
'***********************************************************************************
'***************************** Initialization of Extented vars**********************
'***********************************************************************************
Sub InitializeDialogDlgFunctionExtented
Dim StartStr As Variant
'Fieldname is the name after the . in a dialogline
'DlgValue("Fieldname",Value) for groupbox, Checkbox, DropListBox
'DlgText("Fieldname",Text) for Textbox
End Sub
'***********************************************************************************
'***************************** SetStartValue (from Hops) of Extented vars**********************
'***********************************************************************************
Sub SetStartVarValuesExtented
Dim StartStr As Variant
'Fieldname is the name after the . in a dialogline
'Varname is the Varname of the variable in the hop-macro
'Dim StartStr As Variant
'StartStr=DialogInfo_GetVarValue_Name("VarName")
'DlgValue("Fieldname",Value) for groupbox, Checkbox, DropListBox
'DlgText("Fieldname",Text) for Textbox
' If StartStr="5" Then
' DlgValue("VAR_POS",5)
' End If
' switch_picture
'DlgVisible("VAR_brandschutzstreifen",False)
'##########################################################################################
'####################################DROPBOX LISTEN AUS HOPS###############################
'##########################################################################################
'DropListBox VAR_tuerart
Select Case DialogInfo_GetVarValue_Name("tuerart")
Case "6"'Zeile 6
DlgValue("VAR_tuerart",5)
Case "5"'Zeile 5
DlgValue("VAR_tuerart",4)
Case "4"'Zeile 4
DlgValue("VAR_tuerart",3)
Case "3"'Zeile 3
DlgValue("VAR_tuerart",2)
Case "2" 'Zeile 2
DlgValue("VAR_tuerart",1)
Case Else'Zeile 1
DlgValue("VAR_tuerart",0)
End Select
'DropListBox VAR_Schlosskasten
Select Case DialogInfo_GetVarValue_Name("schlosskasten")
Case "3"'Zeile 3
DlgValue("VAR_schlosskasten",2)
Case "2" 'Zeile 2
DlgValue("VAR_schlosskasten",1)
Case Else'Zeile 1
DlgValue("VAR_schlosskasten",0)
End Select
'DropListBox VAR_baendersys
Select Case DialogInfo_GetVarValue_Name("baendersys")
Case "5" 'Zeile 5
DlgValue("VAR_baendersys",4)
Case "4" 'Zeile 4
DlgValue("VAR_baendersys",3)
Case "3" 'Zeile 3
DlgValue("VAR_baendersys",2)
Case "2" 'Zeile 2
DlgValue("VAR_baendersys",1)
Case Else'Zeile 1
DlgValue("VAR_baendersys",0)
End Select
'DropListBox VAR_schlo_fraeser
Select Case DialogInfo_GetVarValue_Name("schlo_fraeser")
Case "2" 'Zeile 2
DlgValue("VAR_schlo_fraeser",1)
Case Else 'Zeile 1
DlgValue("VAR_schlo_fraeser",0)
End Select
'DropListBox VAR_bohrer
Select Case DialogInfo_GetVarValue_Name("bohrer")
Case "2" 'Zeile 2
DlgValue("VAR_bohrer",1)
Case Else 'Zeile 1
DlgValue("VAR_bohrer",0)
End Select
'DropListBox VAR_brandschutzstreifen
Select Case DialogInfo_GetVarValue_Name("brandschutzstreifen")
Case "3"'Zeile 1
DlgValue("VAR_brandschutzstreifen",2)
Case "2" 'Zeile 2
DlgValue("VAR_brandschutzstreifen",1)
Case Else'Zeile 1
DlgValue("VAR_brandschutzstreifen",0)
End Select
End Sub
'***********************************************************************************
'***************************** SetDefaultValue (From Hop-macro) of Extented vars**********************
'***********************************************************************************
Sub SetDefaultVarValuesExtented
'Fieldname is the name after the . in a dialogline
'Varname is the Varname of the variable in the hop-macro
'Before you set the value check is the Textbox (for example) empty or not
'Dim StartStr As Variant
'StartStr=DialogInfo_GetVarDefaultValue_Name("VarName")
'DlgValue("Fieldname",Value) for groupbox, Checkbox, DropListBox
'DlgText("Fieldname",Text) for Textbox
End Sub
'***********************************************************************************
'***************************** Check Inputs of Extented vars**********************
'***********************************************************************************
Function AllDialogInputsOKExtented
AllDialogInputsOKExtented=True
'Fieldname is the name after the . in a dialogline
'DlgValue("Fieldname",Value) for groupbox, Checkbox, DropListBox
'DlgText("Fieldname",Text) for Textbox
'Check if all Inputfiels with var information are correct
'For example a emty textbox is not correct
End Function
'***********************************************************************************
'***************************** SetBackValue (To Hops) of Extented vars**********************
'***********************************************************************************
Sub SetBackVarValuesExtented
Dim value As Integer
'Fieldname is the name after the . in a dialogline
'Varname is the Varname of the variable in the hop-macro
'Value=DlgValue("Fieldname",Value) for groupbox, Checkbox, DropListBox
'Value=DlgText("Fieldname",Text) for Textbox
'DialogInfo_SetVarValue_Name("VarName",Value)
' value=DlgValue("var_anschlagreihe",value)
' If value=2 Then
' DialogInfo_SetVarValue_Name("AnschlagReihe",0)
' End If
'##########################################################################################
'####################################DROPBOX LISTEN ZU HOPS################################
'##########################################################################################
'DropListBox VAR_tuerart
Select Case DlgValue("Var_tuerart",value)
Case 5'Zeile 6
DialogInfo_SetVarValue_Name("tuerart",6)
Case 4'Zeile 5
DialogInfo_SetVarValue_Name("tuerart",5)
Case 3'Zeile 4
DialogInfo_SetVarValue_Name("tuerart",4)
Case 2'Zeile 3
DialogInfo_SetVarValue_Name("tuerart",3)
Case 1'Zeile 2
DialogInfo_SetVarValue_Name("tuerart",2)
Case Else'Zeile 1
DialogInfo_SetVarValue_Name("tuerart",1)
End Select
'DropListBox VAR_Schlosskasten
Select Case DlgValue("Var_Schlosskasten",value)
Case 2'Zeile 3
DialogInfo_SetVarValue_Name("Schlosskasten",3)
Case 1'Zeile 2
DialogInfo_SetVarValue_Name("Schlosskasten",2)
Case Else'Zeile 1
DialogInfo_SetVarValue_Name("Schlosskasten",1)
End Select
'DropListBox VAR_baendersys
Select Case DlgValue("Var_baendersys",value)
Case 4'Zeile 5
DialogInfo_SetVarValue_Name("baendersys",5)
Case 3'Zeile 4
DialogInfo_SetVarValue_Name("baendersys",4)
Case 2'Zeile 3
DialogInfo_SetVarValue_Name("baendersys",3)
Case 1'Zeile 2
DialogInfo_SetVarValue_Name("baendersys",2)
Case Else 'Zeile 1
DialogInfo_SetVarValue_Name("baendersys",1)
End Select
'DropListBox VAR_Schlo_fraeser
Select Case DlgValue("Var_Schlo_fraeser",value)
Case 1'Zeile 2
DialogInfo_SetVarValue_Name("Schlo_fraeser",2)
Case Else 'Zeile 1
DialogInfo_SetVarValue_Name("Schlo_fraeser",1)
End Select
'DropListBox VAR_bohrer
Select Case DlgValue("Var_bohrer",value)
Case 1'Zeile 2
DialogInfo_SetVarValue_Name("bohrer",2)
Case Else 'Zeile 1
DialogInfo_SetVarValue_Name("bohrer",1)
End Select
'DropListBox VAR_Brandschutzstreifen
Select Case DlgValue("Var_Brandschutzstreifen",value)
Case 2'Zeile 2
DialogInfo_SetVarValue_Name("Brandschutzstreifen",3)
Case 1'Zeile 2
DialogInfo_SetVarValue_Name("Brandschutzstreifen",2)
Case Else 'Zeile 1
DialogInfo_SetVarValue_Name("Brandschutzstreifen",1)
End Select
End Sub
'***********************************************************************************
'***************************** Define all Action ***********************************
'***********************************************************************************
Sub dialogfuncExtented(DlgItem$, Action%, SuppValue&)
Select Case Action%
Case 1 ' Dialog box initialization
InitializeDialogDlgFunctionExtented
If Not DialogInfo_GetValueListIsEmpty Then
SetStartVarValuesExtented
End If
Case 2 ' Value changing or button pressed
Rem dialogfunc = True ' Prevent button press from closing the dialog box
' If UCase(DlgItem) = "VAR_POS" Then
' switch_picture
' End If
'########################################################
'TEXT 6 Switch ##################################
'########################################################
If DlgItem$ = "VAR_streif_anschlag" Then
switch_text6
End If
'########################################################
'Brandschutz Switch Dropbox #####################
'########################################################
If DlgItem$ = "VAR_brandstreifen" Then
switch_brandschutz
Else
DlgVisible("VAR_brandschutzstreifen",False)
End If
'########################################################
'Tectus 340 3D Band Switch ######################
'########################################################
If DlgItem$ = "VAR_Baendersys" Then
switch_tectus340
Else
DlgVisible("VAR_tec3403d_1",False)
DlgVisible("VAR_tec3403d_2",False)
DlgVisible("VAR_tec3403d_3",False)
DlgVisible("VAR_tec3403d_4",False)
DlgVisible("GroupBox1",False)
DlgVisible("Text8",False)
DlgVisible("Text18",False)
DlgVisible("Text20",False)
DlgVisible("Text21",False)
End If
Case 3 ' TextBox or ComboBox text changed
Case 4 ' Focus changed
Case 5 ' Idle
Rem dialogfunc = True ' Continue getting idle actions
Case 6 ' Function key
End Select
End Sub
Rem See DialogFunc help topic for more information.
Private Function dialogfunc(DlgItem$, Action%, SuppValue&) As Boolean
dialogfunc=dialogfuncStandard(DlgItem,Action,SuppValue)
Call dialogfuncExtented(DlgItem,Action,SuppValue)
End Function
'########################################################
'TEXT 6 Switch ##################################
'########################################################
Function switch_text6
Select Case DlgValue("VAR_streif_anschlag")
Case 0
DlgText "Text6","+20mm"
Case 1
DlgText "Text6","+40mm"
Case Else
End Select
End Function
'########################################################
'Brandschutzstreifen Switch #####################
'########################################################
Function switch_brandschutz
If DlgValue ("VAR_brandstreifen",1) Then 'nur wenn gecheckt ist
DlgVisible("VAR_brandschutzstreifen",True)
Else
DlgVisible("VAR_brandschutzstreifen",False)
End If
End Function
'########################################################
'Tectus 340 3D Band Switch ######################
'########################################################
Function switch_tectus340
Select Case DlgValue("VAR_Baendersys")
Case 4
DlgVisible("VAR_tec3403d_1",True)
DlgVisible("VAR_tec3403d_2",True)
DlgVisible("VAR_tec3403d_3",True)
DlgVisible("VAR_tec3403d_4",True)
DlgVisible("Groupbox1",True)
DlgVisible("text8",True)
DlgVisible("text18",True)
DlgVisible("text20",True)
DlgVisible("text21",True)
Case Else
DlgVisible("VAR_tec3403d_1",False)
DlgVisible("VAR_tec3403d_2",False)
DlgVisible("VAR_tec3403d_3",False)
DlgVisible("VAR_tec3403d_4",False)
DlgVisible("GroupBox1",False)
DlgVisible("Text8",False)
DlgVisible("Text18",False)
DlgVisible("Text20",False)
DlgVisible("Text21",False)
End Select
End Function
######################################################################################################################
GLOBAL.bas
######################################################################################################################
'29.06.2001 wurde um Texteingabe für Strings ergänzt
'27.08.2001 Dropdownlistanzahl wurde auf 20 erweitert
'Fehler bei Zugriff auf Nummer >=10 wurde geändert
'Werkzeugverwaltung wird aus Basicerweiterung ausgelesen 14.05.2002
'Es müssen die aktuellsten DLL und EXE installiert sein
Option Explicit
Type TDropListBoxInfo
DropListBoxArrayNames As String
DropListBoxArrayValues As String
NameCount As Long
End Type
'***********************************************************************************
'************************************* constants *********************************
'***********************************************************************************
Const pi = 3.14159265358979
'Separate Char for Parameter (xx;yy;zz)
Const SepStr = ";"
'"Var_"+ToolVarName Is the key For a tool variable
Const ToolVarName = "Tool"
'***********************************************************************************
'************************************* Variables *********************************
'***********************************************************************************
' global name of the actual script
Global script_name As String
Global language_file As String
Global StringFormDateiName As String
Global TLFResult As Integer
'Save the Caption of the Dialog
Global DialogCaption As Variant
'In this StringList are all Tools saved in this structure: BoxNo+" "+Toolname
'In Hops.ini are the Tooltable name. In this list there are all tool from this tooltable
'You can get it with extented Basic functions
Global ToolSLNo As Long
'Use this Toolarray list (contens the same as the stringlist ToolSLNo) in a DropListBox
Global Toollists$()
'In this list are all Checkboxnames with "VAR_" saved
Global CBNameListNo As Long
'In this list is the situation of a Checkbox saved. If there is no action on a Checkbox
'the value is '-1'. So you can use this value to decide if you can set a default value or not
Global CBSituationListNo As Long
'the picture path saved for pictures in the Dialog
Global bmppath As Variant
'the PDF path
Global PDFpath As Variant
'DropListBox File path
Global DLBFilePath As Variant
'The number of the default button saved. A default button is that one which you push if you press enter key
Global ReturnButton As Long
' Arrays for Dropdownlists
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$()
' Arrays for Dropdownlists
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$()
' Arrays for Dropdownlists
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$()
'***********************************************************************************
'********************************** mathematics mocros ***********************
'***********************************************************************************
'change the angle in to the area 0<= A<360°
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
'true if W1 is equal W2
Function equal(W1, W2)
equal = Abs(W1 - W2) < 0.00001
End Function
'Special DropListBox for Tool choose
Function IsToolDropListbox(index)
IsToolDropListbox = (DlgName(index) = "VAR_" + ToolVarName) And ((DlgType(index) = "DropListBox"))
End Function
'DropListBox
Function IsDropDownListbox(index)
IsDropDownListbox = (InStr(AUppercase(DlgName(index)), "VARDDLB_") = 1) And (DlgType(index) = "DropListBox") 'And (GetDDLBIndex(DlgName(index))>=0)
End Function
'DropListBoxNR
Function IsDropDownListboxNR(index)
IsDropDownListboxNR = (InStr(AUppercase(DlgName(index)), "VARDDLBNR_") = 1) And (DlgType(index) = "DropListBox") 'And (GetDDLBIndex(DlgName(index))>=0)
End Function
'DropListBoxStr
Function IsDropDownListboxStr(index)
IsDropDownListboxStr = (InStr(AUppercase(DlgName(index)), "VARDDLBSTR_") = 1) And (DlgType(index) = "DropListBox") 'And (GetDDLBIndex(DlgName(index))>=0)
End Function
'ComboboxListboxStr
Function IsComboboxListboxStr(index)
IsComboboxListboxStr = (InStr(AUppercase(DlgName(index)), "VARDDLBSTR_") = 1) And (DlgType(index) = "ComboBox") 'And (GetDDLBIndex(DlgName(index))>=0)
End Function
'A Field is automatical used (init, start, default) for an Variable if you name a component with "Var_"
'at first
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
'Return the number (No) of the string No+" "+String
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
'Set with value the DropDownListbox of index
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
'Return the Hopsvalue of a DropDownListbox
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
'Set with value the DropDownListboxNR of index
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
'Return the Hopsvalue of a DropDownListboxNR
Function GetDDLBNRValue(index, DDLBIndex)
Dim i As Long
Dim Count As Long
Dim DLBNRArray$()
GetDDLBNRValue = 0
Count = DropListBoxNRInfos(index)
' MsgBox(DDLBIndex+" "+Count)
Call GetDropListBoxNRArray(index,DLBNRArray)
' MsgBox("1:"+Param(2, DLBNRArray(DDLBIndex)))
If (DDLBIndex >= 0) And (DDLBIndex < Count) Then
GetDDLBNRValue = Param(2, DLBNRArray(DDLBIndex))
' MsgBox("2:"+Param(2, DLBNRArray(DDLBIndex)))
End If
' MsgBox("3:"+GetDDLBNRValue)
End Function
'Set with value the DropDownListboxStr of index
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
'Return the Hopsvalue of a DropDownListboxStr
Function GetDDLBStrValue(index, DDLBIndex)
Dim i As Long
Dim Count As Long
Dim DLBStrArray$()
GetDDLBStrValue = ""
Count = DropListBoxStrInfos(index)
' MsgBox(DDLBIndex+" "+Count)
' MsgBox(DDLBIndex)
Call GetDropListBoxStrArray(index,DLBStrArray)
' MsgBox("1:"+Param(2, DLBStrArray(DDLBIndex)))
If (DDLBIndex >= 0) And (DDLBIndex < Count) Then
GetDDLBStrValue = DLBStrArray(DDLBIndex)
' MsgBox("2:"+Param(2, DLBStrArray(DDLBIndex)))
End If
' MsgBox("3:"+GetDDLBStrValue)
GetDDLBStrValue="'"+GetDDLBStrValue+"'"
End Function
'***********************************************************************************
'******************************* String macros **********************************
'***********************************************************************************
'delete in S from index count chars
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
'xyz;zzz;iii -> Result is the count of separated parameters
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
'xyz;zzz;iii -> Result is the Parameter at the Position 'nr'
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
'Change all "\" to "/"
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
'Return the Filename in which are the language strings are saved
Function GetStringFormDateiName()
GetStringFormDateiName = IniFileReadStr("Hops.ini", "HOPS", "StrFormDatei", "c:\Hops\StrFormDatei.ini")
End Function
'Return the Filename in which are the language strings for the Dialogscripts
Function GetStringFormDateiName_Dialogscripts()
GetStringFormDateiName_Dialogscripts = IniFileReadStr("Hops.ini", "LANGUAGE", "LanguageScriptFile", "c:\hops\ScriptLanguage.ini")
End Function
'Return the Filename in which are the language strings are saved
Function GetStringDateiName()
GetStringDateiName = IniFileReadStr("Hops.ini", "HOPS", "StrDatei", "c:\Hops\StrDatei.ini")
End Function
'Return the String for the OK button
Function GetOKString()
GetOKString = IniFileReadStr(StringFormDateiName, "FSP_pas", "0", "OK")
End Function
'Return the String for the Cancel button
Function GetCancelString()
GetCancelString = IniFileReadStr(StringFormDateiName, "FSP_pas", "1", "Cancel")
End Function
'Return the String for the Default button
Function GetDefaultString()
GetDefaultString = IniFileReadStr(StringFormDateiName, "FSP_pas", "2", "Defaultl")
End Function
'Return the String for the Add button
Function GetAddString()
GetAddString = IniFileReadStr(StringFormDateiName, "FSP_pas", "3", "Add")
End Function
'Return the String for the Insert button
Function GetInsertString()
GetInsertString = IniFileReadStr(StringFormDateiName, "FSP_pas", "4", "Insert")
End Function
'language depented function for "Wrong input"
Function GetIncorrect_MSG()
GetIncorrect_MSG = IniFileReadStr(GetStringDateiName, "Fehlermeldung_pas", "9", "Wrong input") + vbCrLf + IniFileReadStr(GetStringDateiName, "Fehlermeldung_pas", "10", "Correct please")
End Function
'language depented function for "Wrong input"
Function GetIncorrectTextStr()
GetIncorrectTextStr = IniFileReadStr(GetStringDateiName, "FEinst_pas", "0", "Wrong input") + " (; , ' " + Chr(34) + ")"
End Function
'Read the actual tooldatabase name from the Hops.ini
Function GetActualToolDataName()
GetActualToolDataName = DialogInfo_GetActualToolData
'GetActualToolDataName = IniFileReadStr("Hops.ini", "NCERZEUGUNG", "WZGV", "Demo")
End Function
'Return the real VarName "Var_HopsVarName" -> "HopsVarName"
Function GetVarName(VarName)
GetVarName = Mid(VarName, 5, Len(VarName) - 4)
End Function
'Return the real VarName "Varstr_HopsVarName" -> "HopsVarName"
Function GetVarNameTextStr(VarName)
GetVarNameTextStr = Mid(VarName, 8, Len(VarName) - 7)
End Function
'Return the real VarName "VarstrNew_HopsVarName" -> "HopsVarName"
Function GetVarNameTextStrNew(VarName)
GetVarNameTextStrNew = Mid(VarName, 11, Len(VarName) - 10)
End Function
'Return the real VarName "VarDDLB_1_HopsVarName" -> "HopsVarName"
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
'Return the real VarName "VarDDLBNR_1_HopsVarName" -> "HopsVarName"
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
'Return the real VarName "VarDDLBNR_1_HopsVarName" -> "HopsVarName"
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
'Delete Beginnen and End Char
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
'Delete Beginnen and End Char
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
'language depented function for "Varname"
Function GetVarNameStr()
GetVarNameStr = IniFileReadStr(GetStringDateiName, "SpestrGr_pas", "0", "Varname")
End Function
'language depented function for "Value"
Function GetValueStr()
GetValueStr = IniFileReadStr(GetStringDateiName, "SpestrGr_pas", "1", "Value")
End Function
'Colors
Function GetColorString(No)
GetColorString = IniFileReadStr(language_file, "Colors", IntToS(No), "No definition In language file")
End Function
'language depented function "Wrong parameter value"
Function GetWrongParaStr()
GetWrongParaStr = IniFileReadStr(GetStringDateiName, "ScriptDialogs", "0", "")
If GetWrongParaStr = "" Then
GetWrongParaStr = "Wrong parameter value"
IniFileWriteStr(GetStringDateiName,"ScriptDialogs","0",GetWrongParaStr)
End If
End Function
'***********************************************************************************
'***************************** convert macros **********************************
'***********************************************************************************
'Convert an Float number to an string
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
'Convert an Integer to an string
Function IntToS(w)
IntToS = Trim(Str(w))
End Function
'***********************************************************************************
'***************************** Initialization macros **********************************
'***********************************************************************************
'Initialization of Variables (not DLLRun)
'Caption of the Dialog
'Default button number
'Picture folder
Sub InitializeDialog()
If Not DialogInfo_GetIsDLLRun Then
Debugfinish
DebugInit
End If
'DialogCaption=DialogInfo_GetDialogInfo
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()
'Set Array count
If DropListBoxCount > 0 Then
ReDim Preserve DropListBoxInfos(DropListBoxCount - 1)
End If
End Sub
Sub InitializeDropListBoxNRInfosSizeSubForm()
'Set Array count
If DropListBoxNRCount > 0 Then
ReDim Preserve DropListBoxNRInfos(DropListBoxNRCount - 1)
End If
End Sub
Sub InitializeDialogSubForm()
InitializeDropListBoxInfosSizeSubForm
InitializeDropListBoxNRInfosSizeSubForm
End Sub
'Open actual tooldatabase an read Data in StringList and ToolArray
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()
'Set Array count
If DropListBoxCount > 0 Then
ReDim DropListBoxInfos(DropListBoxCount - 1)
End If
End Sub
Sub InitializeDropListBoxNRInfosSize()
'Set Array count
If DropListBoxNRCount > 0 Then
ReDim DropListBoxNRInfos(DropListBoxNRCount - 1)
End If
End Sub
Sub InitializeDropListBoxStrInfosSize()
'Set Array count
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
'Init Buttons, Optiongroups,ToolListBox and Checkbox
Sub InitializeDialogDlgFunctionStandard()
InitializeButtons
InitializeOptionGroup
InitializeToolListBox
InitializeDropDownListbox
InitializeDropDownListboxNR
InitializeDropDownListboxStr
InitializeComboboxListboxStr
InitializeCheckbox
End Sub
'Set Caption of the buttons
'Set visible
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
'Set number of default button
Sub SetReturnButton()
If DialogInfo_GetIsLastLine Then
ReturnButton = 1
Else
ReturnButton = 3
End If
End Sub
'Init Optiongroup value (-1)
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
'Init Checkbox value (-1) in StringList
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
'Init ToolDropListbox (-1)
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
'Init DropDownListbox (-1)
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
'Init DropDownListboxNR (-1)
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
'Init DropDownListboxNR (-1)
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
'***********************************************************************************
'***************************** dialogfunc macros **********************************
'***********************************************************************************
'Initialization
'SetStartVarvalue
'Button Clicks
Function dialogfuncStandard(DlgItem$, Action%, SuppValue&)
Dim Lindex As Long
dialogfuncStandard = False
Select Case Action%
Case 5
'Systemmenü zurücksetzten
ResetDialogSystemMenue
Case 6 ' key
If SuppValue=1 Then
CallHelp
End If
Case 1 ' Dialog box initialization
InitializeDialogDlgFunctionStandard
If Not DialogInfo_GetValueListIsEmpty Then
SetStartVarValuesStandard
Else
SetDefaultVarValuesStandard
SetDefaultVarValuesExtented
End If
Case 2 ' Value changing or button pressed
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
'***********************************************************************************
'***************************** SetDefaultVarValues *********************************
'***********************************************************************************
Sub DefaultButtonClick()
SetBackVarValuesStandard(True)
End Sub
'Set Default value of Textbox, OptionGroup, Checkbox and ToolDropListbox
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
'Set Default of Textbox
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
'Set Default of Textboxstr
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
'Set Default of TextboxstrNew
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
'Set Default of Optiongroup
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)
' If EqualStr(VarName,"Ebene") Then
' DlgValue(i,0)
' End If
Exit Sub
Problem:
MsgBox GetWrongParaStr + vbCrLf + GetVarNameStr + ": " + VarName + vbCrLf + GetValueStr + ": " + IntToS(w)
End Sub
'Set Default of Checkbox
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
'Set Default of ToolListbox
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
'Set Default of DropDownListbox
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
'Set Default of DropDownListboxNR
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
'Set Default of DropDownListboxStr
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
'Set Default of ComboboxListboxStr
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
'***********************************************************************************
'***************************** SetBackVarValues **********************************
'***********************************************************************************
Sub SetBackVarValues()
SetBackVarValuesStandard(False)
SetBackVarValuesExtented
End Sub
'Set Back (Return to Hops) value of Textbox, OptionGroup, Checkbox and ToolDropListbox
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)
' new MW 7.6.2001
' , changed in .
'VarValue = Replace$(VarValue, ",", ".")
'Enables textboxes is possible to be empty (SF 16.07.01)
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
'MsgBox(index)
ListName = GetDDLBStrValue(index,VarValue)
'MsgBox(ListName)
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
'***********************************************************************************
'***************************** SetStartVarValues **********************************
'***********************************************************************************
'Set start (From Hops) value of Textbox, OptionGroup, Checkbox and ToolDropListbox
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)
' If EqualStr(VarName,"Ebene") Then
' DlgValue(i,0)
' End If
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
'Set Start of DropDownListbox
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
'Set Start of DropDownListbox
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
'Set Start of DropDownListbox
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
'Set Start of ComboboxListbox
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)
'Wert ist nicht in derListe Listenindex -1 -> Wert manuell setzen
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
'***********************************************************************************
'***************************** DialogInputsOK **********************************
'***********************************************************************************
'Check if Dialoginputs OK and set parameter for hops
Function OKButtonClick()
OKButtonClick = AllDialogInputsOKStandard
If OKButtonClick Then
OKButtonClick = AllDialogInputsOKExtented
If OKButtonClick Then
DialogInfo_SetOKClick (True)
SetBackVarValues
End If
End If
End Function
'Check all Inputs of Textbox, OptionGroup, Checkbox and ToolDropListbox
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
'***********************************************************************************
'***************************** Finialization **********************************
'***********************************************************************************
'Delete Lists
Sub FinializeDialog()
StringListDestroy (ToolSLNo)
StringListDestroy (CBNameListNo)
StringListDestroy (CBSituationListNo)
If Not DialogInfo_GetIsDLLRun Then
Debugfinish
End If
End Sub
'Call in Sub main if you don't use DLL call (for testing)
Sub Debugfinish()
DialogInfo_DeleteVars
End Sub
'***********************************************************************************
'***************************** Flagdialog **********************************
'***********************************************************************************
'Flagdialog
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 ' %GRID:10,7,1,1
GroupBox 20, 7, 480, 196, IniFileReadStr(language_file, "__bohrzyklen", "1", "no definition in language file"), .GroupBox1
' OKButton 120,217,90,21
' CancelButton 290,217,90,21
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
' wenn 1.-stelliger wert
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 ' Dialog box initialization
DlgValue("DrillingTypDDLB",GetTypIndex(FlagValue))
DlgValue("FlagDDLB",GetFlagIndex(FlagValue))
DlgVisible("OKModal",False)
switch_picture_Typ
Case 2 ' Value changing or button pressed
Rem Flagdialogfunc = True ' Prevent button press from closing the dialog box
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 ' TextBox or ComboBox text changed
Case 4 ' Focus changed
Case 5 ' Idle
Rem Flagdialogfunc = True ' Continue getting idle actions
Case 6 ' Function key
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
|