[ubit]

Hi,

ich habe mal eine erste Version für die Anbindung der Soundplatine die Servoplatine gebaut. Siehe hier:

Ein neues Zip kommt im Laufe des Tages.

Enthalten ist auch eine recht ausführliche Anleitung. Wäre super, wenn möglichst viele MLLler das mal ausprobieren könnten. Insbesondere interessant:
* Funktionieren alle Befehle?
* Läuft es zuverlässig? Wenn nicht: Wann/wo genau gibt es Probleme?
* Ist die Anleitung verständlich?

Für "produktive Einsätze" bitte noch nicht nutzen - es kann sein das sich die "Namen" der Funktionen und/oder Parameter nochmal verändern falls das offiziell in die MLL eingebaut wird. Da hat Hardi die Oberhoheit

Wobei ich wirklich Hilfe bräuchte ist der Einbau in den Programmgenerator. Sinnvoll wäre es ja vermutlich, wenn die Soundbefehle die LED-Nummer nicht hochzählen so das man mehrere "Schalter" für unterschiedliche Sounds einfach hintereinander definieren kann. Ich habe aber überhaupt keine Ahnung wir das in den Programmgenerator einzubauen wäre

Ciao, Udo

P.S.: Natürlich alles ohne Gewähr...

[Railcar]

Hi,

pdf kann nicht geöffnet werden - Größe 0 Byte

Ulrich

[4fangnix]

Hallo Ulrich,

bei mir funktioniert es (Firefox/1,2 MB).

Gruß
Armin

[kalaharix]

Moin

das pdf ist bei mir auch leer (0 byte). Das zip lässt sich aber ohne Fehler entpacken.

[4fangnix]

Stimmt! Da war ich zu vorschnell. Das PDF läßt sich nicht öffnen.

Gruß
Armin

[ubit]

So - neuer Versuch

Siehe weiter unten....

Ciao, Udo

[kalaharix]

Jetzt funktioniert es
Danke

[Matthias_h0]

Zitat

---

Wobei ich wirklich Hilfe bräuchte ist der Einbau in den Programmgenerator. Sinnvoll wäre es ja vermutlich, wenn die Soundbefehle die LED-Nummer nicht hochzählen so das man mehrere "Schalter" für unterschiedliche Sounds einfach hintereinander definieren kann. Ich habe aber überhaupt keine Ahnung wir das in den Programmgenerator einzubauen wäre

---

Hallo Udo,
vielen Dank!
Ich werde nachher mal schauen, ob ich es hinkriege,das in den Programm Generator einzubauen...

[ubit]

Wie gesagt: Erst mal abwarten ob es auch zuverlässig bei Allem funktioniert Und dann wüsste ich halt auch gerne wie man das in den Generator einbauen kann. Rein aus Interesse.

Ciao, Udo

[Matthias_h0]

Hallo Udo,
Du musst im Prog Generator die Tabellenblätter Lib_Macros und Par_Descriptions sichtbar machen. Im Tabellenblatt Lib_Macros kannst du dann die neuen Effekte einfach einfügen. Die benötigten Parameter müssen dann noch im Blatt Par_Descriptions eingetragen werden.




Die neuen Makros werden dann automatisch in die Liste übernommen.
Kommst du mit der Beschreibung so klar? Sonst frag´ einfach nochmal nach, gerne auch per PN.

Ich kann das einfügen der neuen Makros dann auch gerne übernehmen, wenn alles so bleibt.

Viele Grüße
Matthias

[ubit]

Jo - hab' ich mittlerweile auch gefunden Lässt sich recht einfach einbauen.

Aber:

Was aber wohl noch fehlt: Es wäre super, wenn man bei den Parametern (verstecktes Sheet Par_Description) eine Optionsliste hinterlegen könnte die dann per Select-Feld auszuwählen ist. Sowas wäre nicht nur für die MP3-Befehle sinnvoll, sondern z.B. auch beim LED-Kanal (0-7) oder anderen Parametern die auf wenige Werte beschränkt sind eine Erleichterung.

Zumindest habe ich dazu nichts gefunden.

Sollte sich doch eigentlich relativ leicht in einer zusätzlichen Spalte einbauen lassen. Dort dann einfach alle möglichen Werte mit | getrennt auflisten. Wenn die Spalte einen Inhalt hat wird im Parameter-Formular dann halt ein Select statt einem Textinput eingebaut. Wobei ich dieses Parameter-Formular noch nicht gefunden habe

Ciao, Udo

[Matthias_h0]

Hallo Udo,
Dafür müsste man dann vermutlich ein neues User_Form mit VBA erstellen bzw. das vorhandene Formular bearbeiten. Möglich ist das auch, es muss sich nur jemand finden, der das einbaut...

[Matthias_h0]

Zitat

---

Sowas wäre nicht nur für die MP3-Befehle sinnvoll, sondern z.B. auch beim LED-Kanal (0-7) oder anderen Parametern die auf wenige Werte beschränkt sind eine Erleichterung.

---

Hallo
Beim Led Kanal habe ich das schon mal eingebaut. Man kann den Led Kanal jetzt über ein Dropdown- Feld auswählen.
Hier ist die neue Datei:
Edit: Die Datei ist leider zu groß, um sie hier anzuhängen. Mal schauen, ob ich das irgendwie anders hinkriege...


Für die anderen Felder wird das dann aber doch komplizierter. Mal schauen, ob ich das auch noch hinkriege...
Viele Grüße,
Matthias

[ubit]

Hi,

das ist relativ einfach

Einfach ein Kombinationsfeld an die selben Stellen legen wo das Eingabefeld ist. Das Kombinationsfeld kopiert bei Änderungen den Wert dann immer in das Textfeld.
Je nach dem ob nun Textfeld oder Kombofeld angezeigt werden wird das jeweils andere Feld einfach ausgeblendet (Eigenschaft Visible=True/False).
Hab' da gerade etwas mit herumgespielt - ist nicht soooo schwierig.
Die Stelle zur Auswertung der Optionen findet sich in "Show_UserForm_Other" - das Formular ist "UserForm_Other".

Ich habe zum Testen die möglichen Werte in der Optionsspalte erweitert. Mehrere Einträge durch Semikolon getrennt (Split(...,";")). Für das Select dann einfach
w=120;Values: Option1,Option2, Option3, Option4....

Setzt die Feldbreite auf 120 und bietet die gelisteten Optionen an. Irgendwo habe ich noch einen Fehler drin, aber grundsätzlich sollte das so funktionieren.

Ciao, Udo

[Matthias_h0]

Hallo Udo,
Hast du das beim LED Kanal auch schon geändert? Ich habe dafür folgenden Code genommen:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
 

Option Explicit
Option Compare Binary ' Use case sensitive compare. Important for the "Sec" compare below
 
' Following parameters exist:
' LED Cx  InCh    Val0    Val1    On_Min  On_Limit    LedCnt  Brightness  DstVar  Mode    Enable  TimeOut DstVar1 DstVarN MinTime MaxTime MinOn   MaxOn   Var SrcLED  EnableCh    Start   End GlobVarNr   FirstInCh   InCh_Cnt    Duration    Period  Pause   Act Off S_InCh  R_InCh  Timeout T_InCh  DstVar0 MinBrightness   MaxBrightness   B_LED_Cx    B_LED   InNr    TmpNr   Rotate  Steps   MaxSoundNr  InReset
'
'
' Maximal 6 named parameter in one macro
'
' ToDo:
' - Alte eingaben speichern und beim nächsten mal wieder verwenden
'   - Geht nicht in dem man das Unload Me weglässt
'   - Man könnte ein Array anlegen in dem die Parameter Namen und der Letzte Wert enthalten ist
'     das sollte aber für jedes Makro spezifisch sein
 
Private ParList As Variant
Private FuncName As String
Private NamesA As Variant
 
Const MAX_PAR_CNT = 14                                                      ' 14.01.20: Old 6 (Warum ncht 7? Es waren doch 7 Felder verfügbar)
Private TypA(MAX_PAR_CNT) As String
Private MinA(MAX_PAR_CNT) As Variant
Private MaxA(MAX_PAR_CNT) As Variant
Private ParName(MAX_PAR_CNT) As String
Private Invers(MAX_PAR_CNT) As Boolean
 
Const DEFAULT_PAR_WIDTH = 48
 
'-------------------------------------------------------------------------------
Private Function Check_Limit_to_MinMax(ParNr As Long, Value As Variant) As Boolean
'-------------------------------------------------------------------------------
' Return true if its within the alowed range
  Dim Msg As String
  'With Controls("Par" & ParNr)
    Dim ValidRangeTxt As String
    ValidRangeTxt = vbCr & Get_Language_Str("Bitte einen Wert zwischen ") & MinA(ParNr - 1) & Get_Language_Str(" und ") & MaxA(ParNr - 1) & Get_Language_Str(" eingeben.")
    If Value = "" Then
                                                                       Msg = Get_Language_Str("leer.") & ValidRangeTxt
    ElseIf Not IsNumeric(Value) Then
                                                                       Msg = Get_Language_Str("keine gültige Zahl.") & ValidRangeTxt
    ElseIf CStr(Round(Value, 0)) <> CStr(Value) Then
                                                                       Msg = Get_Language_Str("nicht Ganzzahlig.") & ValidRangeTxt
 
    ElseIf MinA(ParNr - 1) <> "" And Value < val(MinA(ParNr - 1)) Then
                                                                       Msg = Get_Language_Str("zu klein!" & vbCr & "Der Minimal zulässiger Wert ist: ") & MinA(ParNr - 1)
    ElseIf MaxA(ParNr - 1) <> "" And Value > val(MaxA(ParNr - 1)) Then
                                                                       Msg = Get_Language_Str("zu groß!" & vbCr & "Der Maximal zulässige Wert ist: ") & MaxA(ParNr - 1)
    End If
 
    If Msg <> "" Then
          Controls("Par" & ParNr).setFocus
          MsgBox Get_Language_Str("Der Parameter '") & Controls("LabelPar" & ParNr).Caption & Get_Language_Str("' ist ") & Msg, vbInformation, Get_Language_Str("Bereichsüberschreitung")
    Else: Check_Limit_to_MinMax = True
    End If
  'End With
End Function
 
'--------------------------------------------------------------------------------
Private Sub LimmitActivInput(ct As Control, MinVal As Integer, MaxVal As Integer)
'--------------------------------------------------------------------------------
  With ct
    If Not IsNumeric(.Value) Then
       While Len(.Value) > 0 And Not IsNumeric(.Value)
         .Value = DelLast(.Value)
       Wend
    Else
         If val(.Value) < MinVal Then .Value = MinVal
         If val(.Value) > MaxVal Then .Value = MaxVal
         If Round(.Value, 0) <> .Value Then .Value = Round(.Value, 0)
    End If
  End With
End Sub
 
'-----------------------------------------------------------
Private Function Check_Time_String(ParNr As Long) As Boolean
'-----------------------------------------------------------
  Dim ValidRangeTxt As String
  ValidRangeTxt = vbCr & Get_Language_Str("Bitte einen Zeit zwischen ") & MinA(ParNr - 1) & Get_Language_Str(" ms und ") & MaxA(ParNr - 1) & Get_Language_Str(" ms eingeben." & vbCr & _
                  "Die Zeitangabe kann auch eine der folgenden Einheit enthalten:" & vbCr & _
                  " Min, Sec, ms " & vbCr & _
                  "Achtung: Zwischen Zahl und Einheit muss ein Leerzeichen stehen." & vbCr & _
                  "Beispiel: 3 Sec") ' ToDo: Erlaubte Zeiten zusätzlich in Minuten Angeben
  Dim Parts As Variant
  With Controls("Par" & ParNr)
    Parts = Split(.Value, " ")
    Const ValidUnits = " Min Sek sek Sec sec Ms ms "
    Dim Err As Boolean
    Err = UBound(Parts) <> 1
    If Not Err Then Err = Not IsNumeric(Parts(0))
    If Not Err Then Err = InStr(ValidUnits, " " & Parts(1) & " ") = 0
    If Err Then
         MsgBox Get_Language_Str("Der Parameter '") & ParName(ParNr - 1) & Get_Language_Str("' ist ungültig") & ValidRangeTxt, vbInformation, Get_Language_Str("Ungültiger Parameter")
         Exit Function
    Else ' Two parameter detected. First is numeric, the second is a valid Unit
         Dim val As Double
         Select Case LCase(Parts(1))
           Case "min":             val = Parts(0) * 60 * 1000
           Case "sec", "sek": val = Parts(0) * 1000
           Case "ms":              val = Parts(0)
           Case Else:              MsgBox "Internal error: Unknown unit '" & Parts(1) & "' in Check_Time_String()", vbCritical, "Internal error"
                                   EndProg
         End Select
         If Check_Limit_to_MinMax(ParNr, val) = False Then Exit Function
    End If
  End With
  Check_Time_String = True
End Function
 
'------------------------------------------------------------------------------------------------
Private Function Check_RGB_List(TypStr As String, ByVal Value As String, ParNr As Long) As String
'------------------------------------------------------------------------------------------------
  Dim s As Variant, Err As Boolean, ExpCnt As Long
  If TypStr = "RGB" Then
        ExpCnt = 3
  Else: ExpCnt = 6
  End If
  
  If UBound(Split(Value, ",")) <> ExpCnt - 1 Then
     MsgBox Replace(Get_Language_Str("Fehler: Es müssen #1# Farbwerte zwischen 0 und 255 angegeben werden"), "#1#", ExpCnt), _
            vbCritical, Get_Language_Str("Anzahl der angegebenen Farbwerte ist falsch")
     Exit Function
  End If
  
  For Each s In Split(Value, ",")
      If Not IsNumeric(Trim(s)) Then Err = True
      If Not Err Then Err = val(s) < 0 Or val(s) > 255 Or InStr(Value, ".") > 0
      If Err Then
         MsgBox Replace(Get_Language_Str("Fehler der Parameter '#1#' ist ungültig." & vbCr & _
                "Die Farbwerte müssen im Bereich von 0 bis 255 liegen"), "#1#", Controls("LabelPar" & ParNr)), _
         vbCritical, Get_Language_Str("Ungültiger RGB Parameter")
         Exit Function
      End If
  Next s
  Check_RGB_List = Value
End Function
                      
 
'-------------------------------------------------------------------------------------
Private Function Check_Par_with_ErrMsg(ParNr As Long, ByRef val As Variant) As Boolean
'-------------------------------------------------------------------------------------
  If ParNr > MAX_PAR_CNT Then
     MsgBox "Internal error in Chek_Range()"
     EndProg
  End If
  Dim VarLabel As String, ShowErr As Boolean
  VarLabel = Controls("LabelPar" & ParNr)
  With Controls("Par" & ParNr)
    .Value = Trim(.Value)
    'Debug.Print "Check_Range " & ParName(ParNr - 1) & ": " & .Value
    Select Case TypA(ParNr - 1)
      Case "":        ' Normal Numeric parameter
                      If Check_Limit_to_MinMax(ParNr, .Value) = False Then Exit Function
      Case "Time":    ' time could have a tailing "Min", "Sek", "sek", "Sec", "sec", "Ms", "ms"
                      If IsNumeric(.Value) Then
                           .Value = Int(.Value)
                           If Check_Limit_to_MinMax(ParNr, .Value) = False Then Exit Function
                      Else ' The parameter is NOT numeric
                           If Check_Time_String(ParNr) = False Then Exit Function
                      End If
                      .Value = Replace(.Value, ",", ".") ' Replace the german comma
      Case "Var":     ' Check the variable name
                      ShowErr = (.Value = "")
                      If Not ShowErr Then
                         If Left(.Value, Len("#InCh")) <> "#InCh" Then _
                            ShowErr = Not Left(.Value, 1) Like "[_a-zA-Z]"
                      End If
                      If ShowErr Then
                         MsgBox Replace(Get_Language_Str("Fehler: Der Parameter '#1#' muss einen gültigen Variablennamen enthalten"), _
                                "#1#", VarLabel), vbCritical, Get_Language_Str("Ungültiger Variablenname")
                         .setFocus
                         Exit Function
                      End If
      Case "Txt":     ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "Mode":    ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "PinList": ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "PinNr":   ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "Logic":   ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "OutList": ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "InpVar":  ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "GVarNr":  ' No Check at the moment
                      Debug.Print "ToDo: Check parameter typ '" & TypA(ParNr - 1) & "'" ' ToDo
      Case "RGB", _
           "RGB2": '  Color lists
                      val = Check_RGB_List(TypA(ParNr - 1), Replace(Trim(Replace_Multi_Space(Replace(.Value, ",", " "))), " ", ", "), ParNr)
                      Check_Par_with_ErrMsg = (val <> "")
                      Exit Function
      Case "CmpMod":  ' Compare mode for the LED_to_Var function
                      If InStr(" " & L2V_COM_OPERATORS & " ", " " & .Value & " ") = 0 Then
                         MsgBox Replace(Replace(Get_Language_Str("Fehler: Der Parameter '#1#' muss eine der folgenden Vergleichsoperatoren enthalten:" & vbCr & _
                                "  #2#"), "#1#", VarLabel), "#2#", L2V_COM_OPERATORS), vbCritical, _
                                Get_Language_Str("Ungültiger Vergleichsoprerator")
                         Exit Function
                      End If
      Case "MB_LED":  ' Mainboard LED Number
                      If (IsNumeric(.Value) And (.Value < 0 Or .Value > 16)) Or _
                         (Not IsNumeric(.Value) And InStr(" " & MB_LED_NR_STR & " ", " " & .Value & " ") = 0) Then  ' 21.10.20: Jürgen added: (not IsNumeric(.Value) and
                         MsgBox Replace(Replace(Get_Language_Str("Fehler: Der Parameter '#1#' muss eine der folgenden Werte enthalten:" & vbCr & _
                                "  #2#"), "#1#", VarLabel), "#2#", "0 - 16, D2 - D5, D7 - D13, A0 - A5"), vbCritical, _
                                Get_Language_Str("Ungültige LED Bezeichnung")
                         Exit Function
                      End If
      Case Else:      MsgBox "Internal error: Unknown parameter Typ: '" & TypA(ParNr - 1) & "'", vbCritical, "Internal Error"
                      EndProg
    End Select
    val = .Value
  End With
  Check_Par_with_ErrMsg = True
End Function
 

'---------------------------------------
Private Sub LED_Channel_TextBox_Change()                                    ' 27.04.20:
'---------------------------------------
  LimmitActivInput LED_Channel_TextBox, 0, LED_CHANNELS - 1
End Sub
 
'------------------------------
Private Sub ScrollBar1_Change()
'------------------------------
' ToDo: Die Steuerung ist noch nicht gut
' - Slider Size anpassen
' - Die Description_TextBox sollte nicht editierbar sein
'
  'Debug.Print ScrollBar1.Value
  With Description_TextBox
    .setFocus
    'Debug.Print .LineCount & " " & .MaxLength & " " & .TextLength
    .SelStart = ScrollBar1.Value
  End With
  ScrollBar1.setFocus
End Sub
 
'-----------------------------------------------
Public Sub MouseWheel(ByVal lngRotation As Long)
'-----------------------------------------------
' Process the mouse wheel changes
  'Debug.Print "MouseWheel" & lngRotation ' Debug
  If lngRotation < 0 Then
        ScrollBar1 = Application.Min(ScrollBar1 + 100, ScrollBar1.Max)
  Else: ScrollBar1 = Application.Max(ScrollBar1 - 100, ScrollBar1.Min)
  End If
End Sub
 
'--------------------------------
Private Sub UserForm_Initialize()
'--------------------------------
  'Debug.Print vbCr & me.Name & ": UserForm_Initialize"
  Change_Language_in_Dialog Me                                              ' 20.02.20:
  Restore_Pos_or_Center_Form Me, OtherForm_Pos
  With UserForm_Other.ComboBox_LED_Channel                                   ' 09.03.21 Matthias ComboBox_LED_Channel
  .AddItem "0"
  .AddItem "1"
  .AddItem "2"
  .AddItem "3"
  .AddItem "4"
  .AddItem "5"
  .AddItem "6"
  .AddItem "7"
  End With
End Sub
 
'-----------------------------------------------------------------------------------------------------------
Private Function Get_RGB_from_OldParams(OldParams() As String, ByVal StartNr As Long, Cnt As Long) As String
'-----------------------------------------------------------------------------------------------------------
  Dim Nr As Long, Res As String
  For Nr = StartNr To StartNr + Cnt - 1
      Res = Res & Trim(OldParams(Nr)) & " "
  Next Nr
  Get_RGB_from_OldParams = Res
End Function
 

'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Public Sub Show_UserForm_Other(ByVal Par As String, ByVal Name As String, Description As String, LedChannels As Long, Show_LED_Channel As Boolean, LED_Channel As Long, Def_Channel As Long)  ' 27.04.20: Added: LED_Channel and Def_Channel
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  FuncName = Name
  'Const CNames = "Val0 Val1 Period Duration Timeout DstVar MinTime MaxTime Par1"
  If Description = "" Then
        Description_TextBox = Get_Language_Str("Noch keine Beschreibung zur Funktion '") & Name & Get_Language_Str("' vorhanden ;-(")
  Else: Description_TextBox = Description
  End If
  ScrollBar1.Max = Len(Description_TextBox)
  HookFormScroll Me, "Description_TextBox"   ' Initialize the mouse wheel scroll function
 
  Me.Caption = Get_Language_Str("Parametereingabe der '") & Name & Get_Language_Str("' Funktion")
 
  'Debug.Print                         ' Debug
  'Debug.Print Name & " (" & Par & ")" ' Debug
 
  '*** Hide all entrys in the dialog which are not needed ***
  ParList = Split(Par, ",")
 
  ' Hide CX selection if it's not used
  If Not Is_Contained_in_Array("Cx", ParList) And Not Is_Contained_in_Array("B_LED_Cx", ParList) Then
       Hide_and_Move_up Me, "LED_Kanal_Frame", "Par1"
  Else ' Prepare the Cx selection
       Select Case LedChannels
          #If 1 Then ' deactivated because then the other functions like "Const" can't use more than one LED.    17.04.20:
                     ' On the other hand it's o.K. if the PushButton function could use more than one LED,
                     ' => It's enabled again
          Case -1:  ' Funktions with a single LED like PushButton_w_LED_BL_0_2    ' 13.04.20:
                    OptionButton_All.Enabled = False ' can't access all LEDs
                    OptionButton_12.Enabled = False
                    OptionButton_23.Enabled = False
                    OptionButton_C1 = True  ' Default value                 ' 06.05.20:
          Case -2:  ' Funktions with two LED like Herz_BiRelais             ' 19.05.20:
                    OptionButton_All.Enabled = False ' can't access all LEDs
                    OptionButton_C1 = True  ' Default value
          #End If
          Case 2:   ' Functions with two single LEDs like the Andreaskreuz
                    OptionButton_All.Enabled = False ' can't access all LEDs
                    If OptionButton_All Then OptionButton_23 = True
       End Select
  End If
  
  
  Dim OldCmdLine As String, UseOldParams As Boolean, OldParams() As String
  OldCmdLine = Cells(ActiveCell.Row, Config__Col)
  If Len(OldCmdLine) > Len(Name) And Left(OldCmdLine, Len(Name) + 1) = Name & "(" Then   ' 18.04.20: Added +1 and "(" to prevent mix-up of MonoFlop2 <-> MonoFlop
     UseOldParams = True
     OldParams = Split(Trim(Replace(Mid(OldCmdLine, Len(Name) + 2), ")", "")), ",")
  End If
 

  ComboBox_LED_Channel.Visible = Show_LED_Channel                            '09.03.21 Matthias ComboBox_LED_Channel
  LED_Channel_Label.Visible = ComboBox_LED_Channel.Visible
  If Show_LED_Channel Then
     If UseOldParams Then
           ComboBox_LED_Channel = LED_Channel
     Else: ComboBox_LED_Channel = Def_Channel
     End If
  End If
 
  ' Add parameters
  Dim p As Variant, UsedParNr As Long, Nr As Long, UsedArgNr As Long
  For Each p In ParList
      p = Trim(p)
      'Debug.Print "UsedParNr " & UsedParNr
      If Left(p, 1) <> "#" And InStr(" Cx B_LED_Cx ", " " & p & " ") = 0 Then
         If UsedParNr >= MAX_PAR_CNT Then
            MsgBox "Internal error: The number of parameters is to large in Show_UserForm_Other()"
            EndProg
         End If
         Dim Typ As String, Min As String, Max As String, Def As String, Opt As String, InpTxt As String, Hint As String
         Get_Par_Data p, Typ, Min, Max, Def, Opt, InpTxt, Hint
         If UseOldParams Then
            Select Case Typ
                Case "RGB":  Def = Get_RGB_from_OldParams(OldParams, Nr, 3): Nr = Nr + 2
                Case "RGB2": Def = Get_RGB_from_OldParams(OldParams, Nr, 3) & "  " & Get_RGB_from_OldParams(OldParams, Nr + 3, 3): Nr = Nr + 5
                Case Else:   ' Fill in the old value
                             If Nr <= UBound(OldParams) Then Def = OldParams(Nr)  ' 20.05.20: Added if()... to prevent crash if the number of parameters habe been changed in a new version of the library  ' 07.06.20: Old "<" => "<="
            End Select
         End If
         Def = Trim(Def)
         TypA(UsedParNr) = Typ
         MinA(UsedParNr) = Min
         MaxA(UsedParNr) = Max
         ParName(UsedParNr) = p
         UsedParNr = UsedParNr + 1
         Me.Controls("Par" & UsedParNr) = Def
         If Opt <> "" Then                                                  ' 18.04.20:
            Dim o As Variant, Parts() As String
            For Each o In Split(Opt, " ")
                Parts = Split(o, "=")
                Select Case Parts(0)
                   Case "w":        Me.Controls("Par" & UsedParNr).Width = val(Parts(1))
                                    With Me.Controls("LabelPar" & UsedParNr)
                                      .Left = .Left + val(Parts(1)) - DEFAULT_PAR_WIDTH
                                    End With
                   Case "Inv":      ' Invert input                          ' 30.04.20: Added to invert the Skip0 parameter in the PushButton function
                                    Invers(UsedParNr - 1) = True            '           because its difficult to understand the negative logic of Skip0
                                    If Def = 0 Then                         '           But it's not used because Skip0 has been chanded to Use0 in the C code
                                          Def = 1
                                    Else: Def = 0
                                    End If
                                    Me.Controls("Par" & UsedParNr) = Def
                   Case "...", "…": ' Join all following parameters         ' 21.04.20:
                                    If UseOldParams Then
                                        Dim i As Long
                                        For i = UsedParNr + 1 To UBound(OldParams)
                                            Def = Def & ", " & Trim(OldParams(i))
                                        Next
                                        Me.Controls("Par" & UsedParNr) = Def
                                    End If
                   Case Else:       MsgBox "Internal Error: Unknown option '" & o & "' in parameter '" & InpTxt & "' in sheet '" & PAR_DESCR_SH & "'", vbCritical, "Internal Error"
                                    EndProg
                End Select
            Next o
         End If
         Me.Controls("LabelPar" & UsedParNr) = InpTxt
         Me.Controls("LabelPar" & UsedParNr).ControlTipText = Hint
         Me.Controls("Par" & UsedParNr).ControlTipText = Hint
      End If
      If (p = "Cx" Or p = "B_LED_Cx") And UseOldParams Then
         Set_OptionButton Trim(OldParams(Nr)), p = "B_LED_Cx"
      End If
      Nr = Nr + 1
  Next p
  'Debug.Print "UsedParNr=" & UsedParNr ' Debug
 
  Hide_and_Move_up Me, "Par" & UsedParNr + 1, "Abort_Button" ' Hide the not needed controlls
  
  Center_Form Me                                                            ' 18.01.20:
  Me.Show
End Sub
 
'------------------------------------------------
Private Function Get_OptionButton_Res() As String
'------------------------------------------------
  Dim val As String
  If OptionButton_All Then
                               val = "C_ALL"
  ElseIf OptionButton_C1 Then: val = "C1"
  ElseIf OptionButton_C2 Then: val = "C2"
  ElseIf OptionButton_C3 Then: val = "C3"
  ElseIf OptionButton_12 Then: val = "C12"
  ElseIf OptionButton_23 Then: val = "C23"
  Else: MsgBox Get_Language_Str("LED Auswahl Fehler"), vbCritical
  End If
  Get_OptionButton_Res = val
End Function
 
'------------------------------------------------------------------
Private Sub Set_OptionButton(val As String, Only_Single As Boolean)
'------------------------------------------------------------------
  Select Case val
    Case "C_ALL":
                  If Only_Single Then
                        OptionButton_C1 = True
                  Else: OptionButton_All = True
                  End If
    Case "C1":    OptionButton_C1 = True
    Case "C2":    OptionButton_C2 = True
    Case "C3":    OptionButton_C3 = True
    Case "C12":
                  If Only_Single Then
                        OptionButton_C1 = True
                  Else: OptionButton_12 = True
                  End If
    Case "C23":
                  If Only_Single Then
                        OptionButton_C2 = True
                  Else: OptionButton_23 = True
                  End If
    Case Else:    OptionButton_All = True
                  MsgBox Get_Language_Str("Fehler beim lesen der bestehenden Kanalbezeichnung '") & val & "'", vbCritical, Get_Language_Str("Unbekannte Kanalbezeichnung")
  End Select
End Sub
 
'-------------------------------------------------------------
Private Function Create_Result(ByRef Res As String) As Boolean
'-------------------------------------------------------------
' Return True if sucessfully checked all inputs
  Res = ""
  Dim p As Variant
  For Each p In ParList
      Dim val As Variant
      val = "Not Found"
      p = Trim(p)
      If Left(p, 1) = "#" Then
           val = p
      Else
           If p = "Cx" Or p = "B_LED_Cx" Then
                val = Get_OptionButton_Res()
           Else ' Not a standard parameter
                Dim Nr As Long
                For Nr = 1 To MAX_PAR_CNT
                    If ParName(Nr - 1) = p Then
                       If Check_Par_with_ErrMsg(Nr, val) = False Then
                          Controls("Par" & Nr).setFocus
                          Exit Function
                       End If
                       If Invers(Nr - 1) Then
                          If val = 0 Then
                                val = 1
                          Else: val = 0
                          End If
                       End If
                       Exit For
                    End If
                Next
           End If
      End If
     If val = "Not Found" Then MsgBox Get_Language_Str("Fehler der Parameter '") & p & Get_Language_Str("' wurde nicht gefunden"), vbCritical, Get_Language_Str("Programm Fehler")
      Res = Res & val & ", "
  Next p
  Res = FuncName & "(" & DelLast(Res, 2) & ")"
  
  If ComboBox_LED_Channel.Visible Then                                       ' 27.04.20:
     Res = Res & "$" & ComboBox_LED_Channel
  End If
  
  Create_Result = True
End Function
 

'-------------------------------
Private Sub Abort_Button_Click()
'-------------------------------
  UnhookFormScroll ' Deactivate the mouse wheel scroll function
  Userform_Res = ""
  Store_Pos Me, OtherForm_Pos
  
  Unload Me ' Don't keep the entered data. Importand because the positions of the controlls and the visibility have been changed
End Sub
 
'----------------------------
Private Sub OK_Button_Click()
'----------------------------
  If Create_Result(Userform_Res) Then
     UnhookFormScroll ' Deactivate the mouse wheel scroll function
     Store_Pos Me, OtherForm_Pos
 
     Unload Me ' Don't keep the entered data. Importand because the positions of the controlls and the visibility have been changed
  End If
End Sub
 

 

 

 
 

Der Code muss so nur in das UserForm_Other eingefügt werden. Dann funktioniert es mit dem LED Kanal. Ich habe die TextBox gelöscht und stattdessen eine ComboBox eingefügt. Du kannst das dann ja bei dir noch übernehmen, wenn du beim Led Kanal noch keine ComboBox hast.

[ubit]

Huhu,

meine Version ist hier:

https://ubit-rc.de/downloads/Prog_Generator_MobaLedLib.zip

Vielleicht etwas umständlich, aber scheint zu funktionieren.

Ciao, Udo

[Hardi]

Hallo Udo und Matthias,

ich finde es total klasse, dass Ihr Euch um die Verbesserung des Excel Programmes kümmert.

Vielen Dank.

Ich kann Euch gerne für das GitHub Repository freischalten. Schickt mir einfach mal per Mail Euren GitHub Namen, wenn ihr Euch angemeldet habt.
Wir müssen das aber irgendwie Koordinieren.

Parallel zu Euch arbeitet Jürgen auch noch an dem Programm. Das Bedeutet, dass man die Versionen irgendwie zusammenführen muss.

Am besten es Ändert immer nur einer. Mir ist es auch wichtig, dass die Änderungen im Programm Markiert werden (Datum und Name).

Zu den ComoBoxen:
Ich bin kein Freund der Maus. Darum sollte alles so weit wie möglich per Tastatur bedienbar sein. Mit „Tab“ ins nächste Feld springen, mit Alt + Buchstabe direkt zu einem Feld navigieren, und natürlich die direkte Eingabe eines Wertes (Ja, das geht bei mir auch nicht immer, aber man kann es ja mal wünschen).

Ich habe mir nicht angeschaut wie Ihr das gelöst habt (Ich muss noch 59 Mails bearbeiten und es ist schon wieder Morgen). Vielleicht geht das auch schon…

Hardi

[ubit]

Das war ja jetzt nur eine schneller Lösung. Mir war klar das keine Parallelen Arbeiten am Programmgenerator möglich sind.
Eine Erweiterung macht ja auch erst Sinn wenn die zusätzliche ATTiny-Software im GitHub ist.
Und das macht erst Sinn wenn sich hier ein paar Tester melden ob es funktioniert...

Ciao, Udo

[Railcar]

Hi Udo,

was soweit funktioniert (in Ermangelung eines programmierten ATTiny), wenn eine RGB LED angeschlossen ist, blitzt diese kurz in verschiedenen Farben auf, je nach eingegebenem Befehl.

Jetzt werde ich erstmal meinen Programmer zusammenlöten und dann mal mit nem ATTiny probieren.

Ulrich

[Railcar]

So, jetzt haben wirs,

der Programmer arbeitet zuverlässig, getestet mit einem "Servo-Tiny".

Nur wenn ich das Servo-Sound-Programm in den ATTiny laden will kommt folgende Fehlermeldung:



Irgendeine Idee?

Ulrich

[ubit]

Jo. Neue Version ist in der Mache. Falscher Ordner im Zip...

Ciao, Udo

[ubit]

So, neuer Versuch. Kleine Änderung: Das Soundmodul muss nun an "SERVO1" angeschlossen werden. Dafür kann man nun alle drei Servoanschlüsse nutzen und damit an eine Servoplatine 3 Soundmodule anschließen (Extrafunktion für Schwaben...). Man wählt dann das jeweils aktive Modul an welches man die Befehle senden möchte, kann aber natürlich in kurzer Folge nacheinander alle drei Module zum Klingen bringen. Wenn man nur SERVO3 bestückt hat muss man vorher halt einmal MP3_CHANGE_MODULE(LED, InCh, 3) aktivieren (und wieder abschalten, Monoflop? Taster?).

https://ubit-rc.de/downloads/SoundZIP.zip

Es ist sowohl eine angepasste Version des Patterngenerators (für die ATTiny-Programmierung) als auch eine "Vorschau" des Programmgenerators enthalten.

Ich hoffe ich habe diesmal die richtigen Dateien ins ZIP gepackt....

Ciao, Udo

P.S.: Das Entwickeln ist etwas mühsam, weil meine Arduino-IDE nicht in dem Verzeichnis schreiben darf wo der Patterngenerator das Programm sucht. Außerdem funktioniert mein ATTiny-Programmer sehr unzuverlässig. Da zieht sich Alles etwas in die Länge - sonst bin ich schneller Außerdem ist es wohl 10 Jahre her das ich das letzte Mal C/C++ programmiert habe VBA noch länger....

[Railcar]

Hi,

soweit oder besser so nah klappt es schon mal. Ich kann jetzt über das Servo Modul das TF16 Soundmodul ansprechen.

Nur stimmt die Zuordnung der einzelnen Befehle nicht .

MP3_SELECT_MODULE(#LED, #InCh, 2) ist z.B. der Befehl Play Previous. Irgendwas stimmt da noch nicht. Das direkt Ansprechen über PLAY geht garnicht.
Bisher geht nur PLAY NEXT und PLAY PREVIOUS.

Wo hast du die Umwandlung versteckt?

Ulrich

[ubit]

Die Befehle verstecken sich in MP3.h. In der Anleitung ist auch beschrieben wie man es direkt z.B. mit ConstRGB macht.

Am besten testet man mit dem MP3-Ordner. Lautstärke einstellen ist dann der nächste Test wenn man dem Modul (längere) Sounds entlocken kann. Wichtig ist halt auch immer dem Modul genug Zeit zu geben. Alleine die serielle Übertragung der Befehle dauert ca. 0,1 Sekunden. 10 Bytes mit 9600 Baud.

Ciao, Udo

P.S.: Es muss natürlich auch die normale Farbpalette gelten. Wenn die Werte global skaliert werden klappt es nicht.

[ubit]

Nachtrag:

Es scheint mittlerweile auch Soundmodul zu geben die bei der seriellen Kommunikation Probleme machen. Das könnte man testen indem man das Modul direkt mit einem Arduino anspricht:

https://www.az-delivery.de/en/blogs/azde...p3-player-modul

Die hier genutzte Bibliothek entspricht dem was 03.ServoSound an das Modul schickt. Wenn das klappt, aber an der MLL nicht, gibt es entweder Probleme mit der Messung der PWM-Signale durch den Arduino oder sonst läuft irgendwas falsch. Dafür gibt es eine Debug-Möglichkeit die ich morgen Mal beschreiben kann.

Ciao, Udo