'
' **************************************************************
' **
' **  Parse a basic file for subs/functions/API/constants so you can paste them
' **  into a text editor or have a properties/methods box.
' **  Program will detect continuation to the next line
' **  if the '_' code is separated by a space from other text
' **  most text editors will allow you to run this command from a button
' **
' ** how to use: RQdecl filename {/w} {/f} {/-a}
' **
' **     filename = the file to generate a list of
' **      DECLARE SUB XXX(   )
' **      DECLARE SUBI XXX(   )
' **      DECLARE FUNCTION XXX(  )
' **      DECLARE FUNCTIONI XXX(  )
' **   the list is copied into the clipboard, you then paste them into your program
' **
' **     {option /w} = make a window of subs, functions, consts
' **     double clicking on the name pastes it into the clipboard, you can
' **     then paste it into a "find" box (usually ctrl-F)
' **
' **     {option /f} = automatically perform ctrl-f in the calling program
' **       with the name in the ctrl-f dialog box
' **
' **     {option /-a}     =  don't alphabetic sort subs/functions
' **
' ** example
' ** RQdecl c:\rapidq\test.bas /w /f
' **
' **
' **  BUGS -- Once you simulate CTRL key down, ** Can't get it to 
' **  toggle back up!!! If you use the /f you must press the ctrl-key
' **  to toggle it off.... can't figure it out
' **
' ** by JohnK from lots of help from RQ community
' **
' **************************************************************


$TYPECHECK ON

$INCLUDE "\RapidQ\include\WINDOWS.INC"  'this one is always first
$INCLUDE "\RAPIDQ\include\RAPIDQ2.INC"

DECLARE SUB Get_SUB_Func_Lines_From_File
DECLARE SUB Copy_Lines_To_Clip
DECLARE SUB Make_Properties_Window
DECLARE SUB TabChange
DECLARE SUB ItemDblClick
DECLARE SUB FormInitSize
DECLARE SUB FormResize
DECLARE FUNCTION StripTabs(TheString AS STRING) AS STRING


DIM ShowProp                AS INTEGER: ShowProp = False    'dont show a properties window
DIM SortSubNames            AS INTEGER: SortSubNames = True 'Sort the names alphabetically
DIM AutoFind                AS INTEGER: AutoFind = False    'automate Ctrl-F name
DIM AppHWND                 AS LONG                         'Handle of our text editor ' Must find!!!
DIM TheFileName             AS STRING
DIM Text4Clip               AS STRING
DIM ApiN					AS INTEGER						'count each WINDOWS API function call
DIM ConstN                  AS INTEGER                      'count each of const, function, sub
DIM i                       AS INTEGER                      'reusable loop, index
DIM j                       AS INTEGER
DIM SubFuncLines(1 TO 500)  AS STRING                       'up to 500 sub/functions, should do it!
DIM APIFuncLines(1 TO 500)  AS STRING                       'up to 500 API sub/functions, should do it!
DIM ConstLines(1 TO 500)    AS STRING                       'up to 500 sub/functions, should do it!
DIM ShowPropWind            AS INTEGER: ShowPropWind = False'just copy DECLAREs to clipboard
DIM SortIt                  AS INTEGER: SortIt = True       'default is to sort alphabetic



CREATE PropWind AS QFORM
       ' Autoscroll=True
        Top=100: Width=400: Height=400
		'BorderStyle = bsToolWindow 
        Left= Screen.Width - 410
        Caption = "Properties"
        OnShow = FormInitSize
    CREATE Tab AS QTabControl
        FocusButtons = True
        HotTrack = True
        Top = 1
        Font.Size = 11
        AddTabs "  Subs  ","  Func  ","  APIs  ","  Const  "
        Width = 600
        Height = 600		'PropWind.ClientHeight' + 28
        OnChange = TabChange
    CREATE SubListView AS QListView
        AddItems " ",       'MUST load something !!!
        Top = 26
        'HotTrack = True
        ReadOnly = True
        GridLines = True
        Font.Size = 9
        Width = Tab.ClientWidth - 4
        Height = 600'PropWind.ClientHeight
        ViewStyle = vsReport
        AddColumns "Name","Parameters"
        Column(0).Width = 170
        Column(1).Width = 800
        OnDblClick = ItemDblClick
    END CREATE
    END CREATE
END CREATE



IF COMMANDCOUNT < 1 THEN        'get the command line
    ShowMessage "Usage: RQdecl filename {/p}=properties window {/f}=auto ctrl-f {/-a}=don't sort"
    Application.Terminate       'nothing to do, 'element 0 is application path/name.
ELSE
    i = 1
    TheFileName = COMMAND$(i)
    'Make sure we get any file in the directory C:/Program Files/xxxx
'    -- other directories with spaces fail
    IF (INSTR(1, UCASE$(TheFileName), "\PROGRAM" ) > 0) AND _
    IF (INSTR(1, UCASE$(Command$(2)), "FILES\" ) > 0) THEN
        i= 2
        TheFileName = TheFileName + " " + Command$(i)
    END IF

'************* Now get additional commands if any

    IF COMMANDCOUNT > i THEN
    FOR j = i TO COMMANDCOUNT
        SELECT CASE UCASE$(COMMAND$(j))
        CASE "/P"
            ShowProp = True
        CASE "/W"
            ShowProp = True
        CASE "/F"
            AutoFind = True
            AppHWND=Getforegroundwindow()   'get handle  of calling program, our form not visible yet
        CASE "/-A"
            SortSubNames = 0
        END SELECT
    NEXT j
    END IF
    Get_SUB_Func_Lines_From_File
    Copy_Lines_To_Clip
    IF ShowProp THEN Make_Properties_Window
END IF
Application.Terminate






SUB Get_SUB_Func_Lines_From_File
    DIM TheBasicFile    AS QFILESTREAM
    DIM TheLine         AS STRING
	DIM UpLine			AS STRING
	DIM JmpLoop			AS INTEGER
	DIM LimitEnder		AS INTEGER
    DIM TempStr         AS STRING

    IF FILEEXISTS(TheFileName) THEN
    TheBasicFile.Open(TheFileName, fmOpenRead)
    i = 0
	ApiN = 0
    ConstN = 0
	LimitEnder = 0
    WHILE NOT TheBasicFile.EOF                          'check for end of line
        TheLine = LTRIM$(RTRIM$(TheBasicFile.ReadLine)) 'get whole line w/o spaces
		LimitEnder = INSTR(TheLine, "'")
		IF LimitEnder THEN TheLine = RTRIM$(LEFT$(TheLine, LimitEnder-1))
		TheLine = StripTabs(TheLine)					'replace tab char with space
		UpLine = UCASE$(TheLine)						'get upper case for comparisons
		DO
			JmpLoop = False
			IF RIGHT$(TheLine, 1) = CHR$(95) THEN						   'the _ char messes up parse!
				 LimitEnder = LEN(TheLine) - 1
			ELSE
				LimitEnder = INSTR(TheLine, (CHR$(32)+CHR$(95)))			'continuation delimiter
			END IF
			
			IF LimitEnder THEN 				
				TheLine = RTRIM$(LEFT$(TheLine, LimitEnder))				'get good part
				TempStr = StripTabs(LTRIM$(RTRIM$(TheBasicFile.ReadLine)))
				TheLine = TheLine + " " + TempStr										'append it
				UpLine = UCASE$(TheLine)
			ELSE
				JmpLoop = True
			END IF
		LOOP UNTIL JmpLoop

		IF (LEFT$(UpLine, 5) = "TYPE " AND INSTR(7, UpLine," EXTENDS ")) THEN	'skip class/object declarations
			JmpLoop = 0
			DO
        		TheLine = LTRIM$(RTRIM$(TheBasicFile.ReadLine)) 'read next line
				TheLine = StripTabs(TheLine)					'replace tab char with space
				IF  UCASE$(LEFT$(TheLine, 9)) = "END TYPE" THEN JmpLoop = 1	'found the end of type declare
				IF TheBasicFile.EOF THEN JmpLoop = 1		                    'check for end of line
		    LOOP UNTIL JmpLoop
		END IF

		IF LEFT$(UpLine, 17) = "DECLARE FUNCTION " AND INSTR(19, UpLine," LIB ") THEN	'got us an API
			LimitEnder = INSTR(19, UpLine," LIB ")				'don't need the Alias part
			ApiN++
			APIFuncLines(ApiN) = LTRIM$(RTRIM$(MID$(TheLine, 18, LimitEnder-18)))
			LimitEnder = INSTR(TheLine,"(")					'now get parameters
			APIFuncLines(ApiN) = APIFuncLines(ApiN) + " " + LTRIM$(RTRIM$(MID$(TheLine, LimitEnder, LEN(TheLine) - LimitEnder +1)))
		END IF

		IF LEFT$(UpLine, 12) = "DECLARE SUB " AND INSTR(13, UpLine," LIB ") THEN	'got us an API
			LimitEnder = INSTR(13, UpLine," LIB ")				'don't need the Alias part
			ApiN++
			APIFuncLines(ApiN) = LTRIM$(RTRIM$(MID$(TheLine, 12, LimitEnder-12)))
			LimitEnder = INSTR(TheLine,"(")					'now get parameters
			APIFuncLines(ApiN) = APIFuncLines(ApiN) + " " + LTRIM$(RTRIM$(MID$(TheLine, LimitEnder, LEN(TheLine) - LimitEnder +1)))
		END IF


        IF LEFT$(UpLine, 4) = "SUB "        THEN i++:  SubFuncLines(i) = "DECLARE " + TheLine
        IF LEFT$(UpLine, 9) = "FUNCTION "   THEN i++:  SubFuncLines(i) = "DECLARE " + TheLine
        IF LEFT$(UpLine, 5) = "SUBI "       THEN i++:  SubFuncLines(i) = "DECLARE " + TheLine 'don't use!!
        IF LEFT$(UpLine, 10) = "FUNCTIONI " THEN i++:  SubFuncLines(i) = "DECLARE " + TheLine
        IF ShowProp THEN
            IF LEFT$(UpLine, 6) = "CONST "    THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 7) = "PUBLIC "_
                AND (LEFT$(MID$(Upline, 8, LEN(UpLine)), 6)) = "CONST "_
                THEN ConstN++  :ConstLines(ConstN) = MID$(TheLine, 8, LEN(TheLine))
            IF LEFT$(UpLine, 8) = "DEFBYTE "  THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 7) = "DEFINT "   THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 7) = "DEFDBL "   THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 9) = "DEFDWORD " THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 7) = "DEFLNG "   THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 9) = "DEFSHORT " THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 7) = "DEFSNG "   THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 7) = "DEFSTR "   THEN ConstN++  :ConstLines(ConstN) = TheLine
            IF LEFT$(UpLine, 8) = "DEFWORD "  THEN ConstN++  :ConstLines(ConstN) = TheLine
        END IF
    WEND
    TheBasicFile.Close
    IF SortSubNames THEN QUICKSORT SubFuncLines(1),SubFuncLines(i), ASCEND
    IF ShowProp THEN 
		IF SortSubNames THEN 
			QUICKSORT ConstLines(1),ConstLines(ConstN), ASCEND
			QUICKSORT APIFuncLines(1),APIFuncLines(ApiN), ASCEND
		END IF
    END IF

	END IF		'file exists
END SUB




SUB Copy_Lines_To_Clip
    Text4Clip = ""
    FOR j = 1 TO i
        IF LEN(SubFuncLines(j))> 3 THEN Text4Clip = Text4Clip + SubFuncLines(j) + CHR$(13) + CHR$(10)
    NEXT j

    ClipBoard.Open
    ClipBoard.Clear
    ClipBoard.SetAsText(Text4Clip)
    ClipBoard.Close
END SUB




SUB Make_Properties_Window
    FOR j = 1 TO i
        SubListView.AddItems " ", ""        'Allocate memory otherwise crashes!!!
    NEXT j
    Tab.TabIndex = 0
    TabChange
    PropWind.OnResize = FormResize
    PropWind.ShowModal
END SUB


SUB FormInitSize
    DIM AdjustWindHeight    AS INTEGER
    DIM BiggrList           AS INTEGER

    AdjustWindHeight = SubListView.Font.Size * i * 2' i         'adjust window size for number of entries
    BiggrList = SubListView.Font.Size * ConstN * 2'+ ConstN         'whichever bigger
    IF BiggrList > AdjustWindHeight THEN AdjustWindHeight = BiggrList
    IF AdjustWindHeight < 100 THEN AdjustWindHeight = 200
    IF AdjustWindHeight > Screen.Height THEN AdjustWindHeight = Screen.Height - 180

    PropWind.ClientHeight = AdjustWindHeight
    Tab.Height = AdjustWindHeight
    Tab.Width = PropWind.ClientWidth
    SubListView.Height = AdjustWindHeight - 24
END SUB



SUB FormResize
    Tab.Height = PropWind.ClientHeight
    Tab.Width = PropWind.ClientWidth
    SubListView.Height = PropWind.ClientHeight - 28
    SubListView.Width = PropWind.ClientWidth - 10
END SUB



SUB TabChange
    DIM EndOfName       AS INTEGER
    DIM StartOfName     AS INTEGER
    DIM SubIndx         AS INTEGER
    DIM FuncIndx        AS INTEGER
	DIM APIindx			AS INTEGER
    DIM ConstIndx       AS INTEGER

	PropWind.Cursor = crHourGlass		'this may take some time
    SubListView.Visible = False          'remove all previous the fast way
    SubListView.Clear

    SELECT CASE Tab.TabIndex
        CASE 0
            SubIndx = 0             'keep track of insert position
            FOR j = 1 TO i
                IF UCASE$(LEFT$(SubFuncLines(j), 11)) = "DECLARE SUB" THEN
                SubListView.AddItems " ", ""                            'Allocate memory for each item!!!
                EndOfName = INSTR(1, SubFuncLines(j), "(") - 13
                IF EndOfName < 1 THEN EndOfName = LEN(SubFuncLines(j))' - StartOfName +1
                SubListView.Item(SubIndx).Caption = LTRIM$(RTRIM$(MID$(SubFuncLines(j), 13, EndOfName)))
                SubListView.AddSubItem(SubIndx, MID$(SubFuncLines(j), 8, LEN(SubFuncLines(j))))
                SubIndx++
                END IF
            NEXT j
        CASE 1          'functions
            FuncIndx = 0                'keep track of insert position
            FOR j = 1 TO i
                IF UCASE$(LEFT$(SubFuncLines(j), 16)) = "DECLARE FUNCTION" THEN
                SubListView.AddItems " ", ""
                StartOfName = INSTR(16, SubFuncLines(j), " ") + 1
                EndOfName = INSTR(StartOfName, SubFuncLines(j), "(") - StartOfName
                IF EndOfName = 0 THEN EndOfName = LEN(SubFuncLines(j)) - StartOfName
				SubListView.Item(FuncIndx).Caption = LTRIM$(MID$(SubFuncLines(j), StartOfName, EndOfName))
                SubListView.AddSubItem(FuncIndx, MID$(SubFuncLines(j), 8, LEN(SubFuncLines(j))))
                FuncIndx++
                END IF
            NEXT j
        CASE 2          'APIs
            APIindx = 0                'keep track of insert position
            FOR j = 1 TO ApiN
                SubListView.AddItems " ", ""
				EndOfName = INSTR(APIFuncLines(j),"(") - 1
				SubListView.Item(APIindx).Caption = LTRIM$(RTRIM$(LEFT$(APIFuncLines(j), EndOfName)))	'just the name
				SubListView.AddSubItem(APIindx, MID$(APIFuncLines(j), EndOfName, LEN(APIFuncLines(j))-EndOfName + 1))
                APIindx++
            NEXT j
        CASE 3          'constants
            ConstIndx = 0               'keep track of insert position
            FOR j = 1 TO ConstN
                StartOfName = INSTR(5, ConstLines(j), " ") + 1
                EndOfName = INSTR(5, ConstLines(j), "=")
                SubListView.AddItems " ", ""
                SubListView.Item(ConstIndx).Caption = _
                    LTRIM$(RTRIM$(MID$(ConstLines(j), StartOfName, EndOfName - StartOfName)))
                SubListView.AddSubItem(ConstIndx, MID$(ConstLines(j), EndOfName + 1, LEN(ConstLines(j))))
                ConstIndx++
            NEXT j
    END SELECT
    SubListView.Visible = True		'fast repopulate list
	PropWind.Cursor = crDefault
END SUB



SUB ItemDblClick
    DIM FormTitl    AS STRING: FormTitl = SPACE$(100)
    DIM TextLen     AS INTEGER
    DIM KeyN        AS INTEGER
    DIM PassStr     AS STRING
    DIM PassByte    AS BYTE
'

    ClipBoard.Open
    ClipBoard.Clear
    ClipBoard.SetAsText(SubListView.Item(SubListView.ItemIndex).Caption)
    ClipBoard.Close

' *********************************************************************************************
'           **** may need to modify this code to make sure you always focus your text editor
' *********************************************************************************************
' Sample:
'   AppHWND = Findwindow("TForm","My Text Editor")      'rapidq uses TFORM class, form caption (title bar)
'   TextLen = GetWindowText(AppHWNDD,@FormTitl, 100)    'allows up to 100 chars
'   IF TextLen > 0 THEN
'       ShowMessage ("Title: " + LEFT$(FormTitl$, TextLen))
'   ELSE
'       ShowMessage ("GetWindowText failed: WHND = " + str$(AppHWND))
'   END IF
'CONST KEYEVENTF_SILENT = &h0004
IF AutoFind = False THEN EXIT SUB                   'user doesn't want to search

    IF AppHWND <> 0 THEN
		IF GetAsyncKeyState(VK_CONTROL) THEN						'ctrl-key down?
		 keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0) 			'set up
		END IF

'        keybd_event (VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0)'may need this
		SetForegroundWindow(AppHWND)                				'focus text editor
        keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0) 				'signal release of keys
        keybd_event(VK_CONTROL, 0, 0, 0)      						'press Ctrl
'  ** uncomment next two lines to search from top of file
        keybd_event(VK_HOME, 0, 0, 0)               				'press Ctrl - home, to go to top
        keybd_event(VK_F, 0, 0, 0)            						'press Ctrl - f to find
		keybd_event(VK_V, 0, 0, 0)            						'Ctrl - v to paste
        keybd_event(VK_CONTROL, 0, &H02020202, 0) 				'signal release of keys
        keybd_event(VK_RETURN, 0, 0, 0)            					'Enter
        DOEVENTS                                    				'process Windows messages
    ELSE
        ShowMessage ("SetForegroundWindow failed")
    END IF
END SUB



FUNCTION StripTabs(TheString AS STRING) AS STRING
	IF INSTR(TheString, CHR$(9)) THEN
		StripTabs = REPLACESUBSTR$(TheString, CHR$(9), CHR$(32))
	ELSE
		StripTabs = TheString
	END IF
END FUNCTION