Skip to main content

I need to have cascading DropListBox's for a menu that builds a string. For example if DropListBox1 has three plus options it will display DropListBox2 to DropListBox4 below it depending on selection. Each subsequent DropListBox will need to hide/reveal the appropriate DropListBox selection.  I'm unsure if this would best be done by having multiple sub DropListBox's and have them display or hide depending on previous menu selection like the bad example image or if I should propagate each DropListBox with an array.   Which would be more efficient?  I've been unsuccessful in both hiding / revealing and propagating with arrays.  The goal of the dialog box is to create a string that it sends to the terminal. I'm an end user, not a developer but I am putting in earnest effort to learn.

My current partially functional dialog looks like:

Bad Example:


#Attachmate
#MainframeAccess
#Extra!
#dialogbox
#Macro
#Extra!X-treme
#arrays

I need to have cascading DropListBox's for a menu that builds a string. For example if DropListBox1 has three plus options it will display DropListBox2 to DropListBox4 below it depending on selection. Each subsequent DropListBox will need to hide/reveal the appropriate DropListBox selection.  I'm unsure if this would best be done by having multiple sub DropListBox's and have them display or hide depending on previous menu selection like the bad example image or if I should propagate each DropListBox with an array.   Which would be more efficient?  I've been unsuccessful in both hiding / revealing and propagating with arrays.  The goal of the dialog box is to create a string that it sends to the terminal. I'm an end user, not a developer but I am putting in earnest effort to learn.

My current partially functional dialog looks like:

Bad Example:


#Attachmate
#MainframeAccess
#Extra!
#dialogbox
#Macro
#Extra!X-treme
#arrays

I've decided to go with a two dimensional array, but I'm stuck on how to propagate the DropDownList from an Array range. Selecting a single item like arr_G(5, 0) works fine, but how do i add the range of arr_G(0, 0) to arr_G(5, 0) to "DropListBoxCate"?

Sub Main
Dim arr_G(5, 93) As Variant ' 93 actual count on some subjects

arr_G(0, 0) = "Category 0"
  arr_G(0, 1) = "Subject 1"
  arr_G(0, 2) = "Subject 2"
  arr_G(0, 3) = "Subject 3"
arr_G(1, 0) = "Category 1"
  arr_G(1, 1) = "Subject 1"
  arr_G(1, 2) = "Subject 2"
  arr_G(1, 3) = "Subject 3"

arr_G(2, 0) = "Category 2"
  arr_G(2, 1) = "Subject 1"
  arr_G(2, 2) = "Subject 2"
  arr_G(2, 3) = "Subject 3"

arr_G(3, 0) = "Category 3"
  arr_G(3, 1) = "Subject 1"
  arr_G(3, 2) = "Subject 2"
  arr_G(3, 3) = "Subject 3"
arr_G(4, 0) = "Category 4"
  arr_G(4, 1) = "Subject 1"
  arr_G(4, 2) = "Subject 2"
  arr_G(4, 3) = "Subject 3"
arr_G(5, 0) = "Category 5"
  arr_G(5, 1) = "Subject 1"
  arr_G(5, 2) = "Subject 2"
  arr_G(5, 3) = "Subject 3"


Begin Dialog AddDialog 215, 74, "command"
DropListBox  35, 1, 103, 16, ""+chr$(9)+arr_G(0, 0)+chr$(9)+arr_G(1, 0)+chr$(9)+arr_G(2, 0)+chr$(9)+arr_G(3, 0)+chr$(9)+arr_G(4, 0)+chr$(9)+arr_G(5, 0), .DropListBoxCate
OkButton 148, 21, 50, 14
CancelButton 150, 2, 50, 14
Text 2, 4, 31, 13, "Category"
Text 2, 20, 25, 10, "Subject"
DropListBox 36, 20, 103, 16, arr_G(5, 1), .DropListBoxSubj
Text 3, 35, 19, 10, "Page"
DropListBox 36, 38, 103, 16, ""+chr$(9)+"1"+chr$(9)+"2"+chr$(9)+"3"+chr$(9)+"4"+chr$(9)+"5"+chr$(9)+"6"+chr$(9)+"7"+chr$(9)+"8"+chr$(9)+"9", .DropListBoxPage
End Dialog

dim dlg as AddDialog
ret% = Dialog(dlg)

End Sub


I've decided to go with a two dimensional array, but I'm stuck on how to propagate the DropDownList from an Array range. Selecting a single item like arr_G(5, 0) works fine, but how do i add the range of arr_G(0, 0) to arr_G(5, 0) to "DropListBoxCate"?

Sub Main
Dim arr_G(5, 93) As Variant ' 93 actual count on some subjects

arr_G(0, 0) = "Category 0"
  arr_G(0, 1) = "Subject 1"
  arr_G(0, 2) = "Subject 2"
  arr_G(0, 3) = "Subject 3"
arr_G(1, 0) = "Category 1"
  arr_G(1, 1) = "Subject 1"
  arr_G(1, 2) = "Subject 2"
  arr_G(1, 3) = "Subject 3"

arr_G(2, 0) = "Category 2"
  arr_G(2, 1) = "Subject 1"
  arr_G(2, 2) = "Subject 2"
  arr_G(2, 3) = "Subject 3"

arr_G(3, 0) = "Category 3"
  arr_G(3, 1) = "Subject 1"
  arr_G(3, 2) = "Subject 2"
  arr_G(3, 3) = "Subject 3"
arr_G(4, 0) = "Category 4"
  arr_G(4, 1) = "Subject 1"
  arr_G(4, 2) = "Subject 2"
  arr_G(4, 3) = "Subject 3"
arr_G(5, 0) = "Category 5"
  arr_G(5, 1) = "Subject 1"
  arr_G(5, 2) = "Subject 2"
  arr_G(5, 3) = "Subject 3"


Begin Dialog AddDialog 215, 74, "command"
DropListBox  35, 1, 103, 16, ""+chr$(9)+arr_G(0, 0)+chr$(9)+arr_G(1, 0)+chr$(9)+arr_G(2, 0)+chr$(9)+arr_G(3, 0)+chr$(9)+arr_G(4, 0)+chr$(9)+arr_G(5, 0), .DropListBoxCate
OkButton 148, 21, 50, 14
CancelButton 150, 2, 50, 14
Text 2, 4, 31, 13, "Category"
Text 2, 20, 25, 10, "Subject"
DropListBox 36, 20, 103, 16, arr_G(5, 1), .DropListBoxSubj
Text 3, 35, 19, 10, "Page"
DropListBox 36, 38, 103, 16, ""+chr$(9)+"1"+chr$(9)+"2"+chr$(9)+"3"+chr$(9)+"4"+chr$(9)+"5"+chr$(9)+"6"+chr$(9)+"7"+chr$(9)+"8"+chr$(9)+"9", .DropListBoxPage
End Dialog

dim dlg as AddDialog
ret% = Dialog(dlg)

End Sub

Hi David, 

I'm having a look.

In order to dynamically change the various options you have to create a Function to handle Dialog events.

In your Begin Dialog statement you append a    , .DialogHandler     after the TitleBar string.

e.g.
      Begin Dialog StringBuilder 374, 182, "My Dynamic Dialog", .DialogHandler

Then you create a function to handle the events.

e.g.
      Function DialogHandler(id$, action%, suppvalue&)

           Select Case action%
                      Case 1 'initialize dialog controls
                      Case 2 'button was pressed, radio, checkbox changed#
                      Case 3 'text or combo box changed
                      Case 4 'control focus changed
                      Case 5 'idle
           End Select
      End Function

So you initialise your Category drop down in Case 1, then when you select your Category in the first drop down this will trigger Case 2 (where you execute your code based on the value selected in Category drop down), selecting a value in the Subject list with also trigger Case 2 and you then populate your Page values based on the Subject selected in the Subject control.

I should have something by tomorrow. 

Note: This is really way beyond scope for the forum and really you should be turning towards our consultants. But given the lack of a sample on here I think we should go ahead and get one out there.

Tom


Hi David, 

I'm having a look.

In order to dynamically change the various options you have to create a Function to handle Dialog events.

In your Begin Dialog statement you append a    , .DialogHandler     after the TitleBar string.

e.g.
      Begin Dialog StringBuilder 374, 182, "My Dynamic Dialog", .DialogHandler

Then you create a function to handle the events.

e.g.
      Function DialogHandler(id$, action%, suppvalue&)

           Select Case action%
                      Case 1 'initialize dialog controls
                      Case 2 'button was pressed, radio, checkbox changed#
                      Case 3 'text or combo box changed
                      Case 4 'control focus changed
                      Case 5 'idle
           End Select
      End Function

So you initialise your Category drop down in Case 1, then when you select your Category in the first drop down this will trigger Case 2 (where you execute your code based on the value selected in Category drop down), selecting a value in the Subject list with also trigger Case 2 and you then populate your Page values based on the Subject selected in the Subject control.

I should have something by tomorrow. 

Note: This is really way beyond scope for the forum and really you should be turning towards our consultants. But given the lack of a sample on here I think we should go ahead and get one out there.

Tom

Tom,

  Thanks for pointing out that I'm posting these type of questions to the wrong forum. I'll redirect my questions to Stack Overflow if too far off focus for this group.  I was actually just about to delete my post because I found all the reference information I needed on the link https://portal.microfocus.com/s/article/KM000008384?language=en_US you provided me some time ago.  The manuals help some, but my limited scope of knowledge makes them difficult to use as reference, however the eb-samples files had the example named  DialogUpdates.ebm that gave me the pointers and syntax I needed to know.  I've restructured my code with what I learned from the sample and its working perfectly. Its a bit sloppy at the moment, but after I clean it up, I'll post in this discussion thread for any other end users overstepping their areas of responsibility like myself.   Each of the questions you have answered previously have helped point me in the right direction and bettered my understanding.

Thank You,

David 


Tom,

  Thanks for pointing out that I'm posting these type of questions to the wrong forum. I'll redirect my questions to Stack Overflow if too far off focus for this group.  I was actually just about to delete my post because I found all the reference information I needed on the link https://portal.microfocus.com/s/article/KM000008384?language=en_US you provided me some time ago.  The manuals help some, but my limited scope of knowledge makes them difficult to use as reference, however the eb-samples files had the example named  DialogUpdates.ebm that gave me the pointers and syntax I needed to know.  I've restructured my code with what I learned from the sample and its working perfectly. Its a bit sloppy at the moment, but after I clean it up, I'll post in this discussion thread for any other end users overstepping their areas of responsibility like myself.   Each of the questions you have answered previously have helped point me in the right direction and bettered my understanding.

Thank You,

David 

Hi David, 

It's refreshing to see that you pushed ahead and are willing to do the donkey work. Extra! Basic dialogs are not for the faint of heart (or perseverance). Handling the events is not trivial and hence to recommendation to use consulting services.
 
As for Stack Overflow, it is a great resource, I often use it when I'm trying to figure out how to use Win32API calls in both Extra! Basic and 64-bit VBA.

I had a play with this and this is what I came up with. I'm using an ini file to store the Category/Subject and Page info. My ini is located at c:\\temp\\StringBuilderIni.ini (set in the GetList function below)

My ini looks like this, where the [ListCat] stores a list of all the Categories (and is loaded at initialisation, with the default Category being the first in the list), [My Categories] stores info for each category listed in the [ListCat] section (and the subject associated with the first Category as loaded at initialisation) and finally there are individual Category section which list the number of pages associated with each Subject. 

    [ListCat]
    MyCategories=Category1, Category2, Category3, Category4

    [MyCategories]
    Category1=SubjectA,SubjectB,SubjectC
    Category2=SubjectB,SubjectC,SubjectD
    Category3= SubjectD, SubjectE
    Category4=SubjectV, SubjectW,SubjectX,SubjectY,SubjectZ

    [Category1]
    SubjectA=8
    SubjectB=2
    SubjectC=7

    [Category2]
    SubjectB=8
    SubjectC=14
    SubjectD=12

    [Category3]
    SubjectD=7
    SubjectE=4

    [Category4]
    SubjectV=13
    SubjectW=12
    SubjectX=10
    SubjectY=30
    SubjectZ=93

Then in Extra Basic I have the following code.

---------------------------------------------------------------------------------------------------------------------------------------

Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName as String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturenedString as String, ByVal nSize as Long, ByVal lpFileName as String) as Long

Declare Function DialogHandler(ID$, Action%, SuppVal&) as Integer
Declare Function GetList(Section as String, Key as String) as String

' NOTE it is very important to define the buffer size when
' calling a Winapi function, if you do not define it defaults
' to zero and then your Winapi call will not work. It will
' always return zero.

Const Buffer_size = 255
Const MySeperator = ","


Dim MyCategory() as String
Dim MySubject() as String
Dim MyPage() as String
Dim MyOptions() as String

Sub Main

Begin Dialog StringBuilder 374, 182, "My Dynamic Dialog", .DialogHandler
DropListBox 4, 6, 81, 16, "Category1", .Category
StaticComboBox 89, 6, 112, 153, "", .Subject
StaticComboBox 200, 6, 102, 154, "", .Page
PushButton 311, 4, 49, 17, "&Send String", .SendString
CancelButton 311, 26, 49, 17
End Dialog

Dim myStringBuilder as StringBuilder, ret as Integer
ret% = Dialog(myStringBuilder)

End Sub

Function DialogHandler(id$, action%, suppvalue&)

Dim myList as String, x as Integer, SeperatorLocation as Integer, MyPageCount as String, PageCount as Integer

select case action%
Case 1 'initialize dialog controls

MyList = GetList("ListCat", "MyCategories")
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve myCategory(0)
myCategory(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MyCategory(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
myCategory(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve myCategory(x)
myCategory(x) = LTrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Category"), myCategory
DlgValue DlgControlID("Category"),0
MyList = GetList("MyCategories", myCategory(DlgValue(DlgControlID("Category"))))
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve MySubject(0)
MySubject(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MySubject(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
MySubject(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve MySubject(x)
MySubject(x) = Ltrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Subject"), MySubject
DlgListBoxArray DlgControlID("Page"), myOptions

Case 2 'button was pressed, radio, checkbox changed

Select Case id$
Case "Category"
MyList = GetList("MyCategories", myCategory(DlgValue(DlgControlID("Category"))))
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve MySubject(0)
MySubject(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MySubject(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
MySubject(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve MySubject(x)
MySubject(x) = Ltrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Subject"), MySubject
DlgListBoxArray DlgControlID("Page"), myOptions

Case "Subject"
MyPageCount = GetList(myCategory(DlgValue(DlgControlID("Category"))), mySubject(DlgValue(DlgControlID("Subject"))))
PageCount = CInt(MyPageCount)
ReDim Preserve MyPage(PageCount-1)
For i = 0 to PageCount -1
MyPage(i)= i+1
Next i
DlgListBoxArray DlgControlID("Page"), MyPage

Case "SendString"
If DlgValue(DlgControlID("Category")) = -1 or DlgValue(DlgControlID("Subject")) = -1 or DlgValue(DlgControlID("Page")) = -1 then
DialogHandler = TRUE ' 'prevent MainDialog from closing
Else
Msgbox myCategory(DlgValue(DlgControlID("Category"))) & ":" & mySubject(DlgValue(DlgControlID("Subject"))) & ":" & myPage(DlgValue(DlgControlID("Page"))), 64, "My Selected bits"
DialogHandler = TRUE ' 'prevent MainDialog from closing
End If
Case Else


End Select

'Other cases are available to handle changes
'in textboxes or lists - see help for "begin dialog".
Case 3 'text or combo box changed
Case 4 'control focus changed
Case 5 'idle

End Select


End Function


Function GetList(Section as String, Key as String) as Variant

Dim x, nSize as long
Dim FileName as string, Nodename as string, MyList as String

x = -999

FileName = "c:\\temp\\StringBuilderIni.ini"
Dim Default as String
Default = "notFound"
Dim RetStr as String*Buffer_size

' Initialize the buffer so it will return more than zero
' bytes
'
nsize = Buffer_size

x = GetPrivateProfileString(Section, Key, Default, RetStr, nSize, FileName)
MyList = mid$(RetStr, 1, x)

GetList = MyList

End Function

---------------------------------------------------------------------------------------------------------------------------------------

It likely works in a similar fashion to what you now have, but it demo's how to avoid the multi-dimensional array and it enables one to change the Categories, Subjects and Pages without having to touch the macro.

Looking forward to seeing what you eventually end up with.

Tom


Hi David, 

It's refreshing to see that you pushed ahead and are willing to do the donkey work. Extra! Basic dialogs are not for the faint of heart (or perseverance). Handling the events is not trivial and hence to recommendation to use consulting services.
 
As for Stack Overflow, it is a great resource, I often use it when I'm trying to figure out how to use Win32API calls in both Extra! Basic and 64-bit VBA.

I had a play with this and this is what I came up with. I'm using an ini file to store the Category/Subject and Page info. My ini is located at c:\\temp\\StringBuilderIni.ini (set in the GetList function below)

My ini looks like this, where the [ListCat] stores a list of all the Categories (and is loaded at initialisation, with the default Category being the first in the list), [My Categories] stores info for each category listed in the [ListCat] section (and the subject associated with the first Category as loaded at initialisation) and finally there are individual Category section which list the number of pages associated with each Subject. 

    [ListCat]
    MyCategories=Category1, Category2, Category3, Category4

    [MyCategories]
    Category1=SubjectA,SubjectB,SubjectC
    Category2=SubjectB,SubjectC,SubjectD
    Category3= SubjectD, SubjectE
    Category4=SubjectV, SubjectW,SubjectX,SubjectY,SubjectZ

    [Category1]
    SubjectA=8
    SubjectB=2
    SubjectC=7

    [Category2]
    SubjectB=8
    SubjectC=14
    SubjectD=12

    [Category3]
    SubjectD=7
    SubjectE=4

    [Category4]
    SubjectV=13
    SubjectW=12
    SubjectX=10
    SubjectY=30
    SubjectZ=93

Then in Extra Basic I have the following code.

---------------------------------------------------------------------------------------------------------------------------------------

Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName as String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturenedString as String, ByVal nSize as Long, ByVal lpFileName as String) as Long

Declare Function DialogHandler(ID$, Action%, SuppVal&) as Integer
Declare Function GetList(Section as String, Key as String) as String

' NOTE it is very important to define the buffer size when
' calling a Winapi function, if you do not define it defaults
' to zero and then your Winapi call will not work. It will
' always return zero.

Const Buffer_size = 255
Const MySeperator = ","


Dim MyCategory() as String
Dim MySubject() as String
Dim MyPage() as String
Dim MyOptions() as String

Sub Main

Begin Dialog StringBuilder 374, 182, "My Dynamic Dialog", .DialogHandler
DropListBox 4, 6, 81, 16, "Category1", .Category
StaticComboBox 89, 6, 112, 153, "", .Subject
StaticComboBox 200, 6, 102, 154, "", .Page
PushButton 311, 4, 49, 17, "&Send String", .SendString
CancelButton 311, 26, 49, 17
End Dialog

Dim myStringBuilder as StringBuilder, ret as Integer
ret% = Dialog(myStringBuilder)

End Sub

Function DialogHandler(id$, action%, suppvalue&)

Dim myList as String, x as Integer, SeperatorLocation as Integer, MyPageCount as String, PageCount as Integer

select case action%
Case 1 'initialize dialog controls

MyList = GetList("ListCat", "MyCategories")
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve myCategory(0)
myCategory(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MyCategory(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
myCategory(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve myCategory(x)
myCategory(x) = LTrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Category"), myCategory
DlgValue DlgControlID("Category"),0
MyList = GetList("MyCategories", myCategory(DlgValue(DlgControlID("Category"))))
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve MySubject(0)
MySubject(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MySubject(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
MySubject(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve MySubject(x)
MySubject(x) = Ltrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Subject"), MySubject
DlgListBoxArray DlgControlID("Page"), myOptions

Case 2 'button was pressed, radio, checkbox changed

Select Case id$
Case "Category"
MyList = GetList("MyCategories", myCategory(DlgValue(DlgControlID("Category"))))
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve MySubject(0)
MySubject(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MySubject(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
MySubject(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve MySubject(x)
MySubject(x) = Ltrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Subject"), MySubject
DlgListBoxArray DlgControlID("Page"), myOptions

Case "Subject"
MyPageCount = GetList(myCategory(DlgValue(DlgControlID("Category"))), mySubject(DlgValue(DlgControlID("Subject"))))
PageCount = CInt(MyPageCount)
ReDim Preserve MyPage(PageCount-1)
For i = 0 to PageCount -1
MyPage(i)= i+1
Next i
DlgListBoxArray DlgControlID("Page"), MyPage

Case "SendString"
If DlgValue(DlgControlID("Category")) = -1 or DlgValue(DlgControlID("Subject")) = -1 or DlgValue(DlgControlID("Page")) = -1 then
DialogHandler = TRUE ' 'prevent MainDialog from closing
Else
Msgbox myCategory(DlgValue(DlgControlID("Category"))) & ":" & mySubject(DlgValue(DlgControlID("Subject"))) & ":" & myPage(DlgValue(DlgControlID("Page"))), 64, "My Selected bits"
DialogHandler = TRUE ' 'prevent MainDialog from closing
End If
Case Else


End Select

'Other cases are available to handle changes
'in textboxes or lists - see help for "begin dialog".
Case 3 'text or combo box changed
Case 4 'control focus changed
Case 5 'idle

End Select


End Function


Function GetList(Section as String, Key as String) as Variant

Dim x, nSize as long
Dim FileName as string, Nodename as string, MyList as String

x = -999

FileName = "c:\\temp\\StringBuilderIni.ini"
Dim Default as String
Default = "notFound"
Dim RetStr as String*Buffer_size

' Initialize the buffer so it will return more than zero
' bytes
'
nsize = Buffer_size

x = GetPrivateProfileString(Section, Key, Default, RetStr, nSize, FileName)
MyList = mid$(RetStr, 1, x)

GetList = MyList

End Function

---------------------------------------------------------------------------------------------------------------------------------------

It likely works in a similar fashion to what you now have, but it demo's how to avoid the multi-dimensional array and it enables one to change the Categories, Subjects and Pages without having to touch the macro.

Looking forward to seeing what you eventually end up with.

Tom

WOW, I'm floored by your response. I was hoping for a best case scenario to be nudged in the right direction, but you went way above the call of duty.   With the exception of an INI to provide the data, which I really like by the way.  My code is not exactly identical but surprisingly similar to yours. Not going to lie, seeing the similarities in the code makes me a little proud of myself. LOL.   I just recently moved from railroad electrician to railroad foreman on nights shift, so my time to code is typically five minutes here and there over days, but I'll put my solution up when I'm finished.  I'm working with my live data and need to scrub it to generic topics before posting.  Again, I can’t believe the breath of your response, that's definitely not what I was expecting.  I cant thank you enough.


Hi David, 

It's refreshing to see that you pushed ahead and are willing to do the donkey work. Extra! Basic dialogs are not for the faint of heart (or perseverance). Handling the events is not trivial and hence to recommendation to use consulting services.
 
As for Stack Overflow, it is a great resource, I often use it when I'm trying to figure out how to use Win32API calls in both Extra! Basic and 64-bit VBA.

I had a play with this and this is what I came up with. I'm using an ini file to store the Category/Subject and Page info. My ini is located at c:\\temp\\StringBuilderIni.ini (set in the GetList function below)

My ini looks like this, where the [ListCat] stores a list of all the Categories (and is loaded at initialisation, with the default Category being the first in the list), [My Categories] stores info for each category listed in the [ListCat] section (and the subject associated with the first Category as loaded at initialisation) and finally there are individual Category section which list the number of pages associated with each Subject. 

    [ListCat]
    MyCategories=Category1, Category2, Category3, Category4

    [MyCategories]
    Category1=SubjectA,SubjectB,SubjectC
    Category2=SubjectB,SubjectC,SubjectD
    Category3= SubjectD, SubjectE
    Category4=SubjectV, SubjectW,SubjectX,SubjectY,SubjectZ

    [Category1]
    SubjectA=8
    SubjectB=2
    SubjectC=7

    [Category2]
    SubjectB=8
    SubjectC=14
    SubjectD=12

    [Category3]
    SubjectD=7
    SubjectE=4

    [Category4]
    SubjectV=13
    SubjectW=12
    SubjectX=10
    SubjectY=30
    SubjectZ=93

Then in Extra Basic I have the following code.

---------------------------------------------------------------------------------------------------------------------------------------

Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName as String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturenedString as String, ByVal nSize as Long, ByVal lpFileName as String) as Long

Declare Function DialogHandler(ID$, Action%, SuppVal&) as Integer
Declare Function GetList(Section as String, Key as String) as String

' NOTE it is very important to define the buffer size when
' calling a Winapi function, if you do not define it defaults
' to zero and then your Winapi call will not work. It will
' always return zero.

Const Buffer_size = 255
Const MySeperator = ","


Dim MyCategory() as String
Dim MySubject() as String
Dim MyPage() as String
Dim MyOptions() as String

Sub Main

Begin Dialog StringBuilder 374, 182, "My Dynamic Dialog", .DialogHandler
DropListBox 4, 6, 81, 16, "Category1", .Category
StaticComboBox 89, 6, 112, 153, "", .Subject
StaticComboBox 200, 6, 102, 154, "", .Page
PushButton 311, 4, 49, 17, "&Send String", .SendString
CancelButton 311, 26, 49, 17
End Dialog

Dim myStringBuilder as StringBuilder, ret as Integer
ret% = Dialog(myStringBuilder)

End Sub

Function DialogHandler(id$, action%, suppvalue&)

Dim myList as String, x as Integer, SeperatorLocation as Integer, MyPageCount as String, PageCount as Integer

select case action%
Case 1 'initialize dialog controls

MyList = GetList("ListCat", "MyCategories")
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve myCategory(0)
myCategory(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MyCategory(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
myCategory(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve myCategory(x)
myCategory(x) = LTrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Category"), myCategory
DlgValue DlgControlID("Category"),0
MyList = GetList("MyCategories", myCategory(DlgValue(DlgControlID("Category"))))
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve MySubject(0)
MySubject(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MySubject(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
MySubject(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve MySubject(x)
MySubject(x) = Ltrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Subject"), MySubject
DlgListBoxArray DlgControlID("Page"), myOptions

Case 2 'button was pressed, radio, checkbox changed

Select Case id$
Case "Category"
MyList = GetList("MyCategories", myCategory(DlgValue(DlgControlID("Category"))))
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve MySubject(0)
MySubject(0) = Trim(MyList)
Else
Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve MySubject(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
MySubject(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve MySubject(x)
MySubject(x) = Ltrim(Right((MyList), Len(MyList)))
End If
DlgListBoxArray DlgControlID("Subject"), MySubject
DlgListBoxArray DlgControlID("Page"), myOptions

Case "Subject"
MyPageCount = GetList(myCategory(DlgValue(DlgControlID("Category"))), mySubject(DlgValue(DlgControlID("Subject"))))
PageCount = CInt(MyPageCount)
ReDim Preserve MyPage(PageCount-1)
For i = 0 to PageCount -1
MyPage(i)= i+1
Next i
DlgListBoxArray DlgControlID("Page"), MyPage

Case "SendString"
If DlgValue(DlgControlID("Category")) = -1 or DlgValue(DlgControlID("Subject")) = -1 or DlgValue(DlgControlID("Page")) = -1 then
DialogHandler = TRUE ' 'prevent MainDialog from closing
Else
Msgbox myCategory(DlgValue(DlgControlID("Category"))) & ":" & mySubject(DlgValue(DlgControlID("Subject"))) & ":" & myPage(DlgValue(DlgControlID("Page"))), 64, "My Selected bits"
DialogHandler = TRUE ' 'prevent MainDialog from closing
End If
Case Else


End Select

'Other cases are available to handle changes
'in textboxes or lists - see help for "begin dialog".
Case 3 'text or combo box changed
Case 4 'control focus changed
Case 5 'idle

End Select


End Function


Function GetList(Section as String, Key as String) as Variant

Dim x, nSize as long
Dim FileName as string, Nodename as string, MyList as String

x = -999

FileName = "c:\\temp\\StringBuilderIni.ini"
Dim Default as String
Default = "notFound"
Dim RetStr as String*Buffer_size

' Initialize the buffer so it will return more than zero
' bytes
'
nsize = Buffer_size

x = GetPrivateProfileString(Section, Key, Default, RetStr, nSize, FileName)
MyList = mid$(RetStr, 1, x)

GetList = MyList

End Function

---------------------------------------------------------------------------------------------------------------------------------------

It likely works in a similar fashion to what you now have, but it demo's how to avoid the multi-dimensional array and it enables one to change the Categories, Subjects and Pages without having to touch the macro.

Looking forward to seeing what you eventually end up with.

Tom

Tom,

      Sorry I've not been back to post my version of the code yet.  As a foreman and not a developer its often difficult to find time for coding at work. Today I committed time to my personal project on my day off and after finally getting to really play with the code find your code to be substantially more efficient. I've abandoned my array and I'm reworking my implementation around your much appreciated example. I have found one issue that I can’t seem to grasp. Using an array my DropListBox could handle the number of menu items I needed, but when reading from the INI file I'm limited to approximately 270 characters per line then it self-truncates.  I’ve worked around this by adding  “Category2 Part 1”, “Category2 Part 2”, etc. to subjects in the INI keeping each line under 270 characters which works. I’m just curious why it truncates the line when reading the INI file.

Example:

    [MyCategories]
    Category1=SubjectA,SubjectB,SubjectC (this line works)
    Category2=SubjectB,SubjectC,SubjectD, …(lots of items, in excess of 270 characters)…, SubjectGG (this line does not work)



Tom,

      Sorry I've not been back to post my version of the code yet.  As a foreman and not a developer its often difficult to find time for coding at work. Today I committed time to my personal project on my day off and after finally getting to really play with the code find your code to be substantially more efficient. I've abandoned my array and I'm reworking my implementation around your much appreciated example. I have found one issue that I can’t seem to grasp. Using an array my DropListBox could handle the number of menu items I needed, but when reading from the INI file I'm limited to approximately 270 characters per line then it self-truncates.  I’ve worked around this by adding  “Category2 Part 1”, “Category2 Part 2”, etc. to subjects in the INI keeping each line under 270 characters which works. I’m just curious why it truncates the line when reading the INI file.

Example:

    [MyCategories]
    Category1=SubjectA,SubjectB,SubjectC (this line works)
    Category2=SubjectB,SubjectC,SubjectD, …(lots of items, in excess of 270 characters)…, SubjectGG (this line does not work)


Hi David, 

Glad to see you are using your time off productively !!! :-)

you could try upping the Buffer-size

          Const Buffer_size = 255

however Kernel32's GetPrivateProfileString function does have a limit of the line length, I believe it's 255 bytes (for the Key=KeyValue combined length). So the max lenght of any line in the ini file is 255. Given that this is an MS Windows dll we have no control over it.

Note: At some point Microsoft may have have changed this to so that it's the KeyValue has a limit of 255 bytes, but there is still a limit. 

Splitting the KeyValue over two (or more) lines is one way to workaround this, or you could use an alternative method of reading the config file (e.g. using a FileSystemObject https://www.automateexcel.com/vba/read-text-file-line-by-line/) but that is likely a little less forgiving in terms of format (blank lines, sequence of sections etc) and you would need to read from the top, down to what you are looking for, every time you access the file fresh.

Cheers,
Tom


Hi David, 

Glad to see you are using your time off productively !!! :-)

you could try upping the Buffer-size

          Const Buffer_size = 255

however Kernel32's GetPrivateProfileString function does have a limit of the line length, I believe it's 255 bytes (for the Key=KeyValue combined length). So the max lenght of any line in the ini file is 255. Given that this is an MS Windows dll we have no control over it.

Note: At some point Microsoft may have have changed this to so that it's the KeyValue has a limit of 255 bytes, but there is still a limit. 

Splitting the KeyValue over two (or more) lines is one way to workaround this, or you could use an alternative method of reading the config file (e.g. using a FileSystemObject https://www.automateexcel.com/vba/read-text-file-line-by-line/) but that is likely a little less forgiving in terms of format (blank lines, sequence of sections etc) and you would need to read from the top, down to what you are looking for, every time you access the file fresh.

Cheers,
Tom

Tom,

 

     I was pleasantly surprised that windows accepted Buffer_size = 2048 without any hiccups.  The menu is working perfectly.  I'm still playing with the code on the link you suggested just for personal edification, but using your solution for my current project.  

My new menu and INI look like this and I'm reading over your code solution to repurpose it for this new menu format.

Begin Dialog StringBuilder 45, 24, 334, 174, .DialogHandler_Menu2
     DropComboBox 75, 3, 258, 17, "FacilityCategory", .FacilityCategory
     DropComboBox 75, 23, 258, 17, "FacilitySubject", .FacilitySubject
     DropComboBox 74, 42, 258, 17, "InspectionType", .InspectionType
     DropComboBox 73, 60, 258, 17, "Condition", .Condition
     DropComboBox 74, 82, 258, 17, "EquipmentCategory", .EquipmentCategory
     DropComboBox 74, 103, 258, 17, "EquipmentSubject", .EquipmentSubject
     TextBox 4, 149, 63, 17, .TextBoxStartDate
     TextBox 76, 149, 63, 17, .TextBoxEndDate
     PushButton 277, 132, 49, 17, "&Send String", .SendString
     Text 7, 135, 69, 11, "Start date (ex: 1Aug)"
     Text 80, 135, 62, 11, "End date"
     Text 7, 123, 91, 9, "Enter date range for report"
     Text 9, 8, 66, 8, "Facility Group Type"
     Text 9, 27, 66, 8, "Location(s)"
     Text 9, 46, 66, 8, "Report Type"
     Text 9, 65, 66, 8, "Condition"
     Text 8, 82, 66, 8, "Equipment Type"
     Text 8, 104, 66, 8, "Equipment"
     CancelButton 277, 150, 49, 17
End Dialog

[ListFacilityType]
Facility=Facility Singular,Facility Group

[Facility]
Facility Singular=MF1 - Maintenance Facility1,MF2 - Maintenance Facility2,MF3 - Maintenance Facility3,MF3 - Maintenance Facility3,MF4 - Maintenance Facility4
Facility Group=GP1 - Goup1,GP2 - Goup2

[Facility Singular]
MF1 - Maintenance Facility1
MF2 - Maintenance Facility2
MF3 - Maintenance Facility3
MF3 - Maintenance Facility3
MF4 - Maintenance Facility4

[Facility Group]
GP1 - Goup1
GP2 - Goup2

[ListEquipmentType]
Equipment=Specific Equipment, Equipment Group

[Equipment]
Specific Equipment= EQ1 - Equipment1,EQ2 - Equipment2,EQ3 - Equipment3,EQ4 - Equipment4
Equipment Group= EG1 - Group1,EG2 - Group2

[Specific Equipment]
EQ1 - Equipment1
EQ2 - Equipment2
EQ3 - Equipment3
EQ4 - Equipment4

[Equipment Group]
EG1 - Group1
EG2 - Group2

[ReportType]
RP1 - Report type1
RP2 - Report type2
RP3 - Report type3
RP4 - Report type4

[Conditions]
ZZZ -Condition1
RRR -Condition2
XXX -Condition3
YYY -Condition4
SSS -Condition5
MMM -Condition6
BBB -Condition7
DDD -Condition8

Hi David, 

Glad to see you are using your time off productively !!! :-)

you could try upping the Buffer-size

          Const Buffer_size = 255

however Kernel32's GetPrivateProfileString function does have a limit of the line length, I believe it's 255 bytes (for the Key=KeyValue combined length). So the max lenght of any line in the ini file is 255. Given that this is an MS Windows dll we have no control over it.

Note: At some point Microsoft may have have changed this to so that it's the KeyValue has a limit of 255 bytes, but there is still a limit. 

Splitting the KeyValue over two (or more) lines is one way to workaround this, or you could use an alternative method of reading the config file (e.g. using a FileSystemObject https://www.automateexcel.com/vba/read-text-file-line-by-line/) but that is likely a little less forgiving in terms of format (blank lines, sequence of sections etc) and you would need to read from the top, down to what you are looking for, every time you access the file fresh.

Cheers,
Tom

This is not the most eloquent or refined code, but this is the solution I came up with using your code examples. I'm sure I can reduce the amount of repetitive code, just not solved how to do that yet. lol.  

Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName as String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturenedString as String, ByVal nSize as Long, ByVal lpFileName as String) as Long

Declare Function DialogHandler_PM(ID$, Action%, SuppVal&) as Integer
Declare Function DialogHandler_G(ID$, Action%, SuppVal&) as Integer
Declare Function GetList(Section as String, Key as String) as String
Declare Sub G()
Declare Sub PM()

Const Buffer_size = 2048
Const MySeperator = ","


Dim FacilityType() as String
Dim Facility() as String
Dim EquipType() as String
Dim Equip() as String
Dim InspType() as String
Dim ConditionCodeType() as String
Dim ConditionCode() as String
Dim PassArray() as String
Dim MyCategory() as String
Dim MySubject() as String
Dim MyPage() as String


Sub Main
'test each sub
call PM
Call G
end sub


Sub PM()
Begin Dialog StringBuilder 354, 167, "PM Reports", .DialogHandler_PM
DropListBox 85, 9, 260, 16, "", .FacilityType
DropComboBox 85, 24, 260, 16, "", .Facility
DropListBox 85, 39, 260, 16, "", .EquipmentType
DropComboBox 85, 55, 260, 16, "", .Equipment
PushButton 287, 123, 49, 17, "&Send String", .SendString
CancelButton 287, 143, 49, 17
Text 9, 10, 58, 8, "Facility Category"
Text 9, 25, 58, 8, "Location(s)"
Text 9, 39, 66, 8, "Equipment Category"
Text 9, 57, 58, 8, "Equipment"
Text 9, 71, 58, 8, "Inspection Type"
Text 9, 87, 58, 8, "Condition Type"
DropListBox 85, 70, 260, 16, "", .InspTypes
DropListBox 85, 86, 260, 16, "", .ConditionType
Text 9, 102, 58, 8, "Condition Code"
DropComboBox 85, 101, 260, 16, "", .ConditionCode
Text 9, 117, 70, 10, "Start Date (Optional)"
Text 9, 134, 67, 9, "End Date (Optional)"
TextBox 85, 116, 86, 13, .StartD
TextBox 85, 133, 86, 13, .EndD
End Dialog


Dim myStringBuilder as StringBuilder, ret as Integer
ret% = Dialog(myStringBuilder)
End Sub

Sub G()
CNOC:
Begin Dialog StringBuilder 195, 58, "G/ Menu", .DialogHandler_G
DropComboBox 6, 4, 123, 16, "Category1", .Category
DropComboBox 6, 20, 123, 16, "", .Subject
DropComboBox 6, 35, 123, 16, "", .Page
PushButton 140, 5, 49, 17, "&Send String", .SendString
CancelButton 140, 25, 49, 17
End Dialog


Dim myStringBuilder as StringBuilder, ret as Integer
ret% = Dialog(myStringBuilder)



End sub

Function processArr(MyList As Variant) As String
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve PassArray(0)
PassArray(0) = Trim(MyList)
Else

Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve PassArray(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
PassArray(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve PassArray(x)
PassArray(x) = LTrim(Right((MyList), Len(MyList)))
End If
End Function

Function DialogHandler_G(id$, action%, suppvalue&)
Dim myList as String, x as Integer, c as Integer, SeperatorLocation as Integer

select case action%
Case 1 'initialize dialog controls

' Get G Category
processArr(GetList("ListCat", "MyCategories"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve MyCategory(c)
MyCategory(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Category"), MyCategory
DlgValue DlgControlID("Category"),0


' Get G Subject
processArr(GetList("MyCategories", MyCategory(DlgValue(DlgControlID("Category")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve MySubject(c)
MySubject(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Subject"), MySubject

for c = 1 to 40
ReDim Preserve MyPage(c)
MyPage(c) = str(c)
Next c

DlgListBoxArray DlgControlID("Page"), MyPage


Case 2 'button was pressed, radio, checkbox changed

Select Case id$
Case "Category"
processArr(GetList("MyCategories", MyCategory(DlgValue(DlgControlID("Category")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve MySubject(c)
MySubject(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Subject"), MySubject

Case "SendString"
If DlgValue(DlgControlID("Category")) = -1 then
DialogHandler_G = TRUE ' 'prevent MainDialog from closing

Else
msgbox str(Left(myCategory(DlgValue(DlgControlID("Category"))), 3) & " " & Left(mySubject(DlgValue(DlgControlID("Subject"))), 3) & " " & myPage(DlgValue(DlgControlID("Page"))))


End If

case else

End Select

'Other cases are available to handle changes
'in textboxes or lists - see help for "begin dialog".
Case 3 'text or combo box changed
Case 4 'control focus changed
Case 5 'idle

End Select
End Function

Function DialogHandler_PM(id$, action%, suppvalue&)
Dim myList as String, x as Integer, c as Integer, SeperatorLocation as Integer

select case action%
Case 1 'initialize dialog controls


' Get Facility Code Type
processArr(GetList("ListFacilityType", "Facility"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve FacilityType(c)
FacilityType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("FacilityType"), FacilityType
DlgValue DlgControlID("FacilityType"),0

' Get Facility Code
processArr(GetList("Facility", FacilityType(DlgValue(DlgControlID("FacilityType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Facility(c)
Facility(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Facility"), Facility

' Get Equipment Code Type
processArr(GetList("ListEquipmentType", "Equipment"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve EquipType(c)
EquipType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("EquipmentType"), EquipType
DlgValue DlgControlID("EquipmentType"),0

' Get Equipment Code
processArr(GetList("Equipment", EquipType(DlgValue(DlgControlID("EquipmentType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Equip(c)
Equip(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Equipment"), Equip


' Get Condition Code Type
processArr(GetList("ConditionCodeType", "ConditionType"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve ConditionCodeType(c)
ConditionCodeType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("ConditionType"), ConditionCodeType
DlgValue DlgControlID("ConditionType"),0

' Get Condition Code
processArr(GetList("ConditionType", EquipType(DlgValue(DlgControlID("ConditionType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve ConditionCode(c)
ConditionCode(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("ConditionCode"), ConditionCode


' Get Report Type
processArr(GetList("ReportType", "Reports"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve InspType(c)
InspType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("InspTypes"), InspType
DlgValue DlgControlID("InspTypes"),0



Case 2 'button was pressed, radio, checkbox changed

Select Case id$
Case "FacilityType"
processArr(GetList("Facility", FacilityType(DlgValue(DlgControlID("FacilityType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Facility(c)
Facility(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Facility"), Facility

Case "EquipmentType"
processArr(GetList("Equipment", EquipType(DlgValue(DlgControlID("EquipmentType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Equip(c)
Equip(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Equipment"), Equip

Case "ConditionType"
processArr(GetList("ConditionType", EquipType(DlgValue(DlgControlID("ConditionType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve ConditionCode(c)
ConditionCode(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("ConditionCode"), ConditionCode



Case "SendString"
If DlgValue(DlgControlID("FacilityType")) = -1 or DlgValue(DlgControlID("Facility")) = -1 then
DialogHandler = TRUE ' 'prevent MainDialog from closing
Else
Msgbox Facility(DlgValue(DlgControlID("Facility"))) & " / " & Equip(DlgValue(DlgControlID("Equipment"))) & " / " & ConditionCode(DlgValue(DlgControlID("ConditionCode"))) & " / " & InspType(DlgValue(DlgControlID("InspTypes")))

' DialogHandler = TRUE ' 'prevent MainDialog from closing
End If
Case Else

End Select

'Other cases are available to handle changes
'in textboxes or lists - see help for "begin dialog".
Case 3 'text or combo box changed
Case 4 'control focus changed
Case 5 'idle

End Select


End Function


Function GetList(Section as String, Key as String) as Variant

Dim x, nSize as long
Dim FileName as string, Nodename as string, MyList as String

x = -999

FileName = "C:\\Users\\00818065\\OneDrive - Amtrak\\Documents\\IT Resources\\Macros\\Arrow\\Notes\\NewMenu\\StringBuilder.ini"
Dim Default as String
Default = "notFound"
Dim RetStr as String*Buffer_size

' Initialize the buffer so it will return more than zero
' bytes
'
nsize = Buffer_size

x = GetPrivateProfileString(Section, Key, Default, RetStr, nSize, FileName)
MyList = mid$(RetStr, 1, x)

GetList = MyList

End Function

This is not the most eloquent or refined code, but this is the solution I came up with using your code examples. I'm sure I can reduce the amount of repetitive code, just not solved how to do that yet. lol.  

Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName as String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturenedString as String, ByVal nSize as Long, ByVal lpFileName as String) as Long

Declare Function DialogHandler_PM(ID$, Action%, SuppVal&) as Integer
Declare Function DialogHandler_G(ID$, Action%, SuppVal&) as Integer
Declare Function GetList(Section as String, Key as String) as String
Declare Sub G()
Declare Sub PM()

Const Buffer_size = 2048
Const MySeperator = ","


Dim FacilityType() as String
Dim Facility() as String
Dim EquipType() as String
Dim Equip() as String
Dim InspType() as String
Dim ConditionCodeType() as String
Dim ConditionCode() as String
Dim PassArray() as String
Dim MyCategory() as String
Dim MySubject() as String
Dim MyPage() as String


Sub Main
'test each sub
call PM
Call G
end sub


Sub PM()
Begin Dialog StringBuilder 354, 167, "PM Reports", .DialogHandler_PM
DropListBox 85, 9, 260, 16, "", .FacilityType
DropComboBox 85, 24, 260, 16, "", .Facility
DropListBox 85, 39, 260, 16, "", .EquipmentType
DropComboBox 85, 55, 260, 16, "", .Equipment
PushButton 287, 123, 49, 17, "&Send String", .SendString
CancelButton 287, 143, 49, 17
Text 9, 10, 58, 8, "Facility Category"
Text 9, 25, 58, 8, "Location(s)"
Text 9, 39, 66, 8, "Equipment Category"
Text 9, 57, 58, 8, "Equipment"
Text 9, 71, 58, 8, "Inspection Type"
Text 9, 87, 58, 8, "Condition Type"
DropListBox 85, 70, 260, 16, "", .InspTypes
DropListBox 85, 86, 260, 16, "", .ConditionType
Text 9, 102, 58, 8, "Condition Code"
DropComboBox 85, 101, 260, 16, "", .ConditionCode
Text 9, 117, 70, 10, "Start Date (Optional)"
Text 9, 134, 67, 9, "End Date (Optional)"
TextBox 85, 116, 86, 13, .StartD
TextBox 85, 133, 86, 13, .EndD
End Dialog


Dim myStringBuilder as StringBuilder, ret as Integer
ret% = Dialog(myStringBuilder)
End Sub

Sub G()
CNOC:
Begin Dialog StringBuilder 195, 58, "G/ Menu", .DialogHandler_G
DropComboBox 6, 4, 123, 16, "Category1", .Category
DropComboBox 6, 20, 123, 16, "", .Subject
DropComboBox 6, 35, 123, 16, "", .Page
PushButton 140, 5, 49, 17, "&Send String", .SendString
CancelButton 140, 25, 49, 17
End Dialog


Dim myStringBuilder as StringBuilder, ret as Integer
ret% = Dialog(myStringBuilder)



End sub

Function processArr(MyList As Variant) As String
x=0
If InStr(1, MyList, MySeperator) = 0 then
ReDim Preserve PassArray(0)
PassArray(0) = Trim(MyList)
Else

Do While InStr(1, MyList, MySeperator) > 1
myList = LTrim(MyList)
ReDim Preserve PassArray(x)
SeperatorLocation = InStr(1, MyList, MySeperator)
PassArray(x)=Left(MyList, SeperatorLocation-1)
MyList = Right(MyList, Len(MyList)-SeperatorLocation)
x=x+1
Loop
ReDim Preserve PassArray(x)
PassArray(x) = LTrim(Right((MyList), Len(MyList)))
End If
End Function

Function DialogHandler_G(id$, action%, suppvalue&)
Dim myList as String, x as Integer, c as Integer, SeperatorLocation as Integer

select case action%
Case 1 'initialize dialog controls

' Get G Category
processArr(GetList("ListCat", "MyCategories"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve MyCategory(c)
MyCategory(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Category"), MyCategory
DlgValue DlgControlID("Category"),0


' Get G Subject
processArr(GetList("MyCategories", MyCategory(DlgValue(DlgControlID("Category")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve MySubject(c)
MySubject(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Subject"), MySubject

for c = 1 to 40
ReDim Preserve MyPage(c)
MyPage(c) = str(c)
Next c

DlgListBoxArray DlgControlID("Page"), MyPage


Case 2 'button was pressed, radio, checkbox changed

Select Case id$
Case "Category"
processArr(GetList("MyCategories", MyCategory(DlgValue(DlgControlID("Category")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve MySubject(c)
MySubject(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Subject"), MySubject

Case "SendString"
If DlgValue(DlgControlID("Category")) = -1 then
DialogHandler_G = TRUE ' 'prevent MainDialog from closing

Else
msgbox str(Left(myCategory(DlgValue(DlgControlID("Category"))), 3) & " " & Left(mySubject(DlgValue(DlgControlID("Subject"))), 3) & " " & myPage(DlgValue(DlgControlID("Page"))))


End If

case else

End Select

'Other cases are available to handle changes
'in textboxes or lists - see help for "begin dialog".
Case 3 'text or combo box changed
Case 4 'control focus changed
Case 5 'idle

End Select
End Function

Function DialogHandler_PM(id$, action%, suppvalue&)
Dim myList as String, x as Integer, c as Integer, SeperatorLocation as Integer

select case action%
Case 1 'initialize dialog controls


' Get Facility Code Type
processArr(GetList("ListFacilityType", "Facility"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve FacilityType(c)
FacilityType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("FacilityType"), FacilityType
DlgValue DlgControlID("FacilityType"),0

' Get Facility Code
processArr(GetList("Facility", FacilityType(DlgValue(DlgControlID("FacilityType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Facility(c)
Facility(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Facility"), Facility

' Get Equipment Code Type
processArr(GetList("ListEquipmentType", "Equipment"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve EquipType(c)
EquipType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("EquipmentType"), EquipType
DlgValue DlgControlID("EquipmentType"),0

' Get Equipment Code
processArr(GetList("Equipment", EquipType(DlgValue(DlgControlID("EquipmentType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Equip(c)
Equip(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Equipment"), Equip


' Get Condition Code Type
processArr(GetList("ConditionCodeType", "ConditionType"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve ConditionCodeType(c)
ConditionCodeType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("ConditionType"), ConditionCodeType
DlgValue DlgControlID("ConditionType"),0

' Get Condition Code
processArr(GetList("ConditionType", EquipType(DlgValue(DlgControlID("ConditionType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve ConditionCode(c)
ConditionCode(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("ConditionCode"), ConditionCode


' Get Report Type
processArr(GetList("ReportType", "Reports"))
for c = 0 to UBOUND(PassArray)
ReDim Preserve InspType(c)
InspType(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("InspTypes"), InspType
DlgValue DlgControlID("InspTypes"),0



Case 2 'button was pressed, radio, checkbox changed

Select Case id$
Case "FacilityType"
processArr(GetList("Facility", FacilityType(DlgValue(DlgControlID("FacilityType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Facility(c)
Facility(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Facility"), Facility

Case "EquipmentType"
processArr(GetList("Equipment", EquipType(DlgValue(DlgControlID("EquipmentType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve Equip(c)
Equip(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("Equipment"), Equip

Case "ConditionType"
processArr(GetList("ConditionType", EquipType(DlgValue(DlgControlID("ConditionType")))))
for c = 0 to UBOUND(PassArray)
ReDim Preserve ConditionCode(c)
ConditionCode(c) = PassArray(c)
Next c
DlgListBoxArray DlgControlID("ConditionCode"), ConditionCode



Case "SendString"
If DlgValue(DlgControlID("FacilityType")) = -1 or DlgValue(DlgControlID("Facility")) = -1 then
DialogHandler = TRUE ' 'prevent MainDialog from closing
Else
Msgbox Facility(DlgValue(DlgControlID("Facility"))) & " / " & Equip(DlgValue(DlgControlID("Equipment"))) & " / " & ConditionCode(DlgValue(DlgControlID("ConditionCode"))) & " / " & InspType(DlgValue(DlgControlID("InspTypes")))

' DialogHandler = TRUE ' 'prevent MainDialog from closing
End If
Case Else

End Select

'Other cases are available to handle changes
'in textboxes or lists - see help for "begin dialog".
Case 3 'text or combo box changed
Case 4 'control focus changed
Case 5 'idle

End Select


End Function


Function GetList(Section as String, Key as String) as Variant

Dim x, nSize as long
Dim FileName as string, Nodename as string, MyList as String

x = -999

FileName = "C:\\Users\\00818065\\OneDrive - Amtrak\\Documents\\IT Resources\\Macros\\Arrow\\Notes\\NewMenu\\StringBuilder.ini"
Dim Default as String
Default = "notFound"
Dim RetStr as String*Buffer_size

' Initialize the buffer so it will return more than zero
' bytes
'
nsize = Buffer_size

x = GetPrivateProfileString(Section, Key, Default, RetStr, nSize, FileName)
MyList = mid$(RetStr, 1, x)

GetList = MyList

End Function

Hi David, 

your code looks fine good to me, I'm certain you could shrink it down more but if it does what you need, then........ 

Sometimes more code is good, in that it allows one to follow the logical process flow easier, which in turn helps to find the root of a problem faster if something goes south.

In general my guidance is "if it works and is reliable, don't fix it". Moving some repetitive code into a subroutine won't improve the execution performance. Now there was a limit in the Extra! Basic compiler of 64K, I can't remember if that was ever increased, but unless you start to run into compilation problems or you have plans to add lots more logic to the macro, then I vote save it, make 10 back-up copies, deploy it and take a long well deserved vacation !!!

Tom


Hi David, 

your code looks fine good to me, I'm certain you could shrink it down more but if it does what you need, then........ 

Sometimes more code is good, in that it allows one to follow the logical process flow easier, which in turn helps to find the root of a problem faster if something goes south.

In general my guidance is "if it works and is reliable, don't fix it". Moving some repetitive code into a subroutine won't improve the execution performance. Now there was a limit in the Extra! Basic compiler of 64K, I can't remember if that was ever increased, but unless you start to run into compilation problems or you have plans to add lots more logic to the macro, then I vote save it, make 10 back-up copies, deploy it and take a long well deserved vacation !!!

Tom

Tom,

   Thanks for the encouragement.  Oddly I find it easier to follow, read and troubleshoot when it’s object oriented.  My mind gets bogged down reading long repetitive code. The dialogs you helped me with are far from the entire Macro.  I’m at a little over 3k lines of code now and haven’t had any compile errors.  I’ve still got a long way to go for completion.  I’m working with a legacy system that has an extensive command set and horrific syntax, so while the system is indispensable and highly efficient, very few can actually take advantage of it.  Im writing the GUI interface to make the system useable for the “illiterate”. Lol.  I’d have done it as an independent application which I feel would have been easier, but as an end user (not a company developer) I’m not authorized to do that which is why I’m making a bloated macro.   Considering the group I’m making it for, there will have to be lots of form validation and logic that references existing data to know what’s needed in the syntax of some commands.  As I learn new tricks, I end up rewriting whole sections of code which improves performance and reduces the macro size.  There are still a number of items i’m stuck on but have been actively reading and googling to solve, but I’m coming to my frustration point on a couple issues and may have to post another question to be pointed in the right direction.  

David