DropDown List Box example

Free to use and change to meet your needs.

Hope this helps someone.

Dim PCDDmisApp As Object
    Dim PCDDmisPart As Object
    Dim PCDDmisCommands As Object
    Dim PCDDmisCommand As Object

Sub Main ()
    Set PCDDmisApp = CreateObject("PCDLRN.Application")
    Set PCDDmisPart = PCDDmisApp.ActivePartProgram
    Set PCDDmisCommands = PCDDmisPart.Commands

    Dim Command As Object
'    create a list of part numbers For the drop down list

        Dim MyList$(8)
        MyList(0) = "12345"
        MyList(1) = "12346"
        MyList(2) = "12347"
        MyList(3) = "12348"
        MyList(4) = "12349"
        MyList(5) = "22345"
        MyList(6) = "22346"
        MyList(7) = "22347"
        MyList(8) = "22348"
        
        Begin Dialog DialogName1 200,184, "Part Number Selection Dialog Box"
            Text 10,10,88,22, "Select a Part  Number:"
            DropListBox 42,76,108,186, MyList$(), .DropList1$
            CancelButton 42,108,40,12
            OKButton 90,108,40,12
        End Dialog

        Dim Dlg1 As DialogName1

'       Dlg1.DropList1  =  0 this shows item (0) default In the window In the drop down list
'       You can change it To show Any item On top from Mylist()
        Dlg1.DropList1  =  0

'       If cancel button is selected, Exit Sub
        Button = Dialog(Dlg1)
        If Button = 0 Then Exit Sub 
     
        Vari = Dlg1.DropList1
      
        Set PCDDmisCommand = PCDDmisCommands.Add(ASSIGNMENT,True)
        PCDDmisCommand.Marked = True
        retval = PCDDmisCommand.PutText("Part_Num",DEST_EXPR,0)
        retval = PCDDmisCommand.PutText(mylist$(vari),SRC_EXPR,0)
        
End Sub

Parents

Moolvie over 11 years ago

I have a program I use to setup operator info and such, I have three pulldowns, I read in a text file of all the operator names and ID numbers and a file of all the machines and ID numbers. I dimension and populate arrays and it outputs tracefields that match up with our custom header. I also have a pulldown that is hardcoded in the program for the list of inspectors, it is hardcoded because there are only 2 of us and It wasn't worth the extra code to make it an external text file. What is nice about the external file is that I can modify them and the next time the program reads it, it adjusts on the fly

I have a crude work around that displays the last serialization in a window so we know where we are. I save the serialization to a text file, if the file doesn't exist I display "NEW" in the serialization info window, if it does exist, I display the contents which is the last serialization number. the file is overwritten each run with whatever is input into the serialization prompt. There is a file created for each program run based on the program name. if you change the program name you get the "NEW" prompt, its a low budget way to tell the operator it is a virgin program and to be wary

Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand
Dim Partnumber, Partname, Supplier, Count%, ECount%, TextLine, EmpList$ ( ), EmpNum% ( ), MachName$ ( ), MachNum% ( ), last$
Dim strPrgName$, strNewName$, strNoExt$, strPath$, FindDot

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands



Dim Pserial$(1)
strPrgName = PCDPartProgram.Name
    strPath = "C:\Users\Public\Documents\WAI\PC-DMIS\2011 MR1\PC-DMIS Basic Scripts\"
    FindDot = InStr(1, strPrgName, ".")
    strNoExt = Left(strPrgName, FindDot - 1)
    strNewName = strPath & strNoExt & ".txt"
On Error GoTo MakeNew
    Open  strNewName For Input As #1
               Line Input #1, Pserial(0)
    Close #1
GoTo Contin
MakeNew:
    Pserial (0) =" New "

Contin:
On Error GoTo 0

' Read In the list of employess With clock numbers
Let Count = "1"
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\EmployeeList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      Count = Count + 1
Loop
Close #1
 
 ReDim EmpList$ (Count)
 ReDim  EmpNum% (Count)

Let ECount = "0"

' Separate out the clock number And Employee And Put them In re-dimensioned arrays
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\EmployeeList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      EmpNum (ECount) = Left(Textline, 3)
      EmpList (ECount) = Right(Textline, Len(Textline)-3)
      ECount = ECount + 1
Loop
Close #1

' Read In a list of machines With numbers
Let Count = "1"
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\MachineList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      Count = Count + 1
Loop
Close #1
  
ReDim MachName$(Count)
ReDim MachNum%(Count)

' Separate machine And number into their own arrays
Let ECount = "0"
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\MachineList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      MachNum (ECount) = Left(Textline, 3)
      MachName(ECount) = Right(Textline, Len(Textline)-3)
      ECount = ECount + 1
Loop

' a list of inspectors
Dim NameList$ (3)
  NameList (0) = "None"
  NameList (1) = "Doug"
  NameList (2) = "Chris"
  NameList (3) = "Jon"
  
' And their employee numbers
Dim MyList$ (3)
  MyList (0) = " 0 "
  MyList (1) = " 205 "
  MyList (2) = " 289 "
  MyList (3) = " 104 "
  
 
Begin Dialog DIALOG_1 178,23, 172, 172, "Partprogram information"
   DropListBox 8,26,153,420, EmpList$( ),.DrpList1
  TextBox 8,58,60,12, .PartNameEdit
  DropListBox 8,90,72,40, NameList$( ),.DrpList
  
  
  DropListBox 8,130,153,290,MachName$( ), .MachineNameEdit
  Text 8,18,73,8, "Operator:"
  Text 8,50,85,8, "Serialization:"
  Text 90,50,85,8, "Previous"
  DropListBox 90,58,40,8, Pserial$(), .dummy
  Text 8,82,57,8, "Inspector:"
  Text 8,122,153,8, "Machine Number:"
   OKButton 124,152,37,12
  CancelButton 8,152,37,12
End Dialog

Dim Dlg1 As DIALOG_1
BtnResult = Dialog(Dlg1)

If BtnResult <> 0 Then
result = "****************************** PART INFORMATION ******************************"

Set PCDCommand = PCDCommands.Add(SET_COMMENT, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText("", ID, 0)
    retval = PCDCommand.SetToggleString(4, COMMENT_TYPE, 0)
    retval = PCDCommand.PutText(result, COMMENT_FIELD, 1)
    retval = PCDCommand.SetToggleString(1, OUTPUT_TYPE, 0)'

Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Operator", TRACE_NAME, 0)
    retval = PCDCommand.PutText(EmpNum(Dlg1.DrpList1), TRACE_VALUE, 0)  

Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Serialization", TRACE_NAME, 0)
    retval = PCDCommand.PutText(Dlg1.PartNameEdit, TRACE_VALUE, 0)
Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Inspector", TRACE_NAME, 0)
    retval = PCDCommand.PutText(MyList (Dlg1.DrpList), TRACE_VALUE, 0)
  
Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Machine no.", TRACE_NAME, 0)
    retval = PCDCommand.PutText(MachNum(Dlg1.MachineNameEdit), TRACE_VALUE, 0)
  
    
result = "****************************** PART INFORMATION ******************************"

Set PCDCommand = PCDCommands.Add(SET_COMMENT, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText("", ID, 0)
    retval = PCDCommand.SetToggleString(4, COMMENT_TYPE, 0)
    retval = PCDCommand.PutText(result, COMMENT_FIELD, 1)
    retval = PCDCommand.SetToggleString(1, OUTPUT_TYPE, 0)

 Set PCDCommand = PCDCommands.Add(ASSIGNMENT, True)
    PCDCommand.Marked = True
  ' Set Destination Expression  = SN
    retval = PCDCommand.PutText ("SN", DEST_EXPR, 0)
     retval = PCDCommand.PutText (dlg1.PartNameEdit, SRC_EXPR, 0)

' Open a text file To save serialization info


Open strNewName For Output As #1
      Write #1, dlg1.PartNameEdit
Close #1

End If

End Sub

Reply

Moolvie over 11 years ago

Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand
Dim Partnumber, Partname, Supplier, Count%, ECount%, TextLine, EmpList$ ( ), EmpNum% ( ), MachName$ ( ), MachNum% ( ), last$
Dim strPrgName$, strNewName$, strNoExt$, strPath$, FindDot

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands



Dim Pserial$(1)
strPrgName = PCDPartProgram.Name
    strPath = "C:\Users\Public\Documents\WAI\PC-DMIS\2011 MR1\PC-DMIS Basic Scripts\"
    FindDot = InStr(1, strPrgName, ".")
    strNoExt = Left(strPrgName, FindDot - 1)
    strNewName = strPath & strNoExt & ".txt"
On Error GoTo MakeNew
    Open  strNewName For Input As #1
               Line Input #1, Pserial(0)
    Close #1
GoTo Contin
MakeNew:
    Pserial (0) =" New "

Contin:
On Error GoTo 0

' Read In the list of employess With clock numbers
Let Count = "1"
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\EmployeeList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      Count = Count + 1
Loop
Close #1
 
 ReDim EmpList$ (Count)
 ReDim  EmpNum% (Count)

Let ECount = "0"

' Separate out the clock number And Employee And Put them In re-dimensioned arrays
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\EmployeeList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      EmpNum (ECount) = Left(Textline, 3)
      EmpList (ECount) = Right(Textline, Len(Textline)-3)
      ECount = ECount + 1
Loop
Close #1

' Read In a list of machines With numbers
Let Count = "1"
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\MachineList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      Count = Count + 1
Loop
Close #1
  
ReDim MachName$(Count)
ReDim MachNum%(Count)

' Separate machine And number into their own arrays
Let ECount = "0"
Open "S:\CNC Programs\Unedited From Office\Doug\CMM Programs\MachineList.txt" For Input As #1
Do While Not EOF(1)
      Line Input #1, Textline
      MachNum (ECount) = Left(Textline, 3)
      MachName(ECount) = Right(Textline, Len(Textline)-3)
      ECount = ECount + 1
Loop

' a list of inspectors
Dim NameList$ (3)
  NameList (0) = "None"
  NameList (1) = "Doug"
  NameList (2) = "Chris"
  NameList (3) = "Jon"
  
' And their employee numbers
Dim MyList$ (3)
  MyList (0) = " 0 "
  MyList (1) = " 205 "
  MyList (2) = " 289 "
  MyList (3) = " 104 "
  
 
Begin Dialog DIALOG_1 178,23, 172, 172, "Partprogram information"
   DropListBox 8,26,153,420, EmpList$( ),.DrpList1
  TextBox 8,58,60,12, .PartNameEdit
  DropListBox 8,90,72,40, NameList$( ),.DrpList
  
  
  DropListBox 8,130,153,290,MachName$( ), .MachineNameEdit
  Text 8,18,73,8, "Operator:"
  Text 8,50,85,8, "Serialization:"
  Text 90,50,85,8, "Previous"
  DropListBox 90,58,40,8, Pserial$(), .dummy
  Text 8,82,57,8, "Inspector:"
  Text 8,122,153,8, "Machine Number:"
   OKButton 124,152,37,12
  CancelButton 8,152,37,12
End Dialog

Dim Dlg1 As DIALOG_1
BtnResult = Dialog(Dlg1)

If BtnResult <> 0 Then
result = "****************************** PART INFORMATION ******************************"

Set PCDCommand = PCDCommands.Add(SET_COMMENT, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText("", ID, 0)
    retval = PCDCommand.SetToggleString(4, COMMENT_TYPE, 0)
    retval = PCDCommand.PutText(result, COMMENT_FIELD, 1)
    retval = PCDCommand.SetToggleString(1, OUTPUT_TYPE, 0)'

Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Operator", TRACE_NAME, 0)
    retval = PCDCommand.PutText(EmpNum(Dlg1.DrpList1), TRACE_VALUE, 0)  

Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Serialization", TRACE_NAME, 0)
    retval = PCDCommand.PutText(Dlg1.PartNameEdit, TRACE_VALUE, 0)
Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Inspector", TRACE_NAME, 0)
    retval = PCDCommand.PutText(MyList (Dlg1.DrpList), TRACE_VALUE, 0)
  
Set PCDCommand = PCDCommands.Add(TRACEFIELD, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText(0, DISPLAY_TRACE, 0)
    retval = PCDCommand.PutText("15", TRACE_VALUE_LIMIT, 0)
    retval = PCDCommand.PutText("Machine no.", TRACE_NAME, 0)
    retval = PCDCommand.PutText(MachNum(Dlg1.MachineNameEdit), TRACE_VALUE, 0)
  
    
result = "****************************** PART INFORMATION ******************************"

Set PCDCommand = PCDCommands.Add(SET_COMMENT, True)
    PCDCommand.Marked = True
    retval = PCDCommand.PutText("", ID, 0)
    retval = PCDCommand.SetToggleString(4, COMMENT_TYPE, 0)
    retval = PCDCommand.PutText(result, COMMENT_FIELD, 1)
    retval = PCDCommand.SetToggleString(1, OUTPUT_TYPE, 0)

 Set PCDCommand = PCDCommands.Add(ASSIGNMENT, True)
    PCDCommand.Marked = True
  ' Set Destination Expression  = SN
    retval = PCDCommand.PutText ("SN", DEST_EXPR, 0)
     retval = PCDCommand.PutText (dlg1.PartNameEdit, SRC_EXPR, 0)

' Open a text file To save serialization info


Open strNewName For Output As #1
      Write #1, dlg1.PartNameEdit
Close #1

End If

End Sub

Children

No Data