|
Post by mknarr on Sept 14, 2019 12:18:03 GMT -5
Here is a program that will do that and more.
'Liberty Basic Reader 'Works with any LB 4.5 and lower. 'Copyright 2013 by Jim Brossman
curversion$="12.2" '6/10/2016 dim info$(10,10) dim DataArray$(50000)'This contains all the extracted data. Labels, Handles etc. dim DisplayBox$(2500)'Used to display page numbers in the JumpTo window. dim RecentArray$(8) dir$=DefaultDir$+"\" files DefaultDir$,"recent.ini",info$( if val(info$(0,0))=0 then 'If the recent.ini file doesn't exist open DefaultDir$+"\recent.ini" for output as #1 for x=1 to 8 'then fill it with blank spaces. print #1, "" next close #1 end if call GetIni 'Now get the existing recent files and fill the RecentArray$.
nomainwin WindowWidth = DisplayWidth WindowHeight = DisplayHeight UpperLeftX= 0 UpperLeftY=0 BackgroundColor$ = "white" ForegroundColor$ = "black" loadbmp "lb", dir$+"LBReader.bmp" loadbmp "lastbut",dir$+"lastbut.bmp" loadbmp "dbttn", dir$+"dbttn.bmp" loadbmp "ubttn", dir$+"ubttn.bmp" loadbmp "firstbut", dir$+"firstbut.bmp" loadbmp "jumpto", dir$+"jumpto.bmp" loadbmp "print", dir$+"print.bmp" menu #main, "&File","&Open File && Run", [OpenBasFile],|,"&1. ",[recent1],_ "&2. ",[recent2],"&3.",[recent3],"&4.",[recent4],"&5.",[recent5],"&6.",[recent6],"&7.",[recent7],_ "&8. ",[recent8],|, "E&xit", [Quit] menu #main, "&Display", "&Arrays", [ArrayDisplay],"&File Names",[FileNameDisplay],"&Handles", [HandleDisplay],_ "&Labels", [LabelDisplay],"&Numeric Variables",[NumericDisplay], "&String Variables", [StringDisplay],_ "Gosub Labels", [GosubDisplay], "GoTo Labels",[GotoDisplay],"Subs and &Functions",[SubDisplay],"&Working File",[WorkingFile],_ "Number of Working Lines", [ActualLines] menu #main, "&Help", "&Help",[Help],"&About LB Reader", [About] stylebits #main.st0, _SS_BITMAP, 0, 0, 0 statictext #main.st0, "", int(WindowWidth/2)-175, int(WindowHeight/2)-200, 1, 1
open "LB Reader v"+curversion$ for window as #main hMain=HWnd(#main) 'Handle of main window. calldll #user32, "GetMenu",hMain as ulong,hMenu as ulong 'Get handle of the menu. calldll #user32, "GetSubMenu",hMenu as ulong,0 as long,hfile as ulong 'Get handle of file menu. 'Get info for each recent menu line and modify the menu. for x=1 to 8 a$=RecentArray$(x) calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong 'Get the ID number of the file menu. call MenuMod hfile, hfileid,a$,x 'Modify the recent menu items. next 'And draw the menu bar. calldll #user32, "DrawMenuBar", hMain as ulong, result as boolean 'Redraw the menu. #main, "trapclose [Quit]" 'Handle of main window. callDLL #user32, "ShowWindow",hMain As uLong,_SW_MAXIMIZE As Long, r As Boolean hst0 = hwnd(#main.st0) 'Required for staticimage. hB0 = hbmp("lb") 'Required for staticimage. Call staticImage hst0, hB0 'Required for staticimage.
[MainLoop] wait
[Quit] 'End the program. unloadbmp "lb" unloadbmp "lastbut" unloadbmp "dbttn" unloadbmp "ubttn" unloadbmp "firstbut" unloadbmp "jumpto" unloadbmp "print" close #main end
[ArrayDisplay] 'Will display and optionally print the list of arrays. displayfile$="ArrayFile.txt" gosub [FindFiles] goto [MainLoop]
[FileNameDisplay] 'Will display the list of file names. displayfile$="FileName.txt" gosub [FindFiles] goto [MainLoop]
[HandleDisplay] 'Will display and optionally print the list of handles. displayfile$="HandleFile.txt" gosub [FindFiles] goto [MainLoop]
[LabelDisplay] 'Will display and optionally print the list of labels. displayfile$="LabelFile.txt" gosub [FindFiles] goto [MainLoop]
[NumericDisplay] 'Will display and optionally print the list of numeric variables. displayfile$="NumericFile.txt" gosub [FindFiles] goto [MainLoop]
[StringDisplay] 'Will display and optionally print the list of string variables. displayfile$="StringFile.txt" gosub [FindFiles] goto [MainLoop]
[SubDisplay] 'Will display and optionally print the list of Subs and Functions. displayfile$="SubFile.txt" gosub [FindFiles] goto [MainLoop]
[GosubDisplay] displayfile$="GosubLabelFile.txt" gosub [FindFiles] goto [MainLoop]
[GotoDisplay] displayfile$="GoToLabelFile.txt" gosub [FindFiles] goto [MainLoop]
[WorkingFile] 'Will display and optionally print the remaining lines in the working file. displayfile$="WorkingFile.txt" gosub [FindFiles] goto [MainLoop]
[recent1] 'For recent file 1 RecentFile$=RecentArray$(1) Index=1 goto [OpenRecentFile]
[recent2] RecentFile$=RecentArray$(2) Index=2 goto [OpenRecentFile]
[recent3] RecentFile$=RecentArray$(3) Index=3 goto [OpenRecentFile]
[recent4] RecentFile$=RecentArray$(4) Index=4 goto [OpenRecentFile]
[recent5] RecentFile$=RecentArray$(5) Index=5 goto [OpenRecentFile]
[recent6] RecentFile$=RecentArray$(6) Index=6 goto [OpenRecentFile]
[recent7] RecentFile$=RecentArray$(7) Index=7 goto [OpenRecentFile]
[recent8] RecentFile$=RecentArray$(8) Index=8 goto [OpenRecentFile]
[OpenRecentFile] 'Open a file listed in the recent menus. if RecentFile$="" then 'If the selected menu item does not have a recent file in it. notice "Notice!"+chr$(13)+"No recent file selected" wait end if 'Get the file name and path so the files statement works. FileName$=SeparateFile$(RecentFile$) 'Get the recent file name. FilePath$=SeparatePath$(RecentFile$) 'Get the file path. 'and see if the file really exists. files FilePath$,FileName$,info$( if val(info$(0,0))=0 then 'The file no longer exists. Notice "Notice!"+chr$(13)+ "File "+FileName$+" no longer exists." RecentArray$(Index)="" 'Clear the array element for the file that is missing. RecentFile$="" 'Clear so [UpdateRecentList] removes the missing file. NewFile$="" 'Set to "" so [UpdateRecentList] knows what to do. gosub [UpdateRecentList] else gosub [UpdateRecentList] 'RecentFile$ will not be empty. FileName$=RecentFile$ goto [StartReading] end if wait
[OpenBasFile] 'Get a basic file and open it. 'The file dialog and associated functions are code from Alyce Watson filedialog, "Open Code File","*.bas",NewFile$ 'Call filedialog and select file. if NewFile$="" then wait 'When no file is selected. if upper$(right$(NewFile$,3))<>"BAS" then notice "Error!"+chr$(13)+"The selected file is not a basic file! " goto [MainLoop] end if RecentFile$="" gosub [UpdateRecentList] 'NewFile$ will not be empty. FileName$=NewFile$ 'Fall through.
[StartReading] 'Open the text file and start reading. files dir$, "*.txt", info$( if val(info$(0,0))>0 then for x=1 to val(info$(0,0)) kill dir$+info$(x,0) next end if ActualLines=0 LinesLeft=0
'This section counts the actual number of working lines not 'including blank and remarked lines. This section removes Blank lines and 'lines that start with ' or rem. 'ActualLines=Actual number of working lines. open FileName$ for input as #OriginalFile open dir$+"WorkingFile.txt" for output as #WorkingFile while not(eof(#OriginalFile)) line input #OriginalFile, a$ 'Input each line. a$=trim$(a$) if (a$<>"") and (left$(a$,1)<>"'") and (left$(upper$(a$),3)<>"REM") then 'If the line isn't blank or remarked. ActualLines= ActualLines+1 LinesLeft=LinesLeft+1 'Number of lines left in the working file. Used in the next section. print #WorkingFile, a$ end if wend close #WorkingFile close #OriginalFile
'This section opens the working file, reads each line and removes quotes and blank lines. gosub [ProgressBar] #progbar.st2, "Removing Quoted Strings - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 'Reset the number of lines left in the Working File. gosub [OpenFiles] while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Input each line. gosub [ProgMove] a$=trim$(a$) 'Trim the line. while instr(a$,chr$(34))>0 'Find if there is a quote. a=len(a$) 'Length of a$. b=instr(a$,chr$(34)) 'Find the first quote. b$=left$(a$,b-1) 'Get the part before the first quote. a$=right$(a$,a-b) 'Get the text after the first quote. b=instr(a$,chr$(34)) 'Find the last quote. a$=right$(a$,len(a$)-b) 'Get the remainder of the line. a$=b$+" "+a$ 'Add a space between the parts wend if trim$(a$)>"" then print #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section will remove any remarked lines. ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] #progbar.st2, "Removing Remarked lines - Lines Left ="+str$(LinesLeft) while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Input each line. a$=trim$(a$) 'Trim each line. gosub[ProgMove] if instr(a$,"'")>0 then 'If ' appears in the line a=instr(a$,"'") 'then find the location of the ' and b$=left$(a$,a-1) 'get the left side of the line. if len(b$)>0 then 'If line is not blank then save un remarked portion. print #TemporaryFile, " "+trim$(b$) LinesLeft=LinesLeft+1 end if else print #TemporaryFile, " "+trim$(a$) 'If no ' appears in the line then save the line. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section will find and remove all gosub labels. redim DataArray$(50000) 'Open up the progress bar. #progbar.st2, "Retrieving Gosub Labels - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement. progx=ProgStep 'Set so the progress bar starts at 0%. LinesLeft=0 'Number of lines left in the Working File. linecounter=0 gosub [OpenFiles] counter=0 'How many actual items are saved. while not(eof(#WorkingFile)) 'This section removes label names from the working file. line input #WorkingFile, a$ 'Input each line. linecounter=linecounter +1 gosub [ProgMove] location=1 while instr(upper$(a$),"GOSUB ", location) location=instr(upper$(a$),"GOSUB")+6 startg=location-6 'Include the gosub. a=instr(a$,"[", location) 'Start of label. if a=0 then exit while 'In case the word gosub is in a remark. b=instr(a$,"]",a) 'End of the label. d$=mid$(a$,a,b-a+1) 'The gosub [label]. b$=left$(a$,startg) 'Get the start of the remaining string. c$=right$(a$,len(a$)-b) 'Get the end of the remaining string. a$=b$+c$ 'The reaming string. counter=counter+1 'Number of of gosub labels that appear. DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName]. wend 'Look for more array names. if trim$(a$)>"" then 'If the line isn't empty print #TemporaryFile,a$ 'put it in the Temporary File LinesLeft=LinesLeft+1 'and increase the line count. end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section sorts the gosub labels and deletes duplicates. If counter=0 then [EndGosubLabel] 'In case there were no labels. counter is generated above. #progbar.st2, "Sorting && Saving Gosub Label names - Lines Left ="+str$(LinesLeft) open dir$+"GosubLabelFile.txt" for output as #1 print #1, "Gosub Label List for "+FileName$ 'Title for the display window. gosub [ProcessDataArray] print #1, "Number of Gosub Labels = ";a close #1 [EndGosubLabel] 'Skip to here if counter =0. #progbar.graphicbox1,"cls"
'This section will find and remove all goto labels 'and removes blank lines. redim DataArray$(50000) #progbar.st2, "Retrieving GoTo Labels - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement. progx=ProgStep 'Set so the progress bar starts at 0%. LinesLeft=0 'Number of lines left in the Working File. gosub [OpenFiles] counter=0 'How many actual items are saved. while not(eof(#WorkingFile)) 'This section removes label names from the working file. line input #WorkingFile, a$ 'Input each line. linecounter=linecounter +1 gosub [ProgMove] location=1 while instr(upper$(a$),"GOTO ", location) location=instr(upper$(a$),"GOTO")+5 startg=location-6 'Include the goto. a=instr(a$,"[", location) 'Start of label. if a=0 then exit while 'In case the word goto is in a remark. b=instr(a$,"]",a) 'End of the label. d$=mid$(a$,a,b-a+1) 'The goto [label]. b$=left$(a$,startg) 'Get the start of the remaining string. c$=right$(a$,len(a$)-b) 'Get the end of the remaining string. a$=b$+c$ 'The remaining string. counter=counter+1 'Number of of goto labels that appear. DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName]. wend 'Look for more array names. if trim$(a$)>"" then 'If the line isn't empty print #TemporaryFile,a$ 'put it in the Temporary File LinesLeft=LinesLeft+1 'and increase the line count. end if wend gosub [CloseFiles] #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section sorts the goto labels and deletes duplicates. If counter=0 then [EndGoToLabel] 'In case there were no labels. counter is generated above. #progbar.st2, "Sorting && Saving GoTo Label names - Lines Left ="+str$(LinesLeft) open dir$+"GoToLabelFile.txt" for output as #1 print #1, "GoTo Label List for "+FileName$ 'Title for the display window. gosub [ProcessDataArray] print #1, "Number of GoTo Labels = ";a close #1 [EndGoToLabel] 'Skip to here if counter =0. #progbar.graphicbox1,"cls"
'This section will remove all labels and place them in LabelFile.txt 'and remove blanks lines. redim DataArray$(50000) #progbar.st2, "Retrieving Label names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement. progx=ProgStep 'Set so the progress bar starts at 0%. LinesLeft=0 'Number of lines left in the Working File. linecounter=0 gosub [OpenFiles] counter=0 'How many actual items are saved. while not(eof(#WorkingFile)) 'This section removes label names from the working file. [startlabel] line input #WorkingFile, a$ 'Input each line. linecounter=linecounter +1 gosub [ProgMove] 'Move the progress bar one step. while instr(a$,"[")>0 a=len(a$) b=instr(a$,"[") c=instr(a$,"]") if c=0 then 'In case there is no ] in the line. notice "Notice!"+chr$(13)+"There appears to be a missing ] on line "+str$(linecounter)+chr$(13)+a$ goto [startlabel] end if b$=left$(a$,b-1) d$=mid$(a$,b,c-b+1) 'The label. d=len(d$) 'd$ might equal {LabelName]. e$=trim$(mid$(d$,2,d-2)) 'This is to eliminate any []. e$ should look like LabelName. if e$<>"" then 'If the line isn't blank. counter=counter+1 'Number of times a label appears. DataArray$(counter)=d$ 'So DataArray$(counter) will equal [LabelName]. end if a$=b$+right$(a$,a-c) 'Get the remainder of a$ and wend 'look for more labels. if trim$(a$)>"" then 'If the line isn't empty print #TemporaryFile,a$ 'put it in the Working File LinesLeft=LinesLeft+1 'and increase the line count. end if wend gosub [CloseFiles]
'This section sorts the labels and deletes duplicates. If counter=0 then [EndLabel] 'In case there were no labels. counter is generated above. open dir$+"LabelFile.txt" for output as #1 print #1, "Label List for "+FileName$ 'Title for the display window. gosub [ProcessDataArray] print #1, "Number of Labels = ";a close #1 [EndLabel] 'Skip to here if counter =0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section opens the working file and breaks 'lines with a colon into multiple lines and removes any blank lines. #progbar.st2, "Removing ':'and breaking lines - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Input each line. gosub [ProgMove] a$=trim$(a$) 'Trim each line. while instr(a$,":")>0 'Do until there are no more colons. a=instr(a$,":") 'Break lines with a colon into multiple lines. b$=left$(a$,a-1) print #TemporaryFile, trim$(b$) 'Save leftmost portion of line. LinesLeft=LinesLeft+1 ActualLines=ActualLines+1 'Remove this line if you don't want lines with a colon counted as extra lines. a$=right$(a$,len(a$)-a) 'Get the remainder of the line. wend if trim$(a$)>"" then print #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section will retrieve all array dim statements 'save them to ArrayFile.txt and removes blank lines. redim DataArray$(50000) #progbar.st2, "Retrieving Array names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] redim DataArray$(50000) open dir$+"ArrayFile.txt" for output as #ArrayFile print #ArrayFile, "Array List for "+FileName$ 'Title for display window. counter=0 'Counts how many dim statements. while not(eof(#WorkingFile)) 'This section finds dim statements. line input #WorkingFile, a$ 'Input each line. gosub [ProgMove] a$=trim$(a$) 'Trim each line. if left$(upper$(a$),3)="DIM" then b$=trim$(right$(a$,len(a$)-4)) 'Get the right part of the dim statement. [morearrays] 'If arrays were dimensioned on the next line with the _ character. while instr(b$,")")>0 'Look for the ")" b=len(b$) 'Get the total length of b$ a=instr(b$,")") 'Find the location of the ) c$=left$(b$,a) 'Get the array and size b$=trim$(right$(b$,b-a)) 'Remove the array name and size if left$(b$,1)="," then 'Are there any more dimensioned arrays on the line a=len(b$) 'Get the new length of b$ b$=trim$(right$(b$,a-1)) 'Remove the first comma. end if counter=counter+1 print #ArrayFile,c$ 'Save array name and size. c$=arrayname(x,x) c=instr(c$,"(") 'Find where size starts. c$=trim$(left$(c$,c)) 'Get 'arrayname(' into data array. DataArray$(counter)=c$ wend if trim$(b$)="_" then 'If arrays are dimensioned on the next line. line input #WorkingFile, a$ 'Input the next line. gosub [ProgMove] a$=trim$(a$) b$=a$ goto [morearrays] end if else if trim$(a$)>"" then print #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if end if wend print #ArrayFile, "Number of arrays = "; counter close #ArrayFile gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section removes any references to the arrays from the working file and removes blank lines. #progbar.st2, "Removing Array names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] a$=trim$(a$) if counter=0 then print #TemporaryFile, a$ 'If no arrays specified then save the line. LinesLeft=LinesLeft+1 end if if counter >0 then 'If arrays labels exist then for x= 1 to counter 'go thru all labels. array$=DataArray$(x) 'Get array label from DataArray. while instr(a$,array$)>0 a=len(a$) 'Find length of line. b=instr(a$,array$) 'Find start of label. if b=0 then exit while 'If no more labels in line exit loop. b$=left$(a$,b-1) 'Get left part of line before label. a$=right$(a$,a-b+1) 'Get right part of line including label. b=instr(a$,"(") 'Find ( to right of label. a$=right$(a$,len(a$)-b) 'Get right part of line after label. if len(a$)>0 then a$=b$+" "+a$ else a$=b$+" "+a$ end if wend next if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section will find all subs and functions and passed variables and removes them. #progbar.st2, "Retrieving Subs && Functions - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] open dir$+"SubFile.txt" for output as #SubFile 'Title for display window. print #SubFile, "Subroutine & Function List for "+FileName$ counter=0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] select case case instr(upper$(a$),"CALL")>0 a$=trim$(a$) 'Remove start and ending spaces. Index=0 cfound=0 name$="" token$="dx31b" while token$ <>"" Index=Index+1 token$=word$(a$,Index) if cfound=1 then name$=token$ cfound=0 end if if upper$(token$)="CALL" then cfound=1 wend a=len(a$) b=instr(upper$(a$),"CALL") c=len(name$) b$=left$(a$,b-1) d=a-(b+c+4) c$=right$(a$,d) a$=trim$(b$+c$) if a$<>"" then #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if case instr(upper$(a$),"SUB ")>0 or instr(upper$(a$),"FUNCTION ")>0 counter=counter+1 print #SubFile,trim$(a$) case else #TemporaryFile, a$ LinesLeft=LinesLeft+1 end select wend print #SubFile, "Number of Subs and Functions = "; counter close #SubFile gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section removes the punctuation defined in the first data line and replaces with a space. 'Periods are not removed since they may be used in variables. redim DataArray$(50000) #progbar.st2, "Removing punctuation - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] for x=1 to 13 'Get first 13 punctuation items into array. read character$ DataArray$(x)=character$ next while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] for x=1 to 13 character$=DataArray$(x) while instr(a$,character$)>0 a=len(a$) b=instr(a$,character$) 'Find location of character. b$=right$(a$,a-b) 'Get right side of line. a$=left$(a$,b-1) 'Get left side of line. a$=a$+" "+b$ 'Replace character with a space. wend next if trim$(a$)>"" then print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section finds file names redim DataArray$(50000) #progbar.st2, "Retrieving File names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] if instr(upper$(a$),"INPUT AS")>0 or instr(upper$(a$),"OUTPUT AS")>0 or instr(upper$(a$),"RANDOM AS")>0 then a=instr(a$,"#") b=instr(a$," ",a) b$=trim$(mid$(a$,a,b-a)) a$=left$(a$,a-1) counter=counter+1 DataArray$(counter)=b$ end if if trim$(a$)>"" then print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts and counts the file names. if counter=0 then [EndFileName] 'In case there were no handles. #progbar.st2, "Sorting and Saving File names - Lines Left ="+str$(LinesLeft) open dir$+"FileName.txt" for output as #1 print #1, "File List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of File Names = ";a close #1 [EndFileName] 'Skip to here if counter =0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section finds the handle names and 'removes from line and fills the data array. redim DataArray$(50000) #progbar.st2, "Retrieving Handles names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] while instr(a$,"#")>0 'Loop while '#' exists in line. a=len(a$) b=instr(a$,"#") 'Find location of '#'. c=instr(a$," ",b) 'Find space at end of the handle. b$=left$(a$,b-1) 'Get left side of line. counter =counter +1 DataArray$(counter)=mid$(a$,b,c-b) 'Get handle from line and save in array. a$=b$+" "+right$(a$,a-c) 'Add space where handle was so next section works. wend if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts, finds duplicate Handle names and 'and saves to HandleFile.txt. if counter=0 then [EndHandle] 'In case there were no handles. #progbar.st2, "Sorting and Saving Handle names - Lines Left ="+str$(LinesLeft) open dir$+"HandleFile.txt" for output as #1 print #1, "Handle List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of Handles = ";a close #1 [EndHandle] 'Skip to here if counter =0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This fills the data array with keyword strings 'and removes them from the working file. #progbar.st2, "Removing String Keywords - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] for x=1 to 37 'There are currently 37 string keywords in LB4.5 and 29 in LB 4.04. read a$ DataArray$(x)=a$ next start=1:last=37 'Last = number of keyword$. gosub [RemoveKeywords] gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section finds String Variables and removes them from the file. redim DataArray$(50000) #progbar.st2, "Retrieving String variables - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] do while instr(a$,"$")>0 'Loop while '$' exists in line. a=len(a$) b=instr(a$,"$") 'Find the location of the $. for x= b-1 to 1 step -1 'Step backwards until a space is found. b$=mid$(a$,x,1) 'x= location of space. if b$=" " then exit for 'When a space is found exit loop. next b$=right$(a$,a-b) 'Get right side of line. counter = counter +1 DataArray$(counter)=mid$(a$,x+1,b-x)'Get string variable from line and save in array. a$=b$+left$(a$,x-1) 'Get left side of line. loop if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts the strings and deletes duplicates and saves. if counter=0 then [EndStrings] 'In case there were no string variables. #progbar.st2, "Sorting and Saving String variables - Lines Left ="+str$(LinesLeft) open dir$+"StringFile.txt" for output as #1 print #1, "String Variable List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of String variables = ";a close #1 [EndStrings] 'Skip to here if counter = 0 #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This fills the data array with keywords and removes them from the working file. redim DataArray$(50000) #progbar.st2, "Removing Keywords - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] for x=1 to 171 'There are currently 171 keywords. read a$ DataArray$(x)=a$ next start=1:last=171 gosub [RemoveKeywords] gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section finds numeric variables. redim DataArray$(50000) #progbar.st2, "Retrieving Numeric variables - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ a$=trim$(a$)+" " gosub [ProgMove] a=len(a$) for x = 1 to a if (asc(mid$(a$,x,1))>64) and (asc(mid$(a$,x,1))<123) then 'Look for an alpha character in the line. b=instr(a$," ",x) 'Find a space after numeric variable. b$=mid$(a$,x,b-x) 'numeric variable. c=len(b$) 'Get length of numeric variable. if left$(b$,1)="_" and len(b$)>1 then goto [skip] 'Remove stylebit commands. if b$="_" goto [skip] 'Remove any line continuations. if instr(b$,"_")>1 then [skip] 'Remove any commands xxx_xxx. counter=counter+1 DataArray$(counter)=b$ [skip] b$=right$(a$,a-b+1) 'Get right side of line. a$=left$(a$,x-1)+space$(c)+b$ 'Replace numeric variable with equal number of spaces. end if next if trim$(a$)>"" then print #TemporaryFile,trim$(a$) LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts, finds duplicate numeric variables and 'and saves to NumericFile.txt. if counter=0 then [EndNumeric] 'In case there are no numeric variables. #progbar.st2, "Sorting && Saving Numeric Variables - Lines Left ="+str$(LinesLeft) open dir$+"NumericFile.txt" for output as #1 print #1, "Numeric Variable List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of Numeric variables = ";a close #1 [EndNumeric] 'Skip to here if counter=0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section removes all the numbers and remaining periods from the working file. #progbar.st2, "Cleaning Working File - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] print #TemporaryFile, "Working File for "+FileName$ 'Title for display window. while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] for x=0 to 9 'Remove numbers 0 through 9. while instr(a$,str$(x))<>0 a$=ReplaceMultipleString$(a$, str$(x), " ") 'And replace with a space. wend next a$=trim$(a$) if (a$<>"") and (instr(a$,".")=0) then 'Remove blank lines and lines containing periods print #TemporaryFile,trim$(a$) 'and leaves only missed things. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
[EndJob] close #progbar restore open dir$+"NumberLines.txt" for output as #NumbLines print #NumbLines,str$(ActualLines)+" for basic program "+FileName$ close #NumbLines notice "Job Complete!" + chr$(13) + "Use the Display menu to see results."+Chr$(13)+"Actual working lines = "+str$(ActualLines)_ +Chr$(13)+"Lines Left in Working File = "+str$(LinesLeft) goto [MainLoop]
[ActualLines] 'Displays the number of actual working lines. open dir$+"NumberLines.txt" for input as #NumbLines input #NumbLines,ActualLines close #NumbLines notice "Number of Working lines = ";str$(ActualLines) wait
'Please do not remove this section. 'You may modify the version number if you wish and add your name. [About] 'About LB Reader. WindowWidth = 250 WindowHeight = 220 BackgroundColor$ = "buttonface" ForegroundColor$ = "black"
button #helpabout.bmp1, " OK ", [haclick1], UL, 84, 155 statictext #helpabout, "LB Reader", 80, 10, 220, 20 statictext #helpabout, "Version "+curversion$, 85, 30, 90, 20 statictext #helpabout, "Written in Liberty Basic 4.04", 40, 50, 170, 20 statictext #helpabout, "jbross@sisna.com",70,90,150,20 statictext #helpabout, "Copyright 2014", 75, 110, 150,20 stylebits #helpabout, _DS_CENTER,0,0,0 open "About..." for dialog_modal as #helpabout print #helpabout, "font arial 10" print #helpabout, "trapclose [haclick1]" wait
[haclick1] 'Close close #helpabout goto [MainLoop]
[Help] 'Display the help window. WindowWidth = 800 WindowHeight = 600 BackgroundColor$ = "buttonface" ForegroundColor$ = "black" button #help.default, "enter", [helpok],UL,-400,-400 button #help.b1," OK ",[helpok],UL,360,525 bmpbutton #help.b2, dir$+"print.bmp", [helpprint], UL, 745, 528 stylebits #help, _DS_CENTER,0,0,0 open "LB Reader Help" For dialog_modal As #help #help.b1,"!setfocus" #help, "trapclose [helpok]" #help, "font arial 10 bold" hTip=CreateTooltip(hwnd(#help)) call AddToolTip Hwnd(#help.b1),hTip, "Close Help " call AddToolTip Hwnd(#help.b2),hTip, "Print Help window " open "RICHED32.DLL" for dll as #re calldll #comctl32, "InitCommonControlsEx",result as void hlpT=CreateTextEdit(hWnd(#help), 10,10,775,WindowHeight-97) File$=dir$+"help.rtf" open File$ for input as #TempText txt$=input$(#TempText,lof(#TempText)) close #TempText call SetWindowText hlpT,txt$ wait
[helpprint] 'Print help. run "write.exe "+chr$(34)+File$+chr$(34)+" /p",hide wait
[helpok] 'Close Help. close #help close #re goto [MainLoop]
data ";","/","-","+","*","|",",","=","<",">","^","(",")" '13 entries
'These data items require a space in front and the end so that key words can be found and deleted 'and not variables which may contain the keyword. data " BACKGROUNDCOLOR$ "," CHR$ "," COMBOBOXCOLOR$ "," DATE$ "," DECHEX$ "," DEFAULTDIR$ "," DRIVE$ ",_ " LISTBOXCOLOR$ "," SPACE$ "," STR$ " '10 entries data " FOREGROUNDCOLOR$ "," INKEY$ "," INPUT$ "," KILL$ "," LEFT$ "," LOWER$ "," MID$ "," PRINTERNAME$ ",_ " PLATFORM$ "," WORD$ " '10 entries data " RIGHT$ "," TEXTBOXCOLOR$ "," TEXTEDITORCOLOR$ "," TIME$ "," TRIM$ "," UPPER$ "," COMMANDLINE$ ",_ " VERSION$ "," EVAL$ ", " STARTUPDIR$ " '10 entries data " HTTPGET$ ", " UPTO$ ", " AFTER$ ", " AFTERLAST$ ", "ENDSWITH$ ", " REMCHAR$ "," REPLSTR$ " '7 entries
data " FOR "," TO "," NEXT "," EXIT "," WHILE "," WEND "," IF "," THEN "," ELSE "," END " '10 entries data " SELECT "," CASE "," PRINT "," LPRINT "," DUMP "," OPEN "," CLOSE "," INPUT "," LINE "," AS " '10 entries data " WAIT "," CALL "," CALLDLL "," GOTO "," RETURN "," GET "," GETTRIM "," PUT "," OUT "," OUTPUT " '10 entries data " GOSUB "," READ "," RESTORE "," REDIM "," LEN "," VAL "," INT "," INSTR "," NAME "," SUB " '10 entries data " BMPBUTTON "," BUTTON "," CHECKBOX "," COMBOBOX "," GRAPHICBOX "," GROUPBOX "," LISTBOX ",_ " NOMAINWIN "," RADIOBUTTON "," TEXTBOX " '10 entries data " TEXTEDITOR "," DISPLAYWIDTH "," DISPLAYHEIGHT "," UPPERLEFTX "," UPPERLEFTY ",_ " WINDOWWIDTH "," WINDOWHEIGHT "," FUNCTION "," EOF "," FIELD " '10 entries data " COLORDIALOG "," FONTDIALOG "," FILEDIALOG "," PRINTERDIALOG "," STATICTEXT "," DIALOG "," GRAPHICS ",_ " TEXT "," WINDOW "," CONFIRM " '10 entries data " MENU "," FS "," NF "," NSB "," INS "," POPUP "," MODAL "," FILES "," LOF "," LET " '10 entries data " ABS "," ASC "," AND "," ASC "," ASN "," BEEP "," BINARY "," BMPSAVE "," BOOLEAN "," CALLBACK " '10 entries data " CLS "," COS "," CURSOR "," DATA "," DOUBLE "," DWORD "," EXP "," HBMP "," HEXDEC "," HWND ", '10 entries data " INP "," INPUTTO "," LOADBMP "," LOC "," LOG "," LONG "," MAINWIN "," MAX "," MKDIR "," MIN " '10 entries data " NOT "," NOTICE "," ONCOMERROR "," OPEN "," OR "," PLAYWAVE "," POPUPMENU "," PRINTCOLLATE ",_ " PRINTCOPIES "," PROMPT " '10 entries data " RMDIR "," RND "," RUN "," SCAN "," SEEK "," SHORT "," SIN "," STOP "," RANDOM "," STRUCT " '10 entries data " TAN "," TIMER "," TITLEBAR "," TRACE "," ULONG "," UNLOADBMP "," USHORT "," USING "," VOID ",_ " WINSTRING " '10 entries data " WORD "," XOR "," UL "," DLL "," KILL "," BOLD "," ITALIC "," UNDERLINE "," NORMAL "," TAB " '10 entries data " GLOBAL "," BYREF "," MAPHANDLE "," EVAL "," DO "," LOOP "," ON ERROR "," RESUME "," PLAYMIDI ",_ " MIDIPOS " '10 entries data " SORT "," STOPMIDI "," STYLEBITS "," SQR "," STEP "," UNTIL "," MOD "," INPUTCSV "," FIND "," FINDBACK "'10 entries data " RESETFIND" '1 entry
[Subs_&_Functions] 'Subs and Functions below.
[RemoveKeywords] 'Remove both keywords and string keywords. while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Get a line. gosub[ProgMove] temp$=upper$(a$+" ") 'Change to upper case to make sure the keyword is found. for x=start to last 'Go through all keywords if a$="" then exit for keyword$=DataArray$(x) c=len(keyword$) while instr(temp$,keyword$)>0 'Is the keyword in the line. a=len(a$) b=instr(temp$,keyword$) 'Find location of keyword. b$=right$(a$,(a+1)-(b+c)) 'Get right side of line. a$=left$(a$,b-1) 'Get left side of line. a$=" "+a$+" "+b$+" " 'Replace keyword with a space. temp$=upper$(a$) wend next if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if wend return
[OpenFiles] 'Open the working and temporary files. open dir$+"WorkingFile.txt" for input as #WorkingFile open dir$+"Tempory.txt" for output as #TemporaryFile return
[CloseFiles] 'Close files and clear the progress bar. close #TemporaryFile close #WorkingFile kill dir$+"WorkingFile.txt" 'Delete the working file name dir$+"Tempory.txt" as dir$+"WorkingFile.txt" 'and name the temporary file to the working file. #progbar.graphicbox1,"cls" 'Clears the Progress Bar graphic box. return
[Display] 'Display various files WindowWidth= 800 WindowHeight=600 BackgroundColor$ = "white" ForegroundColor$ = "black" statictext #display.st1, "", 15, 50, 780, 20 statictext #display.st2, "", 15, 70, 780, 20 statictext #display.st3, "", 15, 90, 780, 20 statictext #display.st4, "", 15, 110, 780, 20 statictext #display.st5, "", 15, 130, 780, 20 statictext #display.st6, "", 15, 150, 780, 20 statictext #display.st7, "", 15, 170, 780, 20 statictext #display.st8, "", 15, 190, 780, 20 statictext #display.st9, "", 15, 210, 780, 20 statictext #display.st10, "", 15, 230, 780, 20 statictext #display.st11, "", 15, 250, 780, 20 statictext #display.st12, "", 15, 270, 780, 20 statictext #display.st13, "", 15, 290, 780, 20 statictext #display.st14, "", 15, 310, 780, 20 statictext #display.st15, "", 15, 330, 780, 20 statictext #display.st16, "", 15, 350, 780, 20 statictext #display.st17, "", 15, 370, 780, 20 statictext #display.st18, "", 15, 390, 780, 20 statictext #display.st19, "", 15, 410 , 780, 20 statictext #display.st20, "", 15, 430, 780, 20 statictext #display.st21, "", 15, 450, 780, 20 statictext #display.st22, "", 15, 470, 780, 20 statictext #display.st23, "", 15, 490, 780, 20 statictext #display.st24, "", 15, 510, 780, 20 statictext #display.st25, "", 15, 530, 780, 20 statictext #display.st26, "", 500, 0 ,140, 25 button #display.default, "enter", [displayquit],UL,-400,-400 button #display.b1, "",[lastpage], UL, 651, 0 ,25, 25 'lastbut stylebits #display.b1, _BS_BITMAP, 0, 0, 0 button #display.b2, "", [pagedown], UL, 675, 0, 25, 25 'dbttn stylebits #display.b2, _BS_BITMAP, 0, 0, 0 button #display.b3, "", [pageup], UL, 699, 0, 25, 25 'ubttn stylebits #display.b3, _BS_BITMAP, 0, 0, 0 button #display.b4, "", [firstpage], UL, 723 ,0, 25, 25 'firstbut stylebits #display.b4, _BS_BITMAP, 0, 0, 0 button #display.b5, "",[displayjump], UL, 747, 0, 25, 25 'jumpto stylebits #display.b5, _BS_BITMAP, 0, 0, 0 button #display.b6, "", [displayprint], UL, 770, 0, 25, 25 'print stylebits #display.b6, _BS_BITMAP, 0, 0, 0 stylebits #display, _DS_CENTER,0,0,0 open Title$ for dialog_modal as #display
#display, "font courier new 12 bold" #display, "trapclose [displayquit]" hParent = hwnd(#display) hTip=CreateTooltip(hParent) call AddToolTip Hwnd(#display.b1),hTip, "Last Page " call AddToolTip Hwnd(#display.b2),hTip, "Next Page " call AddToolTip Hwnd(#display.b3),hTip, "Previous Page " call AddToolTip Hwnd(#display.b4),hTip, "First Page " call AddToolTip Hwnd(#display.b5),hTip, "Jump to Page " call AddToolTip Hwnd(#display.b6),hTip, "Print Display " Call BitmapButton Hwnd(#display.b1), HBmp("lastbut") Call BitmapButton Hwnd(#display.b2), HBmp("dbttn") Call BitmapButton Hwnd(#display.b3), HBmp("ubttn") Call BitmapButton Hwnd(#display.b4), HBmp("firstbut") Call BitmapButton Hwnd(#display.b5), HBmp("jumpto") Call BitmapButton Hwnd(#display.b6), HBmp("print")
for hv=1 to 26 var$="#display.st"+str$(hv) #var$ FontVariable$ next Index=1 pagenumb=1 numbpages=int(RecNum/25) if numbpages<1 then numbpages=1 if RecNum/25>numbpages then numbpages=numbpages+1
[nextpage] #display.st26, "Page ";pagenumb;" of ";numbpages for hv=1 to 25 var$="#display.st"+str$(hv) #var$ DataArray$(Index+hv-1) next wait
[displayjump]'Jump to page number. redim DisplayBox$(200) for x=1 to numbpages DisplayBox$(x)=str$(x) next jumpH=25*numbpages if jumpH>400 then jumpH=400
WindowWidth = 150 WindowHeight= 90+jumpH UpperLeftX=int((DisplayWidth-WindowWidth)/2) UpperLeftY=int((DisplayHeight-WindowHeight)/2) ListboxColor$ = "white" BackgroundColor$ = "buttonface" ForegroundColor$ = "black" statictext #jumpto, "Jump to Page",25,3,100,20 listbox #jumpto.lb1, DisplayBox$(, [jumptoselect],45,25,50,jumpH stylebits #jumpto, _DS_CENTER,0,0,0 open "" for dialog_modal as #jumpto
#jumpto, "font arial 10 bold" #jumpto.lb1, "reload" #jumpto, "trapclose [jumptoclose]" #jumpto.lb1,"singleclickselect" hParent = hwnd(#jumpto) hTip=CreateTooltip(hParent) call AddToolTip Hwnd(#jumpto.lb1),hTip, "Click to select a page " wait
[jumptoselect] 'Select a page to jump to #jumpto.lb1, "selectionindex? pagenumb" Index=(pagenumb-1)*25+1
[jumptoclose] 'Close jump to window close #jumpto goto [nextpage]
[lastpage]'Go to last page if RecNum=0 then [nextpage] Index = (numbpages-1)*25+1 pagenumb=numbpages goto [nextpage]
[pagedown]'Page down Index=Index+25 pagenumb=pagenumb+1 if pagenumb>numbpages then Index=Index-25:pagenumb=pagenumb-1 goto [nextpage]
[pageup]'Page up Index=Index-25 pagenumb=pagenumb-1 if pagenumb<1 then Index=Index+25:pagenumb=pagenumb+1 goto [nextpage]
[firstpage]'Go to first page Index=1 pagenumb=1 goto [nextpage]
[displayprint]'Print the file. PrinterFont$="font arial 12" lprint Title$ lprint for x=1 to RecNum lprint DataArray$(x) next dump wait
[displayquit]'Close the display window. a=ReleaseTooltipMemory(hTip) close #display return
[FindFiles] 'See if the file exists. files dir$, displayfile$, info$( If (val(info$(0, 0)) =0) then 'File doesn't exist. notice "Error!"+chr$(13)+"File not created yet. " return end if If (val(info$(1, 1)) =0) then 'File exists but is empty. notice "Error!"+chr$(13)+"The File is empty. " return end if
redim DataArray$(50000) open dir$+displayfile$ for input as #File RecNum=0 line input #File, Title$ while not(eof(#File)) line input #File, a$ RecNum=RecNum+1 DataArray$(RecNum)=a$ wend close #File gosub [Display] return
[ProgressBar] 'Create Progress Bar. WindowWidth = 500 WindowHeight = 165 BackgroundColor$ = "lightgray" ForegroundColor$ = "black" statictext #progbar.st1, "",428,54,50,25 'Percent complete. statictext #progbar.st2, "",20,100,450,25 'File Name. groupbox #progbar.gb1, " Please Wait - Working ",5,5,485,125 graphicbox #progbar.graphicbox1, 20, 55, 400, 25 stylebits #progbar, _DS_CENTER,0,0,0 open "Please Wait" for dialog_popup as #progbar
#progbar, "font arial 14 bold" #progbar.st2, "!font arial 12 bold" #progbar.graphicbox1,"down; backcolor green" progx=ProgStep return
[ProgMove] 'Move Progess Bar. percent=int((progx/400)*100) if percent>100 then percent=100 #progbar.st1,str$(percent)+"%" #progbar.graphicbox1,"discard place 0 0" #progbar.graphicbox1,"boxfilled ";int(progx);" 25" progx=progx+ProgStep return
[ProcessDataArray] 'Sort, count and remove duplicates. ProgStep=400/counter progx=ProgStep sort DataArray$(),1,counter for x=1 to counter 'Find duplicates and mark with **. gosub [ProgMove] 'Move the progress bar one step progx if DataArray$(x)<>"**" then 'As array elements are marked with ** then skip. Makes the routine go faster. NumberofOccurence=1 variable$=DataArray$(x) DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")" for y=x+1 to counter if variable$=DataArray$(y) then DataArray$(y)="**" NumberofOccurence=NumberofOccurence+1 DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")" end if next end if next a=0 'Number of remaining items. for x=1 to counter 'Save ritems excluding **. if DataArray$(x)<>"**" then print #1, DataArray$(x) a=a+1 end if next return
[UpdateRecentList] flag=0 'Set to 1 if the selected new file is already in the recent list. If NewFile$<>"" then 'A new file has been selected. for x=1 to 8 'Does it already exist in the recent list. if RecentArray$(x)="" then exit for 'If an array element is empty exit the for/next. if NewFile$=RecentArray$(x) then 'If it exists in the recent list then flag=1 'set the flag to 1 and exit for 'exit the for/next. end if next if flag=1 then [skipupdate] 'End the update. for x=8 to 2 step-1 'The new file does not exist in the recent list RecentArray$(x)=RecentArray$(x-1) 'then move each recent file down one element next RecentArray$(1)=NewFile$ 'and put the new recent file in element 1. goto [skipupdate] end if if RecentFile$ ="" then 'The recent file selected no longer exists. for x=Index to 7 RecentArray$(x)=RecentArray$(x+1) if RecentArray$(x)="" then exit for next RecentArray$(8)="" else 'The recent file exists so move it to #1 element. a$=RecentArray$(Index) for x=Index to 2 step -1 RecentArray$(x)=RecentArray$(x-1) next RecentArray$(1)=a$ end if
[skipupdate] 'Finaly refil the ini file and update the recent menus. open DefaultDir$+"\recent.ini" for output as #1 for x=1 to 8 a$=RecentArray$(x) print #1,a$ calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong call MenuMod hfile, hfileid, a$, x 'Modify the recent menu items. next close #1 return
sub BitmapButton hButton, hBitmap CallDLL #user32, "SendMessageA", _ hButton as uLong, _ _BM_SETIMAGE as Long, _ _IMAGE_BITMAP as Long, _ hBitmap As uLong, _ result as Long end Sub
sub GetIni 'Open the recent.ini file and fill the array. open DefaultDir$+"\recent.ini" for input as #1 for x=1 to 8 input #1, RecentArray$(x) next close #1 end sub
sub MenuMod hmainmenu, position,pointer$,Index 'Used to modify the Main Window Recent Menus. pointer$="&"+str$(Index)+". "+pointer$ 'The menu will be "1. C:\folder\filename". 'In this demo, the start of the recent file menus is at 2. 'So a 1 must be added to the position. position=position+1 'in this demo, the first recent menu is at position 2 through 9. flags=_MF_STRING or _MF_BYCOMMAND calldll #user32, "ModifyMenuA",_ hmainmenu as ulong,_ position as ulong,_ flags as long,_ position as ulong,_ pointer$ as ptr,_ r as boolean end sub
sub AddToolTip cHndl, hWnd, text$ TOOLINFO.uId.struct = cHndl TOOLINFO.lpszText.struct = text$ CallDLL #user32, "SendMessageA",_ hWnd As ulong, _ 1028 As long, _ 0 As long, _ TOOLINFO as ptr, _ result as long end sub
sub SetWindowText hWnd, txt$ 'Places text in the Help window. callDLL #user32, "SetWindowTextA",hWnd As ulong,txt$ As ptr,result As void end sub
Sub staticImage hSt, hB 'Code from Janet Calldll #user32, "SendMessageA", _ hSt as long, _ _STM_SETIMAGE as long, _ _IMAGE_BITMAP as long, _ hB as long, r as ulong End Sub
FUNCTION CreateTextEdit(hWin, x, y, w, h) style = _WS_CHILDWINDOW OR _WS_BORDER OR _WS_VISIBLE or _ES_MULTILINE or _WS_VSCROLL or _ES_READONLY hInst=GetWindowLong(hWin, _GWL_HINSTANCE) callDLL #user32,"CreateWindowExA",_ 0 As long,"RichEdit" As ptr,_ "" As ptr, style As long,_ x As long,y As long,w As long,h As long,_ hWin As ulong, 0 As long, hInst As ulong,_ 0 As long, CreateTextEdit As long END FUNCTION
FUNCTION CreateTooltip(hMain) Struct TOOLINFO, _ cbSize As long, _ uFlags As long, _ hwnd As ulong, _ uId As long, _ rectLeft As long, _ rectTop As long, _ rectRight As long, _ rectBottom As long, _ hinst As ulong, _ lpszText As ptr CallDLL #comctl32,"InitCommonControlsEx", _ result as void TOOLINFO.cbSize.struct = Len(TOOLINFO.struct) TOOLINFO.uFlags.struct = flags Or 17 'TTF_IDISHWND Or TTF_SUBCLASS TOOLINFO.hwnd.struct = hMain CallDLL #user32,"CreateWindowExA",_ 0 As long, _ "tooltips_class32" As ptr, _ 0 As long, style As long, _ _CW_USEDEFAULT As long, _ _CW_USEDEFAULT As long, _ _CW_USEDEFAULT As long, _ _CW_USEDEFAULT As long, _ hMain As ulong, _ 0 As long, _ 0 as long, _ 0 As long, _ CreateTooltip As Long END FUNCTION
FUNCTION GetWindowLong(hWin, type) callDLL #user32, "GetWindowLongA", hWin As ulong, type As long, GetWindowLong As long END FUNCTION
'The next two functions are from Alyce Watson's web site. Function SeparateFile$(f$) fileindex=len(f$) filelength=len(f$) while mid$(f$, fileindex,1)<>"\" fileindex=fileindex-1 wend SeparateFile$=right$(f$,filelength-fileindex) end function
Function SeparatePath$(f$) fileindex=len(f$) filelength=len(f$) while mid$(f$, fileindex,1)<>"\" fileindex=fileindex-1 wend SeparatePath$=left$(f$,fileindex) end function
FUNCTION ReleaseTooltipMemory(hTip) CallDLL #user32, "DestroyWindow",_ hTip As ulong, _ result As long END FUNCTION
function ReplaceMultipleString$(st$, tg$, rp$) 'Replace multiple occurences. targetlength = len(tg$) 'Find length of target$. nextpos=1 'Start at position 1. while instr(st$,tg$,nextpos)>0 'Do while target$ exists. startlength = len(st$) 'Find length of start$. startposition = instr(st$,tg$,nextpos) 'Find position of target$. LeftofString$ = left$(st$,startposition-1) 'Get left of start$ to target$. nextpos=startposition+targetlength 'Get right of start$ after target$. RightofString$ = Right$(st$,startlength-(nextpos-1)) ReplaceMultipleString$=LeftofString$+rp$+RightofString$ 'Add replace$ to final$. st$=ReplaceMultipleString$ 'Set st$ to final$ so the while loop works. wend end function
|
|
|
Post by pandawdy on Sept 14, 2019 18:42:37 GMT -5
Here is a program that will do that and more. 'Liberty Basic Reader 'Works with any LB 4.5 and lower. 'Copyright 2013 by Jim Brossman
curversion$="12.2" '6/10/2016 dim info$(10,10) dim DataArray$(50000)'This contains all the extracted data. Labels, Handles etc. dim DisplayBox$(2500)'Used to display page numbers in the JumpTo window. dim RecentArray$(8) dir$=DefaultDir$+"\" files DefaultDir$,"recent.ini",info$( if val(info$(0,0))=0 then 'If the recent.ini file doesn't exist open DefaultDir$+"\recent.ini" for output as #1 for x=1 to 8 'then fill it with blank spaces. print #1, "" next close #1 end if call GetIni 'Now get the existing recent files and fill the RecentArray$.
nomainwin WindowWidth = DisplayWidth WindowHeight = DisplayHeight UpperLeftX= 0 UpperLeftY=0 BackgroundColor$ = "white" ForegroundColor$ = "black" loadbmp "lb", dir$+"LBReader.bmp" loadbmp "lastbut",dir$+"lastbut.bmp" loadbmp "dbttn", dir$+"dbttn.bmp" loadbmp "ubttn", dir$+"ubttn.bmp" loadbmp "firstbut", dir$+"firstbut.bmp" loadbmp "jumpto", dir$+"jumpto.bmp" loadbmp "print", dir$+"print.bmp" menu #main, "&File","&Open File && Run", [OpenBasFile],|,"&1. ",[recent1],_ "&2. ",[recent2],"&3.",[recent3],"&4.",[recent4],"&5.",[recent5],"&6.",[recent6],"&7.",[recent7],_ "&8. ",[recent8],|, "E&xit", [Quit] menu #main, "&Display", "&Arrays", [ArrayDisplay],"&File Names",[FileNameDisplay],"&Handles", [HandleDisplay],_ "&Labels", [LabelDisplay],"&Numeric Variables",[NumericDisplay], "&String Variables", [StringDisplay],_ "Gosub Labels", [GosubDisplay], "GoTo Labels",[GotoDisplay],"Subs and &Functions",[SubDisplay],"&Working File",[WorkingFile],_ "Number of Working Lines", [ActualLines] menu #main, "&Help", "&Help",[Help],"&About LB Reader", [About] stylebits #main.st0, _SS_BITMAP, 0, 0, 0 statictext #main.st0, "", int(WindowWidth/2)-175, int(WindowHeight/2)-200, 1, 1
open "LB Reader v"+curversion$ for window as #main hMain=HWnd(#main) 'Handle of main window. calldll #user32, "GetMenu",hMain as ulong,hMenu as ulong 'Get handle of the menu. calldll #user32, "GetSubMenu",hMenu as ulong,0 as long,hfile as ulong 'Get handle of file menu. 'Get info for each recent menu line and modify the menu. for x=1 to 8 a$=RecentArray$(x) calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong 'Get the ID number of the file menu. call MenuMod hfile, hfileid,a$,x 'Modify the recent menu items. next 'And draw the menu bar. calldll #user32, "DrawMenuBar", hMain as ulong, result as boolean 'Redraw the menu. #main, "trapclose [Quit]" 'Handle of main window. callDLL #user32, "ShowWindow",hMain As uLong,_SW_MAXIMIZE As Long, r As Boolean hst0 = hwnd(#main.st0) 'Required for staticimage. hB0 = hbmp("lb") 'Required for staticimage. Call staticImage hst0, hB0 'Required for staticimage.
[MainLoop] wait
[Quit] 'End the program. unloadbmp "lb" unloadbmp "lastbut" unloadbmp "dbttn" unloadbmp "ubttn" unloadbmp "firstbut" unloadbmp "jumpto" unloadbmp "print" close #main end
[ArrayDisplay] 'Will display and optionally print the list of arrays. displayfile$="ArrayFile.txt" gosub [FindFiles] goto [MainLoop]
[FileNameDisplay] 'Will display the list of file names. displayfile$="FileName.txt" gosub [FindFiles] goto [MainLoop]
[HandleDisplay] 'Will display and optionally print the list of handles. displayfile$="HandleFile.txt" gosub [FindFiles] goto [MainLoop]
[LabelDisplay] 'Will display and optionally print the list of labels. displayfile$="LabelFile.txt" gosub [FindFiles] goto [MainLoop]
[NumericDisplay] 'Will display and optionally print the list of numeric variables. displayfile$="NumericFile.txt" gosub [FindFiles] goto [MainLoop]
[StringDisplay] 'Will display and optionally print the list of string variables. displayfile$="StringFile.txt" gosub [FindFiles] goto [MainLoop]
[SubDisplay] 'Will display and optionally print the list of Subs and Functions. displayfile$="SubFile.txt" gosub [FindFiles] goto [MainLoop]
[GosubDisplay] displayfile$="GosubLabelFile.txt" gosub [FindFiles] goto [MainLoop]
[GotoDisplay] displayfile$="GoToLabelFile.txt" gosub [FindFiles] goto [MainLoop]
[WorkingFile] 'Will display and optionally print the remaining lines in the working file. displayfile$="WorkingFile.txt" gosub [FindFiles] goto [MainLoop]
[recent1] 'For recent file 1 RecentFile$=RecentArray$(1) Index=1 goto [OpenRecentFile]
[recent2] RecentFile$=RecentArray$(2) Index=2 goto [OpenRecentFile]
[recent3] RecentFile$=RecentArray$(3) Index=3 goto [OpenRecentFile]
[recent4] RecentFile$=RecentArray$(4) Index=4 goto [OpenRecentFile]
[recent5] RecentFile$=RecentArray$(5) Index=5 goto [OpenRecentFile]
[recent6] RecentFile$=RecentArray$(6) Index=6 goto [OpenRecentFile]
[recent7] RecentFile$=RecentArray$(7) Index=7 goto [OpenRecentFile]
[recent8] RecentFile$=RecentArray$(8) Index=8 goto [OpenRecentFile]
[OpenRecentFile] 'Open a file listed in the recent menus. if RecentFile$="" then 'If the selected menu item does not have a recent file in it. notice "Notice!"+chr$(13)+"No recent file selected" wait end if 'Get the file name and path so the files statement works. FileName$=SeparateFile$(RecentFile$) 'Get the recent file name. FilePath$=SeparatePath$(RecentFile$) 'Get the file path. 'and see if the file really exists. files FilePath$,FileName$,info$( if val(info$(0,0))=0 then 'The file no longer exists. Notice "Notice!"+chr$(13)+ "File "+FileName$+" no longer exists." RecentArray$(Index)="" 'Clear the array element for the file that is missing. RecentFile$="" 'Clear so [UpdateRecentList] removes the missing file. NewFile$="" 'Set to "" so [UpdateRecentList] knows what to do. gosub [UpdateRecentList] else gosub [UpdateRecentList] 'RecentFile$ will not be empty. FileName$=RecentFile$ goto [StartReading] end if wait
[OpenBasFile] 'Get a basic file and open it. 'The file dialog and associated functions are code from Alyce Watson filedialog, "Open Code File","*.bas",NewFile$ 'Call filedialog and select file. if NewFile$="" then wait 'When no file is selected. if upper$(right$(NewFile$,3))<>"BAS" then notice "Error!"+chr$(13)+"The selected file is not a basic file! " goto [MainLoop] end if RecentFile$="" gosub [UpdateRecentList] 'NewFile$ will not be empty. FileName$=NewFile$ 'Fall through.
[StartReading] 'Open the text file and start reading. files dir$, "*.txt", info$( if val(info$(0,0))>0 then for x=1 to val(info$(0,0)) kill dir$+info$(x,0) next end if ActualLines=0 LinesLeft=0
'This section counts the actual number of working lines not 'including blank and remarked lines. This section removes Blank lines and 'lines that start with ' or rem. 'ActualLines=Actual number of working lines. open FileName$ for input as #OriginalFile open dir$+"WorkingFile.txt" for output as #WorkingFile while not(eof(#OriginalFile)) line input #OriginalFile, a$ 'Input each line. a$=trim$(a$) if (a$<>"") and (left$(a$,1)<>"'") and (left$(upper$(a$),3)<>"REM") then 'If the line isn't blank or remarked. ActualLines= ActualLines+1 LinesLeft=LinesLeft+1 'Number of lines left in the working file. Used in the next section. print #WorkingFile, a$ end if wend close #WorkingFile close #OriginalFile
'This section opens the working file, reads each line and removes quotes and blank lines. gosub [ProgressBar] #progbar.st2, "Removing Quoted Strings - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 'Reset the number of lines left in the Working File. gosub [OpenFiles] while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Input each line. gosub [ProgMove] a$=trim$(a$) 'Trim the line. while instr(a$,chr$(34))>0 'Find if there is a quote. a=len(a$) 'Length of a$. b=instr(a$,chr$(34)) 'Find the first quote. b$=left$(a$,b-1) 'Get the part before the first quote. a$=right$(a$,a-b) 'Get the text after the first quote. b=instr(a$,chr$(34)) 'Find the last quote. a$=right$(a$,len(a$)-b) 'Get the remainder of the line. a$=b$+" "+a$ 'Add a space between the parts wend if trim$(a$)>"" then print #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section will remove any remarked lines. ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] #progbar.st2, "Removing Remarked lines - Lines Left ="+str$(LinesLeft) while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Input each line. a$=trim$(a$) 'Trim each line. gosub[ProgMove] if instr(a$,"'")>0 then 'If ' appears in the line a=instr(a$,"'") 'then find the location of the ' and b$=left$(a$,a-1) 'get the left side of the line. if len(b$)>0 then 'If line is not blank then save un remarked portion. print #TemporaryFile, " "+trim$(b$) LinesLeft=LinesLeft+1 end if else print #TemporaryFile, " "+trim$(a$) 'If no ' appears in the line then save the line. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section will find and remove all gosub labels. redim DataArray$(50000) 'Open up the progress bar. #progbar.st2, "Retrieving Gosub Labels - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement. progx=ProgStep 'Set so the progress bar starts at 0%. LinesLeft=0 'Number of lines left in the Working File. linecounter=0 gosub [OpenFiles] counter=0 'How many actual items are saved. while not(eof(#WorkingFile)) 'This section removes label names from the working file. line input #WorkingFile, a$ 'Input each line. linecounter=linecounter +1 gosub [ProgMove] location=1 while instr(upper$(a$),"GOSUB ", location) location=instr(upper$(a$),"GOSUB")+6 startg=location-6 'Include the gosub. a=instr(a$,"[", location) 'Start of label. if a=0 then exit while 'In case the word gosub is in a remark. b=instr(a$,"]",a) 'End of the label. d$=mid$(a$,a,b-a+1) 'The gosub [label]. b$=left$(a$,startg) 'Get the start of the remaining string. c$=right$(a$,len(a$)-b) 'Get the end of the remaining string. a$=b$+c$ 'The reaming string. counter=counter+1 'Number of of gosub labels that appear. DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName]. wend 'Look for more array names. if trim$(a$)>"" then 'If the line isn't empty print #TemporaryFile,a$ 'put it in the Temporary File LinesLeft=LinesLeft+1 'and increase the line count. end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section sorts the gosub labels and deletes duplicates. If counter=0 then [EndGosubLabel] 'In case there were no labels. counter is generated above. #progbar.st2, "Sorting && Saving Gosub Label names - Lines Left ="+str$(LinesLeft) open dir$+"GosubLabelFile.txt" for output as #1 print #1, "Gosub Label List for "+FileName$ 'Title for the display window. gosub [ProcessDataArray] print #1, "Number of Gosub Labels = ";a close #1 [EndGosubLabel] 'Skip to here if counter =0. #progbar.graphicbox1,"cls"
'This section will find and remove all goto labels 'and removes blank lines. redim DataArray$(50000) #progbar.st2, "Retrieving GoTo Labels - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement. progx=ProgStep 'Set so the progress bar starts at 0%. LinesLeft=0 'Number of lines left in the Working File. gosub [OpenFiles] counter=0 'How many actual items are saved. while not(eof(#WorkingFile)) 'This section removes label names from the working file. line input #WorkingFile, a$ 'Input each line. linecounter=linecounter +1 gosub [ProgMove] location=1 while instr(upper$(a$),"GOTO ", location) location=instr(upper$(a$),"GOTO")+5 startg=location-6 'Include the goto. a=instr(a$,"[", location) 'Start of label. if a=0 then exit while 'In case the word goto is in a remark. b=instr(a$,"]",a) 'End of the label. d$=mid$(a$,a,b-a+1) 'The goto [label]. b$=left$(a$,startg) 'Get the start of the remaining string. c$=right$(a$,len(a$)-b) 'Get the end of the remaining string. a$=b$+c$ 'The remaining string. counter=counter+1 'Number of of goto labels that appear. DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName]. wend 'Look for more array names. if trim$(a$)>"" then 'If the line isn't empty print #TemporaryFile,a$ 'put it in the Temporary File LinesLeft=LinesLeft+1 'and increase the line count. end if wend gosub [CloseFiles] #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section sorts the goto labels and deletes duplicates. If counter=0 then [EndGoToLabel] 'In case there were no labels. counter is generated above. #progbar.st2, "Sorting && Saving GoTo Label names - Lines Left ="+str$(LinesLeft) open dir$+"GoToLabelFile.txt" for output as #1 print #1, "GoTo Label List for "+FileName$ 'Title for the display window. gosub [ProcessDataArray] print #1, "Number of GoTo Labels = ";a close #1 [EndGoToLabel] 'Skip to here if counter =0. #progbar.graphicbox1,"cls"
'This section will remove all labels and place them in LabelFile.txt 'and remove blanks lines. redim DataArray$(50000) #progbar.st2, "Retrieving Label names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement. progx=ProgStep 'Set so the progress bar starts at 0%. LinesLeft=0 'Number of lines left in the Working File. linecounter=0 gosub [OpenFiles] counter=0 'How many actual items are saved. while not(eof(#WorkingFile)) 'This section removes label names from the working file. [startlabel] line input #WorkingFile, a$ 'Input each line. linecounter=linecounter +1 gosub [ProgMove] 'Move the progress bar one step. while instr(a$,"[")>0 a=len(a$) b=instr(a$,"[") c=instr(a$,"]") if c=0 then 'In case there is no ] in the line. notice "Notice!"+chr$(13)+"There appears to be a missing ] on line "+str$(linecounter)+chr$(13)+a$ goto [startlabel] end if b$=left$(a$,b-1) d$=mid$(a$,b,c-b+1) 'The label. d=len(d$) 'd$ might equal {LabelName]. e$=trim$(mid$(d$,2,d-2)) 'This is to eliminate any []. e$ should look like LabelName. if e$<>"" then 'If the line isn't blank. counter=counter+1 'Number of times a label appears. DataArray$(counter)=d$ 'So DataArray$(counter) will equal [LabelName]. end if a$=b$+right$(a$,a-c) 'Get the remainder of a$ and wend 'look for more labels. if trim$(a$)>"" then 'If the line isn't empty print #TemporaryFile,a$ 'put it in the Working File LinesLeft=LinesLeft+1 'and increase the line count. end if wend gosub [CloseFiles]
'This section sorts the labels and deletes duplicates. If counter=0 then [EndLabel] 'In case there were no labels. counter is generated above. open dir$+"LabelFile.txt" for output as #1 print #1, "Label List for "+FileName$ 'Title for the display window. gosub [ProcessDataArray] print #1, "Number of Labels = ";a close #1 [EndLabel] 'Skip to here if counter =0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section opens the working file and breaks 'lines with a colon into multiple lines and removes any blank lines. #progbar.st2, "Removing ':'and breaking lines - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Input each line. gosub [ProgMove] a$=trim$(a$) 'Trim each line. while instr(a$,":")>0 'Do until there are no more colons. a=instr(a$,":") 'Break lines with a colon into multiple lines. b$=left$(a$,a-1) print #TemporaryFile, trim$(b$) 'Save leftmost portion of line. LinesLeft=LinesLeft+1 ActualLines=ActualLines+1 'Remove this line if you don't want lines with a colon counted as extra lines. a$=right$(a$,len(a$)-a) 'Get the remainder of the line. wend if trim$(a$)>"" then print #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section will retrieve all array dim statements 'save them to ArrayFile.txt and removes blank lines. redim DataArray$(50000) #progbar.st2, "Retrieving Array names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] redim DataArray$(50000) open dir$+"ArrayFile.txt" for output as #ArrayFile print #ArrayFile, "Array List for "+FileName$ 'Title for display window. counter=0 'Counts how many dim statements. while not(eof(#WorkingFile)) 'This section finds dim statements. line input #WorkingFile, a$ 'Input each line. gosub [ProgMove] a$=trim$(a$) 'Trim each line. if left$(upper$(a$),3)="DIM" then b$=trim$(right$(a$,len(a$)-4)) 'Get the right part of the dim statement. [morearrays] 'If arrays were dimensioned on the next line with the _ character. while instr(b$,")")>0 'Look for the ")" b=len(b$) 'Get the total length of b$ a=instr(b$,")") 'Find the location of the ) c$=left$(b$,a) 'Get the array and size b$=trim$(right$(b$,b-a)) 'Remove the array name and size if left$(b$,1)="," then 'Are there any more dimensioned arrays on the line a=len(b$) 'Get the new length of b$ b$=trim$(right$(b$,a-1)) 'Remove the first comma. end if counter=counter+1 print #ArrayFile,c$ 'Save array name and size. c$=arrayname(x,x) c=instr(c$,"(") 'Find where size starts. c$=trim$(left$(c$,c)) 'Get 'arrayname(' into data array. DataArray$(counter)=c$ wend if trim$(b$)="_" then 'If arrays are dimensioned on the next line. line input #WorkingFile, a$ 'Input the next line. gosub [ProgMove] a$=trim$(a$) b$=a$ goto [morearrays] end if else if trim$(a$)>"" then print #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if end if wend print #ArrayFile, "Number of arrays = "; counter close #ArrayFile gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section removes any references to the arrays from the working file and removes blank lines. #progbar.st2, "Removing Array names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] a$=trim$(a$) if counter=0 then print #TemporaryFile, a$ 'If no arrays specified then save the line. LinesLeft=LinesLeft+1 end if if counter >0 then 'If arrays labels exist then for x= 1 to counter 'go thru all labels. array$=DataArray$(x) 'Get array label from DataArray. while instr(a$,array$)>0 a=len(a$) 'Find length of line. b=instr(a$,array$) 'Find start of label. if b=0 then exit while 'If no more labels in line exit loop. b$=left$(a$,b-1) 'Get left part of line before label. a$=right$(a$,a-b+1) 'Get right part of line including label. b=instr(a$,"(") 'Find ( to right of label. a$=right$(a$,len(a$)-b) 'Get right part of line after label. if len(a$)>0 then a$=b$+" "+a$ else a$=b$+" "+a$ end if wend next if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section will find all subs and functions and passed variables and removes them. #progbar.st2, "Retrieving Subs && Functions - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] open dir$+"SubFile.txt" for output as #SubFile 'Title for display window. print #SubFile, "Subroutine & Function List for "+FileName$ counter=0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] select case case instr(upper$(a$),"CALL")>0 a$=trim$(a$) 'Remove start and ending spaces. Index=0 cfound=0 name$="" token$="dx31b" while token$ <>"" Index=Index+1 token$=word$(a$,Index) if cfound=1 then name$=token$ cfound=0 end if if upper$(token$)="CALL" then cfound=1 wend a=len(a$) b=instr(upper$(a$),"CALL") c=len(name$) b$=left$(a$,b-1) d=a-(b+c+4) c$=right$(a$,d) a$=trim$(b$+c$) if a$<>"" then #TemporaryFile, a$ LinesLeft=LinesLeft+1 end if case instr(upper$(a$),"SUB ")>0 or instr(upper$(a$),"FUNCTION ")>0 counter=counter+1 print #SubFile,trim$(a$) case else #TemporaryFile, a$ LinesLeft=LinesLeft+1 end select wend print #SubFile, "Number of Subs and Functions = "; counter close #SubFile gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section removes the punctuation defined in the first data line and replaces with a space. 'Periods are not removed since they may be used in variables. redim DataArray$(50000) #progbar.st2, "Removing punctuation - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] for x=1 to 13 'Get first 13 punctuation items into array. read character$ DataArray$(x)=character$ next while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] for x=1 to 13 character$=DataArray$(x) while instr(a$,character$)>0 a=len(a$) b=instr(a$,character$) 'Find location of character. b$=right$(a$,a-b) 'Get right side of line. a$=left$(a$,b-1) 'Get left side of line. a$=a$+" "+b$ 'Replace character with a space. wend next if trim$(a$)>"" then print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section finds file names redim DataArray$(50000) #progbar.st2, "Retrieving File names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] if instr(upper$(a$),"INPUT AS")>0 or instr(upper$(a$),"OUTPUT AS")>0 or instr(upper$(a$),"RANDOM AS")>0 then a=instr(a$,"#") b=instr(a$," ",a) b$=trim$(mid$(a$,a,b-a)) a$=left$(a$,a-1) counter=counter+1 DataArray$(counter)=b$ end if if trim$(a$)>"" then print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts and counts the file names. if counter=0 then [EndFileName] 'In case there were no handles. #progbar.st2, "Sorting and Saving File names - Lines Left ="+str$(LinesLeft) open dir$+"FileName.txt" for output as #1 print #1, "File List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of File Names = ";a close #1 [EndFileName] 'Skip to here if counter =0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section finds the handle names and 'removes from line and fills the data array. redim DataArray$(50000) #progbar.st2, "Retrieving Handles names - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] while instr(a$,"#")>0 'Loop while '#' exists in line. a=len(a$) b=instr(a$,"#") 'Find location of '#'. c=instr(a$," ",b) 'Find space at end of the handle. b$=left$(a$,b-1) 'Get left side of line. counter =counter +1 DataArray$(counter)=mid$(a$,b,c-b) 'Get handle from line and save in array. a$=b$+" "+right$(a$,a-c) 'Add space where handle was so next section works. wend if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts, finds duplicate Handle names and 'and saves to HandleFile.txt. if counter=0 then [EndHandle] 'In case there were no handles. #progbar.st2, "Sorting and Saving Handle names - Lines Left ="+str$(LinesLeft) open dir$+"HandleFile.txt" for output as #1 print #1, "Handle List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of Handles = ";a close #1 [EndHandle] 'Skip to here if counter =0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This fills the data array with keyword strings 'and removes them from the working file. #progbar.st2, "Removing String Keywords - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] for x=1 to 37 'There are currently 37 string keywords in LB4.5 and 29 in LB 4.04. read a$ DataArray$(x)=a$ next start=1:last=37 'Last = number of keyword$. gosub [RemoveKeywords] gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section finds String Variables and removes them from the file. redim DataArray$(50000) #progbar.st2, "Retrieving String variables - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] do while instr(a$,"$")>0 'Loop while '$' exists in line. a=len(a$) b=instr(a$,"$") 'Find the location of the $. for x= b-1 to 1 step -1 'Step backwards until a space is found. b$=mid$(a$,x,1) 'x= location of space. if b$=" " then exit for 'When a space is found exit loop. next b$=right$(a$,a-b) 'Get right side of line. counter = counter +1 DataArray$(counter)=mid$(a$,x+1,b-x)'Get string variable from line and save in array. a$=b$+left$(a$,x-1) 'Get left side of line. loop if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts the strings and deletes duplicates and saves. if counter=0 then [EndStrings] 'In case there were no string variables. #progbar.st2, "Sorting and Saving String variables - Lines Left ="+str$(LinesLeft) open dir$+"StringFile.txt" for output as #1 print #1, "String Variable List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of String variables = ";a close #1 [EndStrings] 'Skip to here if counter = 0 #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This fills the data array with keywords and removes them from the working file. redim DataArray$(50000) #progbar.st2, "Removing Keywords - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] for x=1 to 171 'There are currently 171 keywords. read a$ DataArray$(x)=a$ next start=1:last=171 gosub [RemoveKeywords] gosub [CloseFiles] if LinesLeft=0 then [EndJob]
'This section finds numeric variables. redim DataArray$(50000) #progbar.st2, "Retrieving Numeric variables - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] counter =0 while not(eof(#WorkingFile)) line input #WorkingFile, a$ a$=trim$(a$)+" " gosub [ProgMove] a=len(a$) for x = 1 to a if (asc(mid$(a$,x,1))>64) and (asc(mid$(a$,x,1))<123) then 'Look for an alpha character in the line. b=instr(a$," ",x) 'Find a space after numeric variable. b$=mid$(a$,x,b-x) 'numeric variable. c=len(b$) 'Get length of numeric variable. if left$(b$,1)="_" and len(b$)>1 then goto [skip] 'Remove stylebit commands. if b$="_" goto [skip] 'Remove any line continuations. if instr(b$,"_")>1 then [skip] 'Remove any commands xxx_xxx. counter=counter+1 DataArray$(counter)=b$ [skip] b$=right$(a$,a-b+1) 'Get right side of line. a$=left$(a$,x-1)+space$(c)+b$ 'Replace numeric variable with equal number of spaces. end if next if trim$(a$)>"" then print #TemporaryFile,trim$(a$) LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
'This section sorts, finds duplicate numeric variables and 'and saves to NumericFile.txt. if counter=0 then [EndNumeric] 'In case there are no numeric variables. #progbar.st2, "Sorting && Saving Numeric Variables - Lines Left ="+str$(LinesLeft) open dir$+"NumericFile.txt" for output as #1 print #1, "Numeric Variable List for "+FileName$ 'Title for display window. gosub [ProcessDataArray] print #1, "Number of Numeric variables = ";a close #1 [EndNumeric] 'Skip to here if counter=0. #progbar.graphicbox1,"cls" if LinesLeft=0 then [EndJob]
'This section removes all the numbers and remaining periods from the working file. #progbar.st2, "Cleaning Working File - Lines Left ="+str$(LinesLeft) ProgStep=400/LinesLeft progx=ProgStep LinesLeft=0 gosub [OpenFiles] print #TemporaryFile, "Working File for "+FileName$ 'Title for display window. while not(eof(#WorkingFile)) line input #WorkingFile, a$ gosub [ProgMove] for x=0 to 9 'Remove numbers 0 through 9. while instr(a$,str$(x))<>0 a$=ReplaceMultipleString$(a$, str$(x), " ") 'And replace with a space. wend next a$=trim$(a$) if (a$<>"") and (instr(a$,".")=0) then 'Remove blank lines and lines containing periods print #TemporaryFile,trim$(a$) 'and leaves only missed things. LinesLeft=LinesLeft+1 end if wend gosub [CloseFiles]
[EndJob] close #progbar restore open dir$+"NumberLines.txt" for output as #NumbLines print #NumbLines,str$(ActualLines)+" for basic program "+FileName$ close #NumbLines notice "Job Complete!" + chr$(13) + "Use the Display menu to see results."+Chr$(13)+"Actual working lines = "+str$(ActualLines)_ +Chr$(13)+"Lines Left in Working File = "+str$(LinesLeft) goto [MainLoop]
[ActualLines] 'Displays the number of actual working lines. open dir$+"NumberLines.txt" for input as #NumbLines input #NumbLines,ActualLines close #NumbLines notice "Number of Working lines = ";str$(ActualLines) wait
'Please do not remove this section. 'You may modify the version number if you wish and add your name. [About] 'About LB Reader. WindowWidth = 250 WindowHeight = 220 BackgroundColor$ = "buttonface" ForegroundColor$ = "black"
button #helpabout.bmp1, " OK ", [haclick1], UL, 84, 155 statictext #helpabout, "LB Reader", 80, 10, 220, 20 statictext #helpabout, "Version "+curversion$, 85, 30, 90, 20 statictext #helpabout, "Written in Liberty Basic 4.04", 40, 50, 170, 20 statictext #helpabout, "jbross@sisna.com",70,90,150,20 statictext #helpabout, "Copyright 2014", 75, 110, 150,20 stylebits #helpabout, _DS_CENTER,0,0,0 open "About..." for dialog_modal as #helpabout print #helpabout, "font arial 10" print #helpabout, "trapclose [haclick1]" wait
[haclick1] 'Close close #helpabout goto [MainLoop]
[Help] 'Display the help window. WindowWidth = 800 WindowHeight = 600 BackgroundColor$ = "buttonface" ForegroundColor$ = "black" button #help.default, "enter", [helpok],UL,-400,-400 button #help.b1," OK ",[helpok],UL,360,525 bmpbutton #help.b2, dir$+"print.bmp", [helpprint], UL, 745, 528 stylebits #help, _DS_CENTER,0,0,0 open "LB Reader Help" For dialog_modal As #help #help.b1,"!setfocus" #help, "trapclose [helpok]" #help, "font arial 10 bold" hTip=CreateTooltip(hwnd(#help)) call AddToolTip Hwnd(#help.b1),hTip, "Close Help " call AddToolTip Hwnd(#help.b2),hTip, "Print Help window " open "RICHED32.DLL" for dll as #re calldll #comctl32, "InitCommonControlsEx",result as void hlpT=CreateTextEdit(hWnd(#help), 10,10,775,WindowHeight-97) File$=dir$+"help.rtf" open File$ for input as #TempText txt$=input$(#TempText,lof(#TempText)) close #TempText call SetWindowText hlpT,txt$ wait
[helpprint] 'Print help. run "write.exe "+chr$(34)+File$+chr$(34)+" /p",hide wait
[helpok] 'Close Help. close #help close #re goto [MainLoop]
data ";","/","-","+","*","|",",","=","<",">","^","(",")" '13 entries
'These data items require a space in front and the end so that key words can be found and deleted 'and not variables which may contain the keyword. data " BACKGROUNDCOLOR$ "," CHR$ "," COMBOBOXCOLOR$ "," DATE$ "," DECHEX$ "," DEFAULTDIR$ "," DRIVE$ ",_ " LISTBOXCOLOR$ "," SPACE$ "," STR$ " '10 entries data " FOREGROUNDCOLOR$ "," INKEY$ "," INPUT$ "," KILL$ "," LEFT$ "," LOWER$ "," MID$ "," PRINTERNAME$ ",_ " PLATFORM$ "," WORD$ " '10 entries data " RIGHT$ "," TEXTBOXCOLOR$ "," TEXTEDITORCOLOR$ "," TIME$ "," TRIM$ "," UPPER$ "," COMMANDLINE$ ",_ " VERSION$ "," EVAL$ ", " STARTUPDIR$ " '10 entries data " HTTPGET$ ", " UPTO$ ", " AFTER$ ", " AFTERLAST$ ", "ENDSWITH$ ", " REMCHAR$ "," REPLSTR$ " '7 entries
data " FOR "," TO "," NEXT "," EXIT "," WHILE "," WEND "," IF "," THEN "," ELSE "," END " '10 entries data " SELECT "," CASE "," PRINT "," LPRINT "," DUMP "," OPEN "," CLOSE "," INPUT "," LINE "," AS " '10 entries data " WAIT "," CALL "," CALLDLL "," GOTO "," RETURN "," GET "," GETTRIM "," PUT "," OUT "," OUTPUT " '10 entries data " GOSUB "," READ "," RESTORE "," REDIM "," LEN "," VAL "," INT "," INSTR "," NAME "," SUB " '10 entries data " BMPBUTTON "," BUTTON "," CHECKBOX "," COMBOBOX "," GRAPHICBOX "," GROUPBOX "," LISTBOX ",_ " NOMAINWIN "," RADIOBUTTON "," TEXTBOX " '10 entries data " TEXTEDITOR "," DISPLAYWIDTH "," DISPLAYHEIGHT "," UPPERLEFTX "," UPPERLEFTY ",_ " WINDOWWIDTH "," WINDOWHEIGHT "," FUNCTION "," EOF "," FIELD " '10 entries data " COLORDIALOG "," FONTDIALOG "," FILEDIALOG "," PRINTERDIALOG "," STATICTEXT "," DIALOG "," GRAPHICS ",_ " TEXT "," WINDOW "," CONFIRM " '10 entries data " MENU "," FS "," NF "," NSB "," INS "," POPUP "," MODAL "," FILES "," LOF "," LET " '10 entries data " ABS "," ASC "," AND "," ASC "," ASN "," BEEP "," BINARY "," BMPSAVE "," BOOLEAN "," CALLBACK " '10 entries data " CLS "," COS "," CURSOR "," DATA "," DOUBLE "," DWORD "," EXP "," HBMP "," HEXDEC "," HWND ", '10 entries data " INP "," INPUTTO "," LOADBMP "," LOC "," LOG "," LONG "," MAINWIN "," MAX "," MKDIR "," MIN " '10 entries data " NOT "," NOTICE "," ONCOMERROR "," OPEN "," OR "," PLAYWAVE "," POPUPMENU "," PRINTCOLLATE ",_ " PRINTCOPIES "," PROMPT " '10 entries data " RMDIR "," RND "," RUN "," SCAN "," SEEK "," SHORT "," SIN "," STOP "," RANDOM "," STRUCT " '10 entries data " TAN "," TIMER "," TITLEBAR "," TRACE "," ULONG "," UNLOADBMP "," USHORT "," USING "," VOID ",_ " WINSTRING " '10 entries data " WORD "," XOR "," UL "," DLL "," KILL "," BOLD "," ITALIC "," UNDERLINE "," NORMAL "," TAB " '10 entries data " GLOBAL "," BYREF "," MAPHANDLE "," EVAL "," DO "," LOOP "," ON ERROR "," RESUME "," PLAYMIDI ",_ " MIDIPOS " '10 entries data " SORT "," STOPMIDI "," STYLEBITS "," SQR "," STEP "," UNTIL "," MOD "," INPUTCSV "," FIND "," FINDBACK "'10 entries data " RESETFIND" '1 entry
[Subs_&_Functions] 'Subs and Functions below.
[RemoveKeywords] 'Remove both keywords and string keywords. while not(eof(#WorkingFile)) line input #WorkingFile, a$ 'Get a line. gosub[ProgMove] temp$=upper$(a$+" ") 'Change to upper case to make sure the keyword is found. for x=start to last 'Go through all keywords if a$="" then exit for keyword$=DataArray$(x) c=len(keyword$) while instr(temp$,keyword$)>0 'Is the keyword in the line. a=len(a$) b=instr(temp$,keyword$) 'Find location of keyword. b$=right$(a$,(a+1)-(b+c)) 'Get right side of line. a$=left$(a$,b-1) 'Get left side of line. a$=" "+a$+" "+b$+" " 'Replace keyword with a space. temp$=upper$(a$) wend next if trim$(a$)>"" then print #TemporaryFile,a$ LinesLeft=LinesLeft+1 end if wend return
[OpenFiles] 'Open the working and temporary files. open dir$+"WorkingFile.txt" for input as #WorkingFile open dir$+"Tempory.txt" for output as #TemporaryFile return
[CloseFiles] 'Close files and clear the progress bar. close #TemporaryFile close #WorkingFile kill dir$+"WorkingFile.txt" 'Delete the working file name dir$+"Tempory.txt" as dir$+"WorkingFile.txt" 'and name the temporary file to the working file. #progbar.graphicbox1,"cls" 'Clears the Progress Bar graphic box. return
[Display] 'Display various files WindowWidth= 800 WindowHeight=600 BackgroundColor$ = "white" ForegroundColor$ = "black" statictext #display.st1, "", 15, 50, 780, 20 statictext #display.st2, "", 15, 70, 780, 20 statictext #display.st3, "", 15, 90, 780, 20 statictext #display.st4, "", 15, 110, 780, 20 statictext #display.st5, "", 15, 130, 780, 20 statictext #display.st6, "", 15, 150, 780, 20 statictext #display.st7, "", 15, 170, 780, 20 statictext #display.st8, "", 15, 190, 780, 20 statictext #display.st9, "", 15, 210, 780, 20 statictext #display.st10, "", 15, 230, 780, 20 statictext #display.st11, "", 15, 250, 780, 20 statictext #display.st12, "", 15, 270, 780, 20 statictext #display.st13, "", 15, 290, 780, 20 statictext #display.st14, "", 15, 310, 780, 20 statictext #display.st15, "", 15, 330, 780, 20 statictext #display.st16, "", 15, 350, 780, 20 statictext #display.st17, "", 15, 370, 780, 20 statictext #display.st18, "", 15, 390, 780, 20 statictext #display.st19, "", 15, 410 , 780, 20 statictext #display.st20, "", 15, 430, 780, 20 statictext #display.st21, "", 15, 450, 780, 20 statictext #display.st22, "", 15, 470, 780, 20 statictext #display.st23, "", 15, 490, 780, 20 statictext #display.st24, "", 15, 510, 780, 20 statictext #display.st25, "", 15, 530, 780, 20 statictext #display.st26, "", 500, 0 ,140, 25 button #display.default, "enter", [displayquit],UL,-400,-400 button #display.b1, "",[lastpage], UL, 651, 0 ,25, 25 'lastbut stylebits #display.b1, _BS_BITMAP, 0, 0, 0 button #display.b2, "", [pagedown], UL, 675, 0, 25, 25 'dbttn stylebits #display.b2, _BS_BITMAP, 0, 0, 0 button #display.b3, "", [pageup], UL, 699, 0, 25, 25 'ubttn stylebits #display.b3, _BS_BITMAP, 0, 0, 0 button #display.b4, "", [firstpage], UL, 723 ,0, 25, 25 'firstbut stylebits #display.b4, _BS_BITMAP, 0, 0, 0 button #display.b5, "",[displayjump], UL, 747, 0, 25, 25 'jumpto stylebits #display.b5, _BS_BITMAP, 0, 0, 0 button #display.b6, "", [displayprint], UL, 770, 0, 25, 25 'print stylebits #display.b6, _BS_BITMAP, 0, 0, 0 stylebits #display, _DS_CENTER,0,0,0 open Title$ for dialog_modal as #display
#display, "font courier new 12 bold" #display, "trapclose [displayquit]" hParent = hwnd(#display) hTip=CreateTooltip(hParent) call AddToolTip Hwnd(#display.b1),hTip, "Last Page " call AddToolTip Hwnd(#display.b2),hTip, "Next Page " call AddToolTip Hwnd(#display.b3),hTip, "Previous Page " call AddToolTip Hwnd(#display.b4),hTip, "First Page " call AddToolTip Hwnd(#display.b5),hTip, "Jump to Page " call AddToolTip Hwnd(#display.b6),hTip, "Print Display " Call BitmapButton Hwnd(#display.b1), HBmp("lastbut") Call BitmapButton Hwnd(#display.b2), HBmp("dbttn") Call BitmapButton Hwnd(#display.b3), HBmp("ubttn") Call BitmapButton Hwnd(#display.b4), HBmp("firstbut") Call BitmapButton Hwnd(#display.b5), HBmp("jumpto") Call BitmapButton Hwnd(#display.b6), HBmp("print")
for hv=1 to 26 var$="#display.st"+str$(hv) #var$ FontVariable$ next Index=1 pagenumb=1 numbpages=int(RecNum/25) if numbpages<1 then numbpages=1 if RecNum/25>numbpages then numbpages=numbpages+1
[nextpage] #display.st26, "Page ";pagenumb;" of ";numbpages for hv=1 to 25 var$="#display.st"+str$(hv) #var$ DataArray$(Index+hv-1) next wait
[displayjump]'Jump to page number. redim DisplayBox$(200) for x=1 to numbpages DisplayBox$(x)=str$(x) next jumpH=25*numbpages if jumpH>400 then jumpH=400
WindowWidth = 150 WindowHeight= 90+jumpH UpperLeftX=int((DisplayWidth-WindowWidth)/2) UpperLeftY=int((DisplayHeight-WindowHeight)/2) ListboxColor$ = "white" BackgroundColor$ = "buttonface" ForegroundColor$ = "black" statictext #jumpto, "Jump to Page",25,3,100,20 listbox #jumpto.lb1, DisplayBox$(, [jumptoselect],45,25,50,jumpH stylebits #jumpto, _DS_CENTER,0,0,0 open "" for dialog_modal as #jumpto
#jumpto, "font arial 10 bold" #jumpto.lb1, "reload" #jumpto, "trapclose [jumptoclose]" #jumpto.lb1,"singleclickselect" hParent = hwnd(#jumpto) hTip=CreateTooltip(hParent) call AddToolTip Hwnd(#jumpto.lb1),hTip, "Click to select a page " wait
[jumptoselect] 'Select a page to jump to #jumpto.lb1, "selectionindex? pagenumb" Index=(pagenumb-1)*25+1
[jumptoclose] 'Close jump to window close #jumpto goto [nextpage]
[lastpage]'Go to last page if RecNum=0 then [nextpage] Index = (numbpages-1)*25+1 pagenumb=numbpages goto [nextpage]
[pagedown]'Page down Index=Index+25 pagenumb=pagenumb+1 if pagenumb>numbpages then Index=Index-25:pagenumb=pagenumb-1 goto [nextpage]
[pageup]'Page up Index=Index-25 pagenumb=pagenumb-1 if pagenumb<1 then Index=Index+25:pagenumb=pagenumb+1 goto [nextpage]
[firstpage]'Go to first page Index=1 pagenumb=1 goto [nextpage]
[displayprint]'Print the file. PrinterFont$="font arial 12" lprint Title$ lprint for x=1 to RecNum lprint DataArray$(x) next dump wait
[displayquit]'Close the display window. a=ReleaseTooltipMemory(hTip) close #display return
[FindFiles] 'See if the file exists. files dir$, displayfile$, info$( If (val(info$(0, 0)) =0) then 'File doesn't exist. notice "Error!"+chr$(13)+"File not created yet. " return end if If (val(info$(1, 1)) =0) then 'File exists but is empty. notice "Error!"+chr$(13)+"The File is empty. " return end if
redim DataArray$(50000) open dir$+displayfile$ for input as #File RecNum=0 line input #File, Title$ while not(eof(#File)) line input #File, a$ RecNum=RecNum+1 DataArray$(RecNum)=a$ wend close #File gosub [Display] return
[ProgressBar] 'Create Progress Bar. WindowWidth = 500 WindowHeight = 165 BackgroundColor$ = "lightgray" ForegroundColor$ = "black" statictext #progbar.st1, "",428,54,50,25 'Percent complete. statictext #progbar.st2, "",20,100,450,25 'File Name. groupbox #progbar.gb1, " Please Wait - Working ",5,5,485,125 graphicbox #progbar.graphicbox1, 20, 55, 400, 25 stylebits #progbar, _DS_CENTER,0,0,0 open "Please Wait" for dialog_popup as #progbar
#progbar, "font arial 14 bold" #progbar.st2, "!font arial 12 bold" #progbar.graphicbox1,"down; backcolor green" progx=ProgStep return
[ProgMove] 'Move Progess Bar. percent=int((progx/400)*100) if percent>100 then percent=100 #progbar.st1,str$(percent)+"%" #progbar.graphicbox1,"discard place 0 0" #progbar.graphicbox1,"boxfilled ";int(progx);" 25" progx=progx+ProgStep return
[ProcessDataArray] 'Sort, count and remove duplicates. ProgStep=400/counter progx=ProgStep sort DataArray$(),1,counter for x=1 to counter 'Find duplicates and mark with **. gosub [ProgMove] 'Move the progress bar one step progx if DataArray$(x)<>"**" then 'As array elements are marked with ** then skip. Makes the routine go faster. NumberofOccurence=1 variable$=DataArray$(x) DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")" for y=x+1 to counter if variable$=DataArray$(y) then DataArray$(y)="**" NumberofOccurence=NumberofOccurence+1 DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")" end if next end if next a=0 'Number of remaining items. for x=1 to counter 'Save ritems excluding **. if DataArray$(x)<>"**" then print #1, DataArray$(x) a=a+1 end if next return
[UpdateRecentList] flag=0 'Set to 1 if the selected new file is already in the recent list. If NewFile$<>"" then 'A new file has been selected. for x=1 to 8 'Does it already exist in the recent list. if RecentArray$(x)="" then exit for 'If an array element is empty exit the for/next. if NewFile$=RecentArray$(x) then 'If it exists in the recent list then flag=1 'set the flag to 1 and exit for 'exit the for/next. end if next if flag=1 then [skipupdate] 'End the update. for x=8 to 2 step-1 'The new file does not exist in the recent list RecentArray$(x)=RecentArray$(x-1) 'then move each recent file down one element next RecentArray$(1)=NewFile$ 'and put the new recent file in element 1. goto [skipupdate] end if if RecentFile$ ="" then 'The recent file selected no longer exists. for x=Index to 7 RecentArray$(x)=RecentArray$(x+1) if RecentArray$(x)="" then exit for next RecentArray$(8)="" else 'The recent file exists so move it to #1 element. a$=RecentArray$(Index) for x=Index to 2 step -1 RecentArray$(x)=RecentArray$(x-1) next RecentArray$(1)=a$ end if
[skipupdate] 'Finaly refil the ini file and update the recent menus. open DefaultDir$+"\recent.ini" for output as #1 for x=1 to 8 a$=RecentArray$(x) print #1,a$ calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong call MenuMod hfile, hfileid, a$, x 'Modify the recent menu items. next close #1 return
sub BitmapButton hButton, hBitmap CallDLL #user32, "SendMessageA", _ hButton as uLong, _ _BM_SETIMAGE as Long, _ _IMAGE_BITMAP as Long, _ hBitmap As uLong, _ result as Long end Sub
sub GetIni 'Open the recent.ini file and fill the array. open DefaultDir$+"\recent.ini" for input as #1 for x=1 to 8 input #1, RecentArray$(x) next close #1 end sub
sub MenuMod hmainmenu, position,pointer$,Index 'Used to modify the Main Window Recent Menus. pointer$="&"+str$(Index)+". "+pointer$ 'The menu will be "1. C:\folder\filename". 'In this demo, the start of the recent file menus is at 2. 'So a 1 must be added to the position. position=position+1 'in this demo, the first recent menu is at position 2 through 9. flags=_MF_STRING or _MF_BYCOMMAND calldll #user32, "ModifyMenuA",_ hmainmenu as ulong,_ position as ulong,_ flags as long,_ position as ulong,_ pointer$ as ptr,_ r as boolean end sub
sub AddToolTip cHndl, hWnd, text$ TOOLINFO.uId.struct = cHndl TOOLINFO.lpszText.struct = text$ CallDLL #user32, "SendMessageA",_ hWnd As ulong, _ 1028 As long, _ 0 As long, _ TOOLINFO as ptr, _ result as long end sub
sub SetWindowText hWnd, txt$ 'Places text in the Help window. callDLL #user32, "SetWindowTextA",hWnd As ulong,txt$ As ptr,result As void end sub
Sub staticImage hSt, hB 'Code from Janet Calldll #user32, "SendMessageA", _ hSt as long, _ _STM_SETIMAGE as long, _ _IMAGE_BITMAP as long, _ hB as long, r as ulong End Sub
FUNCTION CreateTextEdit(hWin, x, y, w, h) style = _WS_CHILDWINDOW OR _WS_BORDER OR _WS_VISIBLE or _ES_MULTILINE or _WS_VSCROLL or _ES_READONLY hInst=GetWindowLong(hWin, _GWL_HINSTANCE) callDLL #user32,"CreateWindowExA",_ 0 As long,"RichEdit" As ptr,_ "" As ptr, style As long,_ x As long,y As long,w As long,h As long,_ hWin As ulong, 0 As long, hInst As ulong,_ 0 As long, CreateTextEdit As long END FUNCTION
FUNCTION CreateTooltip(hMain) Struct TOOLINFO, _ cbSize As long, _ uFlags As long, _ hwnd As ulong, _ uId As long, _ rectLeft As long, _ rectTop As long, _ rectRight As long, _ rectBottom As long, _ hinst As ulong, _ lpszText As ptr CallDLL #comctl32,"InitCommonControlsEx", _ result as void TOOLINFO.cbSize.struct = Len(TOOLINFO.struct) TOOLINFO.uFlags.struct = flags Or 17 'TTF_IDISHWND Or TTF_SUBCLASS TOOLINFO.hwnd.struct = hMain CallDLL #user32,"CreateWindowExA",_ 0 As long, _ "tooltips_class32" As ptr, _ 0 As long, style As long, _ _CW_USEDEFAULT As long, _ _CW_USEDEFAULT As long, _ _CW_USEDEFAULT As long, _ _CW_USEDEFAULT As long, _ hMain As ulong, _ 0 As long, _ 0 as long, _ 0 As long, _ CreateTooltip As Long END FUNCTION
FUNCTION GetWindowLong(hWin, type) callDLL #user32, "GetWindowLongA", hWin As ulong, type As long, GetWindowLong As long END FUNCTION
'The next two functions are from Alyce Watson's web site. Function SeparateFile$(f$) fileindex=len(f$) filelength=len(f$) while mid$(f$, fileindex,1)<>"\" fileindex=fileindex-1 wend SeparateFile$=right$(f$,filelength-fileindex) end function
Function SeparatePath$(f$) fileindex=len(f$) filelength=len(f$) while mid$(f$, fileindex,1)<>"\" fileindex=fileindex-1 wend SeparatePath$=left$(f$,fileindex) end function
FUNCTION ReleaseTooltipMemory(hTip) CallDLL #user32, "DestroyWindow",_ hTip As ulong, _ result As long END FUNCTION
function ReplaceMultipleString$(st$, tg$, rp$) 'Replace multiple occurences. targetlength = len(tg$) 'Find length of target$. nextpos=1 'Start at position 1. while instr(st$,tg$,nextpos)>0 'Do while target$ exists. startlength = len(st$) 'Find length of start$. startposition = instr(st$,tg$,nextpos) 'Find position of target$. LeftofString$ = left$(st$,startposition-1) 'Get left of start$ to target$. nextpos=startposition+targetlength 'Get right of start$ after target$. RightofString$ = Right$(st$,startlength-(nextpos-1)) ReplaceMultipleString$=LeftofString$+rp$+RightofString$ 'Add replace$ to final$. st$=ReplaceMultipleString$ 'Set st$ to final$ so the while loop works. wend end function
Thanks. The program mentions several bitmap files. Where can I get them?
|
|