2010-12-07 21:18

'modified for FreeQ by JohnK

     CONST rqPrettyBuild = "08.22.2009"        '-- Bitte immer updaten !!!
     CONST rqPrettyName = "RQ-Pretty by V. Dobiasch; "


     DEFBYTE Beautify = False
     DEFSTR TmpStr$, btfyLine1 = ""
     DEFLNG SubStrFound = 0

     tmpList.Clear
     DIM DimList AS QSTRINGLIST
     DIM PosList AS QSTRINGLIST

     SUB BeautifyForm_Close
      Beautify = False
     END SUB


     CREATE BeautifyForm AS QFORM
      CAPTION = rqPrettyName + rqPrettyBuild
      Width = 480
      Height = 265
      Center
      BorderStyle = bsSingle
      DelBorderIcons(biMaximize)
'    OnClose = BeautifyForm_Close

      CREATE Beautifypanel AS QPANEL
       Font.Size = 10
       CAPTION = "http://vdobiasch.2ya.de/"
       Top = 5
       Left = 5
       Height = 32
       Width = 463

       CREATE BeautifyCancel AS QBUTTON
        Left = 3
        Top = 3
        Width = 100
        Height = 26
        Kind = bkCancel
        Cancel = True
        CAPTION = "&Cancel"
        Hint = "Exit out / Bildschirm-Foto schliessen"
        TabOrder = - 1
        OnClick = BeautifyExitClick
       END CREATE

       CREATE BeautifyStart AS QBUTTON
        Top = 3
        Left = 360
        Width = 100
        Height = 26
        CAPTION = "Start"
        OnClick = BeautifyGo
        Default = True
       END CREATE
      END CREATE


      CREATE BeautifyPanelRS AS QGROUPBOX
       Left = 5
       Top = 145
       Width = 463
       Height = 62
       CREATE BeautifyEditS AS QEDIT
        Text = STR$(IDE.TabSpaces)
        Left = 10
        Top = 13
        Width = 20
       END CREATE
       CREATE BeautifyLabelS AS QLABEL
        CAPTION = "# Spaces replace one Tab"
        Left = 35
        Top = 16
        Width = 150
        Height = 20
       END CREATE

       CREATE BeautifyEditC AS QEDIT
        Text = "0"
        Left = 220
        Top = 13
        Width = 20
       END CREATE

       CREATE BeautifyLabelC AS QLABEL
        CAPTION = "Spaces before Comments"
        Left = 245
        Top = 16
        Width = 200
        Height = 20
       END CREATE
      END CREATE

     END CREATE



      '---------Subroutines---------
     SUB BeautifyExitClick
      IF Beautify THEN
       IF MESSAGEBOX("Abort Operation? / Wollen Sie das Programm wirklich jetzt abbrechen ?" , "Beautify" , 36) = mrYes THEN Beautify = False
      ELSE
       BeautifyForm.CLOSE
      END IF
     END SUB



     FUNCTION Indikator(TestIn AS STRING) AS STRING
      SELECT CASE UCASE$(Testin)
      CASE "DBL"
       Testin = "DOUBLE"
      CASE "INT"
       Testin = "INTEGER"
      CASE "LNG"
       Testin = "LONG"
      CASE "SNG"
       Testin = "SINGLE"
      CASE "STR"
       Testin = "STRING"
                  'case "BYTE", "WORD", "DWORD", "SHORT"
                  'Testin=TestIn+" "
      END SELECT
      result = UCASE$(Testin) + " "
     END FUNCTION


     SUB definition(test AS STRING , indicate AS STRING)

      DEFLNG defa = INSTR(test , ",") , defb = INSTR(test , "=") , defc = 0
      DEFSTR indizw = LTRIM$(Indikator(indicate)), PosStr$
      WHILE defa > 0
       TmpStr$ = LEFT$(test , defa - 1)
       IF defb > 0 THEN TmpStr$ = LEFT$(TmpStr$ , defb - 1)
       IF INSTR(UCASE$(TmpStr$) , " AS ") > 0 THEN TmpStr$ = LEFT$(TmpStr$ , INSTR(UCASE$(TmpStr$) , " AS "))
       PosStr$ = TmpStr$
       PosStr$ = REPLACESUBSTR$(PosStr$ , " " , "")
       IF INSTR(TmpStr$ , " ") > 0 THEN TmpStr$ = LEFT$(TmpStr$ , INSTR(TmpStr$ , " "))
       IF LEFT$(TmpStr$ , 1) <> " " THEN TmpStr$ = " " + TmpStr$
       IF RIGHT$(TmpStr$ , 1) <> " " THEN TmpStr$ = TmpStr$ + " "
       IF LTRIM$(TmpStr$) <> "" THEN
        tmpList.AddItems TmpStr$
        DimList.AddItems TmpStr$
        defc = INSTR(UCASE$(test) , " AS ")
        IF indizw = "" AND defc > 0 THEN
         PosList.AddItems UCASE$(MID$(test , defc + 4 , INSTR(defc + 4 , test , " ") - defc - 3)) + PosStr$
        ELSE
         PosList.AddItems indizw + PosStr$
        END IF
       END IF
       defb = INSTR(test , "(")
       defc = INSTR(test , ")")
       IF defb > 0 AND defb < defa AND defc > defa THEN
        test = LTRIM$(RIGHT$(test , LEN(test) - defc))
       ELSE
        defb = INSTR(test , "{")
        defc = INSTR(test , "}")
        IF defb > 0 AND defb < defa AND defc > defa THEN
         test = LTRIM$(RIGHT$(test , LEN(test) - defc))
        ELSE
         defb = INSTR(test , Quot$)
         IF defb > 0 THEN defc = INSTR(defb + 1 , test , Quot$)
         IF defb > 0 AND defb < defa AND defc > defa THEN
          test = LTRIM$(RIGHT$(test , LEN(test) - defc))
         ELSE
          test = LTRIM$(RIGHT$(test , LEN(test) - defa))
         END IF
        END IF
       END IF
       IF LEFT$(UCASE$(test) , 3) = "AS " THEN test = MID$(test , INSTR(4 , test , " ") + 1)
       defa = INSTR(test , ",")
       defb = INSTR(test , "=")
      WEND
      IF defb > 0 THEN test = LEFT$(test , defb - 1)
      TmpStr$ = test
      PosStr$ = test
      IF INSTR(UCASE$(TmpStr$) , " AS ") > 0 THEN TmpStr$ = LEFT$(TmpStr$ , INSTR(UCASE$(TmpStr$) , " AS ") - 1)
      PosStr$ = TmpStr$
      PosStr$ = REPLACESUBSTR$(PosStr$ , " " , "")
      IF INSTR(TmpStr$ , " ") > 0 THEN TmpStr$ = LEFT$(TmpStr$ , INSTR(TmpStr$ , " "))
      IF RIGHT$(TmpStr$ , 1) <> " " THEN TmpStr$ = TmpStr$ + " "
      IF LTRIM$(TmpStr$) <> "" THEN
       tmpList.AddItems " " + TmpStr$
       DimList.AddItems " " + TmpStr$
       defc = INSTR(UCASE$(test) , " AS ")
       IF indizw = "" AND defc > 0 THEN
        PosList.AddItems UCASE$(MID$(test , defc + 4 , INSTR(defc + 4 , test , " ") - defc - 3)) + PosStr$
       ELSE
        PosList.AddItems indizw + PosStr$
       END IF
      END IF
     END SUB


     SUB BeautifyForm_Show
      Beautify = False
      BeautifyStart.Enabled = True
      Beautifypanel.CAPTION = "http://vdobiasch.2ya.de/"
      IF re.Text <> "" THEN
       BeautifyForm.Show
       BeautifyGo
      END IF
     END SUB


     SUB BeautifyGo
      BeautifyForm.Cursor = crHourGlass
      Beautifypanel.CAPTION = "Please Wait...."
      DEFSTR tmp
      IF re.SelText <> "" THEN tmp = re.SelText ELSE tmp = re.Text
      tmp = StartBeautify(tmp + CRLF)         'need the last line to be at end!!!
      IF tmp <> "" THEN
       IF re.SelText <> "" THEN re.Set_SelText(tmp) ELSE re.Set_Text(tmp)
      END IF
      gmem.Clear
      tmp = ""        'dealloc
      Beautify = False
      BeautifyForm.Cursor = crDefault
      BeautifyForm.CLOSE
     END SUB



     FUNCTION StartBeautify(Buf AS STRING) AS STRING
      DEFSTR Commentpart, TmpStr$, Tabpart = ""
      DEFLNG a , b , c , d , LC
      DIM mem1 AS QMEMORYSTREAM

      DEFBYTE gef = 0 , OneTab = False
      DEFWORD spacenumber = VAL(BeautifyEditS.Text)        'spaces for tab
      DEFWORD SpaceNumberC = VAL(BeautifyEditC.Text)       'spaces before comment,
      IF spacenumber < 0 THEN spacenumber = 0
      IF SpaceNumberC < 0 THEN SpaceNumberC = 0

      DEFSTR Spacepart = SPACE$(spacenumber), Teststr, e$
      BeautifyStart.Enabled = False

    'load up keyword list
      IF FILEEXISTS(Application.Path +"\Pretty.lst") THEN
       tmpList.LoadFromFile(Application.Path +"\Pretty.lst")
      ELSE
       IF FILEEXISTS(Application.Path +"\tools\Pretty.lst") THEN
        tmpList.LoadFromFile(Application.Path +"\tools\Pretty.lst")
       ELSE
        SHOWMESSAGE ("Error: missing component 'pretty.lst'")
'            Beautify = False
        BeautifyForm.CLOSE
        Result = ""
        EXIT FUNCTION
       END IF
      END IF

      Beautify = True
      OneTab = False
      btfyLine1 = Buf                     'transfer text
      btfyLine1 = SubstSubstr(btfyLine1 , tab , Spacepart , False)
      Killspaces "^"
      Killspaces "["
      Killspaces "]"

      gMem.Clear
      mem1.Clear
      gMem.Write btfyLine1
      gMem.Seek 0 , soFromBeginning

      LC = gMem.LineCount
      FOR a = 0 TO LC
       Beautifypanel.CAPTION = " Line: " + STR$(a)
       DOEVENTS    : IF Beautify = False THEN RESULT = "": EXIT FUNCTION
       Commentpart = ""
       btfyLine1 = gMem.ReadLine
       btfyLine1 = TRIM$(btfyLine1)
       b = INSTR(btfyLine1 , sQuot)
       c = INSTR(btfyLine1 , Quot$)
       WHILE c > 0 AND c < b AND INSTR(c + 1 , btfyLine1 , Quot$) > 0
        c = INSTR(c + 1 , btfyLine1 , Quot$)
        b = INSTR(c , btfyLine1 , sQuot)
       WEND
       IF b THEN
        c = LEN(btfyLine1)
        Commentpart = MID$(btfyLine1 , b , c - b + 1)
        btfyLine1 = LEFT$(btfyLine1 , b - 1)
        btfyLine1 = RTRIM$(btfyLine1) + " "
        Commentpart = SPACE$(spacenumberC) + REPLACESUBSTR$(Commentpart , sQuot + sQuot , sQuot)
        WHILE MID$(Commentpart , INSTR(Commentpart , sQuot) + 1 , 1) = " "
         Commentpart = LEFT$(Commentpart , INSTR(Commentpart , sQuot)) + MID$(Commentpart , INSTR(Commentpart , sQuot) + 2 , LEN(Commentpart))
        WEND
       END IF
       Killspaces " "
       WHILE LEFT$(btfyLine1 , 1) = tab
        btfyLine1 = MID$(btfyLine1 , 2)
       WEND

       Killspaces ","
       btfyLine1 = SubstSubstr(btfyLine1 , "," , " , " , False)
       Killspaces "-"
       btfyLine1 = SubstSubstr(btfyLine1 , "-" , " - " , False)
       Killspaces "+"
       btfyLine1 = SubstSubstr(btfyLine1 , "+" , " + " , False)
       Killspaces "*"
       btfyLine1 = SubstSubstr(btfyLine1 , "*" , " * " , False)
       Killspaces "/"
       btfyLine1 = SubstSubstr(btfyLine1 , "/" , " / " , False)
       Killspaces "="
       btfyLine1 = SubstSubstr(btfyLine1 , "=" , " = " , False)
       Killspaces "<"
       btfyLine1 = SubstSubstr(btfyLine1 , "<" , " < " , False)
       Killspaces ">"
       btfyLine1 = SubstSubstr(btfyLine1 , ">" , " > " , False)
       Killspaces "\"
       btfyLine1 = SubstSubstr(btfyLine1 , "\" , " \ " , False)
       Killspaces "("
       btfyLine1 = SubstSubstr(btfyLine1 , "(" , " ( " , False)
       Killspaces ")"
       btfyLine1 = SubstSubstr(btfyLine1 , ")" , " ) " , False)
       Killspaces "."
       btfyLine1 = SubstSubstr(btfyLine1 , "." , " . " , False)
       DOEVENTS    : IF Beautify = False THEN RESULT = "": EXIT FUNCTION
       btfyLine1 = " " + btfyLine1 + " "
       IF UCASE$(LEFT$(btfyLine1 , 5)) = " DIM " THEN
        definition(LTRIM$(MID$(btfyLine1 , 6)) , "")


       ELSEIF UCASE$(LEFT$(btfyLine1 , 8)) = " STATIC " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 9 , INSTR(9 , btfyLine1 , " ") - 9) + " "
        DimList.AddItems " " + MID$(btfyLine1 , 9 , INSTR(9 , btfyLine1 , " ") - 9) + " "
        d = INSTR(UCASE$(btfyLine1) , " AS ")
        IF d > 6 THEN
         PosList.AddItems "STATIC " + MID$(btfyLine1 , d + 4) + MID$(btfyLine1 , 6 , d - 6)
        ELSE
         PosList.AddItems "STATIC " + MID$(btfyLine1 , 6 , INSTR(6 , btfyLine1 , " ") - 6)
        END IF
       ELSEIF UCASE$(LEFT$(btfyLine1 , 7)) = " CONST " THEN
        definition(LTRIM$(MID$(btfyLine1 , 8)) , "CONST")
       ELSEIF INSTR(" DEFDBL DEFINT DEFLNG DEFSNG DEFSTR " , UCASE$(LEFT$(btfyLine1 , 8))) > 0 THEN
        definition(LTRIM$(MID$(btfyLine1 , 9)) , MID$(btfyLine1 , 5 , 3))
       ELSEIF INSTR(" DEFBYTE DEFWORD " , UCASE$(LEFT$(btfyLine1 , 9))) > 0 THEN
        definition(LTRIM$(MID$(btfyLine1 , 10)) , MID$(btfyLine1 , 5 , 4))
       ELSEIF INSTR(" DEFDWORD DEFSHORT " , UCASE$(LEFT$(btfyLine1 , 10))) > 0 THEN
        definition(LTRIM$(MID$(btfyLine1 , 11)) , MID$(btfyLine1 , 5 , 5))
       ELSEIF UCASE$(LEFT$(btfyLine1 , 6)) = " TYPE " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 7 , INSTR(7 , btfyLine1 , " ") - 7) + " "
                  'ELSEIF UCASE$(LEFT$(btfyLine1 , 7)) = " CONST " THEN
                  'tmpList.AddItems " " + MID$(btfyLine1 , 8 , INSTR(8 , btfyLine1 , " ") - 8) + " "
       ELSEIF UCASE$(LEFT$(btfyLine1 , 8)) = " CREATE " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 9 , INSTR(9 , btfyLine1 , " ") - 9) + " "
       ELSEIF UCASE$(LEFT$(btfyLine1 , 11)) = " $RESOURCE " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 12 , INSTR(12 , btfyLine1 , " ") - 12) + " "
        DimList.AddItems " " + MID$(btfyLine1 , 12 , INSTR(12 , btfyLine1 , " ") - 12) + " "
        PosList.AddItems "RESOURCE " + MID$(btfyLine1 , 12 , INSTR(12 , btfyLine1 , " ") - 12) + " "
       ELSEIF UCASE$(LEFT$(btfyLine1 , 13)) = " DECLARE SUB " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 14 , INSTR(14 , btfyLine1 , " ") - 14) + " "
        DimList.AddItems " " + MID$(btfyLine1 , 14 , INSTR(14 , btfyLine1 , " ") - 14) + " "
        PosList.AddItems "SUB " + MID$(btfyLine1 , 14 , INSTR(14 , btfyLine1 , " ") - 14)
       ELSEIF UCASE$(LEFT$(btfyLine1 , 14)) = " DECLARE SUBI " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 15 , INSTR(15 , btfyLine1 , " ") - 15) + " "
        DimList.AddItems " " + MID$(btfyLine1 , 15 , INSTR(15 , btfyLine1 , " ") - 15) + " "
        PosList.AddItems "SUBI " + MID$(btfyLine1 , 15 , INSTR(15 , btfyLine1 , " ") - 15)
       ELSEIF UCASE$(LEFT$(btfyLine1 , 18)) = " DECLARE FUNCTION " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 19 , INSTR(19 , btfyLine1 , " ") - 19) + " "
        DimList.AddItems " " + MID$(btfyLine1 , 19 , INSTR(19 , btfyLine1 , " ") - 19) + " "
        PosList.AddItems "FUNCTION " + MID$(btfyLine1 , 19 , INSTR(19 , btfyLine1 , " ") - 19)
       ELSEIF UCASE$(LEFT$(btfyLine1 , 19)) = " DECLARE FUNCTIONI " THEN
        tmpList.AddItems " " + MID$(btfyLine1 , 20 , INSTR(20 , btfyLine1 , " ") - 20) + " "
        DimList.AddItems " " + MID$(btfyLine1 , 20 , INSTR(20 , btfyLine1 , " ") - 20) + " "
        PosList.AddItems "FUNCTIONI " + MID$(btfyLine1 , 20 , INSTR(20 , btfyLine1 , " ") - 20)
       END IF
       TmpStr$ = UCASE$(btfyLine1)

       FOR d = 0 TO tmpList.ItemCount - 1
        IF INSTR(TmpStr$ , UCASE$(tmpList.Item(d))) > 0 THEN
         btfyLine1 = SubstSubstr(btfyLine1 , tmpList.Item(d) , tmpList.Item(d) , True)
         gef = 1
        END IF
       NEXT d
       DOEVENTS    : IF Beautify = False THEN RESULT = "": EXIT FUNCTION
       Teststr = ""
       IF UCASE$(LEFT$(btfyLine1 , 5)) = " SUB " THEN
        Teststr = " " + MID$(btfyLine1 , 6 , INSTR(6 , btfyLine1 , " ") - 6) + " "
       ELSEIF UCASE$(LEFT$(btfyLine1 , 6)) = " SUBI " THEN
        Teststr = " " + MID$(btfyLine1 , 7 , INSTR(7 , btfyLine1 , " ") - 7) + " "
       ELSEIF UCASE$(LEFT$(btfyLine1 , 10)) = " FUNCTION " THEN
        Teststr = " " + MID$(btfyLine1 , 11 , INSTR(11 , btfyLine1 , " ") - 11) + " "
       ELSEIF UCASE$(LEFT$(btfyLine1 , 11)) = " FUNCTIONI " THEN
        Teststr = " " + MID$(btfyLine1 , 12 , INSTR(12 , btfyLine1 , " ") - 12) + " "
       END IF
       gef = 0
       FOR d = 0 TO DimList.ItemCount - 1
        IF INSTR(btfyLine1 , DimList.Item(d)) > 0 THEN PosList.Item(d) = PosList.Item(d) + ", " + STR$(a + 1)
        IF Teststr <> "" AND DimList.Item(d) = Teststr THEN gef = 1
       NEXT
       IF gef = 0 THEN
        IF UCASE$(LEFT$(btfyLine1 , 5)) = " SUB " THEN
         tmpList.AddItems " " + MID$(btfyLine1 , 6 , INSTR(6 , btfyLine1 , " ") - 6) + " "
         DimList.AddItems " " + MID$(btfyLine1 , 6 , INSTR(6 , btfyLine1 , " ") - 6) + " "
         PosList.AddItems "SUB " + MID$(btfyLine1 , 6 , INSTR(6 , btfyLine1 , " ") - 6) + ", " + STR$(a + 1)
        ELSEIF UCASE$(LEFT$(btfyLine1 , 6)) = " SUBI " THEN
         tmpList.AddItems " " + MID$(btfyLine1 , 7 , INSTR(7 , btfyLine1 , " ") - 7) + " "
         DimList.AddItems " " + MID$(btfyLine1 , 7 , INSTR(7 , btfyLine1 , " ") - 7) + " "
         PosList.AddItems "SUBI " + MID$(btfyLine1 , 7 , INSTR(7 , btfyLine1 , " ") - 7) + ", " + STR$(a + 1)
        ELSEIF UCASE$(LEFT$(btfyLine1 , 10)) = " FUNCTION " THEN
         tmpList.AddItems " " + MID$(btfyLine1 , 11 , INSTR(11 , btfyLine1 , " ") - 11) + " "
         DimList.AddItems " " + MID$(btfyLine1 , 11 , INSTR(11 , btfyLine1 , " ") - 11) + " "
         PosList.AddItems "FUNCTION " + MID$(btfyLine1 , 11 , INSTR(11 , btfyLine1 , " ") - 11) + ", " + STR$(a + 1)
        ELSEIF UCASE$(LEFT$(btfyLine1 , 11)) = " FUNCTIONI " THEN
         tmpList.AddItems " " + MID$(btfyLine1 , 12 , INSTR(12 , btfyLine1 , " ") - 12) + " "
         DimList.AddItems " " + MID$(btfyLine1 , 12 , INSTR(12 , btfyLine1 , " ") - 12) + " "
         PosList.AddItems "FUNCTIONI " + MID$(btfyLine1 , 12 , INSTR(12 , btfyLine1 , " ") - 12) + ", " + STR$(a + 1)
        ELSEIF UCASE$(LEFT$(btfyLine1 , 14)) = " PROPERTY SET " THEN
         tmpList.AddItems " " + MID$(btfyLine1 , 15 , INSTR(15 , btfyLine1 , " ") - 15) + " "
         DimList.AddItems " " + MID$(btfyLine1 , 15 , INSTR(15 , btfyLine1 , " ") - 15) + " "
         PosList.AddItems "PROPERTY SET " + MID$(btfyLine1 , 15 , INSTR(15 , btfyLine1 , " ") - 15) + ", " + STR$(a + 1)
        END IF
       END IF
       Killspaces "("
       Killspaces ") "
       Killspaces "."
       btfyLine1 = SubstSubstr(btfyLine1 , ") )" , "))" , False)
       btfyLine1 = SubstSubstr(btfyLine1 , "+  +" , "++" , False)
       btfyLine1 = SubstSubstr(btfyLine1 , "-  -" , "--" , False)
       btfyLine1 = SubstSubstr(btfyLine1 , ") )" , "))" , False)
       btfyLine1 = SubstSubstr(btfyLine1 , "< >" , "<>" , False)
       btfyLine1 = SubstSubstr(btfyLine1 , "< =" , "<=" , False)
       btfyLine1 = SubstSubstr(btfyLine1 , "> =" , ">=" , False)
       btfyLine1 = SubstSubstr(btfyLine1 , " IF(" , " IF (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " IF." , " IF ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " THEN." , " THEN ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " ELSE." , " ELSE ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " ELSEIF(" , " ELSEIF (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " ELSEIF." , " ELSEIF ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " AND(" , " AND (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " NOT(" , " NOT (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " OR(" , " OR (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " XOR(" , " XOR (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " SHL(" , " SHL (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " SHR(" , " SHR (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " MOD(" , " MOD (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " INV(" , " INV (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " WHILE(" , " WHILE (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " UNTIL(" , " UNTIL (" , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " AND." , " AND ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " NOT." , " NOT ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " OR." , " OR ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " XOR." , " XOR ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " SHL." , " SHL ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " SHR." , " SHR ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " MOD." , " MOD ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " INV." , " INV ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " WHILE." , " WHILE ." , True)
       btfyLine1 = SubstSubstr(btfyLine1 , " UNTIL." , " UNTIL ." , True)
       btfyLine1 = LTRIM$(btfyLine1)
       b = INSTR(btfyLine1 , " ")
       e$ = UCASE$(LEFT$(btfyLine1 , b - 1))
       DOEVENTS    : IF Beautify = False THEN RESULT = "": EXIT FUNCTION

       SELECT CASE e$
       CASE "CREATE" , "DO" , "FOR" , "TYPE" , "SUB" , "SUBI" , "FUNCTION" , _
         "FUNCTIONI" , "PROPERTY" , "WHILE" , "CONSTRUCTOR" , "WITH" , "EVENT"
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        btfyLine1 = SubstSubstr(btfyLine1 , ":" , ":" , False)
        IF SubStrFound = 0 THEN Tabpart = Tabpart + Spacepart
                      'IF INSTR(btfyLine1 , ":") = 0 THEN Tabpart = Tabpart + Spacepart
       CASE "SELECT"
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        Tabpart = Tabpart + Spacepart + Spacepart
       CASE "IF" , "$IFDEF" , "$IFNDEF"
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        IF UCASE$(RIGHT$(RTRIM$(btfyLine1) , 4)) = "THEN" OR LEFT$(e$ , 3) = "$IF" THEN
         Tabpart = Tabpart + Spacepart
        END IF
       CASE "LOOP" , "NEXT" , "WEND"
        Tabpart = LEFT$(Tabpart , LEN(Tabpart) - spacenumber)
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
       CASE "END" , "$ENDIF"
        IF RTRIM$(btfyLine1) <> "END" THEN
         Tabpart = LEFT$(Tabpart , LEN(Tabpart) - spacenumber)
         IF INSTR(btfyLine1 , "SELECT") THEN Tabpart = LEFT$(Tabpart , LEN(Tabpart) - spacenumber)
         mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        ELSE
         mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        END IF
       CASE "CASE"
        Tabpart = LEFT$(Tabpart , LEN(Tabpart) - spacenumber)
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        Tabpart = Tabpart + Spacepart
       CASE "ELSE" , "$ELSE"
        Tabpart = LEFT$(Tabpart , LEN(Tabpart) - spacenumber)
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        Tabpart = Tabpart + Spacepart
       CASE "ELSEIF"
        Tabpart = LEFT$(Tabpart , LEN(Tabpart) - spacenumber)
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
        IF UCASE$(RIGHT$(RTRIM$(btfyLine1) , 4)) = "THEN" THEN
         Tabpart = Tabpart + Spacepart
        END IF
       CASE "PUBLIC:" , "PRIVATE:"
        mem1.WriteLine btfyLine1 + Commentpart
       CASE ELSE
        mem1.WriteLine Tabpart + btfyLine1 + Commentpart
       END SELECT
       IF OneTab = True THEN
        IF UCASE$(RIGHT$(RTRIM$(btfyLine1) , 4)) <> "THEN" THEN
         Tabpart = LEFT$(Tabpart , LEN(Tabpart) - spacenumber)
         OneTab = False
        END IF
       END IF
       IF RIGHT$(RTRIM$(btfyLine1) , 1) = "_" THEN
        OneTab = True
        Tabpart = Tabpart + Spacepart
       ELSE
        OneTab = False
       END IF
      NEXT a

      buf = ""
      mem1.position = 0
      c = 0
      FOR a = 0 TO LC -1
       btfyLine1 = RTRIM$(mem1.ReadLine)
       IF btfyLine1 = "" THEN
        c = c + 1
       ELSE
        c = 0
       END IF
       IF c < 3 THEN Buf = Buf + btfyLine1  + CHR$(13) + CHR$(10)
      NEXT a

      gMem.CLOSE
      mem1.CLOSE
'    Beautify = False
      Beautifypanel.CAPTION = " Done"
      BeautifyStart.Enabled = True
      Result = Buf
     END FUNCTION


     SUB Killspaces(t$ AS STRING)
      btfyLine1 = SubstSubstr(btfyLine1 , " " + t$ , t$ , False)
      btfyLine1 = SubstSubstr(btfyLine1 , t$ + " " , t$ , False)
     END SUB


     FUNCTION SubstSubstr(byref Mainstring AS STRING , Orgstring AS STRING , Sparestring AS STRING , BigL AS INTEGER) AS STRING
      DIM fund1 AS LONG
      DIM afz1 AS LONG
      DIM afz2 AS LONG
      DIM safz AS LONG
      DIM zw1 AS STRING

      zw1 = Mainstring
      IF BigL THEN
       fund1 = INSTR(UCASE$(zw1) , UCASE$(Orgstring))
      ELSE
       fund1 = INSTR(zw1 , Orgstring)
      END IF
      safz = 1
      SubStrFound = 0
      WHILE fund1 > 0 DO
       afz1 = INSTR(safz , zw1 , Quot$)
       IF afz1 = 0 THEN
        afz1 = 99999999
        afz2 = 99999999
       ELSE
        afz2 = INSTR(afz1 + 1 , zw1 , Quot$)
        IF afz2 = 0 THEN afz2 = 99999999
       END IF
       IF fund1 < afz1 THEN
        zw1 = LEFT$(Mainstring , fund1 - 1) + Sparestring + RIGHT$(Mainstring , LEN(Mainstring) - LEN(Orgstring) - fund1 + 1)
        SubStrFound ++
        Mainstring = zw1
        IF BigL THEN
         fund1 = INSTR(fund1 + LEN(Sparestring) , UCASE$(zw1) , UCASE$(Orgstring))
        ELSE
         fund1 = INSTR(fund1 + LEN(Sparestring) , zw1 , Orgstring)
        END IF
       ELSE
        safz = afz2 + 1
        IF Bigl THEN
         fund1 = INSTR(safz , UCASE$(zw1) , UCASE$(Orgstring))
        ELSE
         fund1 = INSTR(safz , zw1 , Orgstring)
        END IF
       END IF
      WEND
      SubstSubstr = zw1
     END FUNCTION

2010-12-07 21:18