This discussion has been locked.
You can no longer post new replies to this discussion. If you have a question you can start a new discussion

Extra! Basic Dialog box manipulation

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:

Labels:

Mainframe Access
Parents
  • 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

  • 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 

  • Verified Answer

    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.

  • 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

  • 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
  • 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

Reply
  • 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

Children
  • 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