Of the 3 programs listed, nr. 1 is what i have learned to be the bare minimum needed to create a treeview in windows. All 3 programs uses a previously saved cross reference report named @usr$+"crossref.rpt" as data input.
Program 1 is for BB4W only, the others will work in BB4W and BBCsdl.
What i need to know is whether you are sending the data already sorted as they appear in the saved file, or if perhaps the main folders (i think of parents as folders) are sendt in the order they appear in the treeview and then marked with hInsertAfter%=TVI_SORT if its content needs to be sorted.
Or if you by any chance are sending data unordered and use TVI_FIRST to build the list.
TVI_LAST is implied in windows and can be ignored.
I also need to know if you need to store data in lParam% ? and if this data is to be returned when the user clicks on a line in the GUI program.
Program 2 also uses the crossref.rpt file as input and builds a treelike linked list.
This list will be transferred to a struct array later on, which is what the GUI program uses, but for now its just printed on the screen.
This one has the interface you will use later on (FNcreatetree,FNfilltree,FNtreeview).
I have kept these 2 programs separate just in case i need to rewrite them depending on you answers.
Nr. 2 and 3 is to be merged later on.
Program 3 is the fully functional GUI, it also uses crossref.rpt as a temporary input.
There are 2 menus, accessible via right_click on an empty area in the window or on a text line.
Instructions on use are to be found there. (translation into proper english is likely needed)
When selecting 'save as' from the file menu (also accessible via alt+f and then alt+first_letter) then the list is saved as @usr$+"Crossref_"+timestamp+".rpt" for now.
Hope you enjoy the program.
Great if more people could give this GUI program a spin, and report back when/if a bug is found. Just make a cross reference report of any progam and then save it as @usr$+"crossref.rpt" .
And remember that @usr$ in BB4W is not in the same place as in BBCsdl.
Known bugs:
One can't change the font yet. Messy graphic as a result.
The line clicked on is marked, and it (the mark) moves depending on user action, but not always as expected.
Limitation:
When there is more than 1000-1100 lines visible (to scroll through) then the connecting lines wraps around vertically. Maybe never a problem ?
Svein
1:
Code: Select all
TVI_FIRST = -65535
TVI_LAST = -65534
TVI_ROOT = -65536
TVI_SORT = -65533
TVIF_CHILDREN = &40
TVIF_TEXT = 1
TVS_HASBUTTONS = 1
TVS_HASLINES = 2
TVM_INSERTITEM = &1100
TVS_LINESATROOT = 4
WS_BORDER = &800000
DIM H%(12), Text% 255
DIM tvi{hParent%, \
\ hInsertAfter%, \
\ mask%, \
\ hItem%, \
\ state%, \
\ stateMask%, \
\ pszText%, \
\ cchTextMax%, \
\ iImage%, \
\ iSelectedImage%,\
\ cChildren%, \
\ lParam% \
\ }
INSTALL @lib$+"WINLIB5"
ON ERROR SYS "MessageBox", @hwnd%, REPORT$, 0, 48 : PROCcleanup : QUIT
ON CLOSE PROCcleanup : QUIT
VDU 23,22,600;800;8,16,16,128
SYS "InitCommonControls"
hTree% = FN_createwindow("SysTreeView32","",2,2,596,796,0,WS_BORDER OR TVS_HASLINES OR TVS_HASBUTTONS OR TVS_LINESATROOT,0)
tvi.mask% = TVIF_TEXT OR TVIF_CHILDREN
tvi.pszText% = Text%
tvi.cchTextMax% = 256
F%=OPENIN(@usr$+"crossref.rpt")
IF F%=0 THEN ERROR 0,"fail to open"
REPEAT
Text$=GET$#F%
UNTIL Text$="Main program:"
$$Text%=LEFT$(Text$)
tvi.hParent%=TVI_ROOT
tvi.cChildren%=1
tvi.lParam%+=1 : REM user data
SYS "SendMessage", hTree%, TVM_INSERTITEM, 0, tvi{} TO H%(1)
REPEAT
REPEAT
Text$=GET$#F%
UNTIL Text$<>""
IF Text$="End of report." THEN EXIT REPEAT
Level%=FNspaces(Text$)/2+1
IF Level%=1 THEN tvi.hParent%=TVI_ROOT ELSE tvi.hParent%=H%(Level%-1)
IF RIGHT$(Text$)=":" THEN tvi.cChildren%=1 ELSE tvi.cChildren%=0
IF tvi.cChildren%=1 THEN $$Text%=LEFT$(Text$) ELSE $$Text%=Text$
tvi.lParam%+=1 : REM user data
SYS "SendMessage", hTree%, TVM_INSERTITEM, 0, tvi{} TO H%(Level%)
UNTIL EOF#F%
CLOSE#F%
END
DEF FNspaces(RETURN a$)
LOCAL I%
WHILE ASCa$=32
I%+=1 : a$=MID$(a$,2)
ENDWHILE
=I%
DEF PROCcleanup
hTree% += 0 : IF hTree% PROC_closewindow(hTree%)
ENDPROC
Code: Select all
TVI_ROOT = -65536
VDU 23,22,600;800;8,16,16,128
DIM H%(12), Text% 255
DIM tvi{hParent%, \
\ hInsertAfter%, \ : REM TVI_FIRST,TVI_LAST,TVI_SORT
\ mask%, \
\ hItem%, \
\ state%, \
\ stateMask%, \
\ pszText%, \
\ cchTextMax%, \
\ iImage%, \
\ iSelectedImage%,\
\ cChildren%, \
\ lParam% \
\ }
hTree%=FNcreatetree : REM hTree% = FN_createwindow("SysTreeView32","",2
tvi.pszText% = Text%
F%=OPENIN(@usr$+"crossref.rpt")
IF F%=0 THEN ERROR 0,"fail to open"
REPEAT
Text$=GET$#F%
UNTIL Text$="Main program:"
$$Text%=LEFT$(Text$)
tvi.hParent%=TVI_ROOT
tvi.cChildren%=1
tvi.lParam%+=1 : REM user data
H%(1)=FNfilltree(hTree%,tvi{}) : REM SYS "SendMessage", hTree%, TVM_INSERTITEM, 0, tvi{} TO
REPEAT
REPEAT
Text$=GET$#F%
UNTIL Text$<>""
IF Text$="End of report." THEN EXIT REPEAT
Level%=FNspaces(Text$)/2+1
IF Level%=1 THEN tvi.hParent%=TVI_ROOT ELSE tvi.hParent%=H%(Level%-1)
IF RIGHT$(Text$)=":" THEN tvi.cChildren%=1 ELSE tvi.cChildren%=0
IF tvi.cChildren%=1 THEN $$Text%=LEFT$(Text$) ELSE $$Text%=Text$
tvi.lParam%+=1 : REM user data
H%(Level%)=FNfilltree(hTree%,tvi{}) : REM SYS "SendMessage", hTree%, TVM_INSERTITEM, 0, tvi{} TO
UNTIL EOF#F%
CLOSE#F%
PROClisttree(hTree%) : REM FNtreeview(hTree%)
END
DEF FNspaces(RETURN a$)
LOCAL I%
WHILE ASCa$=32
I%+=1 : a$=MID$(a$,2)
ENDWHILE
=I%
DEF FNcreatetree : LOCAL A% : DIM A% 17 : =A%
DEF FNfilltree(D%,s{})
LOCAL E%,level%,G%,R%
R%=17 : REM down% right% text% lparam% &level &flag
DIM G% R%
IF s.hParent%=TVI_ROOT OR s.hParent%=0 THEN level%=1 ELSE D%=s.hParent% : level%=D%?16+1
IF D%!4 THEN
D%=D%!4
WHILE !D% : D%=!D% : ENDWHILE : REM scan to last
!D%=G% : REM down
ELSE
D%!4=G% : REM right
ENDIF
DIM E% LEN($$s.pszText%)
$$E%=$$s.pszText%
G%!8=E%
G%!12=s.lParam%
G%?16=level%
G%?17=s.cChildren%<<1
=G%
DEF PROClisttree(D%)
LOCAL stack%,ptr%,endstack%,A%
DIM stack% 4*10000 : ptr%=stack% : endstack%=stack%+4*10000-1
D%=D%!4 : A%=1
REPEAT
PRINT STRING$(D%?16*2," ");$$D%!8
IF D%!4 THEN
REM folder
PROCpush(D%)
D%=D%!4
ELSE
REM item
WHILE !D%
D%=!D%
PRINT STRING$(D%?16*2," ");$$D%!8
ENDWHILE
REPEAT
A%=FNpop
UNTIL !A%
D%=!A%
ENDIF
UNTIL A%=0
ENDPROC
DEF FNpop : ptr%-=4
IF ptr%<stack% THEN =0 ELSE =!ptr%
DEF PROCpush(A%)
IF ptr%>=endstack% THEN ERROR 0,"Full stack, to many branches."
!ptr%=A% : ptr%+=4
ENDPROC
Code: Select all
REM Treeviewer version 2.3
REM Svein Svensson Dec.2018
DIM Menu{l%,b%,t%,r%,w%,h%,item1$,item2$,item3$,item4$,item5$,item6$,item7$}
Menu.item1$="Save as ..."
Menu.item2$="Run again"
Menu.item3$="Exit"
Menu.item4$="Info"
Menu.item5$="Expand"
Menu.item6$="Compress"
Menu.item7$="Copy"
VDU 23,22,600;800;8,16,16,128
PRINT ".... Working ...."
ON MOVE PROCsize(@msg%) : RETURN
Winx%=0
Winy%=0
Ch%=@vdu%!220*2
Indent%=64
Scrollpos%=0
Scrollmax%=0
Rows%=0
Datalines%=0
Outlines%=0
Dblclk%=0
Oldi%=0
Timer1%=0
Timer2%=0
Index%=0
Previndex%=0
MOUSE ON 2
PROCparcefile
PROCtextsize
PROCnewsize
Update%=2
W1%=0
ON MOUSE PROCdblclk : RETURN
REM main ..............................................
REPEAT
IF Timer1% THEN IF Timer1%<TIME THEN Timer1%=0 : Update%=2 : REM user aborted backup
IF Update% THEN
*REFRESH OFF
B%=Update% : Update%=0
CASE B% OF
WHEN 2 : PROCtextarray : PROCprintpos : PROCdrawlines : REM when folder change
WHEN 3 : PROCprintpos : PROCdrawlines : REM when view change
WHEN 4 : PROCmark(Oldi%)
ENDCASE
*REFRESH ON
IF W1%=0 THEN WHILE B% : MOUSE X%,Y%,B% : WAIT 5 : ENDWHILE
ENDIF
IF INKEY(-2) THEN PROCarrow(-2) : REM ctrl
IF W1%=-2 THEN W1%=0 : PROCarrow(-2) : REM user aborted
IF W1%>=8 THEN W%=W1% : W1%=0 ELSE W%=INKEY(1) : REM user aborted
REPEAT UNTIL INKEY(0)=-1 : REM empty keybuffer
CASE W% OF
WHEN 140 : PROCscroll(6) : REM mouse wheel down
IF Oldi%<Scrollpos% THEN PROCmark(Scrollpos%)
IF Oldi%>=Scrollpos%+Rows% THEN PROCmark(Scrollpos%+Rows%-1)
WHEN 141 : PROCscroll(-6) : REM mouse wheel up
IF Oldi%<Scrollpos% THEN PROCmark(Scrollpos%)
IF Oldi%>=Scrollpos%+Rows% THEN PROCmark(Scrollpos%+Rows%-1)
WHEN 136,137,138,139 : PROCarrow(W%)
WHEN 130 : Scrollpos%=0 : PROCmark(0) : Update%=3 : REM home
WHEN 131 : Scrollpos%=Outlines%-Rows% : PROCmark(Outlines%-1) : Update%=3 : REM end
WHEN 132 : Scrollpos%-=Rows% : IF Scrollpos%<0 THEN Scrollpos%=0 : REM pgup
PROCmark(Oldi%-Rows%) : Update%=3
WHEN 133 : Scrollpos%+=Rows% : IF Scrollpos%>Scrollmax% THEN Scrollpos%=Scrollmax% : REM pgdn
PROCmark(Oldi%+Rows%) : Update%=3
WHEN 8 : PROCmark(FNscandown(Oldi%,Data{(Out%(Oldi%))}.level%-1)) : REM bksp
OTHERWISE
REM scan after text beginning with letter in W%, start at current mark or top, go cyclic
IF W%>96 AND W%<123 THEN
C%=0
WHILE C%<2
Index%=Previndex%+1
IF Index%>=Outlines% THEN Index%=1
FOR A%=Index% TO Outlines%-1
B%=Out%(A%) : D%=ASCData{(B%)}.text$
IF D%=W% OR D%=W%-32 THEN
PROCmark(A%) : Previndex%=A% : EXIT WHILE
ENDIF
NEXT
Previndex%=-1
C%+=1
ENDWHILE
ENDIF
ENDCASE
REM .................................................
MOUSE X%,Y%,B% : A%=-1
IF W1%=4 OR W1%=1 THEN B%=W1% : W1%=0 : REM user aborted
IF X%>10 AND X%<Winx%-10 AND Y%>10 AND Y%<Winy% THEN
A%=FNwhereami(X%,Y%,C%)
IF A%>=0 THEN MOUSE ON 137 ELSE MOUSE ON 0
ENDIF
IF B%=1 THEN PROCmenu(X%,Y%,B%,A%)
IF B%=4 THEN
IF A%>=0 THEN
I%=Out%(A%)
IF C%=1 THEN
REM box, toggle open
IF Data{(I%)}.flag%AND4 THEN Data{(I%)}.flag%AND=-5 ELSE Data{(I%)}.flag%OR=4
Update%=2 : PROCmark(A%)
ELSE
PROCmark(A%) : REM click on text
IF Dblclk% THEN
REM doubleclick, toggle open
IF Data{(I%)}.flag%AND4 THEN Data{(I%)}.flag%AND=-5 ELSE Data{(I%)}.flag%OR=4
Update%=2 : PROCmark(A%) : Dblclk%=0
ENDIF
ENDIF
WHILE B% : MOUSE X%,Y%,B% : WAIT 1 : ENDWHILE
ELSE
PROCscroll(0)
IF Oldi%<Scrollpos% THEN PROCmark(Scrollpos%)
IF Oldi%>=Scrollpos%+Rows% THEN PROCmark(Scrollpos%+Rows%-1)
ENDIF
ENDIF
REM alt+f
IF INKEY(-3) THEN
REPEAT
IF INKEY(-68) THEN PROCmenu(0,Winy%,1,-1) : EXIT REPEAT : REM "F"
MOUSE X%,Y%,B%
UNTIL INKEY(1)>0 OR B%
ENDIF
UNTIL FALSE
REM main ..............................................
DEF FNwhereami(X%,Y%,RETURN Z%) : REM just scan visible lines
LOCAL I%,O%,J%,E%
O%=Scrollpos%*Ch%
IF Scrollpos%+Rows%<Outlines% THEN E%=Scrollpos%+Rows%-1 ELSE E%=Outlines%-1
FOR J%=Scrollpos% TO E%
I%=Out%(J%)
IF Y%>Data{(I%)}.textb%+O% THEN
IF Y%<Data{(I%)}.textt%+O% THEN
IF X%>Data{(I%)}.textl% THEN
IF X%<Data{(I%)}.textr% THEN
REM mouse over text
Z%=0 : =J%
ENDIF
ELSE
IF X%<Data{(I%)}.boxr% THEN
IF X%>Data{(I%)}.boxl% THEN
IF Y%>Data{(I%)}.boxb% AND Y%<Data{(I%)}.boxt% THEN
REM mouse in box
Z%=1 : =J%
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
=-1 : REM nothing
DEF PROCdblclk
LOCAL X%,Y% : MOUSE X%,Y%,W1% : Timer1%=TIME+100 : REM user abort backup timer
IF Timer2%>TIME THEN Dblclk%=1 : Timer2%=0 ELSE Dblclk%=0 : Timer2%=TIME+20 : REM doubleclick timer
ENDPROC
DEF PROCarrow(W%)
LOCAL A%
A%=Out%(Oldi%)
CASE W% OF
WHEN 136 : REM left
IF Data{(A%)}.flag%AND2 THEN
REM if folder is open then close it and keep mark, if folder is closed move one level down and mark the new one
IF Data{(A%)}.flag%AND4 THEN
Data{(A%)}.flag%AND=-5 : REM close folder
Update%=2
ELSE
REM scan backwards until level-1
PROCmark(FNscandown(Oldi%,Data{(A%)}.level%-1))
ENDIF
ELSE
REM item, just move to level
PROCmark(FNscandown(Oldi%,Data{(A%)}.level%-1))
ENDIF
WHEN 137 : REM right
IF Data{(A%)}.flag%AND2 THEN
REM if folder is open move mark, if folder is closed then open it and keep mark
IF Data{(A%)}.flag%AND4 THEN
PROCmark(Oldi%+1)
ELSE
Data{(A%)}.flag%OR=4
Update%=2
ENDIF
ENDIF
WHEN 139 : PROCmark(Oldi%-1) : REM up
WHEN 138 : PROCmark(Oldi%+1) : REM down
WHEN -2 : REM ctrl
WHILE INKEY(-2) : WAIT 1
IF INKEY(-42) THEN PROCscroll(1) : REM down
IF INKEY(-58) THEN PROCscroll(-1) : REM up
REPEAT UNTIL INKEY(0)=-1 : REM empty keybuffer
ENDWHILE
IF Oldi%<Scrollpos% THEN PROCmark(Scrollpos%)
IF Oldi%>=Scrollpos%+Rows% THEN PROCmark(Scrollpos%+Rows%-1)
ENDCASE
ENDPROC
REM store text width all lines, at start only
DEF PROCtextsize : VDU 5
LOCAL I%,X%,Y%,S%
S%=8
FOR I%=0 TO Datalines%-1
X%=Data{(I%)}.level%*Indent%
Data{(I%)}.textl%=X%-S%
MOVE X%,Y% : PRINT Data{(I%)}.text$;
IF POS
Data{(I%)}.textr%=@vdu.l.x%*2+S%
NEXT
ENDPROC
DEF PROCbox(I%,F%,X%,Y%,S%)
RECTANGLE X%,Y%,S%
Data{(I%)}.boxl%=X%
Data{(I%)}.boxb%=Y%
Data{(I%)}.boxt%=Y%+S%
Data{(I%)}.boxr%=X%+S%
I%=S%/2
IF F%AND4 THEN
REM - it's open
LINE X%+4,Y%+I%,X%+S%-4,Y%+I%
ELSE
REM + it's closed
LINE X%+4,Y%+I%,X%+S%-4,Y%+I%
LINE X%+I%,Y%+4,X%+I%,Y%+S%-4
ENDIF
ENDPROC
REM store text Y_pos and store visible text to out_array
DEF PROCtextarray
LOCAL I%,L%,X%,Y%,F%,N%
Y%=Winy%
FOR I%=0 TO Datalines%-1
IF W1%>0 THEN Timer1%=TIME+50 : ENDPROC : REM
W1%=INKEY(0) : IF W1%>0 THEN Timer1%=TIME+50 : ENDPROC : REM user abort
IF INKEY(-2) THEN W1%=-2 : Timer1%=TIME+50 ENDPROC : REM
F%=Data{(I%)}.flag%
L%=Data{(I%)}.level%
Data{(I%)}.textb%=Y%-Ch%+2
Data{(I%)}.textt%=Y%
Y%-=Ch%
Out$(N%)=STRING$(L%," ")+Data{(I%)}.text$
Out%(N%)=I%
N%+=1
IF (F%AND4)=0 THEN
IF F%AND2 THEN
REPEAT : I%+=1 : REM if folder closed then skip hidden lines
UNTIL Data{(I%)}.level%<=L%
I%-=1
ENDIF
ENDIF
NEXT
Outlines%=N%
Scrollmax%=N%-Rows%
IF Scrollmax%<0 THEN Scrollmax%=0
ENDPROC
DEF PROCdrawlines
LOCAL I%,J%,K%,F%,G%,L%,M%,A%,O%,size%
LOCAL boxl%,boxb%,boxt%,boxr%,boxmy%,boxmx%
size%=16
I%=size%/2
boxmy%=Ch%/2
boxmx%=Indent%/2
boxl%=boxmx%+I%
boxb%=boxmy%-I%
boxt%=boxmy%+I%
boxr%=boxmx%-I%
O%=Scrollpos%*Ch%
F%=Data{(0)}.flag%
PROCbox(0,F%,Data{(0)}.textl%-boxl%, Data{(0)}.textb%+boxb%+O%,size%) : REM box
LINE Data{(0)}.textl%, Data{(0)}.textb%+boxmy%+O%, Data{(0)}.textl%-boxr%, Data{(0)}.textb%+boxmy%+O% : REM line left text-box
IF Scrollpos%=0 THEN J%=1 ELSE J%=Scrollpos%
FOR A%=J% TO Outlines%-1
IF W1%>0 THEN Timer1%=TIME+50 : ENDPROC : REM
W1%=INKEY(0) : IF W1%>0 THEN Timer1%=TIME+50 : ENDPROC : REM user abort
IF INKEY(-2) THEN W1%=-2 : Timer1%=TIME+50 : ENDPROC : REM
I%=Out%(A%)
F%=Data{(I%)}.flag%
G%=Data{(I%-1)}.flag%
L%=Data{(I%)}.level%
M%=Data{(I%-1)}.level%
REM draw connecting lines
CASE TRUE OF
WHEN L%=M%
IF F%AND2 THEN
REM current is folder
PROCbox(I%,F%,Data{(I%)}.textl%-boxl%, Data{(I%)}.textb%+boxb%+O%,size%) : REM box
LINE Data{(I%)}.textl%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxr%, Data{(I%)}.textb%+boxmy%+O% : REM line left text-box
IF G%AND2 THEN
REM previous is folder
LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxt%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%-1)}.textb%+boxb%+O% : REM line up box-box
ELSE
REM previous is item
LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxt%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%-1)}.textb%+boxmy%+O% : REM line up box-pmid
ENDIF
ELSE
REM current is item
IF G%AND2 THEN
REM previous is folder
LINE Data{(I%)}.textl%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O% : REM line left text-mid
LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%-1)}.textb%+boxb%+O% : REM line up mid-pbox
ELSE
LINE Data{(I%)}.textl%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O% : REM line left text-mid
LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%-1)}.textb%+boxmy%+O% : REM line up mid-pmid
ENDIF
ENDIF
WHEN L%>M%
IF F%AND2 THEN
REM current is folder
PROCbox(I%,F%,Data{(I%)}.textl%-boxl%, Data{(I%)}.textb%+boxb%+O%,size%) : REM box
LINE Data{(I%)}.textl%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxr%, Data{(I%)}.textb%+boxmy%+O% : REM line left text-box
IF I% THEN LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxt%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%-1)}.textb%+O% : REM line up box-text, skip first line
ELSE
REM current is item
LINE Data{(I%)}.textl%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O% : REM line left text-mid
LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%-1)}.textb%+O% : REM line up mid-text
ENDIF
WHEN L%<M%
REM find previous at same level
J%=I%
WHILE L%<>M%
J%-=1 : IF J%<=0 THEN EXIT WHILE
M%=Data{(J%)}.level%
ENDWHILE
IF F%AND2 THEN
REM current is folder
PROCbox(I%,F%,Data{(I%)}.textl%-boxl%, Data{(I%)}.textb%+boxb%+O%,size%) : REM box
LINE Data{(I%)}.textl%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxr%, Data{(I%)}.textb%+boxmy%+O% : REM line left text-box
LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxt%+O%, Data{(J%)}.textl%-boxmx%, Data{(J%)}.textb%+boxb%+O% : REM line up box-pbox
ELSE
REM current is item
LINE Data{(I%)}.textl%, Data{(I%)}.textb%+boxmy%+O%, Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O% : REM line left text-mid
LINE Data{(I%)}.textl%-boxmx%, Data{(I%)}.textb%+boxmy%+O%, Data{(J%)}.textl%-boxmx%, Data{(J%)}.textb%+boxb%+O% : REM line up mid-pbox
ENDIF
ENDCASE
IF K%>0 THEN I%=K%-1 : K%=0 : REM skip hidden lines
NEXT
ENDPROC
DEF PROCparcefile
LOCAL num%,F%,text$
F%=OPENIN(@usr$+"crossref.rpt")
IF F%=0 THEN ERROR 0,"fail to open"
REPEAT
REPEAT
text$=GET$#F%
IF text$="End of report." THEN EXIT REPEAT
UNTIL text$<>"" OR EOF#F%
num%+=1
UNTIL EOF#F%
REM Out$ for scrolling, Out% = index in Data struct
DIM Out$(num%),Out%(num%)
DIM Data{(num%) text$,level%,flag%,lparam%,textl%,textb%,textt%,textr%,boxl%,boxb%,boxt%,boxr%}
PTR#F%=0
num%=0
REPEAT
text$=GET$#F%
UNTIL text$="Main program:"
Data{(num%)}.text$=LEFT$(text$)
Data{(num%)}.level%=1
Data{(num%)}.flag%=2
REPEAT
num%+=1
REPEAT
text$=GET$#F%
UNTIL text$<>""
IF text$="End of report." THEN EXIT REPEAT
Data{(num%)}.level%=FNspaces(text$)/2+1
IF Data{(num%)}.level%=0 THEN Data{(num%)}.level%=1
IF RIGHT$(text$)=":" THEN
Data{(num%)}.flag%=2
Data{(num%)}.text$=LEFT$(text$)
ELSE
Data{(num%)}.text$=text$
ENDIF
UNTIL EOF#F%
Datalines%=num%
ENDPROC
DEF FNspaces(RETURN a$)
LOCAL I%
WHILE ASCa$=32
I%+=1 : a$=MID$(a$,2)
ENDWHILE
=I%
DEF PROCsize(M%) : REM resize window
PRIVATE F%
IF M%<>5 OR F%=1 THEN ENDPROC
F%=1
LOCAL X%,Y%,B%
REPEAT WAIT 2
MOUSE X%,Y%,B%
UNTIL B%=0
F%=0
DEF PROCnewsize
LOCAL C%,Y%
VDU 26 : COLOUR 128+15
IF POS
C%=Ch%/2
Y%=INT(@vdu%!212/C%+0.5)*C%
VDU 23,22,@vdu%!208;Y%;8,16,16,128
VDU 26 : CLS : VDU 5 : OFF
IF POS
Winx%=@vdu%!208*2
Winy%=@vdu%!212*2-1
C%=Rows% : REM oldrows
Rows%=Winy%/Ch%+1
IF Oldi%>Rows%-1 THEN Oldi%=Rows%-1
IF Rows%>C% THEN Scrollpos%+=C%-Rows%
IF Scrollpos%<0 THEN Scrollpos%=0
Update%=2
ENDPROC
DEF PROCmenu(X%,Y%,B%,A%) : Y%-=Ch%/2 : REM check diff font size !!
ON MOUSE LOCAL OFF
LOCAL I%,T%
IF X%>Winx%-Menu.w% THEN X%=Winx%-Menu.w%-10
IF Y%<Menu.h% THEN Y%=Menu.h%+10
Menu.w%=200
Menu.h%=Ch%*5
Menu.l%=X%
Menu.b%=Y%-Menu.h%
Menu.t%=Menu.b%+Menu.h%
Menu.r%=Menu.l%+Menu.w%
GCOL 7 : RECTANGLE FILL Menu.l%,Menu.b%,Menu.w%,Menu.h%
GCOL 0 : RECTANGLE Menu.l%,Menu.b%,Menu.w%,Menu.h%
GCOL 8 : VDU 23,23,2|
LINE Menu.l%+8,Menu.b%-6,Menu.r%+6,Menu.b%-6
LINE Menu.r%+6,Menu.b%-6,Menu.r%+6,Menu.t%-8
VDU 23,23,1|
IF A%<0 THEN
MOVE Menu.l%+15,Menu.b%+Ch%*4+20 : PRINT Menu.item1$;
MOVE Menu.l%+15,Menu.b%+Ch%*3+15 : PRINT Menu.item2$;
MOVE Menu.l%+15,Menu.b%+Ch%*2+10 : PRINT Menu.item3$;
MOVE Menu.l%+15,Menu.b%+Ch%+5 : PRINT Menu.item4$;
ELSE
MOVE Menu.l%+15,Menu.b%+Ch%*4+20 : PRINT Menu.item5$;
MOVE Menu.l%+15,Menu.b%+Ch%*3+15 : PRINT Menu.item6$;
MOVE Menu.l%+15,Menu.b%+Ch%*2+10 : PRINT Menu.item7$;
MOVE Menu.l%+15,Menu.b%+Ch%+5 : PRINT Menu.item4$;
ENDIF
WHILE B% : MOUSE X%,Y%,B% : WAIT 5 : ENDWHILE
REPEAT : WAIT 5
IF INKEY(-3) THEN
T%=TIME+200
REPEAT
IF INKEY(-82) THEN PROCsave : ENDPROC : REM "S"
IF INKEY(-52) THEN RUN : REM "R"
IF INKEY(-38) THEN PROCinfo(0,Winy%) : ENDPROC : REM "I"
IF INKEY(-35) THEN QUIT : REM "E"
MOUSE X%,Y%,B%
UNTIL INKEY(1)>0 OR B%
ENDIF
MOUSE X%,Y%,B%
I%=FNmenu(X%,Y%)
IF I% THEN MOUSE ON 137 ELSE MOUSE ON 0
UNTIL B%
IF B%=4 THEN
CASE I% OF
WHEN 1 :
IF A%<0 THEN PROCsave ELSE PROCexpand(A%)
WHEN 2 :
IF A%<0 THEN RUN ELSE PROCcompress(A%)
WHEN 3 :
IF A%<0 THEN QUIT ELSE PROCcopy(A%)
WHEN 4 :
IF A%<0 THEN PROCinfo(X%,Y%) ELSE PROCinfo2(X%,Y%)
ENDCASE
ENDIF
WHILE B% : MOUSE X%,Y%,B% : WAIT 5 : ENDWHILE
IF Update%=0 THEN Update%=3
ENDPROC
DEF FNmenu(X%,Y%) : REM font size ??
IF X%>Menu.l% AND X%<Menu.r% AND Y%>Menu.b% AND Y%<Menu.t% THEN
IF Y%>Menu.b%+Ch%*3+24 AND Y%<Menu.b%+Ch%*4+20 : =1
IF Y%>Menu.b%+Ch%*2+18 AND Y%<Menu.b%+Ch%*3+14 : =2
IF Y%>Menu.b%+Ch%+12 AND Y%<Menu.b%+Ch%*2+10 : =3
IF Y%>Menu.b%+5 AND Y%<Menu.b%+Ch%+2 : =4
ENDIF
=0
DEF PROCexpand(A%)
MOUSE ON 2
LOCAL I%,L%
I%=Out%(A%)
IF Data{(I%)}.flag%AND2 THEN
Data{(I%)}.flag%OR=4
L%=Data{(I%)}.level%
I%+=1
WHILE Data{(I%)}.level%>L%
IF Data{(I%)}.flag%AND2 THEN Data{(I%)}.flag%OR=4
I%+=1
ENDWHILE
Update%=2
ENDIF
ENDPROC
DEF PROCcompress(A%)
MOUSE ON 2
LOCAL I%,L%
I%=Out%(A%)
IF Data{(I%)}.flag%AND2 THEN
Data{(I%)}.flag%AND=-5
L%=Data{(I%)}.level%
I%+=1
WHILE Data{(I%)}.level%>L%
IF Data{(I%)}.flag%AND2 THEN Data{(I%)}.flag%AND=-5
I%+=1
ENDWHILE
Update%=2
ENDIF
ENDPROC
DEF PROCcopy(A%)
MOUSE ON 2
LOCAL I%,L%,c$
I%=Out%(A%)
L%=Data{(I%)}.level%
c$=STRING$(L%," ")+Data{(I%)}.text$+CHR$13+CHR$10
IF Data{(I%)}.flag%AND2 THEN
I%+=1
WHILE Data{(I%)}.level%>L%
c$+=STRING$(Data{(I%)}.level%," ")+Data{(I%)}.text$+CHR$13+CHR$10
I%+=1
ENDWHILE
ENDIF
PROC_putclipboardtext(c$)
ENDPROC
REM Put text in the clipboard (replacing any existing contents):
DEF PROC_putclipboardtext(a$)
LOCAL H%,T%
IF INKEY(-256) = &57 THEN
SYS "GlobalAlloc",&2000,LEN(a$)+1 TO H%
SYS "GlobalLock",H% TO T% : $$T% = a$
SYS "GlobalUnlock",H%
SYS "OpenClipboard",@hwnd%
SYS "EmptyClipboard"
SYS "SetClipboardData",1,H%
SYS "CloseClipboard"
ELSE
SYS "SDL_SetClipboardText",a$
ENDIF
ENDPROC
DEF PROCsave
LOCAL F%,f$,t$,I%,T%,X%,Y%,B%
MOUSE X%,Y%,B%
IF X%>Winx%-200 THEN X%=Winx%-200
IF Y%<110 THEN Y%=110
GCOL 15 : RECTANGLE FILL X%,Y%-110,200,100
GCOL 0 : RECTANGLE X%,Y%-110,200,100
MOVE X%,Y%-60+Ch%/2 : PRINT ".. SAVING .." : T%=TIME+100
t$=RIGHT$(TIME$,8)
MID$(t$,3,1)="."
MID$(t$,6,1)="."
f$=@usr$+"Crossref_"+t$+".rpt"
F%=OPENOUT(f$)
IF F%=0 THEN ERROR 0,"Failed to save"
PRINT#F%,"Cross Reference Utility Report File" : BPUT#F%,10
PRINT#F%,"Created "+TIME$ : BPUT#F%,10
PRINT#F%,"" : BPUT#F%,10
FOR I%=0 TO Datalines%-1
IF t$="" AND Data{(I%)}.flag%AND2>0 THEN PRINT#F%,"" : BPUT#F%,10
IF Data{(I%)}.flag%AND2 THEN t$=":" ELSE t$=""
PRINT#F%,STRING$(Data{(I%)}.level%*2," ")+Data{(I%)}.text$+t$ : BPUT#F%,10
NEXT
PRINT#F%,"" : BPUT#F%,10
PRINT#F%,"End of report." : BPUT#F%,10
CLOSE #F%
WHILE T%>TIME : WAIT 1 : ENDWHILE
Update%=3
ENDPROC
DEF PROCinfo(X%,Y%) : Y%-=Ch%
LOCAL w%,h%,B%
w%=600 : h%=300
IF X%>Winx%-w% THEN X%=Winx%-w%-10
IF Y%<h% THEN Y%=h%+10
GCOL 7 : RECTANGLE FILL X%,Y%-h%,w%,h%
GCOL 0 : RECTANGLE X%,Y%-h%,w%,h%
GCOL 8 : VDU 23,23,2|
LINE X%+8,Y%-h%-6,X%+w%+6,Y%-h%-6
LINE X%+w%+6,Y%-h%-6,X%+w%+6,Y%-8
VDU 23,23,1|
MOVE X%+15,Y%-8 : PRINT "Left-click/hold/move or ctrl+arrows"
MOVE X%+15,Y%-Ch%-8 : PRINT "or use mousewheel to scroll."
MOVE X%+15,Y%-Ch%*2.5-8 : PRINT "Navigate in list with mouse or"
MOVE X%+15,Y%-Ch%*3.5-8 : PRINT "arrows/home/end/pgup/pgdn/bksp."
MOVE X%+15,Y%-Ch%*5-8 : PRINT "Type a letter to jump to the next"
MOVE X%+15,Y%-Ch%*6-8 : PRINT "line starting with the same letter."
MOVE X%+15,Y%-Ch%*8-8 : PRINT "Click to close."
REPEAT : MOUSE X%,Y%,B% : WAIT 5 : UNTIL B%=0
REPEAT : MOUSE X%,Y%,B% : WAIT 5 : UNTIL B%
Update%=3
ENDPROC
DEF PROCinfo2(X%,Y%) : Y%-=Ch%
LOCAL w%,h%,B%
w%=600 : h%=300
IF X%>Winx%-w% THEN X%=Winx%-w%-10
IF Y%<h% THEN Y%=h%+10
GCOL 7 : RECTANGLE FILL X%,Y%-h%,w%,h%
GCOL 0 : RECTANGLE X%,Y%-h%,w%,h%
GCOL 8 : VDU 23,23,2|
LINE X%+8,Y%-h%-6,X%+w%+6,Y%-h%-6
LINE X%+w%+6,Y%-h%-6,X%+w%+6,Y%-8
VDU 23,23,1|
MOVE X%+15,Y%-8 : PRINT "Expand = open folder and all"
MOVE X%+15,Y%-Ch%-8 : PRINT "subfolders."
MOVE X%+15,Y%-Ch%*2.5-8 : PRINT "Compress = close folder and all"
MOVE X%+15,Y%-Ch%*3.5-8 : PRINT "subfolders."
MOVE X%+15,Y%-Ch%*5-8 : PRINT "Copy = send folder and subfolders"
MOVE X%+15,Y%-Ch%*6-8 : PRINT "content to clipboard."
MOVE X%+15,Y%-Ch%*8-8 : PRINT "Click to close."
REPEAT : MOUSE X%,Y%,B% : WAIT 5 : UNTIL B%=0
REPEAT : MOUSE X%,Y%,B% : WAIT 5 : UNTIL B%
Update%=3
ENDPROC
DEF PROCscroll(A%) : VDU 4
LOCAL X%,Y%,x%,y%,B%,dn$,up$
dn$ = CHR$30+CHR$11
up$ = CHR$31+CHR$0+CHR$(Rows%-1)+CHR$10
IF A%=0 THEN
REM click/hold/move in window
MOUSE x%,y%,B%
REPEAT : WAIT 0
MOUSE X%,Y%,B%
IF B%=4 AND ABS(Y%-y%)>Ch% THEN
IF Y%>y% THEN PROCscroll(1) : y%=y%+Ch% ELSE PROCscroll(-1) : y%=y%-Ch%
ENDIF
UNTIL B%=0
ELSE
REM A%=lines to scroll +-
REPEAT
IF A%>0 THEN
A%-=1 : Scrollpos%+=1
IF Scrollpos%<=Scrollmax% THEN Update%=3 : PRINT up$; : PRINT Out$(Scrollpos%+Rows%-1); ELSE Scrollpos%=Scrollmax%
ELSE
A%+=1 : Scrollpos%-=1
IF A%<-20 THEN A%+=20 Scrollpos%-=20 : REM speedup scroll for BBCsdl
IF Scrollpos%>=0 THEN Update%=3 : PRINT dn$+Out$(Scrollpos%); ELSE Scrollpos%=0
ENDIF
UNTIL A%=0 OR Scrollpos%=0 OR Scrollpos%=Scrollmax%
ENDIF
VDU 5 : REM need to stay in vdu5 mode, menu etc.
ENDPROC
DEF PROCprintpos : REM print visible lines
LOCAL I%,Y%,E%
CLS : VDU 5 : Y%=Winy%
IF Scrollpos%+Rows%<Outlines% THEN E%=Scrollpos%+Rows%-1 ELSE E%=Outlines%-1
FOR I%=Scrollpos% TO E%
MOVE 0,Y% : PRINT Out$(I%);
Y%=Y%-Ch%
NEXT
Update%=4
ENDPROC
REM scan backwards from K% until level=L%, use index in Out%()
DEF FNscandown(K%,L%)
REPEAT : K%-=1
IF K%<0 THEN =0
UNTIL Data{(Out%(K%))}.level%=L%
=K%
DEF PROCmark(I%) : VDU 23,23,1| : REM maybe fill and invert ?
LOCAL O%
IF Oldi%>=0 THEN
O%=Scrollpos%*Ch%
Oldi%=Out%(Oldi%) : GCOL 15
RECTANGLE Data{(Oldi%)}.textl%,Data{(Oldi%)}.textb%+O%,Data{(Oldi%)}.textr%-Data{(Oldi%)}.textl%,Data{(Oldi%)}.textt%-Data{(Oldi%)}.textb%
ENDIF
IF I%<0 THEN I%=0
IF I%>=Outlines% THEN I%=Outlines%-1
CASE TRUE OF
WHEN I%<Scrollpos% : PROCscroll(I%-Scrollpos%)
WHEN I%>=Scrollpos%+Rows% : PROCscroll(I%-Scrollpos%-Rows%+1)
ENDCASE
Oldi%=I%
I%=Out%(I%)
O%=Scrollpos%*Ch%
GCOL 1
RECTANGLE Data{(I%)}.textl%,Data{(I%)}.textb%+O%,Data{(I%)}.textr%-Data{(I%)}.textl%,Data{(I%)}.textt%-Data{(I%)}.textb%
VDU 23,23,1| : GCOL 0 : ENDPROC