2010-11-14 18:07

     $INCLUDE "rapidq.inc"
     $ESCAPECHARS ON
'$optimize on
     $APPTYPE GUI
     $TYPECHECK ON

     $OPTION ICON "Bitmaps\MenuDesigner.ico"
     APPLICATION.TITLE = "MenuDesigner"

     $RESOURCE MenuDesigner_ico AS "Bitmaps\MenuDesigner.ico"
     $RESOURCE ARW06LT_bmp AS "Bitmaps\ARW06LT.bmp"
     $RESOURCE ARW06RT_bmp AS "Bitmaps\ARW06RT.bmp"
     $RESOURCE ARW06DN_bmp AS "Bitmaps\ARW06DN.bmp"
     $RESOURCE ARW06UP_bmp AS "Bitmaps\ARW06UP.bmp"
     $RESOURCE preview_bmp AS "Bitmaps\Preview.bmp"
     $RESOURCE Menu_bmp AS "Bitmaps\MenuDesigner.bmp"
     $RESOURCE New_bmp AS "Bitmaps\New.bmp"
     $RESOURCE Open_bmp AS "Bitmaps\Open.bmp"
     $RESOURCE Save_bmp AS "Bitmaps\Save.bmp"
     $RESOURCE Options_bmp AS "Bitmaps\Options.bmp"
     $RESOURCE Help_bmp AS "Bitmaps\Help.bmp"
     $RESOURCE Exit_bmp AS "Bitmaps\Exit.bmp"

     $INCLUDE "APIs.inc"

'Subs Declares
     DECLARE SUB Inicialize
     DECLARE SUB GetDefaults
     DECLARE SUB SetDefaults
     DECLARE SUB FileOpen
     DECLARE SUB NewMenu
     DECLARE SUB SaveMenu
     DECLARE SUB Options
     DECLARE SUB About
     DECLARE SUB WriteFields
     DECLARE SUB NewItem
     DECLARE SUB SaveAs
     DECLARE FUNCTION ValidateMenu AS INTEGER
     DECLARE SUB WriteCode
     DECLARE SUB MadePreviewMenu
     DECLARE SUB gotoweb
     DECLARE SUB sendemail
     DECLARE SUB ExitProgram


     CONST cr = CHR$(13)+CHR$(10)

     DIM szFile AS STRING
     DIM Languages AS SINGLE
     DIM Language AS STRING
     DIM Indice AS INTEGER
     DIM maxItem AS INTEGER
     DIM Level AS INTEGER
     DIM CaptionStr AS STRING
     DIM Archivo AS STRING
     DIM ArchivoMenu AS STRING
     DIM Saved AS SINGLE
     DIM udtBI AS BrowseInfo
     DIM mii AS MENUITEMINFO  ' describes a menu item to add

     CREATE SaveDialog AS QSAVEDIALOG
     END CREATE

     $INCLUDE "frmPreview.bas"
     $INCLUDE "frmMain.bas"
     $INCLUDE "frmAbout.bas"
     $INCLUDE "frmOptions.bas"
     $INCLUDE "iniFiles.bas"

     Inicialize
     frmMain.SHOWMODAL

'--------- Subroutines ---------
     SUB Inicialize
      Indice = 0 :Level = 0 : maxItem = 0 :CaptionStr ="" :
      Archivo = "$NoName.mnu" : ArchivoMenu = "$NoName.inc"
      Saved = False
      SetFocus (txtCaption.Handle)
      szFile = GetIniPaht + "\\MenuDesigner.ini"
      GetDefaults
     END SUB

     SUB GetDefaults
      DIM KeyLanguage AS STRING
      DIM TempStr AS STRING
      DIM a AS SINGLE
      IF FILEEXISTS(szFile) THEN
       chkChecked.Checked = VAL(GetIni("Defaults","Checked","0"))
       chkOptChecked.Checked = chkChecked.Checked
       chkEnabled.Checked = VAL(GetIni("Defaults","Enabled","0"))
       chkOptEnabled.Checked = chkEnabled.Checked
       chkVisible.Checked = VAL(GetIni("Defaults","Visible","0"))
       chkOptVisible.Checked = chkVisible.Checked

       txtWorkFolder.Text = GetIni("Defaults","WorkFolder",CURDIR$)
       CHDIR txtWorkFolder.Text

       Language = GetIni("Defaults","Language","1")
       Languages = VAL(GetIni("Languages","Languages","1"))
       cmbOptLanguage.Clear
       FOR a = 1 TO Languages
        TempStr = "Language" + STR$(LTRIM$(RTRIM$(a)))
        KeyLanguage = GetIni("Languages",TempStr,"English")
        cmbOptLanguage.InsertItem a-1, KeyLanguage
       NEXT
       cmbOptLanguage.ItemIndex = VAL(Language)-1
       TempStr = "Language" + Language
       KeyLanguage = GetIni("Languages",TempStr,"English")

       mnuFile.CAPTION = GetIni(KeyLanguage, "File","&File")
       mnuFileNew.CAPTION = GetIni(KeyLanguage, "New","&New")
       mnuFileOpen.CAPTION = GetIni(KeyLanguage, "Open","&Open")
       mnuFileSave.CAPTION = GetIni(KeyLanguage, "Save","&Save")
       mnuFileSaveAs.CAPTION = GetIni(KeyLanguage, "SaveAs","Sa&ve as")
       mnuFileExit.CAPTION = GetIni(KeyLanguage, "Exit","&Exit")
       mnuView.CAPTION = GetIni(KeyLanguage, "View","&View")
       mnuViewOptions.CAPTION = GetIni(KeyLanguage, "Options","&Options")
       mnuViewTBar.CAPTION = GetIni(KeyLanguage, "ToolBar","&ToolBar")
       mnuHelp.CAPTION = GetIni(KeyLanguage, "Help","&Help")
       mnuHelpAbout.CAPTION = GetIni(KeyLanguage, "About","&About")
       cmdNew.Hint = GetIni(KeyLanguage, "bNew","New")
       cmdOpen.Hint = GetIni(KeyLanguage, "bOpen","Open")
       cmdSave.Hint = GetIni(KeyLanguage, "bSave","Save")
       cmdHelp.Hint = GetIni(KeyLanguage, "bHelp","Help")
       cmdExit.Hint = GetIni(KeyLanguage, "bExit","Exit")
       lblCaption.CAPTION = GetIni(KeyLanguage, "lblCaption","Ca&ption:")
       lblName.CAPTION = GetIni(KeyLanguage, "lblName","Na&me")
       chkChecked.CAPTION = GetIni(KeyLanguage, "CChecked","&Checked")
       chkEnabled.CAPTION = GetIni(KeyLanguage, "CEnabled","&Enabled")
       chkVisible.CAPTION = GetIni(KeyLanguage, "CVisible","&Visible")
       LblShortCut.CAPTION = GetIni(KeyLanguage, "lblShortCut","&ShortCut")
       cmdNext.CAPTION = GetIni(KeyLanguage, "Next","&Next")
       cmdInsert.CAPTION = GetIni(KeyLanguage, "Insert","&Insert")
       cmdDelete.CAPTION = GetIni(KeyLanguage, "Delete","&Delete")
       cmdWizard.CAPTION = GetIni(KeyLanguage, "Wizard","&Wi&zard")
       cmdPreview.CAPTION = GetIni(KeyLanguage, "Preview","Previe&w")
       stgItems.cell(0,0) = GetIni(KeyLanguage, "Properties","Properties")
       stgItems.cell(0,1) = GetIni(KeyLanguage, "Name","Name")
       stgItems.cell(0,2) = GetIni(KeyLanguage, "Caption","Caption")
       stgItems.cell(0,3) = GetIni(KeyLanguage, "Checked","Checked")
       stgItems.cell(0,4) = GetIni(KeyLanguage, "Enabled","Enabled")
       stgItems.cell(0,5) = GetIni(KeyLanguage, "Visible","Visible")
       stgItems.cell(0,6) = GetIni(KeyLanguage, "ShortCut","ShortCut")
       stgItems.cell(0,7) = GetIni(KeyLanguage, "Level","Level")
       cmdSaveCode.CAPTION = GetIni(KeyLanguage, "bSaveCode","&Save Code")
       cmdCopyCode.CAPTION = GetIni(KeyLanguage, "bCopyCode","&Copy Code")
       cmdClosePreview.CAPTION = GetIni(KeyLanguage, "bClosePreview","C&lose Preview")

       chkOptPreDeclares.Checked = VAL(GetIni("Defaults","PreDeclare","0"))
       chkOptDeclares.Checked = VAL(GetIni("Defaults","Declares","1"))
       chkOptOnlyMenu.Checked = VAL(GetIni("Defaults","OnlyMenu","0"))

       chkOptHardTabs.Checked = VAL(GetIni("Defaults","HardTabs","1"))
       chkOptSoftTabs.Checked = VAL(GetIni("Defaults","SoftTabs","0"))
       txtOptSpaces.Text = (GetIni("Defaults","Spaces","3"))
       txtOptSpaces.enabled = False
       IF chkOptSoftTabs.Checked THEN txtOptSpaces.enabled = True

      END IF
     END SUB

     SUB SetDefaults
      WriteIni "Defaults", "Checked", STR$(LTRIM$(RTRIM$(chkOptChecked.Checked)))
      WriteIni "Defaults", "Enabled", STR$(LTRIM$(RTRIM$(chkOptChecked.Enabled)))
      WriteIni "Defaults", "Visible", STR$(LTRIM$(RTRIM$(chkOptChecked.Visible)))

      WriteIni "Defaults", "WorkFolder", txtWorkFolder.Text
      WriteIni "Defaults", "Language", STR$(LTRIM$(RTRIM$(cmbOptLanguage.ItemIndex + 1)))

      WriteIni "Defaults", "PreDeclare", STR$(LTRIM$(RTRIM$(chkOptPreDeclares.Checked)))
      WriteIni "Defaults", "Declares", STR$(LTRIM$(RTRIM$(chkOptDeclares.Checked)))
      WriteIni "Defaults", "OnlyMenu", STR$(LTRIM$(RTRIM$(chkOptOnlyMenu.Checked)))

      WriteIni "Defaults", "HardTabs", STR$(LTRIM$(RTRIM$(chkOptHardTabs.Checked)))
      WriteIni "Defaults", "SoftTabs", STR$(LTRIM$(RTRIM$(chkOptSoftTabs.Checked)))
      WriteIni "Defaults", "Spaces", txtOptSpaces.Text

      GetDefaults
     END SUB

     SUB NewMenu
      SetFocus (txtCaption.Handle)
      Indice = 0 : Level = 0 : maxItem = 0
      CaptionStr = "" : Archivo = "$NoName.mnu"
      WITH stgItems
       .ColCount = 2
       .InsertCol(1)
       .deleteCol(2)
      END WITH
      NewItem
      WITH lstItems
       .Clear
       .addItems = ""
       .ItemIndex = Indice
      END WITH
     END SUB

     SUB FileOpen
      SetFocus (txtCaption.Handle)
      OpenDialog.FileName = ""
      IF OpenDialog.EXECUTE THEN
       DIM ArchivoStrLine AS STRING
       DIM File AS QFILESTREAM
       DIM Count% AS SINGLE
       DIM p  AS SINGLE
       Archivo = OpenDialog.FileName
       p = rinstr(Archivo,"\\")
       Archivo = MID$(OpenDialog.FileName,p + 1)
       File.OPEN(Archivo, fmOpenRead)
       ArchivoStrLine = File.ReadLine
       File.CLOSE
       Count% = TALLY(ArchivoStrLine, ",")
       stgItems.ColCount = Count% + 1
       stgItems.LoadFromFile Archivo,1,1,7
       lstItems.Clear
       DIM a% AS SINGLE
       FOR a%= 0 TO Count% -1
        stgItems.Cell(a% +1 ,0) ="Values"
        Level = VAL(stgItems.Cell(a% + 1,7))
        lstItems.addItems = ""
        lstItems.Item(a%) =  STRING$(Level, "=") + stgItems.Cell(a% + 1,2)
       NEXT
       Indice = 0
       Level = VAL(stgItems.Cell(1,7))
       lstItems.ItemIndex = Indice
       WriteFields
       frmMain.CAPTION = "MenuDesigner  " + Archivo
      END IF
     END SUB

     SUB SaveMenu (Sender AS QMENUITEM)
      SetFocus (txtCaption.Handle)
      IF Archivo <> "$NoName.mnu" THEN
       stgItems.SaveToFile Archivo,1,1,7
       SHOWMESSAGE Archivo + " Saved"
       Saved = True
      ELSE
       SaveAs
      END IF
     END SUB

     SUB SaveAs
      SetFocus (txtCaption.Handle)
      DIM ext$ AS STRING
      SaveDialog.CAPTION = "Save Menu Template as..."
      SaveDialog.Filter = "Menu Template (*.mnu)|*.mnu|All Files (*.*)|*.*"

      IF Archivo <> "$NoName.mnu" THEN
       SaveDialog.FileName = Archivo
      ELSE
       SaveDialog.FileName = "$NoName.mnu"
      END IF

      IF SaveDialog.EXECUTE THEN
       Archivo = SaveDialog.FileName
       ext$ = RIGHT$(Archivo,4)
       IF ext$ <> ".mnu" THEN Archivo = Archivo + ".mnu"
       stgItems.SaveToFile Archivo,1,1,7
       DIM p  AS SINGLE
       p = rinstr(Archivo,"\\")
       Archivo = MID$(Archivo,p + 1)
       frmMain.CAPTION = "MenuDesigner  " + Archivo
       SHOWMESSAGE Archivo + " Saved"
       Saved = True
      END IF
     END SUB

     SUB Options
      SetFocus (txtCaption.Handle)
      frmOptions.SHOWMODAL
     END SUB

     SUB About
      SetFocus (txtCaption.Handle)
      frmAbout.SHOWMODAL
     END SUB

     SUB ExitProgram
      DIM Message AS STRING
      Message = "If you have made changes to this menu."+ cr + "Would you like save them?"
      IF MESSAGEDLG(Message,  mtWarning,  mbYes OR mbNo,  0) = mrNo THEN
       frmMain.CLOSE
      ELSE
       SaveMenu
       IF Saved THEN frmMain.CLOSE
      END IF
     END SUB

     FUNCTION ValidateMenu
      DIM oldLevel AS INTEGER
      DIM ActualLevel AS INTEGER
      DIM Faild AS INTEGER
      DIM a% AS SINGLE

      OldLevel = VAL(stgItems.Cell(1,7))
      IF oldLevel > 0 THEN
       SHOWMESSAGE "Menu jump a Level"
       Indice = 0
       WriteFields
       lstItems.ItemIndex = Indice
       ValidateMenu = False
       EXIT SUB
      END IF

      maxItem = stgItems.ColCount - 1
      FOR a%= 1 TO maxItem
       IF stgItems.Cell(a%,1) = "" THEN
        SHOWMESSAGE "Name is necesary"
        Faild = True
        EXIT FOR
       END IF
       IF stgItems.Cell(a%,2) = "" THEN
        SHOWMESSAGE "Caption is necesary"
        Faild = True
        EXIT FOR
       END IF
       ActualLevel = VAL(stgItems.Cell(a%,7))
       IF ActualLevel = 0 THEN
        IF VAL(stgItems.Cell(a%,6)) THEN
         SHOWMESSAGE "This Item canŽt have ShortCut"
         Faild = True
         EXIT FOR
        END IF
        IF VAL(stgItems.Cell(a%,3)) THEN
         SHOWMESSAGE "This Item canŽt set Checked"
         Faild = True
         EXIT FOR
        END IF
       END IF
       IF ActualLevel > OldLevel + 1 THEN
        SHOWMESSAGE "Menu jump a Level"
        Faild = True
        EXIT FOR
       ELSE
        OldLevel = ActualLevel
       END IF
      NEXT

      IF Faild THEN
       Indice = a%-1
       WriteFields
       lstItems.ItemIndex = Indice
       ValidateMenu = False
      ELSE
       ValidateMenu = True
      END IF

     END SUB

     SUB WriteFields
      Level = VAL(stgItems.cell(Indice + 1,7))
      txtName.text = stgItems.cell(Indice + 1,1)
      txtCaption.text = stgItems.cell(Indice + 1,2)
      chkChecked.Checked = VAL(stgItems.cell(Indice + 1,3))
      chkEnabled.Checked = VAL(stgItems.cell(Indice + 1,4))
      chkVisible.Checked = VAL(stgItems.cell(Indice + 1,5))
      cmbShortCut.ItemIndex = VAL(stgItems.cell(Indice + 1,6))
      stgItems.Row = 0:stgItems.col = 0
      stgItems.leftcol = Indice + 1
     END SUB

     SUB NewItem
      DIM DefaultStr AS STRING
      stgItems.Cell(Indice + 1,0) = "Values" : stgItems.Col=0 : stgItems.Row=0
      txtCaption.text = "" : txtName.text = ""
      chkChecked.Checked = chkOptChecked.Checked
      chkEnabled.Checked = chkOptEnabled.Checked
      chkVisible.Checked = chkOptVisible.Checked
      cmbShortCut.ItemIndex = 0
      WITH stgItems
       .Cell(Indice + 1,1) = ""
       .Cell(Indice + 1,2) = ""
       IF chkChecked.Checked THEN DefaultStr = "1 -True" ELSE DefaultStr = "0 -False"
       .Cell(Indice + 1,3) = DefaultStr
       IF chkEnabled.Checked THEN DefaultStr = "1 -True" ELSE DefaultStr = "0 -False"
       .Cell(Indice + 1,4) = DefaultStr
       IF chkVisible.Checked THEN DefaultStr = "1 -True" ELSE DefaultStr = "0 -False"
       .Cell(Indice + 1,5) = DefaultStr
       .Cell(Indice + 1,6) = "0 -(None)"
       .Cell(Indice + 1,7) = STR$(Level)
      END WITH
     END SUB


     SUB MadePreviewMenu
      DIM hMenu AS LONG, hSubMenu AS LONG  ' handle to the menu and subMenu
      DIM count AS LONG        ' the number of items initially on the menu
'    Dim mii As MENUITEMINFO  ' describes a menu item to add
      DIM retval AS LONG       ' return value
      DIM dwTD  AS STRING
      DIM s AS LONG, f AS SINGLE, g AS SINGLE
      DIM Level AS SINGLE, nextLevel AS SINGLE, BackLevel AS SINGLE
      DIM hd(1 TO stgItems.ColCount) AS LONG, HdParent AS LONG
      DIM shCut$ AS STRING

    ' Get a handle to the menu.
      hMenu = GetMenu(frmPreview.Handle)
      IF hMenu <> 0 THEN
       DestroyMenu hMenu
      END IF
      hMenu = CreateMenu
      SetMenu frmPreview.Handle, hMenu

    'For frist item HdParent as hMenu
      hd(1) = hMenu
    ' The size of the structure.
      mii.cbSize = SIZEOF (mii)

      FOR s = 1 TO stgItems.ColCount - 1
       Level = VAL(stgItems.Cell(s,7))
       nextLevel = VAL(stgItems.Cell(s + 1,7))
       hdParent = hd(s)
       WITH mii
         ' This is a regular text item.
        .fType = MFT_STRING
        IF stgItems.Cell(s,2)= "-" THEN .fType = .fType OR MFT_SEPARATOR
        IF VAL(stgItems.Cell(s,5)) THEN ' The Item is Visible.
         .fState = MFS_ENABLED
        ELSE                            ' The Item isn't Visible.
         .fState = MFS_DISABLED OR  MFT_MENUBREAK
        END IF
         'The Item is checked
        IF VAL(stgItems.Cell(s,3)) THEN .fState = .fState OR MFS_CHECKED
         'The Item is Disabled
        IF (VAL(stgItems.Cell(s,4))) = 0 THEN .fState = .fState OR MFS_GRAYED
         ' It has an ID of 1 (this identifies it in the window procedure).
        .wID = s
         ' The text to place in the menu item.
        ShCut$ = stgItems.Cell(s,6)
        IF VAL(ShCut$) > 0 THEN                         'if have a ShorCut
         g = INSTR(ShCut$,"-")
         ShCut$ = MID$(ShCut$, g + 1 ,LEN(ShCut$))
         dwTD = stgItems.Cell(s,2) + CHR$(9) + ShCut$ 'add it
        ELSE
         dwTD = stgItems.Cell(s,2)
        END IF
        .dwTypeData =  VARPTR(dwTD)
        .cch = LEN(dwTD)
        IF nextLevel > Level THEN 'The Item  have soons
         hSubMenu = CreatePopUpMenu
         .fMask = MIIM_STATE OR MIIM_ID OR MIIM_TYPE OR MIIM_SUBMENU
         .hSubMenu = hSubMenu
         hd(s+1) = hSubMenu
        ELSEIF nextLevel = Level THEN
         .fMask = MIIM_STATE OR MIIM_ID OR MIIM_TYPE
         .hSubMenu = 0
         hd(s+1) = hd(s)
        ELSEIF nextLevel < Level THEN 'Find Parent
         FOR f = s - 1 TO 1 STEP -1
          BackLevel = VAL(stgItems.Cell(f,7))
          IF BackLevel =< nextLevel THEN
           .fMask = MIIM_STATE OR MIIM_ID OR MIIM_TYPE
           .hSubMenu = 0
           hd(s+1) = hd(f)
           EXIT FOR
          END IF
         NEXT
        END IF
       END WITH
       Count = GetMenuItemCount(hdParent)
       retval = InsertMenuItem(hdParent, count, 1, mii)
      NEXT
      retval = DrawMenuBar (frmPreview.handle)

     END SUB

     SUB WriteCode
      DIM s AS INTEGER , b AS INTEGER 'Contadores
      DIM ctab1 AS STRING , ctab2 AS STRING 'Tabuladores
      DIM cre AS STRING 'Strings predefinidos
      DIM Jtext AS STRING
      DIM ocli AS STRING, cli AS STRING, ccli AS STRING
      DIM oldLevel AS SINGLE, nextLevel AS SINGLE 'el nombre lo dice
      DIM shCut$ AS STRING
      DIM g AS SINGLE, SelTemp AS LONG 'Variables de uso general Temporal
      DIM N AS LONG
      DIM declares AS STRING, subs AS STRING 'Declaraciones y procedures
      DIM Coment AS STRING, Procedure AS INTEGER
      DIM Tabu AS STRING

      cre = "CREATE " : Jtext = "END " + cre
      ocli = "onclick = ": cli = "_Click"
      Procedure = True
      IF chkOptPreDeclares.checked THEN Coment = "'"
      IF chkOptDeclares.checked THEN Coment = ""
      IF chkOptOnlyMenu.checked THEN Procedure = False
      IF chkOptSoftTabs.checked THEN Tabu = SPACE$(VAL(txtOptSpaces.Text))

      rhtCode.Clear
      rhtCode.addstring cre + "mnuMain as QMAINMENU"

      rhtCode.addstring Tabu + "'Parent = Form"
      oldLevel = -1
      stgItems.cell(stgItems.ColCount,7) = 0

      FOR s = 1 TO stgItems.ColCount - 1
       Level = VAL(stgItems.Cell(s,7))
       nextLevel = VAL(stgItems.Cell(s + 1,7))
       ctab1 = "" : ctab2 = ""
       ctab1 = STRING$(Level + 1, "\t")
       ctab2 = STRING$(Level + 2, "\t")
       IF chkOptSoftTabs.checked THEN
        ctab1 =REPLACESUBSTR$(ctab1, "\t", Tabu)
        ctab2 =REPLACESUBSTR$(ctab2, "\t", Tabu)
       END IF
       WITH rhtCode
        .addstring ctab1 + cre + stgItems.Cell(s,1)+ " as QMENUITEM   "
        .addstring  ctab2 + "Caption = \"" + stgItems.Cell(s,2) + "\""
        .addstring ctab2 + "Checked = " + STR$(VAL(stgItems.Cell(s,3)))
        .addstring ctab2 + "Enabled = " + STR$(VAL(stgItems.Cell(s,4)))
        .addstring ctab2 + "Visible = " + STR$(VAL(stgItems.Cell(s,5)))
        ShCut$ = stgItems.Cell(s,6)
        IF VAL(ShCut$) > 0 THEN
         g = INSTR(ShCut$,"-")
         ShCut$ = MID$(ShCut$, g + 1 ,LEN(ShCut$))
         .addstring ctab2 + "ShortCut = \"" + ShCut$ + "\""
        END IF
        IF Level = nextLevel THEN
         IF stgItems.Cell(s,2)<> "-" THEN
          IF Procedure THEN
           ccli = stgItems.Cell(s,1) + cli
           .addstring ctab2 + Coment + ocli + ccli
           Declares = Declares + Coment + "DECLARE SUB " + ccli + " (Sender as QMENUITEM)" + cr
          END IF
         END IF
         .addstring ctab1 + Jtext
        END IF
        IF Level > nextLevel THEN
         IF stgItems.Cell(s,2)<> "-" THEN
          IF Procedure THEN
           ccli = stgItems.Cell(s,1) + cli
           .addstring ctab2 + Coment + ocli + ccli
           Declares = Declares + Coment + "DECLARE SUB " + ccli + " (Sender as QMENUITEM)" + cr
          END IF
         END IF
         FOR b = Level TO nextLevel STEP -1
          ctab1 = STRING$(b + 1, "\t")
          IF chkOptSoftTabs.checked THEN
           ctab1 = REPLACESUBSTR$(ctab1, "\t", Tabu)
          END IF
          .addstring ctab1 + Jtext
         NEXT
        END IF
       END WITH
      NEXT

      WITH rhtCode
       .addstring Jtext
       IF Procedure THEN
        selTemp = .SelStart
        .SelStart = 0
        .SelLength = 0
        .SelText = Declares + cr
        .SelStart = selTemp
        .addString
        N = INSTR(Declares, " SUB ")
        WHILE N > 0
         subs = Coment + MID$(Declares, N+1, INSTR(N+1,Declares, cr)-N-1)
         .addString subs
         .addString Coment + "END SUB"
         .addString
         N = INSTR(N + 1, Declares," SUB ")
        WEND
       END IF
       .SelStart = 0
       .HiLight
       .Plaintext = True
       .ReadOnly = 1
      END WITH

     END SUB

     SUB gotoweb
     END SUB

     SUB sendemail
     END SUB

2010-11-14 18:07