2010-12-07 21:18

     $RESOURCE Project_Ico AS ".\_res\Project.ico"
     $RESOURCE Form_Ico AS ".\_res\Form.ico"
     $RESOURCE Bitmap_Ico AS ".\_res\Bitmap.ico"
     $RESOURCE Button_Ico AS ".\_res\Button.ico"
     $RESOURCE Check_Ico AS ".\_res\Check.ico"
     $RESOURCE Combo_Ico AS ".\_res\Combo.ico"
     $RESOURCE CoolBtn_Ico AS ".\_res\CoolBtn.ico"
     $RESOURCE Dialog_Ico AS ".\_res\Dialog.ico"
     $RESOURCE Edit_Ico AS ".\_res\Edit.ico"
     $RESOURCE Frame_Ico AS ".\_res\Frame.ico"
     $RESOURCE Gauge_Ico AS ".\_res\Gauge.ico"
     $RESOURCE Image_Ico AS ".\_res\Image.ico"
     $RESOURCE Label_Ico AS ".\_res\Label.ico"
     $RESOURCE List_Ico AS ".\_res\List.ico"
     $RESOURCE ListView_Ico AS ".\_res\ListView.ico"
     $RESOURCE MainMenu_Ico AS ".\_res\MainMenu.ico"
     $RESOURCE MenuItem_Ico AS ".\_res\MenuItem.ico"
     $RESOURCE Option_Ico AS ".\_res\Option.ico"
     $RESOURCE Panel_Ico AS ".\_res\Panel.ico"
     $RESOURCE RichEdit_Ico AS ".\_res\RichEdit.ico"
     $RESOURCE ScrollBar_Ico AS ".\_res\ScrollBar.ico"
     $RESOURCE Slide_Ico AS ".\_res\Slide.ico"
     $RESOURCE Splitter_Ico AS ".\_res\Splitter.ico"
     $RESOURCE StatusBar_Ico AS ".\_res\StatusBar.ico"
     $RESOURCE StringGrid_Ico AS ".\_res\StringGrid.ico"
     $RESOURCE Tab_Ico AS ".\_res\Tab.ico"
     $RESOURCE TreeView_Ico AS ".\_res\TreeView.ico"
     $RESOURCE Desconocido_Ico AS ".\_res\Desconocido.ico"

     CONST TVM_SETITEMHEIGHT AS LONG =(&H1100 + 27)  'TV_FIRST + 27


     DIM ImagenList AS QIMAGELIST
     ImagenList.AddICOHandle Project_Ico
     ImagenList.AddICOHandle Form_Ico
     ImagenList.AddICOHandle Bitmap_Ico
     ImagenList.AddICOHandle Button_Ico
     ImagenList.AddICOHandle Check_Ico
     ImagenList.AddICOHandle Combo_Ico
     ImagenList.AddICOHandle CoolBtn_Ico
     ImagenList.AddICOHandle Dialog_Ico
     ImagenList.AddICOHandle Edit_Ico
     ImagenList.AddICOHandle Frame_Ico
     ImagenList.AddICOHandle Gauge_Ico
     ImagenList.AddICOHandle Image_Ico
     ImagenList.AddICOHandle Label_Ico
     ImagenList.AddICOHandle List_Ico
     ImagenList.AddICOHandle ListView_Ico
     ImagenList.AddICOHandle MainMenu_Ico
     ImagenList.AddICOHandle MenuItem_Ico
     ImagenList.AddICOHandle Option_Ico
     ImagenList.AddICOHandle Panel_Ico
     ImagenList.AddICOHandle RichEdit_Ico
     ImagenList.AddICOHandle ScrollBar_Ico
     ImagenList.AddICOHandle Slide_Ico
     ImagenList.AddICOHandle Splitter_Ico
     ImagenList.AddICOHandle StatusBar_Ico
     ImagenList.AddICOHandle StringGrid_Ico
     ImagenList.AddICOHandle Tab_Ico
     ImagenList.AddICOHandle TreeView_Ico
     ImagenList.AddICOHandle Desconocido_Ico

     CREATE ProjectTree AS QTREEVIEW
      PARENT = LeftPanelBottomPanel
      Align = alClient
      ReadOnly = True
      Images = ImagenList
      Item(0).SelectedIndex = 0
      Indent = 6
      Hint = "Click to locate," + CRLF + "double click to edit"
      OnMouseDown = ProjectTree_MouseDown
'    OnExpanding = ProjectTree_Expand
'    OnCollapsing = ProjectTree_Collapse
      OnGetSelectedIndex = ProjectTree_OnGetSelectedIndex
      OnDblClick = ProjectTree_DblClick
      OnClick = ProjectTree_Click
      FullCollapse
     END CREATE

     SendMessage(ProjectTree.Handle , TVM_SETITEMHEIGHT , 22 , 0)        'set item heights



     SUB ProjectTree_MouseDown(Button% , X% , Y% , Shift%)
      DIM a AS LONG
      IF Button% = 1 THEN                                             'be sure to set index for right click
       a = ProjectTree.GetItemAt(X% , Y%)
       ProjectTree.ItemIndex = a
      END IF
     END SUB


     SUB ProjectTree_Click
      IF ProjectTree.ItemIndex > 0 THEN                               'no clicking on "<new form>"
        'get line # from combobox !!
       DEFSTR tmp = FIELD$(SubsCombo_objects.Item(ProjectTree.ItemIndex-1), LineNumDelimitr, 2)
       re.GotoLine(VAL(tmp))                                           'jump to that line
       re.ActiveLineColor(RGB(255,200,128), 0)                         'high light line
       IDE.HiLightTurnOFF = True                                       'toggle to turn off compile error line
       re.SetFocus
      END IF
     END SUB


     SUB ProjectTreeFullCollapse
      ProjectTree.FullCollapse
     END SUB

     SUB ProjectTreeFullExpand
      ProjectTree.FullExpand
     END SUB



'SUB ProjectTree_Expand(index% , AllowExpansion%)
'    'If Index% = 0 then exit Sub
'    'ProjectTree.Item(Index%).ImageIndex = 2
'    'ProjectTree.Item(Index%).SelectedIndex = 2
'END SUB
'
'SUB ProjectTree_Collapse(index%)
'    'If Index% = 0 then exit Sub
'    'ProjectTree.Item(Index%).ImageIndex = 1
'END SUB


     SUB ProjectTree_OnGetSelectedIndex(Index%)
      IF Index% <> 0 THEN ProjectTree.Item(Index%).SelectedIndex = ProjectTree.Item(Index%).ImageIndex
     END SUB


' double click means you want to edit the code in the visual designer
     SUB ProjectTree_DblClick
      DEFSTR tmp = SubsCombo_objects.Item(ProjectTree.ItemIndex-1)        'get the text from the comboBox!
      DEFSTR tmp2 = ""
      DEFSTR s

      IF ProjectTree.ItemIndex = 0 THEN                               '"<new form>"
       tmp2 = Clipboard.Text
       tmpList.Clear
       tmpList.AddItems "CREATE Form AS QFORM"
       tmpList.AddItems "  Center"
       tmpList.AddItems "END CREATE"
       Clipboard.OPEN
       Clipboard.Clear
       Clipboard.SetAsText tmpList.Text
       Clipboard.CLOSE
       CenterPanel.Visible = False
       re.Enabled = False
       IF FILEEXISTS(Application.Path + "\RapidFRM.exe" ) THEN
        s = Quote$(Application.Path + "\RapidFRM.exe" ) + " clipboard"
       ELSE
        s = Quote$(Application.Path + "\tools\RapidFRM.exe" ) + " clipboard"
       END IF
       SHELL s
       re.Enabled = True
       CenterPanel.Visible = True
       IF Clipboard.Text <> "" THEN re.AddStrings (Clipboard.Text)
       Clipboard.OPEN
       Clipboard.Clear
       Clipboard.SetAsText tmp2
       Clipboard.CLOSE
       LeftPanelRefresh                                               'update project explorer
       EXIT SUB
      END IF

      IF INSTR(UCASE$(tmp), "QFORM") THEN                                 'did we click on a QForm?
       DEFINT CreateStacks = 1                                         'stack counter of create.. end create
       DEFINT strt, ennd
       tmpList.Clear                                                   'this is the CREATE... END CREATE block to send to form designer

        'get line # from combobox !!
       DEFINT StrLine = VAL(FIELD$(SubsCombo_objects.Item(ProjectTree.ItemIndex-1), LineNumDelimitr, 2)) + 1
       re.GotoLine(StrLine)                                            'jump to that line
       strt = re.Position - LEN(re.Line(StrLine))                      'get start of selection
       tmpList.AddItems (re.Line(StrLine) - CRLF)

       IF StrLine <= re.LineCount THEN
        DO

         StrLine++
         re.GoToLine(StrLine)
         tmp2 = re.Line(StrLine) - CRLF
         tmpList.AddItems (tmp2)
         tmp2 = UCASE$(TRIM$(CleanComents(tmp2)))

         IF (LEFT$(tmp2, 4) = "END ") THEN                           'maybe found end create statement
          IF INSTR(tmp2 , " CREATE") > 3 THEN                     'found it
           CreateStacks--
          END IF
         END IF

         IF (LEFT$(tmp2, 7) = "CREATE ") AND (INSTR(tmp2 , " AS ") > 8) THEN     'found a create statement
          CreateStacks++
         END IF
        LOOP UNTIL (StrLine = re.LineCount) OR (CreateStacks = 0)
       END IF

       ennd = re.Position
       re.Set_AnchorPosition strt
       tmp2 = Clipboard.Text
       Clipboard.OPEN
       Clipboard.Clear
       Clipboard.SetAsText tmpList.Text
       Clipboard.CLOSE
       CenterPanel.Visible = False
       re.Enabled = False
       IF FILEEXISTS(Application.Path + "\RapidFRM.exe" ) THEN
        s = Quote$(Application.Path + "\RapidFRM.exe" ) + " clipboard"
       ELSE
        s = Quote$(Application.Path + "\tools\RapidFRM.exe" ) + " clipboard"
       END IF
       SHELL s
       re.Enabled = True
       CenterPanel.Visible = True
       IF Clipboard.Text <> "" THEN re.Set_SelText Clipboard.Text
       Clipboard.OPEN
       Clipboard.Clear
       Clipboard.SetAsText tmp2
       Clipboard.CLOSE
       LeftPanelRefresh            'must do this for next Double-Click
      END IF
     END SUB


     SUB Properties_Clear
      SubsCombo_objects.Clear
      ProjectTree.Enabled = False
      ProjectTree.Visible = False
      ProjectTree.Clear
      ProjectTree.Enabled = True
      ProjectTree.Visible = True
     END SUB





     SUB LoadProjectTree(indx AS INTEGER, SourceText AS STRING)
    'IF (indx = -1) OR (SourceText = "") THEN EXIT SUB           'invalid file
      IF (indx = -1) THEN EXIT SUB           'invalid file


      DEFINT i,  Cnt = 0, SubsFound = 0, CommFound = 0, ObjNamLoc
      DEFSTR myLine, TheObjName, TheQObjName
      SCREEN.Cursor = crHourGlass

      Stat.Panel(5).CAPTION = "Parsing file for objects"
      tmpList.Text = SourceText
      Properties_Clear
      ProjectTree.AddItems ("<new form at cursor>")
      DEFINT ProjParent = ProjectTree.ItemCount -1                    'should be 0 here

      FOR i = 0 TO tmpList.ItemCount - 1
       myLine = TRIM$(tmpList.Item(i))                             '<-------------------------get new line
       myLine = CleanComents(myLine)                               '<----------Clean Comentaries
        '<may need to check for line continuation here>

       IF (LEFT$(UCASE$(myLine), 7) = "CREATE ") THEN              'maybe found a create statement
        ObjNamLoc = INSTR(UCASE$(myLine) , " AS ")              'get end location of object name
        IF ObjNamLoc > 8 THEN
         TheObjName = TRIM$(MID$(myLine, 8, ObjNamLoc - 8))
         TheQObjName = TRIM$(MID$(myLine, ObjNamLoc + 4, LEN(myLine) - (ObjNamLoc + 3)))
                'now store the line (without CREATE) in the combo box, and give it a line #
         SubsCombo_objects.AddItems (DELETE$(LTRIM$(tmpList.Item(i)), 1, 7) + SPACE$(50) + LineNumDelimitr + STR$(i))

         IF INSTR(UCASE$(TheQObjName), "QFORM") THEN
          ProjectTree.AddItems (TheQObjName + "   (" + UCASE$(TheObjName) + ")")
          ProjParent = ProjectTree.ItemCount - 1
         ELSE
          IF ProjParent = 0 THEN                         'first object found
           ProjectTree.AddItems (TheQObjName + "   (" + UCASE$(TheObjName) + ")")
           ProjParent = ProjectTree.ItemCount -1
          ELSE
           ProjectTree.AddChildItems (ProjParent , TheQObjName + "   (" + UCASE$(TheObjName) + ")")
          END IF
         END IF
         AddIco UCASE$(TheQObjName)
         ProjectTree.expand ProjParent , 0
        END IF
       END IF

        'Find : END CREATE
       IF (LEFT$(UCASE$(myLine), 4) = "END ") THEN              'maybe found end create statement
        IF INSTR(UCASE$(myLine) , " CREATE") > 4 THEN        'found it
         DEC ProjParent
        END IF
       END IF
      NEXT i


      tmpList.Text = ""
      subscombo_objects.ItemIndex = 0
      Stat.Panel(5).CAPTION = ""
      IF ProjectTree.ItemCount > 0 THEN
       ProjectTree.FullCollapse
       ProjectTree.Expand 0 , 0
      END IF
      SCREEN.Cursor = 0
     END SUB




     FUNCTION CleanComents(str AS STRING) AS STRING  'Delete all comments
      DIM Position AS INTEGER
      result = str  '<------------- Asume no coments in line
      Position = INSTR(str , "'") '<------------- search comment in the string
      IF Position > 0 THEN result = RTRIM$(LEFT$(str , Position - 1)) '<-----  If any, Clean it
     END FUNCTION


     SUB AddIco(Control AS STRING)
      SELECT CASE Control
      CASE "QFORM", "QFORMEX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 1
      CASE "QBITMAP", "QBITMAPEX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 2
      CASE "QBUTTON"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 3
      CASE "QCHECKBOX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 4
      CASE "QCOMBOBOX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 5
      CASE "QCOOLBTN"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 6
      CASE "QOPENDIALOG" , "QSAVEDIALOG", "QFILEDIALOG"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 7
      CASE "QEDIT"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 8
      CASE "QGROUPBOX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 9
      CASE "QGAUGE"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 10
      CASE "QIMAGE", "QIMAGEEX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 11
      CASE "QLABEL"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 12
      CASE "QLISTBOX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 13
      CASE "QLISTVIEW"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 14
      CASE "QMAINMENU"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 15
      CASE "QMENUITEM"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 16
      CASE "QRADIOBUTTON"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 17
      CASE "QPANEL"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 18
      CASE "QRICHEDIT", "QRICHEDITEX"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 19
      CASE "QSCROLLBAR"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 20
      CASE "QSLIDE"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 21
      CASE "QSPLITTER"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 22
      CASE "QSTATUSBAR"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 23
      CASE "QSTRINGGRID"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 24
      CASE "QTABCONTROL"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 25
      CASE "QTREEVIEW"
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 26
      CASE ELSE
       ProjectTree.Item(ProjectTree.ItemCount - 1).ImageIndex = 27
      END SELECT
     END SUB

2010-12-07 21:18