home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD139111192001.psc / frmEditor.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-01-20  |  45.0 KB  |  1,343 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
  5. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  6. Begin VB.Form frmEditor 
  7.    BorderStyle     =   1  'Fixed Single
  8.    Caption         =   "Bobo Menu Builder"
  9.    ClientHeight    =   6120
  10.    ClientLeft      =   45
  11.    ClientTop       =   615
  12.    ClientWidth     =   5415
  13.    Icon            =   "frmEditor.frx":0000
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   6120
  18.    ScaleWidth      =   5415
  19.    StartUpPosition =   2  'CenterScreen
  20.    Begin RichTextLib.RichTextBox rtftext 
  21.       Height          =   255
  22.       Left            =   1560
  23.       TabIndex        =   33
  24.       Top             =   1920
  25.       Visible         =   0   'False
  26.       Width           =   495
  27.       _ExtentX        =   873
  28.       _ExtentY        =   450
  29.       _Version        =   393217
  30.       TextRTF         =   $"frmEditor.frx":08CA
  31.    End
  32.    Begin MSComctlLib.ListView LV 
  33.       Height          =   255
  34.       Left            =   3840
  35.       TabIndex        =   21
  36.       Top             =   480
  37.       Visible         =   0   'False
  38.       Width           =   615
  39.       _ExtentX        =   1085
  40.       _ExtentY        =   450
  41.       LabelWrap       =   -1  'True
  42.       HideSelection   =   -1  'True
  43.       _Version        =   393217
  44.       ForeColor       =   -2147483640
  45.       BackColor       =   -2147483643
  46.       BorderStyle     =   1
  47.       Appearance      =   1
  48.       NumItems        =   9
  49.       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  50.          Object.Width           =   2540
  51.       EndProperty
  52.       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  53.          SubItemIndex    =   1
  54.          Object.Width           =   2540
  55.       EndProperty
  56.       BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  57.          SubItemIndex    =   2
  58.          Object.Width           =   2540
  59.       EndProperty
  60.       BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  61.          SubItemIndex    =   3
  62.          Object.Width           =   2540
  63.       EndProperty
  64.       BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  65.          SubItemIndex    =   4
  66.          Object.Width           =   2540
  67.       EndProperty
  68.       BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  69.          SubItemIndex    =   5
  70.          Object.Width           =   2540
  71.       EndProperty
  72.       BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  73.          SubItemIndex    =   6
  74.          Object.Width           =   2540
  75.       EndProperty
  76.       BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  77.          SubItemIndex    =   7
  78.          Object.Width           =   2540
  79.       EndProperty
  80.       BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  81.          SubItemIndex    =   8
  82.          Object.Width           =   2540
  83.       EndProperty
  84.    End
  85.    Begin VB.PictureBox Picture2 
  86.       BackColor       =   &H80000011&
  87.       BorderStyle     =   0  'None
  88.       Height          =   975
  89.       Left            =   0
  90.       ScaleHeight     =   975
  91.       ScaleWidth      =   5415
  92.       TabIndex        =   28
  93.       Top             =   0
  94.       Width           =   5415
  95.       Begin VB.TextBox Text4 
  96.          BackColor       =   &H8000000B&
  97.          ForeColor       =   &H80000007&
  98.          Height          =   315
  99.          Left            =   1320
  100.          TabIndex        =   30
  101.          Top             =   120
  102.          Width           =   3735
  103.       End
  104.       Begin VB.TextBox Text6 
  105.          BackColor       =   &H8000000B&
  106.          ForeColor       =   &H80000007&
  107.          Height          =   315
  108.          Left            =   1320
  109.          TabIndex        =   29
  110.          Top             =   495
  111.          Width           =   3735
  112.       End
  113.       Begin VB.Label Label5 
  114.          BackColor       =   &H80000010&
  115.          Caption         =   "Form Name :"
  116.          ForeColor       =   &H8000000E&
  117.          Height          =   255
  118.          Left            =   240
  119.          TabIndex        =   32
  120.          Top             =   165
  121.          Width           =   975
  122.       End
  123.       Begin VB.Label Label8 
  124.          BackColor       =   &H80000010&
  125.          Caption         =   "Path :"
  126.          ForeColor       =   &H8000000E&
  127.          Height          =   255
  128.          Left            =   240
  129.          TabIndex        =   31
  130.          Top             =   525
  131.          Width           =   855
  132.       End
  133.    End
  134.    Begin VB.ComboBox Combo2 
  135.       Height          =   315
  136.       ItemData        =   "frmEditor.frx":0993
  137.       Left            =   3960
  138.       List            =   "frmEditor.frx":09A3
  139.       Style           =   2  'Dropdown List
  140.       TabIndex        =   25
  141.       Top             =   2280
  142.       Width           =   1335
  143.    End
  144.    Begin VB.TextBox Text5 
  145.       Height          =   315
  146.       Left            =   1320
  147.       TabIndex        =   24
  148.       Text            =   "0"
  149.       Top             =   2280
  150.       Width           =   975
  151.    End
  152.    Begin VB.CheckBox Check4 
  153.       Caption         =   "Widow List"
  154.       Height          =   255
  155.       Left            =   3840
  156.       TabIndex        =   23
  157.       Top             =   2700
  158.       Width           =   1335
  159.    End
  160.    Begin VB.PictureBox Picture1 
  161.       BorderStyle     =   0  'None
  162.       Height          =   2655
  163.       Left            =   0
  164.       ScaleHeight     =   2655
  165.       ScaleWidth      =   135
  166.       TabIndex        =   22
  167.       Top             =   3480
  168.       Width           =   135
  169.    End
  170.    Begin VB.ComboBox Combo1 
  171.       Height          =   315
  172.       ItemData        =   "frmEditor.frx":09D2
  173.       Left            =   3360
  174.       List            =   "frmEditor.frx":0AC6
  175.       Style           =   2  'Dropdown List
  176.       TabIndex        =   6
  177.       Top             =   1880
  178.       Width           =   1935
  179.    End
  180.    Begin VB.TextBox Text3 
  181.       Height          =   315
  182.       Left            =   840
  183.       TabIndex        =   2
  184.       Top             =   1880
  185.       Width           =   495
  186.    End
  187.    Begin VB.CommandButton Command3 
  188.       Caption         =   "Delete"
  189.       Height          =   330
  190.       Left            =   4200
  191.       TabIndex        =   13
  192.       Top             =   3180
  193.       Width           =   1095
  194.    End
  195.    Begin VB.CommandButton Command2 
  196.       Caption         =   "Insert"
  197.       Height          =   330
  198.       Left            =   3000
  199.       TabIndex        =   12
  200.       Top             =   3180
  201.       Width           =   1095
  202.    End
  203.    Begin VB.CommandButton Command1 
  204.       Caption         =   "Next"
  205.       Height          =   330
  206.       Left            =   1800
  207.       TabIndex        =   11
  208.       Top             =   3180
  209.       Width           =   1095
  210.    End
  211.    Begin VB.CheckBox Check3 
  212.       Caption         =   "Visible"
  213.       Height          =   255
  214.       Left            =   2760
  215.       TabIndex        =   5
  216.       Top             =   2700
  217.       Value           =   1  'Checked
  218.       Width           =   975
  219.    End
  220.    Begin VB.CheckBox Check2 
  221.       Caption         =   "Enabled"
  222.       Height          =   255
  223.       Left            =   1440
  224.       TabIndex        =   4
  225.       Top             =   2700
  226.       Value           =   1  'Checked
  227.       Width           =   975
  228.    End
  229.    Begin VB.CheckBox Check1 
  230.       Caption         =   "Checked"
  231.       Height          =   255
  232.       Left            =   120
  233.       TabIndex        =   3
  234.       Top             =   2700
  235.       Width           =   1095
  236.    End
  237.    Begin VB.CommandButton cmdCancel 
  238.       Caption         =   "Cancel"
  239.       Height          =   330
  240.       Left            =   4200
  241.       TabIndex        =   16
  242.       Top             =   1480
  243.       Width           =   1095
  244.    End
  245.    Begin VB.CommandButton cmdOK 
  246.       Caption         =   "OK"
  247.       Height          =   330
  248.       Left            =   4200
  249.       TabIndex        =   15
  250.       Top             =   1080
  251.       Width           =   1095
  252.    End
  253.    Begin VB.TextBox Text2 
  254.       Height          =   315
  255.       Left            =   840
  256.       TabIndex        =   1
  257.       Top             =   1480
  258.       Width           =   3135
  259.    End
  260.    Begin VB.TextBox Text1 
  261.       Height          =   315
  262.       Left            =   840
  263.       TabIndex        =   0
  264.       Top             =   1080
  265.       Width           =   3135
  266.    End
  267.    Begin VB.CommandButton cmdpos 
  268.       Height          =   330
  269.       Index           =   3
  270.       Left            =   1200
  271.       Picture         =   "frmEditor.frx":0DA5
  272.       Style           =   1  'Graphical
  273.       TabIndex        =   10
  274.       Top             =   3180
  275.       Width           =   300
  276.    End
  277.    Begin VB.CommandButton cmdpos 
  278.       Height          =   330
  279.       Index           =   2
  280.       Left            =   840
  281.       Picture         =   "frmEditor.frx":10D3
  282.       Style           =   1  'Graphical
  283.       TabIndex        =   9
  284.       Top             =   3180
  285.       Width           =   300
  286.    End
  287.    Begin VB.CommandButton cmdpos 
  288.       Height          =   330
  289.       Index           =   1
  290.       Left            =   480
  291.       Picture         =   "frmEditor.frx":1401
  292.       Style           =   1  'Graphical
  293.       TabIndex        =   8
  294.       Top             =   3180
  295.       Width           =   300
  296.    End
  297.    Begin VB.CommandButton cmdpos 
  298.       BeginProperty Font 
  299.          Name            =   "Webdings"
  300.          Size            =   8.25
  301.          Charset         =   2
  302.          Weight          =   400
  303.          Underline       =   0   'False
  304.          Italic          =   0   'False
  305.          Strikethrough   =   0   'False
  306.       EndProperty
  307.       Height          =   330
  308.       Index           =   0
  309.       Left            =   120
  310.       Picture         =   "frmEditor.frx":172F
  311.       Style           =   1  'Graphical
  312.       TabIndex        =   7
  313.       Top             =   3180
  314.       Width           =   300
  315.    End
  316.    Begin MSComDlg.CommonDialog CommonDialog1 
  317.       Left            =   4800
  318.       Top             =   840
  319.       _ExtentX        =   847
  320.       _ExtentY        =   847
  321.       _Version        =   393216
  322.       Flags           =   5
  323.    End
  324.    Begin VB.Label Label7 
  325.       Caption         =   "NegotiatePosition :"
  326.       Height          =   255
  327.       Left            =   2520
  328.       TabIndex        =   27
  329.       Top             =   2340
  330.       Width           =   1455
  331.    End
  332.    Begin VB.Label Label6 
  333.       Caption         =   "HelpcontextID :"
  334.       Height          =   255
  335.       Left            =   120
  336.       TabIndex        =   26
  337.       Top             =   2340
  338.       Width           =   1335
  339.    End
  340.    Begin MSForms.ListBox List1 
  341.       Height          =   2415
  342.       Left            =   0
  343.       TabIndex        =   14
  344.       Top             =   3600
  345.       Width           =   5295
  346.       ScrollBars      =   3
  347.       DisplayStyle    =   2
  348.       Size            =   "9340;4260"
  349.       ColumnCount     =   2
  350.       cColumnInfo     =   1
  351.       MatchEntry      =   0
  352.       SpecialEffect   =   0
  353.       FontHeight      =   165
  354.       FontCharSet     =   0
  355.       FontPitchAndFamily=   2
  356.       Object.Width           =   "6350"
  357.    End
  358.    Begin VB.Line Line2 
  359.       BorderColor     =   &H80000005&
  360.       X1              =   120
  361.       X2              =   5280
  362.       Y1              =   3045
  363.       Y2              =   3045
  364.    End
  365.    Begin VB.Line Line1 
  366.       X1              =   120
  367.       X2              =   5280
  368.       Y1              =   3030
  369.       Y2              =   3030
  370.    End
  371.    Begin VB.Label Label4 
  372.       Caption         =   "Shortcut :"
  373.       Height          =   255
  374.       Left            =   2520
  375.       TabIndex        =   20
  376.       Top             =   1925
  377.       Width           =   735
  378.    End
  379.    Begin VB.Label Label3 
  380.       Caption         =   "Index :"
  381.       Height          =   255
  382.       Left            =   120
  383.       TabIndex        =   19
  384.       Top             =   1925
  385.       Width           =   615
  386.    End
  387.    Begin VB.Label Label2 
  388.       Caption         =   "Name :"
  389.       Height          =   255
  390.       Left            =   120
  391.       TabIndex        =   18
  392.       Top             =   1520
  393.       Width           =   735
  394.    End
  395.    Begin VB.Label Label1 
  396.       Caption         =   "Caption :"
  397.       Height          =   255
  398.       Left            =   120
  399.       TabIndex        =   17
  400.       Top             =   1110
  401.       Width           =   735
  402.    End
  403.    Begin VB.Menu mnuFile 
  404.       Caption         =   "File"
  405.       Begin VB.Menu mnuFileNew 
  406.          Caption         =   "New Menu"
  407.       End
  408.       Begin VB.Menu mnuFileOpen 
  409.          Caption         =   "Open Form"
  410.       End
  411.       Begin VB.Menu mnuFileOpenTemplate 
  412.          Caption         =   "Open Template"
  413.       End
  414.       Begin VB.Menu mnuFileSpace 
  415.          Caption         =   "-"
  416.       End
  417.       Begin VB.Menu mnuFileSaveFormAs 
  418.          Caption         =   "Save Form As"
  419.       End
  420.       Begin VB.Menu mnuFileSaveMenu 
  421.          Caption         =   "Save Menu As New Form"
  422.       End
  423.       Begin VB.Menu mnuFileSaveAsTemplate 
  424.          Caption         =   "Save Menu As Template"
  425.       End
  426.       Begin VB.Menu mnuFileSpace1 
  427.          Caption         =   "-"
  428.       End
  429.       Begin VB.Menu mnuFileAbout 
  430.          Caption         =   "About"
  431.       End
  432.       Begin VB.Menu mnuFileExit 
  433.          Caption         =   "Exit"
  434.       End
  435.    End
  436.    Begin VB.Menu mnuEdit 
  437.       Caption         =   "Edit"
  438.       Begin VB.Menu mnuEditClear 
  439.          Caption         =   "Clear Menu"
  440.       End
  441.       Begin VB.Menu mnuEditTemplate 
  442.          Caption         =   "Replace with Template"
  443.       End
  444.    End
  445.    Begin VB.Menu mnuHelp 
  446.       Caption         =   "Help"
  447.    End
  448. Attribute VB_Name = "frmEditor"
  449. Attribute VB_GlobalNameSpace = False
  450. Attribute VB_Creatable = False
  451. Attribute VB_PredeclaredId = True
  452. Attribute VB_Exposed = False
  453. 'Copyright Bobo Enterprises 2001
  454. 'This is a beta version of a tool which forms part of a commercial
  455. 'release VB6 addin. This version is made as a stand-alone exe for
  456. 'testing. Some of the code is a bit messy and inefficient.
  457. 'Most of the code is self explanatory or is simple 'House keeping'
  458. 'and I haven't bothered to comment on it.
  459. 'Recommend you test it first on copies of forms to
  460. 'get the hang of how it works
  461. '***ADVANTAGES OVER STANDARD MENU EDITOR***
  462. 'No limit on size or nested submenus
  463. 'Allows easy moving of menu structures between forms
  464. 'Lets you save oft used menus for re-use
  465. '***DISADVANTAGES***
  466. 'This beta works outside the IDE
  467. 'I've included the couple of images used so just
  468. 'compile the EXE and you should have a useful tool.
  469. 'Please send any comments or report bugs to
  470. 'gtkerr@bigpond.com
  471. Public existing As Boolean          'it's an existing form we're editing
  472. Public ExistingPath As String       'and this is where its' at
  473. Dim ic As ListItem
  474. Dim InvalidMenu As Boolean          'they cocked up, submenu in the wrong place or summit
  475. Dim BeforeTxt As String             'the text in a form before the menu structure
  476. Dim AfterTxt As String              'the text in a form after the menu structure
  477. Dim curtext As String               'the menu structure
  478. Dim textfound As Long
  479. Dim pos As Long
  480. Private Sub Check1_Click()
  481. LV.SelectedItem.SubItems(1) = Check1.Value
  482. End Sub
  483. Private Sub Check2_Click()
  484. LV.SelectedItem.SubItems(2) = Check2.Value
  485. End Sub
  486. Private Sub Check3_Click()
  487. LV.SelectedItem.SubItems(3) = Check3.Value
  488. End Sub
  489. Private Sub Check4_Click()
  490. LV.SelectedItem.SubItems(6) = Check4.Value
  491. End Sub
  492. Private Sub cmdCancel_Click()
  493. Unload Me
  494. End Sub
  495. Private Sub cmdOK_Click()
  496. 'In a normal app this button would be the "Save" menuitem
  497. 'But to keep it like VB6s' menu editor we've used the "OK" button
  498. On Error GoTo woops
  499. Dim temp As String, sfile As String, myMenu As String
  500. Dim DialogType As Integer
  501. Dim DialogTitle As String
  502. Dim DialogMsg As String
  503. Dim Response As Integer
  504. If Label5 = "Template" Then
  505.     Screen.MousePointer = 11
  506.     myMenu = GetMyMenu
  507.     If InvalidMenu Then
  508.         InvalidMenu = False
  509.         Exit Sub
  510.     End If
  511.     Screen.MousePointer = 0
  512.     FileSave myMenu, Text6.Text
  513.     Exit Sub
  514. End If
  515. If List1.List(List1.ListCount - 1) = "" And LV.ListItems(LV.ListItems.Count).Text = "" Then
  516.     List1.RemoveItem List1.ListCount - 1
  517.     LV.ListItems.Remove LV.ListItems.Count
  518. End If
  519. If List1.ListCount = 0 Then
  520.     myMenu = ""
  521.     Screen.MousePointer = 11
  522.     myMenu = GetMyMenu
  523.     Screen.MousePointer = 0
  524. End If
  525. If InvalidMenu Then
  526.     InvalidMenu = False
  527.     Exit Sub
  528. End If
  529. If existing = True Then
  530.     'Better remind them this is editing a form
  531.     'and cant be undone
  532.     DialogType = vbYesNoCancel
  533.     DialogTitle = "Bobo Enterprises"
  534.     DialogMsg = "This will overwrite an existing form. Do you wish to save as a copy instead ?"
  535.     Response = MsgBox(DialogMsg, DialogType, DialogTitle)
  536.     Select Case Response
  537.         Case vbYes
  538.             'Whooh ! Lets just save a copy to be safe
  539.             With CommonDialog1
  540.                 .FileName = Text4.Text + ".frm"
  541.                 .DialogTitle = "Save Form"
  542.                 .CancelError = True
  543.                 .Filter = "VB 6 Forms |*.frm"
  544.                 .ShowSave
  545.                 If Len(.FileName) = 0 Then Exit Sub
  546.                 sfile = .FileName
  547.             End With
  548.         Case vbNo
  549.             'Damn the torpedoes full speed ahead
  550.             sfile = ExistingPath
  551.         Case vbCancel
  552.             'Panic
  553.             Exit Sub
  554.     End Select
  555.     With CommonDialog1
  556.         .FileName = Text4.Text + ".frm"
  557.         .DialogTitle = "Save Form"
  558.         .CancelError = True
  559.         .Filter = "VB 6 Forms |*.frm"
  560.         .ShowSave
  561.         If Len(.FileName) = 0 Then Exit Sub
  562.         sfile = .FileName
  563.     End With
  564. End If
  565. If Not existing Then
  566. 'The user wants a new form so lets create one
  567. temp = "VERSION 5.00" + vbCrLf + "Begin VB.Form " + Text4.Text + vbCrLf + "   Caption         =   " + Chr(34) + Text4.Text + Chr(34) + vbCrLf _
  568. + "   ClientHeight    =   3195" + vbCrLf + "   ClientLeft      =   60" + vbCrLf + "   ClientTop       =   345" + vbCrLf _
  569. + "   ClientWidth     =   4680" + vbCrLf + "   LinkTopic       =   " + Chr(34) + "Form1" + Chr(34) + vbCrLf + "   ScaleHeight     =   3195" + vbCrLf _
  570. + "   ScaleWidth      =   4680" + vbCrLf + "   StartUpPosition =   3" + vbCrLf + myMenu + vbCrLf + "End" + vbCrLf _
  571. + "Attribute VB_Name = " + Chr(34) + Text4.Text + Chr(34) + vbCrLf + "Attribute VB_GlobalNameSpace = False" + vbCrLf + "Attribute VB_Creatable = False" + vbCrLf _
  572. + "Attribute VB_PredeclaredId = True" + vbCrLf + "Attribute VB_Exposed = False" + vbCrLf
  573. temp = BeforeTxt + myMenu + vbCrLf + "End" + vbCrLf + AfterTxt
  574. End If
  575. FileSave temp, sfile
  576. existing = True
  577. Text6.Text = sfile
  578. ExistingPath = sfile
  579. woops:
  580. End Sub
  581. Private Sub cmdpos_Click(Index As Integer)
  582. Dim nItem As Integer
  583. Select Case Index
  584. Case 0 'left
  585.     If Left(List1.List(List1.ListIndex), 4) = "
  586. " Then
  587.         List1.List(List1.ListIndex) = Right(List1.List(List1.ListIndex), Len(List1.List(List1.ListIndex)) - 4)
  588.     End If
  589. Case 1 'right
  590.     List1.List(List1.ListIndex) = "
  591. " + List1.List(List1.ListIndex)
  592. Case 2 'up
  593.     If List1.ListIndex < 1 Then Exit Sub
  594.     nItem = List1.ListIndex
  595.     If nItem = 0 Then Exit Sub
  596.     Set ic = LV.ListItems.Add(nItem, , Text2.Text)
  597.     ic.SubItems(1) = Check1.Value
  598.     ic.SubItems(2) = Check2.Value
  599.     ic.SubItems(3) = Check3.Value
  600.     ic.SubItems(4) = Text3.Text
  601.     ic.SubItems(5) = Combo1.ListIndex
  602.     ic.SubItems(6) = Check4.Value
  603.     ic.SubItems(7) = Combo2.ListIndex
  604.     ic.SubItems(8) = Text5.Text
  605.     LV.ListItems.Remove nItem + 2
  606.     List1.AddItem List1.Text, nItem - 1
  607.     List1.RemoveItem nItem + 1
  608.     List1.Selected(nItem - 1) = True
  609. Case 3 'down
  610.     If List1.ListIndex < List1.ListCount - 1 Then
  611.         nItem = List1.ListIndex
  612.         If nItem = List1.ListCount - 1 Then Exit Sub
  613.         Set ic = LV.ListItems.Add(nItem + 3, , Text2.Text)
  614.         ic.SubItems(1) = Check1.Value
  615.         ic.SubItems(2) = Check2.Value
  616.         ic.SubItems(3) = Check3.Value
  617.         ic.SubItems(4) = Text3.Text
  618.         ic.SubItems(5) = Combo1.ListIndex
  619.         ic.SubItems(6) = Check4.Value
  620.         ic.SubItems(7) = Combo2.ListIndex
  621.         ic.SubItems(8) = Text5.Text
  622.         LV.ListItems.Remove nItem + 1
  623.         List1.AddItem List1.Text, nItem + 2
  624.         List1.RemoveItem nItem
  625.         List1.Selected(nItem + 1) = True
  626.     Else
  627.         If List1.List(List1.ListCount - 1) <> "" Then
  628.             List1.AddItem ""
  629.             Text2.Text = ""
  630.             Set ic = LV.ListItems.Add(, , Text2.Text)
  631.             ic.SubItems(1) = Check1.Value
  632.             ic.SubItems(2) = Check2.Value
  633.             ic.SubItems(3) = Check3.Value
  634.             ic.SubItems(4) = Text3.Text
  635.             ic.SubItems(5) = Combo1.ListIndex
  636.             ic.SubItems(6) = Check4.Value
  637.             ic.SubItems(7) = Combo2.ListIndex
  638.             ic.SubItems(8) = Text5.Text
  639.             List1.ListIndex = List1.ListIndex + 1
  640.         End If
  641.     End If
  642. End Select
  643. 'update caption and name
  644. Text1.Text = Mid$(List1.List(List1.ListIndex), InStrRev(List1.List(List1.ListIndex), "
  645. ") + 1)
  646. Text2.Text = ic.Text
  647. End Sub
  648. Private Sub Combo1_Click()
  649. LV.SelectedItem.SubItems(5) = Combo1.ListIndex
  650. If Combo1.ListIndex > 0 Then
  651.     List1.Column(1, List1.ListIndex) = Combo1.Text
  652.     List1.Column(1, List1.ListIndex) = ""
  653. End If
  654. End Sub
  655. Private Sub Combo2_Click()
  656. LV.SelectedItem.SubItems(7) = Combo2.ListIndex
  657. End Sub
  658. Private Sub Command1_Click() 'next
  659. Dim emp As String
  660. If List1.ListIndex < List1.ListCount - 1 Then
  661.     List1.ListIndex = List1.ListIndex + 1
  662.     If List1.List(List1.ListCount - 1) <> "" Then
  663.         emp = Mid$(List1.List(List1.ListCount - 1), 1, InStrRev(List1.List(List1.ListCount - 1), "
  664.         List1.AddItem emp
  665.         Combo1.ListIndex = 0
  666.         Check1.Value = 0
  667.         Check2.Value = 1
  668.         Check3.Value = 1
  669.         Check4.Value = 0
  670.         Combo2.ListIndex = 0
  671.         Text5.Text = "0"
  672.         Set ic = LV.ListItems.Add(, , "")
  673.         ic.SubItems(1) = Check1.Value
  674.         ic.SubItems(2) = Check2.Value
  675.         ic.SubItems(3) = Check3.Value
  676.         ic.SubItems(4) = Text3.Text
  677.         ic.SubItems(5) = Combo1.ListIndex
  678.         ic.SubItems(6) = Check4.Value
  679.         ic.SubItems(7) = Combo2.ListIndex
  680.         ic.SubItems(8) = Text5.Text
  681.         Dim bg As Integer
  682.         bg = LV.ListItems.Count
  683.         List1.ListIndex = List1.ListIndex + 1
  684.     End If
  685. End If
  686. Text1.Text = Mid$(List1.List(List1.ListIndex), InStrRev(List1.List(List1.ListIndex), "
  687. ") + 1)
  688. Text2.Text = ic.Text
  689. End Sub
  690. Private Sub Command2_Click() 'insert
  691. Dim emp As String
  692. emp = Mid$(List1.List(List1.ListIndex), 1, InStrRev(List1.List(List1.ListIndex), "
  693. List1.AddItem emp, List1.ListIndex
  694. Combo1.ListIndex = 0
  695. Check1.Value = 0
  696. Check2.Value = 1
  697. Check3.Value = 1
  698. Check4.Value = 0
  699. Combo2.ListIndex = 0
  700. Text5.Text = "0"
  701. Set ic = LV.ListItems.Add(, , "")
  702. ic.SubItems(1) = Check1.Value
  703. ic.SubItems(2) = Check2.Value
  704. ic.SubItems(3) = Check3.Value
  705. ic.SubItems(4) = Text3.Text
  706. ic.SubItems(5) = Combo1.ListIndex
  707. ic.SubItems(6) = Check4.Value
  708. ic.SubItems(7) = Combo2.ListIndex
  709. ic.SubItems(8) = Text5.Text
  710. List1.ListIndex = List1.ListIndex - 1
  711. Text1.Text = Mid$(List1.List(List1.ListIndex), InStrRev(List1.List(List1.ListIndex), "
  712. ") + 1)
  713. Text2.Text = ic.Text
  714. End Sub
  715. Private Sub Command3_Click() 'delete
  716. If List1.ListCount > 1 Then
  717.     If List1.ListIndex > 0 Then
  718.         List1.ListIndex = List1.ListIndex - 1
  719.         List1.RemoveItem List1.ListIndex + 1
  720.         LV.ListItems.Remove List1.ListIndex + 2
  721.     Else
  722.         List1.ListIndex = List1.ListIndex + 1
  723.         List1.RemoveItem List1.ListIndex - 1
  724.         LV.ListItems.Remove List1.ListIndex
  725.     End If
  726.     List1.List(0) = ""
  727.     LV.ListItems.Clear
  728.     Combo1.ListIndex = 0
  729.     Check1.Value = 0
  730.     Check2.Value = 1
  731.     Check3.Value = 1
  732.     Check4.Value = 0
  733.     Combo2.ListIndex = 0
  734.     Text5.Text = "0"
  735.     Set ic = LV.ListItems.Add(, , "")
  736.     ic.SubItems(1) = Check1.Value
  737.     ic.SubItems(2) = Check2.Value
  738.     ic.SubItems(3) = Check3.Value
  739.     ic.SubItems(4) = Text3.Text
  740.     ic.SubItems(5) = Combo1.ListIndex
  741.     ic.SubItems(6) = Check4.Value
  742.     ic.SubItems(7) = Combo2.ListIndex
  743.     ic.SubItems(8) = Text5.Text
  744. End If
  745. Text1.Text = Mid$(List1.List(List1.ListIndex), InStrRev(List1.List(List1.ListIndex), "
  746. ") + 1)
  747. Text2.Text = ic.Text
  748. End Sub
  749. Private Sub Form_Load()
  750. Dim mycommand As String
  751. Dim temp As String
  752. 'Associates itself to its own filetype .bmu
  753. 'These are the template files to hold menu structures
  754. 'When clicked on in Explorer they open in this app
  755. mycommand = Command()
  756. If mycommand = "" Then 'not shelled so set defaults
  757.     Text4.Text = "Form1"
  758.     List1.AddItem ""
  759.     Check1.Value = 0
  760.     Check2.Value = 1
  761.     Check3.Value = 1
  762.     Check4.Value = 0
  763.     Text5.Text = "0"
  764.     Set ic = LV.ListItems.Add(, , Text2.Text)
  765.     ic.SubItems(1) = Check1.Value
  766.     ic.SubItems(2) = Check2.Value
  767.     ic.SubItems(3) = Check3.Value
  768.     ic.SubItems(4) = Text3.Text
  769.     ic.SubItems(5) = 0
  770.     ic.SubItems(6) = Check4.Value
  771.     ic.SubItems(7) = 0
  772.     ic.SubItems(8) = Text5.Text
  773.     ic.Selected = True
  774.     List1.ListIndex = 0
  775.     Combo1.ListIndex = 0
  776.     Combo2.ListIndex = 0
  777. Else 'shelled so open the file and read the menu structure
  778.     Text4.Text = Mid$(mycommand, InStrRev(mycommand, "\") + 1)
  779.     Text6.Text = mycommand
  780.     Label5 = "Template"
  781.     rtftext.LoadFile mycommand  'using a Richtextbox to open files
  782.                                 'this avoids some errors
  783.     curtext = rtftext.Text
  784.     ParseMenu
  785. End If
  786. 'make sure we're still associated to our filetype
  787. Associate App.Path + "\BoboMenuBuilder.exe", ".bmu"
  788. End Sub
  789. Private Sub List1_Click()
  790. Text1.Text = Mid$(List1.List(List1.ListIndex), InStrRev(List1.List(List1.ListIndex), "
  791. ") + 1)
  792. LV.ListItems(List1.ListIndex + 1).Selected = True
  793. Text2.Text = LV.SelectedItem.Text
  794. Check1.Value = LV.SelectedItem.SubItems(1)
  795. Check2.Value = LV.SelectedItem.SubItems(2)
  796. Check3.Value = LV.SelectedItem.SubItems(3)
  797. Text3.Text = LV.SelectedItem.SubItems(4)
  798. Check4.Value = LV.SelectedItem.SubItems(6)
  799. Text5.Text = LV.SelectedItem.SubItems(8)
  800. Combo1.ListIndex = LV.SelectedItem.SubItems(5)
  801. Combo2.ListIndex = LV.SelectedItem.SubItems(7)
  802. End Sub
  803. Private Sub mnuEditClear_Click()
  804. List1.Clear
  805. LV.ListItems.Clear
  806. List1.AddItem ""
  807. Set ic = LV.ListItems.Add(, , "")
  808. ic.SubItems(1) = 0
  809. ic.SubItems(2) = 1
  810. ic.SubItems(3) = 1
  811. ic.SubItems(4) = ""
  812. ic.SubItems(5) = 0
  813. ic.SubItems(6) = 0
  814. ic.SubItems(7) = 0
  815. ic.SubItems(8) = "0"
  816. ic.Selected = True
  817. Check1.Value = 0
  818. Check2.Value = 1
  819. Check3.Value = 1
  820. Check4.Value = 0
  821. Text5.Text = "0"
  822. List1.ListIndex = 0
  823. Combo1.ListIndex = 0
  824. Combo2.ListIndex = 0
  825. End Sub
  826. Private Sub mnuEditTemplate_Click()
  827. Dim temp As String
  828. On Error GoTo woops
  829. With CommonDialog1
  830.     .DialogTitle = "Replace Menu with Template"
  831.     .CancelError = True
  832.     .Filter = "Menu Template |*.bmu"
  833.     .ShowOpen
  834.     If Len(.FileName) = 0 Then Exit Sub
  835.     temp = .FileName
  836. End With
  837. rtftext.LoadFile temp
  838. curtext = rtftext.Text
  839. ParseMenu
  840. woops:
  841. End Sub
  842. Private Sub mnuFileAbout_Click()
  843. Dim temp As String
  844. temp = "This little App will allow you to edit or create" + vbCrLf + _
  845. "menus in VB6 Forms. New forms can be created with" + vbCrLf + _
  846. "menus in place. It can be used to extract menu" + vbCrLf + _
  847. "structures from one form and place it in another." + vbCrLf + _
  848. "You can save menu structures as templates for later use." + vbCrLf + vbCrLf + _
  849. "It removes the limitations of the number of nested" + vbCrLf + _
  850. "submenus allowable in the VB6 menu editor on which" + vbCrLf + _
  851. "it is based. It has only been tested in VB6." + vbCrLf + vbCrLf + _
  852. "Use it as you would the Menu Editor in VB6 with the" + vbCrLf + _
  853. "exception of the Open/Save operations. As with all" + vbCrLf + _
  854. "my submissions, bugs and errors are provided completely" + vbCrLf + _
  855. "free of charge."
  856. MsgBox temp, vbInformation, "Bobo Enterprises"
  857. End Sub
  858. Private Sub mnuFileExit_Click()
  859. Unload Me
  860. End Sub
  861. Private Sub mnuFileNew_Click()
  862. List1.Clear
  863. LV.ListItems.Clear
  864. Text4.Text = "Form1"
  865. Text6.Text = ""
  866. Label5 = "Form Name :"
  867. ExistingPath = ""
  868. List1.AddItem ""
  869. Set ic = LV.ListItems.Add(, , "")
  870. ic.SubItems(1) = 0
  871. ic.SubItems(2) = 1
  872. ic.SubItems(3) = 1
  873. ic.SubItems(4) = ""
  874. ic.SubItems(5) = 0
  875. ic.SubItems(6) = 0
  876. ic.SubItems(7) = 0
  877. ic.SubItems(8) = "0"
  878. ic.Selected = True
  879. Check1.Value = 0
  880. Check2.Value = 1
  881. Check3.Value = 1
  882. Check4.Value = 0
  883. Text5.Text = "0"
  884. List1.ListIndex = 0
  885. Combo1.ListIndex = 0
  886. Combo2.ListIndex = 0
  887. existing = False
  888. End Sub
  889. Private Sub mnuFileOpen_Click()
  890. 'On Error GoTo woops
  891. Dim curtext1 As String
  892. Dim temp As String
  893. Dim temp1 As String
  894. Dim tempInt1 As Integer
  895. Dim tempInt2 As Integer
  896. Dim tempInt3 As Integer
  897. With CommonDialog1
  898.     .DialogTitle = "Edit Existing Form"
  899.     .CancelError = True
  900.     .Filter = "VB 6 Forms |*.frm"
  901.     .ShowOpen
  902.     If Len(.FileName) = 0 Then Exit Sub
  903.     temp = .FileName
  904. End With
  905. Label5 = "Form Name :"
  906. ExistingPath = temp
  907. Text6.Text = temp
  908. existing = True
  909. 'read the form to get the befor menu structure and after menu
  910. 'structure text and finally the menu structure itself
  911. 'We separate it like this to make it easy to put back
  912. 'together when we get to saving
  913. rtftext.LoadFile ExistingPath
  914. curtext = rtftext.Text
  915. textfound = InStr(1, curtext, "Attribute VB_Name =")
  916. AfterTxt = Mid(curtext, textfound, Len(curtext) - textfound + 1)
  917. textfound = InStr(1, AfterTxt, vbCrLf)
  918. curtext1 = Left(AfterTxt, textfound)
  919. tempInt1 = InStr(curtext1, Chr(34))
  920. tempInt2 = InStr(tempInt1 + 1, curtext1, Chr(34))
  921. tempInt3 = tempInt2 - tempInt1
  922. temp1 = Mid(curtext1, tempInt1, tempInt3)
  923. temp = Right(temp1, Len(temp1) - 1)
  924. Text4.Text = temp
  925. textfound = InStr(1, curtext, "Begin VB.Menu")
  926. If textfound = -1 Then
  927.     curtext1 = Left(curtext, Len(curtext) - Len(AfterTxt))
  928.     BeforeTxt = Mid$(curtext1, 1, InStrRev(curtext1, "E") - 1)
  929.     Exit Sub
  930. End If
  931. BeforeTxt = Left(curtext, textfound - 1)
  932. curtext = Mid(curtext, Len(BeforeTxt), Len(curtext) - Len(AfterTxt) - Len(BeforeTxt))
  933. ParseMenu
  934. woops:
  935. End Sub
  936. Public Function GetMyMenu() As String
  937. 'This function is really messy - but what it does is
  938. 'writes to a form or a template the menu structure
  939. 'shown in the list, in a format acceptable to VB6
  940. Dim tempstr() As String, emp As String, empcnt() As Integer, diffemp As Integer
  941. Dim chcheck As String, chenable As String, chvis As String, txtIndex As String, cboShcut As String
  942. Dim txtHelpCID As String, chWlist As String, cboNegPos As String
  943. Dim EndCount As Integer, alreadyWlist As Boolean
  944. EndCount = 1
  945. ReDim tempstr(0 To List1.ListCount - 1)
  946. ReDim empcnt(0 To List1.ListCount - 1) 'nested depth
  947. For x = 0 To List1.ListCount - 1
  948.     emp = Mid$(List1.List(x), 1, InStrRev(List1.List(x), "
  949.     empcnt(x) = Len(emp)
  950.     chcheck = ""
  951.     chenable = ""
  952.     chvis = ""
  953.     txtIndex = ""
  954.     cboShcut = ""
  955.     chWlist = ""
  956.     cboNegPos = ""
  957.     txtHelpCID = ""
  958.     'get the data from the hidden ListView
  959.     If LV.ListItems(x + 1).SubItems(1) = 1 Then chcheck = vbCrLf + String(empcnt(x) + 7, " ") + "Checked        =   -1"
  960.     If LV.ListItems(x + 1).SubItems(2) = 0 Then chenable = vbCrLf + String(empcnt(x) + 7, " ") + "Enabled        =   0"
  961.     If LV.ListItems(x + 1).SubItems(3) = 0 Then chvis = vbCrLf + String(empcnt(x) + 7, " ") + "Visible        =   0"
  962.     If LV.ListItems(x + 1).SubItems(4) <> "" Then txtIndex = vbCrLf + String(empcnt(x) + 7, " ") + "Index           =   " + LV.ListItems(x + 1).SubItems(4)
  963.     If LV.ListItems(x + 1).SubItems(5) <> 0 Then cboShcut = vbCrLf + String(empcnt(x) + 7, " ") + "Shortcut        =   " + GetShortCut(Val(LV.ListItems(x + 1).SubItems(5)))
  964.     If LV.ListItems(x + 1).SubItems(6) = 1 Then chWlist = vbCrLf + String(empcnt(x) + 7, " ") + "WindowList      =   -1"
  965.     If LV.ListItems(x + 1).SubItems(7) <> 0 Then cboNegPos = vbCrLf + String(empcnt(x) + 7, " ") + "NegotiatePosition=   " + LV.ListItems(x + 1).SubItems(7)
  966.     If LV.ListItems(x + 1).SubItems(8) = "" Then LV.ListItems(x + 1).SubItems(8) = "0"
  967.     If LV.ListItems(x + 1).SubItems(8) <> "0" Then txtHelpCID = vbCrLf + String(empcnt(x) + 7, " ") + "HelpContextID   =   " + LV.ListItems(x + 1).SubItems(8)
  968.     'Make sure the menu structure is valid
  969.     If x = 0 Then
  970.         If empcnt(x) > 0 Then GoTo mnuError1 'read mnuError1 for explanation
  971.     Else
  972.         If empcnt(x) > empcnt(x - 1) + 4 Then GoTo mnuError1
  973.     End If
  974.     If empcnt(x) = 0 Then 'things disallowed in parent menus
  975.         If LV.ListItems(x + 1).SubItems(5) <> 0 Then GoTo mnuError2
  976.         If LV.ListItems(x + 1).SubItems(1) = 1 Then GoTo mnuError3
  977.         If alreadyWlist = True Then
  978.             GoTo mnuError7
  979.         Else
  980.             If LV.ListItems(x + 1).SubItems(6) = 1 Then
  981.                 alreadyWlist = True
  982.             End If
  983.         End If
  984.     Else                 'things disallowed in submenus
  985.         If LV.ListItems(x + 1).SubItems(6) = 1 Then GoTo mnuError8
  986.     End If
  987.     'needs a menu name
  988.     If LV.ListItems(x + 1).Text = "" Then GoTo mnuError4
  989.     'make sure everythings OK with index numbers
  990.     If txtIndex = "" Then
  991.         For z = 1 To LV.ListItems.Count
  992.             For p = 1 To LV.ListItems.Count
  993.                 If p <> z Then
  994.                     If Len(LV.ListItems(z).SubItems(4)) = 0 Then
  995.                         If Len(LV.ListItems(p).SubItems(4)) = 0 Then
  996.                             If LV.ListItems(z).Text = LV.ListItems(p).Text Then GoTo mnuError5
  997.                         End If
  998.                     End If
  999.                 End If
  1000.             Next p
  1001.         Next z
  1002.     Else
  1003.         If Val(LV.ListItems(x + 1).SubItems(4)) > 0 Then
  1004.             If empcnt(x) <> empcnt(x - 1) Then
  1005.                 GoTo mnuError6
  1006.             Else
  1007.                 If Val(LV.ListItems(x).SubItems(4)) <> Val(LV.ListItems(x + 1).SubItems(4)) - 1 Then GoTo mnuError6
  1008.             End If
  1009.         End If
  1010.     End If
  1011.     'if we get this far the structure must be valid so fill
  1012.     'our string array with data
  1013.     If x = 0 Then
  1014.         tempstr(x) = String(3, " ") + "Begin VB.Menu " + LV.ListItems(x + 1).Text + vbCrLf + String(empcnt(x) + 7, " ") + "Caption        =   " + Chr(34) + Mid$(List1.List(x), InStrRev(List1.List(x), "
  1015. ") + 1) + Chr(34) + chcheck + chenable + chvis + txtIndex + cboShcut + chWlist + cboNegPos + txtHelpCID
  1016.     Else
  1017.         If empcnt(x) = empcnt(x - 1) + 4 Then
  1018.             tempstr(x) = String(empcnt(x) + 3, " ") + "Begin VB.Menu " + LV.ListItems(x + 1).Text + vbCrLf + String(empcnt(x) + 7, " ") + "Caption        =   " + Chr(34) + Mid$(List1.List(x), InStrRev(List1.List(x), "
  1019. ") + 1) + Chr(34) + chcheck + chenable + chvis + txtIndex + cboShcut + chWlist + cboNegPos + txtHelpCID
  1020.         ElseIf empcnt(x) = empcnt(x - 1) Then
  1021.             tempstr(x) = String(empcnt(x - 1) + 3, " ") + "End" + vbCrLf + String(empcnt(x) + 3, " ") + "Begin VB.Menu " + LV.ListItems(x + 1).Text + vbCrLf + String(empcnt(x) + 7, " ") + "Caption        =   " + Chr(34) + Mid$(List1.List(x), InStrRev(List1.List(x), "
  1022. ") + 1) + Chr(34) + chcheck + chenable + chvis + txtIndex + cboShcut + chWlist + cboNegPos + txtHelpCID
  1023.             EndCount = EndCount + 1
  1024.         ElseIf empcnt(x) = 0 Then
  1025.             tempstr(x) = String(empcnt(x) + 3, " ") + "Begin VB.Menu " + LV.ListItems(x + 1).Text + vbCrLf + String(empcnt(x) + 7, " ") + "Caption        =   " + Chr(34) + Mid$(List1.List(x), InStrRev(List1.List(x), "
  1026. ") + 1) + Chr(34) + chcheck + chenable + chvis + txtIndex + cboShcut + chWlist + cboNegPos + txtHelpCID
  1027.             For Y = 0 To x - EndCount
  1028.             tempstr(x) = String(Y * 4 + 3, " ") + "End" + vbCrLf + tempstr(x)
  1029.             EndCount = EndCount + 1
  1030.             Next Y
  1031.         End If
  1032.     End If
  1033. Next x
  1034. 'this makes sure we have the right number of 'End' statements
  1035. 'and to keep it neat, that they are indented appropriately
  1036. For x = 0 To List1.ListCount - 1
  1037.     If x <> List1.ListCount - 1 Then
  1038.         GetMyMenu = GetMyMenu + tempstr(x) + vbCrLf
  1039.     Else
  1040.         GetMyMenu = GetMyMenu + tempstr(x)
  1041.     End If
  1042. Next x
  1043. diffemp = (List1.ListCount) - EndCount
  1044. For Y = diffemp To 1 Step -1
  1045. GetMyMenu = GetMyMenu + vbCrLf + String(Y * 4 + 3, " ") + "End"
  1046. Next Y
  1047. GetMyMenu = GetMyMenu + vbCrLf + String(3, " ") + "End"
  1048. Exit Function
  1049. 'If the menu structure was invalid we end up here
  1050. mnuError1:
  1051. MsgBox "Menu Item skipped a level"
  1052. List1.ListIndex = x
  1053. InvalidMenu = True
  1054. Exit Function
  1055. mnuError2:
  1056. MsgBox "Parent Menu cannot have a Shortcut"
  1057. List1.ListIndex = x
  1058. InvalidMenu = True
  1059. Exit Function
  1060. mnuError3:
  1061. MsgBox "Parent Menu cannot be Checked"
  1062. List1.ListIndex = x
  1063. InvalidMenu = True
  1064. Exit Function
  1065. mnuError4:
  1066. MsgBox "Menu must have a name"
  1067. List1.ListIndex = x
  1068. InvalidMenu = True
  1069. Exit Function
  1070. mnuError5:
  1071. MsgBox "Menu name cannot be duplicated"
  1072. List1.ListIndex = z
  1073. InvalidMenu = True
  1074. Exit Function
  1075. mnuError6:
  1076. MsgBox "Invalid index"
  1077. List1.ListIndex = x
  1078. InvalidMenu = True
  1079. Exit Function
  1080. mnuError7:
  1081. MsgBox "Only one Window List allowed"
  1082. List1.ListIndex = x
  1083. InvalidMenu = True
  1084. Exit Function
  1085. mnuError8:
  1086. MsgBox "Only Parent Menu can be a Window List"
  1087. List1.ListIndex = x
  1088. InvalidMenu = True
  1089. Exit Function
  1090. End Function
  1091. Private Sub mnuFileOpenTemplate_Click()
  1092. Dim temp As String
  1093. On Error GoTo woops
  1094. With CommonDialog1
  1095.     .DialogTitle = "Open Template"
  1096.     .CancelError = True
  1097.     .Filter = "Menu Template |*.bmu"
  1098.     .ShowOpen
  1099.     If Len(.FileName) = 0 Then Exit Sub
  1100.     temp = .FileName
  1101.     Text4.Text = .FileTitle
  1102.     Text6.Text = .FileName
  1103.     Label5 = "Template"
  1104. End With
  1105. rtftext.LoadFile temp
  1106. curtext = rtftext.Text
  1107. ParseMenu
  1108. woops:
  1109. End Sub
  1110. Private Sub mnuFileSaveAsTemplate_Click()
  1111. Dim temp As String, myMenu As String
  1112. On Error GoTo woops
  1113. With CommonDialog1
  1114.     .DialogTitle = "Save Menu as Template"
  1115.     .CancelError = True
  1116.     .Filter = "Menu Template |*.bmu"
  1117.     .ShowSave
  1118.     If Len(.FileName) = 0 Then Exit Sub
  1119.     temp = .FileName
  1120. End With
  1121. Screen.MousePointer = 11
  1122. myMenu = GetMyMenu
  1123. Screen.MousePointer = 0
  1124. FileSave myMenu, temp
  1125. woops:
  1126. End Sub
  1127. Private Sub mnuFileSaveFormAs_Click()
  1128. On Error GoTo woops
  1129. Dim temp As String, myMenu As String, sfile As String
  1130. Screen.MousePointer = 11
  1131. myMenu = GetMyMenu
  1132. Screen.MousePointer = 0
  1133. If InvalidMenu Then
  1134.     InvalidMenu = False
  1135.     Screen.MousePointer = 0
  1136.     Exit Sub
  1137. End If
  1138. With CommonDialog1
  1139.     .FileName = Text4.Text + ".frm"
  1140.     .DialogTitle = "Save Form"
  1141.     .CancelError = True
  1142.     .Filter = "VB 6 Forms |*.frm"
  1143.     .ShowSave
  1144.     If Len(.FileName) = 0 Then Exit Sub
  1145.     sfile = .FileName
  1146. End With
  1147. temp = BeforeTxt + vbCrLf + myMenu + vbCrLf + "End" + vbCrLf + AfterTxt
  1148. FileSave temp, sfile
  1149. existing = True
  1150. Text6.Text = sfile
  1151. ExistingPath = sfile
  1152. woops:
  1153. Screen.MousePointer = 0
  1154. End Sub
  1155. Private Sub mnuFileSaveMenu_Click()
  1156. On Error GoTo woops
  1157. Dim temp As String, myMenu As String, sfile As String
  1158. Screen.MousePointer = 11
  1159. myMenu = GetMyMenu
  1160. Screen.MousePointer = 0
  1161. If InvalidMenu Then
  1162.     InvalidMenu = False
  1163.     Exit Sub
  1164. End If
  1165. With CommonDialog1
  1166.     .FileName = Text4.Text + ".frm"
  1167.     .DialogTitle = "Save Form"
  1168.     .CancelError = True
  1169.     .Filter = "VB 6 Forms |*.frm"
  1170.     .ShowSave
  1171.     If Len(.FileName) = 0 Then Exit Sub
  1172.     sfile = .FileName
  1173. End With
  1174. temp = "VERSION 5.00" + vbCrLf + "Begin VB.Form " + Text4.Text + vbCrLf + "   Caption         =   " + Chr(34) + Text4.Text + Chr(34) + vbCrLf _
  1175. + "   ClientHeight    =   3195" + vbCrLf + "   ClientLeft      =   60" + vbCrLf + "   ClientTop       =   345" + vbCrLf _
  1176. + "   ClientWidth     =   4680" + vbCrLf + "   LinkTopic       =   " + Chr(34) + "Form1" + Chr(34) + vbCrLf + "   ScaleHeight     =   3195" + vbCrLf _
  1177. + "   ScaleWidth      =   4680" + vbCrLf + "   StartUpPosition =   3" + vbCrLf + myMenu + vbCrLf + "End" + vbCrLf _
  1178. + "Attribute VB_Name = " + Chr(34) + Text4.Text + Chr(34) + vbCrLf + "Attribute VB_GlobalNameSpace = False" + vbCrLf + "Attribute VB_Creatable = False" + vbCrLf _
  1179. + "Attribute VB_PredeclaredId = True" + vbCrLf + "Attribute VB_Exposed = False" + vbCrLf
  1180. FileSave temp, sfile
  1181. existing = True
  1182. Text6.Text = sfile
  1183. ExistingPath = sfile
  1184. woops:
  1185. Screen.MousePointer = 0
  1186. End Sub
  1187. Private Sub mnuHelp_Click()
  1188. mnuFileAbout_Click
  1189. End Sub
  1190. Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
  1191. Dim emp As String
  1192. emp = Mid$(List1.List(List1.ListIndex), 1, InStrRev(List1.List(List1.ListIndex), "
  1193. List1.List(List1.ListIndex) = emp + Text1.Text
  1194. End Sub
  1195. Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
  1196. LV.ListItems(List1.ListIndex + 1).Text = Text2.Text
  1197. End Sub
  1198. Private Sub Text3_KeyUp(KeyCode As Integer, Shift As Integer)
  1199. LV.ListItems(List1.ListIndex + 1).SubItems(4) = Text3.Text
  1200. End Sub
  1201. Private Sub Text5_KeyUp(KeyCode As Integer, Shift As Integer)
  1202. LV.ListItems(List1.ListIndex + 1).SubItems(8) = Text5.Text
  1203. End Sub
  1204. Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  1205. Dim emp As String
  1206. emp = Mid$(List1.List(List1.ListIndex), 1, InStrRev(List1.List(List1.ListIndex), "
  1207. List1.List(List1.ListIndex) = emp + Text1.Text
  1208. End Sub
  1209. Private Sub Text2_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  1210. LV.ListItems(List1.ListIndex + 1).Text = Text2.Text
  1211. End Sub
  1212. Private Sub Text3_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  1213. LV.ListItems(List1.ListIndex + 1).SubItems(4) = Text3.Text
  1214. End Sub
  1215. Public Sub ParseMenu()
  1216. 'This sub loads an existing menu from either a form
  1217. 'or a template into the hidden ListView and the
  1218. 'list used to show the user
  1219. Dim x As Integer
  1220. Dim newpos As Integer
  1221. Dim Blankcnt As Integer
  1222. Dim temp As String
  1223. Dim temp1 As String
  1224. Dim tempInt1 As Integer
  1225. Dim tempInt2 As Integer
  1226. Dim tempInt3 As Integer
  1227. Dim mnuDot As Integer
  1228. Dim mnuCount As Integer
  1229. List1.Clear
  1230. LV.ListItems.Clear
  1231. Set ic = LV.ListItems.Add(, , "")
  1232. ic.SubItems(1) = 0
  1233. ic.SubItems(2) = 1
  1234. ic.SubItems(3) = 1
  1235. ic.SubItems(4) = ""
  1236. ic.SubItems(5) = 0
  1237. ic.SubItems(6) = 0
  1238. ic.SubItems(7) = 0
  1239. mnuCount = 0
  1240. mnuDot = 0
  1241. pos = 1
  1242. Do Until pos >= Len(curtext) - 1
  1243. textfound = InStr(pos, curtext, vbCrLf)
  1244. If textfound = 0 Then Exit Do
  1245. newpos = pos
  1246. pos = textfound + 1
  1247. temp = Mid(curtext, newpos, pos - newpos)
  1248. If InStr(1, temp, "Begin VB.Menu") Then
  1249.     'found a menu so load up the hidden Listview
  1250.     Blankcnt = InStr(1, temp, "Begin VB.Menu")
  1251.     If Blankcnt > 0 Then Blankcnt = Blankcnt - 1
  1252.     temp = TrimVoid(Right(temp, Len(temp) - 14 - Blankcnt))
  1253.     mnuCount = mnuCount + 1
  1254.     LV.ListItems(mnuCount).Text = temp
  1255.     LV.ListItems(mnuCount).SubItems(1) = 0
  1256.     LV.ListItems(mnuCount).SubItems(2) = 1
  1257.     LV.ListItems(mnuCount).SubItems(3) = 1
  1258.     LV.ListItems(mnuCount).SubItems(4) = ""
  1259.     LV.ListItems(mnuCount).SubItems(5) = 0
  1260.     LV.ListItems(mnuCount).SubItems(6) = 0
  1261.     LV.ListItems(mnuCount).SubItems(7) = 0
  1262.     Set ic = LV.ListItems.Add(, , "")
  1263.     ic.SubItems(1) = 0
  1264.     ic.SubItems(2) = 1
  1265.     ic.SubItems(3) = 1
  1266.     ic.SubItems(4) = ""
  1267.     ic.SubItems(5) = 0
  1268.     ic.SubItems(6) = 0
  1269.     ic.SubItems(7) = 0
  1270.     GoTo doboy
  1271. End If
  1272. 'read the file for menu data and add if found
  1273. 'adjusting checks and comboboxes as we go
  1274. If InStr(1, temp, "Caption") Then
  1275.     Dim intFirstOne As Integer
  1276.     Dim intSecondOne As Integer
  1277.     Dim intLength As Integer
  1278.     temp = Mid$(temp, InStrRev(temp, "=") + 1)
  1279.     tempInt1 = InStr(temp, Chr(34))
  1280.     tempInt2 = InStr(tempInt1 + 1, temp, Chr(34))
  1281.     tempInt3 = tempInt2 - tempInt1
  1282.     temp1 = Mid(temp, tempInt1, tempInt3)
  1283.     temp = Right(temp1, Len(temp1) - 1)
  1284.     If temp = "" Then temp = "-"
  1285.     List1.AddItem String(mnuDot * 4, "
  1286. ") + temp, mnuCount - 1
  1287.     List1.Selected(mnuCount - 1) = True
  1288.     mnuDot = mnuDot + 1
  1289.     GoTo doboy
  1290. End If
  1291. If InStr(1, temp, "Checked") Then
  1292.     LV.ListItems(mnuCount).SubItems(1) = 1
  1293.     GoTo doboy
  1294. End If
  1295. If InStr(1, temp, "Enabled") Then
  1296.     LV.ListItems(mnuCount).SubItems(2) = 0
  1297.     GoTo doboy
  1298. End If
  1299. If InStr(1, temp, "Visible") Then
  1300.     LV.ListItems(mnuCount).SubItems(3) = 0
  1301.     GoTo doboy
  1302. End If
  1303. If InStr(1, temp, "Index") Then
  1304.     temp = TrimVoid(Mid$(temp, InStrRev(temp, "=") + 1))
  1305.     LV.ListItems(mnuCount).SubItems(4) = temp
  1306.     GoTo doboy
  1307. End If
  1308. If InStr(1, temp, "Shortcut") Then
  1309.     For x = 1 To 79
  1310.         temp1 = GetShortCut(x)
  1311.         If InStr(1, temp, temp1) Then
  1312.             LV.ListItems(mnuCount).SubItems(5) = x
  1313.             List1.Column(1, mnuCount - 1) = Combo1.List(x)
  1314.             Exit For
  1315.         End If
  1316.     Next x
  1317.     GoTo doboy
  1318. End If
  1319. If InStr(1, temp, "WindowList") Then
  1320.     LV.ListItems(mnuCount).SubItems(6) = 1
  1321.     GoTo doboy
  1322. End If
  1323. If InStr(1, temp, "NegotiatePosition") Then
  1324.     temp = TrimVoid(Mid$(temp, InStrRev(temp, "=") + 1))
  1325.     LV.ListItems(mnuCount).SubItems(7) = Val(Left(temp, 1))
  1326.     GoTo doboy
  1327. End If
  1328. If InStr(1, temp, "HelpContextID") Then
  1329.     temp = TrimVoid(Mid$(temp, InStrRev(temp, "=") + 1))
  1330.     LV.ListItems(mnuCount).SubItems(8) = temp
  1331.     GoTo doboy
  1332. End If
  1333. If InStr(1, temp, "End") Then
  1334.     mnuDot = mnuDot - 1 'gives us the indented level of the menuitem
  1335.     GoTo doboy
  1336. End If
  1337. doboy:
  1338. List1.ListIndex = 0
  1339. End Sub
  1340. Private Sub Text6_KeyPress(KeyAscii As Integer)
  1341. KeyAscii = 0 'no manually adjusting the path thanks
  1342. End Sub
  1343.