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 TV_FIRST AS LONG = &H1100
     CONST TVM_SETITEMHEIGHT AS LONG = (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 = 10
      OnMouseDown = ProjectTree_MouseDown
      OnExpanding = ProjectTree_Expand
      OnCollapsing = ProjectTree_Collapse
      OnGetSelectedIndex = ProjectTree_OnGetSelectedIndex
      OnDblClick = ProjectTree_DblClick
      FullCollapse
     END CREATE


     SendMessage(ProjectTree.Handle,TVM_SETITEMHEIGHT,25,0)


     SUB ProjectTree_MouseDown(Button%,X%,Y%,Shift%)
      DIM a AS LONG
      IF Button% = 1 THEN
       a = ProjectTree.GetItemAt(X%,Y%)
       ProjectTree.ItemIndex = a
      END IF
      IF Button% = 0 THEN
'    ClickAt = ProjectTree.GetItemAt(X%,Y%)
      END IF
     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 EXIT SUB
      ProjectTree.Item(Index%).SelectedIndex = ProjectTree.Item(Index%).ImageIndex
     END SUB


     SUB ProjectTree_DblClick
'  ShowMessage str$(ClickAt)
     END SUB

     SUB LoadProjectTree 'mnuFileOpen_Click
      ProjectTree.Clear
'  File.Open(OpenDlg.FileName,fmOpenRead)
      ProjectTree.AddItems "Project"
      tmpList.Text = re.Text
      inspector(tmpList)
      ProjectTree.FullCollapse
      ProjectTree.Expand 0,0
     END SUB


     SUB Inspector (TheList AS QSTRINGLIST) ' Recursive Sub for populate TreeView
      DIM Position AS INTEGER
      DIM j AS INTEGER
      DIM PARENT AS INTEGER
      DIM Line AS STRING
      DIM newline AS STRING
      DIM replaced AS STRING
      DIM nb AS INTEGER
      DIM test AS STRING
      DIM tmpLine AS STRING

      STATIC i '= 0

      PARENT = ProjectTree.ItemCount-1 '<--------------This the KEY for work
      WHILE (i < TheList.ItemCount -1) 'NOT File.EOF

       DOEVENTS

       DO

        Test = TRIM$(TheList.Item(i))    '<-------------------------get new line
        Test = CleanComents(test)                   '<----------Clean Comentaries
        IF RIGHT$(Test,1) = "_" THEN Position = LEN(Test) ELSE Position = 0  ' <---- test for line break
        WHILE Position <> 0                        '<-----------if any then
         Test = LEFT$(Test, Position-1)            '<----------Clean it
         i++
         tmpLine = TRIM$( TheList.Item(i))       '<----------Read the next line
         tmpLine = CleanComents(TmpLine)         '<----------Clean Comentaries
         test = test + tmpLine                   '<----------Concatena line
         IF RIGHT$(Test,1) = "_" THEN Position = LEN(Test) ELSE Position = 0 '<----test for new line break
        WEND
       LOOP UNTIL LEN(Test) OR (i = ( TheList.ItemCount -1))

    ' Create Fields
       replaced= REPLACESUBSTR$(Line," ", "|")
       nb=TALLY(replaced,"|")
       NewLine = ""
       FOR j =1 TO nb
        IF LEN(FIELD$(replaced,"|",j))>0 THEN newline = newline + FIELD$(replaced,"|",j)+"|"
        IF j=nb THEN newline=newline+FIELD$(replaced,"|",nb+1)
       NEXT

    ' Find for: END CREATE
       IF UCASE$(FIELD$(newline,"|",1))="END" AND UCASE$(FIELD$(newline,"|",2))="CREATE" THEN
        DEC PARENT
        EXIT SUB
       END IF

    'Find for: CREATE + AS + any <-- you can create one control with not "Q" in first character
       IF UCASE$(FIELD$(newline,"|",1))="CREATE" THEN
        IF UCASE$(FIELD$(newline,"|",3))="AS" THEN
         IF LEN(FIELD$(newline,"|",4)) <> 0 THEN
          ProjectTree.AddChildItems PARENT,FIELD$(newline,"|",2)+ "   (" + UCASE$(FIELD$(newline,"|",4)) +")"
          AddIco UCASE$(FIELD$(newline,"|",4))
          ProjectTree.expand PARENT, 0
          Inspector(TheList)
         END IF
        END IF
       END IF
      WEND
     END SUB


' Function GetLine(Test AS STRING)as string ' Read one new line skip comentaries, blank lines and concatenate lines
'   dim test as string
'   Dim position as integer
'   Dim tmpLine as string
'   Do
' '    Test = File.ReadLine
'     Test = TRIM$(Test)        '<----------Clean Spaces
'     Test = CleanComents(test) '<----------Clean Comentaries
'     if Right$(Test,1) = "_" then Position = Len(Test) Else Position = 0  ' <---- test for line break
'     While Position <> 0                       '<-----------if any then
'       Test = LEFT$(Test,Position-1)           '<----------Clean it
' '      tmpLine = File.ReadLine                 '<----------Read the next line
'       tmpLine = TRIM$(tmpLine)                '<----------Clean Spaces
'       tmpLine = CleanComents(TmpLine)         '<----------Clean Comentaries
'       test = test + tmpLine                   '<----------Concatena line
'       if Right$(Test,1) = "_" then Position = Len(Test) else Position = 0 '<----test for new line break
'     Wend
'   Loop Until Len(Test) 'or File.EOF
'   result = test
' End Function


     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"
       ProjectTree.Item(ProjectTree.ItemCount-1).ImageIndex = 1
      CASE "QBITMAP"
       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"
       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"
       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"
       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