: "@(#)shar.sh 1.8" #! /bin/sh # # This is a shell archive. # Remove everything above this line and run sh on the resulting file. # If this archive is complete, you will see this message at the end: # "All files extracted" # # Created: Wed Jul 16 11:20:36 CDT 1997 by joseph at Informix Software Ltd. # Files archived in this archive: # browser.txt # browser.4gl # #-------------------- if [ -f browser.txt -a "$1" != "-c" ] then echo shar: browser.txt already exists else echo 'x - browser.txt 1366 characters)' sed -e 's/^X//' >browser.txt <<'SHAR-EOF' X Xcall to browse_array needs these parameters passed to it in this order: X X 1. table name to select from (currently only set for 1 table) [20 characters] X 2. column names to display (must be listed no * ) [256 characters] X 3. the where clause [256 characters] X 4. the order by clause (can be null) [256 characters] X 5. available options to choose from i.e. EQMD [20 characters] X 6. the number of array elements to display [smallint] X 7. starting column to open the window at [smallint] X 8. starting row to open the window at [smallint] X 9. characters to start out at [2 characters] X10. the window title/heading [78 characters] X11. the column titles/headings [78 characters] X12. the display statement for the options(#5) [78 characters] X13. true or false for opening the window [smallint] X14. true or false for closing the window [smallint] X Xbrowse_array return 2 variables a smallint and a char(78). Xbrowse_array may be called up to 10 times without closing any windows. X XAny comments,suggestions or bugs please email me at joseph@cannonexpress.com SHAR-EOF if [ `wc -c browser.4gl <<'SHAR-EOF' X{############################################################################## X# Module : browser.4gl (version 1.22) X# Programmers : Joseph Cullipher X# Date : 06/03/97 X# Description : This module performs the browsing of a table X# X# Database : Any X# X# Functions : browse_array X# : point_shoot X# : line_down X# : line_up X# : page_up X# : page_down X# : get_arr_pos X# : show_page X# : reload_array X# : get_length X# : beep X# : change_ops X# X# The ability to do expressions and define window attributes, to work with X# aliases and tablenames not specified in Mcolnames will be in upcoming versions X###############################################################################} X Xdefine X Mtablename varchar(255), --self explanatory X Mcolnames char(256), --columns to select from (MUST be listed) X Mselect char(512), --the select statement X Mwhere char(256), --the where clause X Morder char(256), --the order by X Mbeginning smallint, --true or false beginning of table X Mnbr_cols smallint, --the number of columns to select/display X Moptions varchar(20), --any extra prompt options X A_browse array[100] of char(78), --Array to use through out this module X Mmax_len smallint, --the Max length of the array X A_substr array[20] of record X len char(5), --holds size of each column X name char(37), --holds name of each column X type smallint X end record, X Mdescending,M_asc_desc smallint, --determines order by X Mmatchit varchar(78), --holds matching cahracters for reload X Mstart_row smallint, X A_info array[20] of char(78) --columns get fetched into X X{############################################################################## X# Function : browse_array X# Module : browser.4gl X# Programmers : Joseph Cullipher X# Date : 06/03/97 X# Description : This function performs the loading of the array and the sizing X# : of the window. browse_array may be called up to 10 times. X# X# Received Parameters: 1. Mtablename2 - table name to select from X# : (currently only set for 1 table) X# : 2. Mcolnames2 - column names to display X# : (must be listed no * ) X# : 3. Mwhere2 - the where clause X# : 4. Morder2 - the order by clause (can be null) X# : 5. Moptions2 - available options to choose from i.e.EQMD X# : 6. Msize - the number of array elements to display X# : 7. Mcol - starting column to open the window at X# : 8. Mrow - starting row to open the window at X# : 9. Mcheck - 2 char to start out at in no options(#5) X# :10. Mpg_head - the window title/heading X# :11. Mcol_head - the column titles/headings X# :12. Mopt_stmt - the display statement for the options(#5) X# :13. M_opn_win - true or false for opening the window X# :14. M_close_win - true or false for closing the window X# X# Returned Parameters: Mi - a smallint combination of the array element number X# : and a key stroke they pressed if #5 above X# : A_browse[Mj] -the complete array element that was chosen X# : it is 78 characters long. X# X###############################################################################} X Xfunction browse_array(Mtablename2,Mcolnames2,Mwhere2,Morder2,Moptions2,Msize, X Mcol,Mrow,Mcheck,Mpg_head,Mcol_head,Mopt_stmt,M_opn_win,M_close_win) X define X Mtablename2 varchar(255), --self explanatory X Mcolnames2 char(256), --columns to select from (must be listed) X Mwhere2 char(256), --the where clause (blank for the whole table) X Morder2 char(256), --the order by X Moptions2 varchar(20), --any extra prompt options X Mcheck char(2), X M_cname char(37), X Mpg_head,Mcol_head,Mopt_stmt char(78), X Mcol,Mrow,Msize,Mi,Mj,Mlen,Mx,Mz,My,Mtype,Mcenter, X M_opn_win,M_close_win,Mmulti,Mcnt,Mk,Mh smallint, X Mtabid int, X A_tabs array[20] of record X tabid int, X tabname char(20) X end record X X let Mtablename=Mtablename2 X let Mcolnames=Mcolnames2 X let Mwhere=Mwhere2 X let Morder=Morder2 X let Moptions=Moptions2 X let Mbeginning=false X let Mmatchit=null X X if Morder matches "* desc*" X then X let Mdescending=true X let Morder2=Morder2 clipped,"," X let Mh=length(Morder2) X let M_asc_desc=false X for Mk=6 to Mh X if Morder2[Mk]="," and Morder2[Mk-5,Mk-1]<>" desc" X then X let M_asc_desc=true X exit for X end if X end for X else X let Mdescending=false X end if X initialize A_browse to null X initialize A_substr to null X initialize A_info to null X initialize A_tabs to null X let Mz=length(Mcolnames)+1 X let Mnbr_cols=0 X let My=1 X let Mmax_len=0 X if Mtablename matches "*,*" X then X let Mmulti=length(Mtablename) X let Mx=1 X for Mj=1 to Mmulti X if Mtablename[Mj]="," X then X let A_tabs[My].tabname=Mtablename[Mx,Mj-1] X select tabid into A_tabs[My].tabid from systables where X tabname=A_tabs[My].tabname X let My=My+1 X let Mx=Mj+1 X end if X end for X let A_tabs[My].tabname=Mtablename[Mx,Mj-1] X select tabid into A_tabs[My].tabid from systables where X tabname=A_tabs[My].tabname X let Mmulti=true X else X let Mmulti=false X select tabid into Mtabid from systables where tabname=Mtablename X end if X let My=1 X let Mj=1 X for Mx=1 to Mz X if Mcolnames[Mx]="[" X then X let A_substr[Mj].name=Mcolnames[My,Mx-1] X let Mnbr_cols=Mnbr_cols+1 X while Mcolnames[Mx]<>"," X let Mx=Mx+1 X end while X let Mx=Mx+2 X let A_substr[Mj].len=Mcolnames[Mx-1] X let A_substr[Mj].type=1 X while Mcolnames[Mx]<>"]" X let A_substr[Mj].len=A_substr[Mj].len clipped,Mcolnames[Mx] X let Mx=Mx+1 X end while X while Mcolnames[Mx]<>"," and Mcolnames[Mx]<>" " X let Mx=Mx+1 X end while X let Mmax_len=Mmax_len+A_substr[Mj].len X let Mj=Mj+1 X let My=Mx+1 X continue for X end if X if (Mcolnames[Mx]="," or Mcolnames[Mx]=" ") and not Mmulti X then X let Mnbr_cols=Mnbr_cols+1 X let M_cname=Mcolnames[My,Mx-1] X let A_substr[Mj].name=M_cname X let Mlen=null X select coltype,collength into Mtype,Mlen from syscolumns where colname= X M_cname and tabid=Mtabid X let Mlen=get_length(Mtype,Mlen) X let A_substr[Mj].type=Mtype X let A_substr[Mj].len=Mlen X let Mmax_len=Mmax_len+A_substr[Mj].len X let Mj=Mj+1 X let My=Mx+1 X end if X if (Mcolnames[Mx]="," or Mcolnames[Mx]=" ") and Mmulti X then X let Mnbr_cols=Mnbr_cols+1 X let M_cname=Mcolnames[My,Mx-1] X let A_substr[Mj].name=M_cname X let Mlen=null X let Mk=length(M_cname) X for Mcnt=1 to Mk X if M_cname[Mcnt]="." X then X for Mh=1 to 20 X if M_cname[1,Mcnt-1]=A_tabs[Mh].tabname X then X exit for X end if X end for X let M_cname=M_cname[Mcnt+1,Mk] X exit for X end if X end for X select coltype,collength into Mtype,Mlen from syscolumns where colname= X M_cname and tabid=A_tabs[Mh].tabid X let Mlen=get_length(Mtype,Mlen) X let A_substr[Mj].type=Mtype X let A_substr[Mj].len=Mlen X let Mmax_len=Mmax_len+A_substr[Mj].len X let Mj=Mj+1 X let My=Mx+1 X end if X end for X let Mmax_len=Mmax_len+Mj-1 X if length(Mpg_head)>Mmax_len X then X let Mmax_len=length(Mpg_head) X end if X if length(Mcol_head)>Mmax_len X then X let Mmax_len=length(Mcol_head) X end if X if length(Mopt_stmt)>Mmax_len X then X let Mmax_len=length(Mopt_stmt) X end if X if Mmax_len>77 X then X let Mmax_len=77 X end if X if Mmax_len+Mcol>80 X then X let Mmax_len=80-Mcol X end if X if Mpg_head is not null X then X let Msize=Msize+1 X end if X if Mcol_head is not null X then X let Msize=Msize+1 X end if X if Mopt_stmt is not null X then X let Msize=Msize+1 X end if X#some extra checks for size errors X if Msize>22 X then X let Msize=22 X end if X if Mrow<2 X then X let Mrow=2 X end if X if Mcol<2 X then X let Mcol=2 X end if X if Mrow>23 X then X let Mrow=23 X let Msize=1 X end if X if Mrow+Msize>24 X then X let Msize=Msize-(Mrow+Msize-22) X end if X let Mselect="select ",Mcolnames clipped," from ",Mtablename clipped X if length(Mwhere)>0 X then X let Mselect=Mselect clipped," where ",Mwhere X end if X if length(Morder)>0 X then X let Mselect=Mselect clipped," order by ",Morder clipped X end if X let Mi=1 X let Mlen=0 X prepare Mstatement from Mselect X declare C_browser cursor for Mstatement X foreach C_browser into A_info[1],A_info[2],A_info[3],A_info[4],A_info[5], X A_info[6],A_info[7],A_info[8],A_info[9],A_info[10],A_info[11],A_info[12], X A_info[13],A_info[14],A_info[15],A_info[16],A_info[17],A_info[18], X A_info[19],A_info[20] X let A_browse[Mi]=" " X let My=0 X for Mx=1 to Mnbr_cols X#check for columns selected longer than the array X if My+A_substr[Mx].len>77 X then X let Mz=77-My X if Mz<1 X then X exit for X end if X if Mx=1 X then X let A_browse[Mi]=A_browse[Mi] clipped,A_info[1][1,Mz] X else X let A_browse[Mi]=A_browse[Mi][1,My]," ",A_info[Mx][1,Mz] X end if X exit for X end if X let Mz=A_substr[Mx].len X if Mx=1 X then X let A_browse[Mi]=A_browse[Mi] clipped,A_info[1][1,Mz] X let My=My+Mz X else X let A_browse[Mi]=A_browse[Mi][1,My]," ",A_info[Mx][1,Mz] X let My=My+Mz+1 X end if X end for X if length(A_browse[Mi])>Mlen X then X let Mlen=length(A_browse[Mi]) X end if X let Mi=Mi+1 X if Mi>100 X then X exit foreach X end if X end foreach X let Mi=Mi-1 X if Mi=0 X then X call beep() X open window W_nothing at 12,15 with 2 rows,50 columns X attribute(border,prompt line last) X display " There are no records which matches your criteria." at 1,1 X prompt " Press any key to continue..." for char Mcheck X close window W_nothing X return 0," " X end if X let Mlen=Mmax_len+1 X if Mcol>(80-Mlen) X then X let Mcol=80-Mlen X end if X let Mj=Mi X free C_browser X free Mstatement X let Msize=Msize+1 --needed because point_shoot will clear last line X if Mlen<77 X then X let Mlen=Mlen+2 --this is so data is easier read X end if X if M_opn_win X then X whenever error continue X for Mcenter=1 to 10 X case Mcenter X when 1 X open window W_brow_1 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 2 X open window W_brow_2 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 3 X open window W_brow_3 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 4 X open window W_brow_4 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 5 X open window W_brow_5 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 6 X open window W_brow_6 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 7 X open window W_brow_7 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 8 X open window W_brow_8 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 9 X open window W_brow_9 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X when 10 X open window W_brow_10 at Mrow,Mcol with Msize rows, Mlen columns X attribute(border) X end case X if status=0 X then X exit for X end if X end for X whenever any error stop X if Mpg_head is not null X then X let Mrow=Mrow+1 X let Mcenter=(Mlen/2)-(length(Mpg_head)/2) X display Mpg_head at 1,Mcenter X end if X if Mcol_head is not null X then X let Mrow=Mrow+1 X display Mcol_head at 2,2 X end if X if Mopt_stmt is not null X then X let Mcenter=(Mlen/2)-(length(Mopt_stmt)/2) X display Mopt_stmt at Msize,Mcenter X let Msize=Msize-1 X end if X if Mpg_head is not null X then X let Msize=Msize-1 X end if X if Mcol_head is not null X then X let Msize=Msize-1 X end if X if Mpg_head is not null or Mcol_head is not null or Mopt_stmt is not null X then X#this second window is so the headings won't be cleared X whenever error continue X for Mcenter=1 to 10 X case Mcenter X when 1 X open window W_brow2_1 at Mrow,Mcol with Msize rows, X Mlen columns X when 2 X open window W_brow2_2 at Mrow,Mcol with Msize rows, X Mlen columns X when 3 X open window W_brow2_3 at Mrow,Mcol with Msize rows, X Mlen columns X when 4 X open window W_brow2_4 at Mrow,Mcol with Msize rows, X Mlen columns X when 5 X open window W_brow2_5 at Mrow,Mcol with Msize rows, X Mlen columns X when 6 X open window W_brow2_6 at Mrow,Mcol with Msize rows, X Mlen columns X when 7 X open window W_brow2_7 at Mrow,Mcol with Msize rows, X Mlen columns X when 8 X open window W_brow2_8 at Mrow,Mcol with Msize rows, X Mlen columns X when 9 X open window W_brow2_9 at Mrow,Mcol with Msize rows, X Mlen columns X when 10 X open window W_brow2_10 at Mrow,Mcol with Msize rows, X Mlen columns X end case X if status=0 X then X exit for X end if X end for X whenever any error stop X end if X end if X let Msize=Msize-1 X if not M_opn_win and not M_close_win X then X let Mstart_row=Mrow-1 X else X let Mstart_row=0 X end if X if length(Mcheck)>0 X then X call get_arr_pos(Mj,Mcheck,Msize,true) returning Mi,Mj,Mx X else X let Mi=1 X end if X call point_shoot(Msize,Mi,Mj) returning Mi X if M_close_win X then X whenever error continue X for Mcenter=10 to 1 step -1 X case Mcenter X when 1 X close window W_brow2_1 X close window W_brow_1 X when 2 X close window W_brow2_2 X close window W_brow_2 X when 3 X close window W_brow2_3 X close window W_brow_3 X when 4 X close window W_brow2_4 X close window W_brow_4 X when 5 X close window W_brow2_5 X close window W_brow_5 X when 6 X close window W_brow2_6 X close window W_brow_6 X when 7 X close window W_brow2_7 X close window W_brow_7 X when 8 X close window W_brow2_8 X close window W_brow_8 X when 9 X close window W_brow2_9 X close window W_brow_9 X when 10 X close window W_brow2_10 X close window W_brow_10 X end case X if status=0 X then X exit for X end if X end for X whenever any error stop X end if X if not M_opn_win and not M_close_win X then X for Mz=Mstart_row+1 to Mstart_row+Msize+1 X display "" at Mz,1 X end for X end if X if Mi=0 X then X return 0," " X else X let Mj=Mi X while Mj>100 X let Mj=Mj-100 X end while X return Mi,A_browse[Mj] X end if Xend function X X{############################################################################## X# Function : point_shoot X# Programmers : Joseph Cullipher X# Date : 08/23/95 X# Description : This function performs the main loop for all associated X# : point and shoot functions. X# X# Received Parameters: Mscrnsize (the number of screen array elements) X# : Mposition (the array element number you are at) X# : Mcount (the total number of array elements) X# X# Returned Parameters: Mposition (the array element number you are at) X# X###############################################################################} X Xfunction point_shoot(Mscrnsize,Mposition,Mcount) X define X Mposition,Mscrnsize,Msline,Mi,Mcount,Mx smallint, X Mkey_pressed int, X Mans char(1), X Mlook char(2) X X let int_flag=false X let Msline=1+Mstart_row X options X prompt line last, X accept key return X X call show_page(Mposition,Mscrnsize,Mcount,true) returning Mposition,Mcount X while (Mkey_pressed<>fgl_keyval("accept") and X Mkey_pressed<>fgl_keyval("interrupt")) or Mkey_pressed is null X prompt "" for char Mans X on key (down) X call line_down(Mposition,Mcount,Mscrnsize,Msline) X returning Mposition,Msline,Mcount X on key (up) X call line_up(Mposition,Mcount,Mscrnsize,Msline) X returning Mposition,Msline,Mcount X on key (nextpage,control-f) X call page_down(Mposition,Mcount,Mscrnsize,Msline) X returning Mposition,Msline,Mcount X on key (prevpage,control-b) X call page_up(Mposition,Mcount,Mscrnsize,Msline) X returning Mposition,Msline,Mcount X on key (accept) X if length(Moptions)=0 or Moptions is null X then X exit while X end if X on key (escape,interrupt) X let int_flag=true X exit while X end prompt X let Mkey_pressed=fgl_keyval(upshift(Mans)) X case X when length(Moptions)>0 X for Mi=1 to length(Moptions) X if Mkey_pressed=ord(Moptions[Mi,Mi]) X then X let Mposition=Mposition+(Mi*100) X exit while X end if X end for X when ((Mkey_pressed>=65 and Mkey_pressed<=90) or X (Mkey_pressed>=48 and Mkey_pressed<=57)) and A_substr[1].type=0 X let Mlook=ascii Mkey_pressed X call get_arr_pos(Mcount,Mlook,Mscrnsize,false) X returning Mposition,Mcount,Mx X if Mx=50 X then X exit while X end if X let Msline=Mx X end case X end while X options X accept key f24 X if int_flag X then X let int_flag=false X return 0 X end if X return Mposition Xend function X X{############################################################################## X# Function : line_down X# Programmers : Joseph Cullipher X# Date : 08/23/95 X# Description : This function performs the down movement of the highlight X# : on a point and shoot X# X# Received Parameters: Mpos (the array element number you are at) X# : Mcnt (the total number of array elements) X# : Msize (the number of screen array elements displayed) X# : Mline (the line of the screen array you are on) X# X# Returned Parameters: Mpos (the array element number you are at) X# : Mline (the line of the screen array you are on) X# : Mcnt (the new array count if reload_array is called) X# X###############################################################################} X Xfunction line_down(Mpos,Mcnt,Msize,Mline) X define X Mpos,Msize,Mline,Mcnt smallint, X Mdisplay varchar(78) X X let int_flag=false X if Mpos+1>Mcnt X then X if Mcnt>=100 X then X let Mcnt=reload_array("down",Mpos) X let Mpos=1 X call show_page(Mpos,Msize,Mcnt,true) returning Mpos,Mcnt X return 1,1+Mstart_row,Mcnt X else X call beep() X return Mpos,Mline,Mcnt X end if X end if X let Mdisplay=A_browse[Mpos][1,Mmax_len] X display Mdisplay at Mline,2 attribute(normal) X let Mpos=Mpos+1 X let Mline=Mline+1 X if Mline>Msize+Mstart_row X then X call show_page(Mpos-(Msize-1),Msize,Mcnt,false) returning Msize,Mcnt X let Mline=Mline-1 X end if X let Mdisplay=A_browse[Mpos][1,Mmax_len] X display Mdisplay at Mline,2 attribute(reverse) X return Mpos,Mline,Mcnt Xend function X X{############################################################################## X# Function : line_up X# Programmers : Joseph Cullipher X# Date : 08/23/95 X# Description : This function performs the upward movement of the highlight X# : on a point and shoot X# X# Received Parameters: Mpos (the array element number you are at) X# : Mcnt (the total number of array elements) X# : Msize (the number of screen array elements displayed) X# : Mline (the line of the screen array you are on) X# X# Returned Parameters: Mpos (the array element number you are at) X# : Mline (the line of the screen array you are on) X# : Mcnt (the new array count if reload_array is called) X# X###############################################################################} X Xfunction line_up(Mpos,Mcnt,Msize,Mline) X define X Mpos,Msize,Mline,Mcnt smallint, X Mdisplay varchar(78) X X let int_flag=false X if Mpos-1 <1 X then X if not Mbeginning X then X let Mdisplay=A_browse[1] X let Mcnt=reload_array("up",Mpos) X if Mdisplay=A_browse[1] X then X let Mpos=1 X else X let Mpos=Mcnt-Msize+1 X if Mpos<1 X then X let Mpos=1 X end if X end if X call show_page(Mpos,Msize,Mcnt,true) returning Mpos,Mcnt X else X let Mpos=1 X call beep() X end if X return Mpos,1+Mstart_row,Mcnt X end if X let Mdisplay=A_browse[Mpos][1,Mmax_len] X display Mdisplay at Mline,2 attribute(normal) X let Mpos=Mpos-1 X let Mline=Mline-1 X if Mline-Mstart_row<1 X then X call show_page(Mpos,Msize,Mcnt,false) returning Msize,Mcnt X let Mline=Mline+1 X end if X let Mdisplay=A_browse[Mpos][1,Mmax_len] X display Mdisplay at Mline,2 attribute(reverse) X return Mpos,Mline,Mcnt Xend function X X{############################################################################## X# Function : page_up X# Programmers : Joseph Cullipher X# Date : 08/23/95 X# Description : This function performs the upward paging of a point and shoot X# X# Received Parameters: Mpos (the array element number you are at) X# : Mcnt (the total number of array elements) X# : Msize (the number of screen array elements displayed) X# : Mline (the line of the screen array you are on) X# X# Returned Parameters: Mpos (the array element number you are at) X# : Mline (the line of the screen array you are on) X# : Mcnt (the newarray count if reload_array is called) X# X###############################################################################} X Xfunction page_up(Mpos,Mcnt,Msize,Mline) X define X Mpos,Msize,Mline,Mcnt,Mi smallint, X Mdisplay varchar(78) X X let int_flag=false X if Mpos-Msize <0 X then X if not Mbeginning X then X let Mdisplay=A_browse[Mpos] X let Mcnt=reload_array("up",Mpos) X for Mi=1 to Mcnt-1 X if Mdisplay=A_browse[Mi] X then X exit for X end if X end for X let Mpos=Mi-Msize+1 X if Mpos<1 X then X let Mpos=1 X end if X else X if Mpos-1<=0 X then X call beep() X return Mpos,Mline,Mcnt X else X let Mpos=1 X end if X end if X else X let Mpos=Mpos-Msize+1 X end if X call show_page(Mpos,Msize,Mcnt,true) returning Mpos,Mcnt X return Mpos,1+Mstart_row,Mcnt Xend function X X{############################################################################## X# Function : page_down X# Programmers : Joseph Cullipher X# Date : 08/23/95 X# Description : This function performs the upward paging of a point and shoot X# X# Received Parameters: Mpos (the array element number you are at) X# : Mcnt (the total number of array elements) X# : Msize (the number of screen array elements displayed) X# : Mline (the line of the screen array you are on) X# X# Returned Parameters: Mpos (the array element number you are at) X# : Mline (the line of the screen array you are on) X# : Mcnt (the new array count if reload_array is called) X# X###############################################################################} X Xfunction page_down(Mpos,Mcnt,Msize,Mline) X define X Mpos,Msize,Mline,Mcnt smallint X X let int_flag=false X if Mpos+Msize-1 >Mcnt X then X if Mcnt>=100 X then X let Mcnt=reload_array("down",Mpos) X let Mpos=1 X else X call beep() X return Mpos,Mline,Mcnt X end if X else X let Mpos=Mpos+Msize-1 X end if X call show_page(Mpos,Msize,Mcnt,true) returning Mpos,Mcnt X return Mpos,1+Mstart_row,Mcnt Xend function X X{############################################################################## X# Function : get_arr_pos X# Programmers : Joseph Cullipher X# Date : 06/06/97 X# Description : This function performs the starting position in an array if X# : not already accomplished. X# X# Received Parameters: Mtotal (the total number of array elements) X# : Mmatch (the letters or numbers to match) X# : Msize (the size of the screen) X# : Monce (true/false if find first match and return) X# X# Returned Parameters: Mreturn (the starting position in the array) X# : Mtotal (the array count if reload_array is called) X# X###############################################################################} X Xfunction get_arr_pos(Mtotal,Mmatch,Msize,Monce) X define X Mexit,Mi,Mreturn,Mtotal,Mend,Msize,Monce smallint, X Mfirst char(1), X Mkey int, X Mmatch,Mcheck varchar(70) X X let Mreturn=1 X let Mexit=false X let Mmatch=Mmatch clipped X let Mend=length(Mmatch) X let Mcheck=" " X for Mi=1 to Mend X if A_browse[1][Mi]>="a" X then X let Mcheck=Mcheck clipped,downshift(Mmatch[Mi]) X else X let Mcheck=Mcheck clipped,upshift(Mmatch[Mi]) X end if X end for X let Mmatch=Mcheck X let Mkey=fgl_keyval(Mmatch) X while (Mkey<>fgl_keyval("accept") and Mkey<>fgl_keyval("interrupt")) X or Mkey is not null or (Mkey>=65 and Mkey<=90) or (Mkey>=48 and Mkey<=57) X or Mkey=32 X for Mi=1 to Mtotal X if not Mdescending X then X if A_browse[Mi][1,Mend]>Mmatch and Mi=1 X then X let Mmatchit=" and ",A_substr[1].name clipped,"<='",Mmatch,"'" X let Mtotal=reload_array("up",1) X let Mreturn=Mtotal X let Mi=Mtotal X exit for X end if X if A_browse[Mi][1,Mend]>=Mmatch X then X let Mreturn=Mi X exit for X end if X else X let Mcheck="*",A_substr[1].name clipped," desc*" X #if not M_asc_desc or Morder not matches Mcheck X if M_asc_desc and Morder matches Mcheck X then X if A_browse[Mi][1,Mend]='",Mmatch,"'" X let Mtotal=reload_array("up",1) X let Mreturn=Mtotal X let Mi=Mtotal X exit for X end if X if A_browse[Mi][1,Mend]<=Mmatch X then X let Mreturn=Mi X exit for X end if X else X if A_browse[Mi][1,Mend]>Mmatch and Mi=1 X then X let Mmatchit=" and ",A_substr[1].name clipped,">='",Mmatch,"'" X let Mtotal=reload_array("up",1) X let Mreturn=Mtotal X let Mi=Mtotal X exit for X end if X if A_browse[Mi][1,Mend]>=Mmatch X then X let Mreturn=Mi X exit for X end if X end if X end if X end for X if Mi>Mtotal X then X if not Mdescending X then X let Mmatchit=" and ",A_substr[1].name clipped,">='",Mmatch,"'" X else X if not M_asc_desc X then X let Mmatchit=" and ",A_substr[1].name clipped,"<='",Mmatch,"'" X else X let Mcheck="*",A_substr[1].name clipped," desc*" X if Morder matches Mcheck X then X let Mmatchit=" and ",A_substr[1].name clipped,">='",Mmatch,"'" X else X let Mmatchit=" and ",A_substr[1].name clipped,"<='",Mmatch,"'" X end if X end if X end if X let Mtotal=reload_array("down",100) X let Mi=Mtotal X continue while X end if X if Monce or Mend=A_substr[1].len X then X exit while X end if X if A_browse[Mreturn][1,Mend]>Mmatch X then X let Mreturn=Mreturn-1 X call beep() X let Mexit=1 X exit while X end if X call show_page(Mi,Msize,Mtotal,true) returning Mreturn,Mtotal X if A_browse[Mreturn][1,Mend]="a" X then X let Mfirst=downshift(Mfirst) X else X let Mfirst=upshift(Mfirst) X end if X let Mkey=fgl_keyval(Mfirst) X end if X let Mmatch=Mmatch,Mfirst X let Mend=length(Mmatch) X end while X return Mreturn,Mtotal,Mexit Xend function X X{############################################################################## X# Function : show_page X# Programmers : Joseph Cullipher X# Date : 08/23/95 X# Description : This function performs the redisplay of a screen array after X# : the page_up or page_down function is called. Also called if X# : the function reload_array is called. X# X# Received Parameters: Mpos (the array element number you are at) X# : Msize (the number of screen array elements displayed) X# : Mcnt (the total number of array elements) X# : Mclear (clear window variable) X# X# Returned Parameters: Mpos (the current array element number..only changes X# : if reload_array is called) X# : Mcnt (the array count if reload_array is called) X# X###############################################################################} X Xfunction show_page(Mpos,Msize,Mcnt,Mclear) X define X Mpos,Msize,Mi,Mj,Mclear,Mk,Mcnt smallint, X Mdisplay varchar(78) X X let int_flag=false X if Mclear X then X whenever error continue X for Mk=10 to 1 step -1 X case Mk X when 1 X clear window W_brow2_1 X if status<>0 X then X clear window W_brow_1 X end if X when 2 X clear window W_brow2_2 X if status<>0 X then X clear window W_brow_2 X end if X when 3 X clear window W_brow2_3 X if status<>0 X then X clear window W_brow_3 X end if X when 4 X clear window W_brow2_4 X if status<>0 X then X clear window W_brow_4 X end if X when 5 X clear window W_brow2_5 X if status<>0 X then X clear window W_brow_5 X end if X when 6 X clear window W_brow2_6 X if status<>0 X then X clear window W_brow_6 X end if X when 7 X clear window W_brow2_7 X if status<>0 X then X clear window W_brow_7 X end if X when 8 X clear window W_brow2_8 X if status<>0 X then X clear window W_brow_8 X end if X when 9 X clear window W_brow2_9 X if status<>0 X then X clear window W_brow_9 X end if X when 10 X clear window W_brow2_10 X if status<>0 X then X clear window W_brow_10 X end if X end case X if status=0 X then X exit for X end if X if Mk=1 X then X let Mdisplay=" " X for Mk=2 to Mmax_len X let Mdisplay=Mdisplay," " X end for X for Mk=1+Mstart_row to Msize+Mstart_row X display Mdisplay at Mk,2 X end for X end if X end for X whenever any error stop X end if X if Mpos=0 X then X let Mpos=1 X end if X let Mi=Mpos X for Mj=1+Mstart_row to Msize+Mstart_row X let Mdisplay=A_browse[Mi][1,Mmax_len] X display Mdisplay at Mj,2 attribute(normal) X let Mi=Mi+1 X if Mi>Mcnt and Mj=100 X then X let Mcnt=reload_array("down",Mi-Mj) X let Mi=1 X let Mj=0 X let Mpos=1 X else X if Mi>Mcnt X then X exit for X end if X end if X end for X if Mclear X then X let Mdisplay=A_browse[Mpos][1,Mmax_len] X let Mj=1+Mstart_row X display Mdisplay at Mj,2 attribute(reverse) X end if X return Mpos,Mcnt Xend function X X{############################################################################## X# Function : reload_array X# Programmers : Joseph Cullipher X# Date : 06/03/97 X# Description : This function performs the reloading of an array after you X# : have reached the beginning or end and want to continue X# : browsing in that direction. X# X# Received Parameters: Mdirection (up or down) X# : Mpos (position of array to do select) X# X# Returned Parameters: Mi (the number of elements in the array the got loaded) X# X###############################################################################} X Xfunction reload_array(Mdirection,Mpos) X define X Mi,Mpos,Mx,My,Mz smallint, X Mtmp_order char(256), X Msearch varchar(43), X Mdirection,Mchkdir char(4) X X let int_flag=false X let Msearch=" " X for Mi=2 to (Mmax_len/2)-5 X let Msearch=Msearch," " X end for X let Msearch=Msearch,"Searching" X options message line last X message Msearch attribute(blink) X options message line 2 X if length(Mwhere)=0 X then X return Mpos X end if X let Mdirection=upshift(Mdirection) X call change_ops(Mdirection,Mpos) X let Mselect="select ",Mcolnames clipped," from ",Mtablename clipped, X " where ",Mwhere clipped X if Mmatchit is not null X then X let Mselect=Mselect clipped,Mmatchit X let Mmatchit=null X end if X if length(Morder)>0 and not M_asc_desc X then X let Mtmp_order=Morder clipped,"," X case X when Mdescending and Mdirection="UP " X let Mchkdir="DOWN" X when not Mdescending and Mdirection="UP " X let Mchkdir="UP " X when Mdescending and Mdirection="DOWN" X let Mchkdir="DOWN" X when not Mdescending and Mdirection="DOWN" X let Mchkdir="UP " X end case X let Mx=length(Mtmp_order) X let Morder=Mtmp_order[1] X if Mdirection=Mchkdir --adds desc X then X for Mi=2 to Mx X if Mtmp_order[Mi]="," X then X if Mtmp_order[Mi-5,Mi-1]<>" desc" X then X let Morder=Morder clipped," desc" X end if X end if X if Mtmp_order[Mi-1]=" " X then X let Morder=Morder clipped," ",Mtmp_order[Mi] X else X let Morder=Morder clipped,Mtmp_order[Mi] X end if X end for X else --removes desc X for Mi=2 to Mx X if Mtmp_order[Mi,Mi+4]=" desc" X then X let Mi=Mi+5 X end if X let Morder=Morder clipped,Mtmp_order[Mi] X end for X end if X end if X if length(Morder)>0 and M_asc_desc X then X let Mtmp_order=Morder clipped,"," X if Mdirection="UP" X then X let Mx=length(Mtmp_order) X let Morder=Mtmp_order[1] X for Mi=2 to Mx X if Mtmp_order[Mi,Mi+4]=" desc" X then X let Mi=Mi+5 X else X if Mtmp_order[Mi]="," X then X let Morder=Morder clipped," desc" X end if X end if X let Morder=Morder clipped,Mtmp_order[Mi] X end for X else X let Morder=Morder clipped,"," X end if X end if X let Mx=length(Morder)-1 X let Morder=Morder[1,Mx] X let Mselect=Mselect clipped," order by ",Morder clipped X let Mx=length(Mtmp_order)-1 X let Morder=Mtmp_order[1,Mx] X initialize A_info to null X initialize A_browse to null X prepare Mreload from Mselect X if Mdirection="UP " X then X let Mi=100 X else X let Mi=1 X end if X declare C_reload cursor for Mreload X foreach C_reload into A_info[1],A_info[2],A_info[3],A_info[4],A_info[5], X A_info[6],A_info[7],A_info[8],A_info[9],A_info[10],A_info[11],A_info[12], X A_info[13],A_info[14],A_info[15],A_info[16],A_info[17],A_info[18], X A_info[19],A_info[20] X let A_browse[Mi]=" " X let My=0 X for Mx=1 to Mnbr_cols X#check for columns selected longer than the array X if My+A_substr[Mx].len>77 X then X let Mz=77-My X if Mz<1 X then X exit for X end if X if Mx=1 X then X let A_browse[Mi]=A_browse[Mi] clipped,A_info[1][1,Mz] X else X let A_browse[Mi]=A_browse[Mi][1,My]," ",A_info[Mx][1,Mz] X end if X exit for X end if X let Mz=A_substr[Mx].len X if Mx=1 X then X let A_browse[Mi]=A_browse[Mi] clipped,A_info[1][1,Mz] X let My=My+Mz X else X let A_browse[Mi]=A_browse[Mi][1,My]," ",A_info[Mx][1,Mz] X let My=My+Mz+1 X end if X end for X if Mdirection="DOWN" X then X let Mi=Mi+1 X if Mi>100 X then X exit foreach X end if X else X let Mi=Mi-1 X if Mi=0 X then X let Mi=Mi+1 X exit foreach X end if X end if X end foreach X if Mdirection="DOWN" X then X let Mi=Mi-1 X end if X if Mdirection="UP " and A_browse[1] is null X then X let Mi=reload_array("DOWN",Mi+1) X let Mbeginning=true X else X if Mdirection="UP " X then X let Mi=100 X end if X let Mbeginning=false X end if X return Mi Xend function X X{############################################################################## X# Function : get_length X# Programmers : Joseph Cullipher X# Date : 01/02/97 X# Description : This function performs the length conversion of columns X# X# Received Parameters: Mcoltype (the column type reported by syscolumns) X# : Mcollenght (the length of the column reported by X# syscolumns) X# X# Returned Parameters: Mlength (the computed length) X# X###############################################################################} X Xfunction get_length(Mcoltype,Mcollength) X define X Mcoltype,Mcollength,Mi,Mj smallint, X Mdate_type,Mlength char(4) X X let Mcoltype=Mcoltype+1 -- coltype is offset by one X let Mcoltype=Mcoltype mod 256 -- lose the NO NULLS determinator X case Mcoltype X when 1 -- char X let Mlength=Mcollength using "<<<<" X when 2 -- smallint X let Mlength=5 using "<<<<" X when 3 -- int X let Mlength=11 using "<<<<" X when 4 -- float X let Mi=Mcollength/256 X let Mj=Mcollength mod 256 X if Mj>0 X then X let Mj=Mj+1 --add 1 for the decimal point X end if X let Mlength=Mi+Mj using "<<<<" X when 5 -- smallfloat X let Mi=Mcollength/256 X let Mj=Mcollength mod 256 X if Mj>0 X then X let Mj=Mj+1 --add 1 for the decimal point X end if X let Mlength=Mi+Mj using "<<<<" X when 6 -- decimal X let Mi=Mcollength/256 X let Mj=Mcollength mod 256 X if Mj>0 X then X let Mj=Mj+1 --add 1 for the decimal point X end if X let Mlength=Mi+Mj using "<<<<" X when 7 -- serial X let Mlength=11 using "<<<<" X when 8 -- date X let Mdate_type=fgl_getenv("DBDATE") X if Mdate_type[4]="4" X then X let Mlength=10 using "<<<<" X else X let Mlength=8 using "<<<<" X end if X when 9 -- money X let Mi=Mcollength/256 X let Mj=Mcollength mod 256 X if Mj>0 X then X let Mj=Mj+1 --add 1 for the decimal point X end if X let Mlength=Mi+Mj using "<<<<" X when 11 -- datetime X let Mi=Mcollength/256 X let Mi=Mi+(Mi/3) X if Mi<10 X then X let Mi=Mi-1 X end if X let Mlength=Mi using "<<<<" X when 14 -- varchar X# Mi is min size X let Mi=Mcollength/256 X# Mj is max size X let Mj=Mcollength mod 256 X let Mlength=Mj using "<<<<" X when 15 -- interval X let Mi=(Mcollength/256) X let Mi=Mi+(Mi/3) X let Mlength=Mi using "<<<<" X end case X return Mlength Xend function X X{############################################################################## X# Function : beep.4gl X# Programmers : Joseph Cullipher X# Date : 09/14/95 X# Description : This function performs beeping of the bell. It was put in X# : because the error command in some versions of 4GL cleared X# : the last line and didn't restore it. X# X# Received Parameters: NONE X# X# Returned Parameters: NONE X# X###############################################################################} X Xfunction beep() X define X Mbell char(1) X X let int_flag=false X let Mbell=ascii 7 X open window w_beep at 1,1 with 1 rows, 1 columns X display Mbell at 1,1 X close window w_beep Xend function X X{############################################################################## X# Function : change_ops X# Programmers : Joseph Cullipher X# Date : 05/27/97 X# Description : This function changes the where clause for reloading this X# : modules browse array X# X# Received Parameters: Mdirection (the direction that the user wants to go) X# : Mpos (the position currently at in the array) X# X# Returned Parameters: NONE X# X###############################################################################} X Xfunction change_ops(Mdirection,Mpos) X define X Mdirection char(4), X Mop char(1), X M_tmp_where char(256), X M_where_pipe,M_chkorder varchar(255), X M_pipe,M_2pipes char(70), X Mi,Mj,Mx,Mpos,Mz,Mk,My,Mw,Mquote,Mconcat,Ma smallint X X if Mdescending and not M_asc_desc X then X if Mdirection="DOWN" X then X let Mdirection="UP " X else X let Mdirection="DOWN" X end if X end if X let Mj=length(Mwhere) X let M_tmp_where=Mwhere X let Mx=1 X let Mw=1 X let Mwhere=M_tmp_where[1] X for Mi=2 to Mj X case X when M_tmp_where[Mi]="|" and M_tmp_where[Mi+1]="|" X let M_pipe="*||*" X let Mconcat=1 X for Ma=Mi to Mj X if M_tmp_where[Ma]=" " X then X exit for X end if X end for X let Ma=Ma-1 X while M_tmp_where[Mi,Ma] matches M_pipe X let Mconcat=Mconcat+1 X let M_pipe=M_pipe clipped,"||*" X end while X let M_where_pipe="'" X for Ma=1 to Mconcat X let My=0 X for Mz=1 to 20 X if A_substr[Mz].name is null X then X let Mz=21 X exit for X end if X if A_substr[Mz].name=M_tmp_where[Mw,Mi-1] X then X exit for X else X let My=A_substr[Mz].len+My X end if X end for X if Mz<21 X then X if Ma>1 X then X let Mwhere=Mwhere clipped,M_tmp_where[Mw,Mi-1] X end if X if Ma<>Mconcat X then X let Mwhere=Mwhere clipped,"||" X let Mi=Mi+2 X end if X let Mk=A_substr[Mz].len+My+Mz-1 X let M_where_pipe=M_where_pipe,A_browse[Mpos][My+Mz,Mk] X let Mw=Mi X while M_tmp_where[Mi] not matches "[|><= ]" X let Mi=Mi+1 X end while X end if X end for X case X when M_tmp_where[Mi]=">" and Mdirection="UP " X and M_tmp_where[Mi-1]<>"<" X let Mop="<" X when M_tmp_where[Mi]="<" and Mdirection="UP " X and M_tmp_where[Mi+1]<>">" X let Mop="<" X when M_tmp_where[Mi]="<" and Mdirection="DOWN" X and M_tmp_where[Mi+1]<>">" X let Mop=">" X when M_tmp_where[Mi]=">" and Mdirection="DOWN" X and M_tmp_where[Mi-1]<>"<" X let Mop=">" X end case X let Mwhere=Mwhere clipped,Mop X if M_tmp_where[Mi+1]="=" X then X let Mwhere=Mwhere clipped,"=" X end if X let Mwhere=Mwhere clipped,M_where_pipe,"'" X let Mquote=0 X while Mquote<>2 and Mi<>Mj X if M_tmp_where[Mi]="'" or M_tmp_where='"' X then X let Mquote=Mquote+1 X end if X let Mi=Mi+1 X end while X continue for X when M_tmp_where[Mi]=">" and Mdirection="UP " --changes operand X and M_tmp_where[Mi-1]<>"<" X let Mop="<" X if M_asc_desc X then X let M_chkorder="*",M_tmp_where[Mw,Mi-1]," desc*" X if Morder matches M_chkorder X then X let Mop=">" X end if X end if X when M_tmp_where[Mi]="<" and Mdirection="UP " --changes values X and M_tmp_where[Mi+1]<>">" X let Mop="<" X if M_asc_desc X then X let M_chkorder="*",M_tmp_where[Mw,Mi-1]," desc*" X if Morder matches M_chkorder X then X let Mop="<" X end if X end if X when M_tmp_where[Mi]="<" and Mdirection="DOWN" --changes operand X and M_tmp_where[Mi+1]<>">" X let Mop=">" X if M_asc_desc X then X let M_chkorder="*",M_tmp_where[Mw,Mi-1]," desc*" X if Morder matches M_chkorder X then X let Mop="<" X end if X end if X when M_tmp_where[Mi]=">" and Mdirection="DOWN" --changes values X and M_tmp_where[Mi-1]<>"<" X let Mop=">" X if M_asc_desc X then X let M_chkorder="*",M_tmp_where[Mw,Mi-1]," desc*" X if Morder matches M_chkorder X then X let Mop=">" X end if X end if X otherwise X if M_tmp_where[Mi-1]=" " X then X let Mwhere=Mwhere clipped," ",M_tmp_where[Mi] X let Mw=Mi X else X let Mwhere=Mwhere clipped,M_tmp_where[Mi] X end if X let Mx=Mx+1 X continue for X end case X let My=0 X for Mz=1 to 20 X if A_substr[Mz].name is null X then X let Mz=21 X exit for X end if X if A_substr[Mz].name=M_tmp_where[Mw,Mi-1] X then X exit for X else X let My=A_substr[Mz].len+My X end if X end for X let Mwhere=Mwhere clipped,Mop X if M_tmp_where[Mi+1]="=" X then X let Mwhere=Mwhere clipped,"=" X let Mi=Mi+2 X else X let Mi=Mi+1 X end if X if Mz<21 X then X let Mk=A_substr[Mz].len+My+Mz-1 X let Mwhere=Mwhere clipped,"'",A_browse[Mpos][My+Mz,Mk],"' " X let Mquote=0 X while Mquote<>2 and Mi<>Mj X if M_tmp_where[Mi]="'" or M_tmp_where='"' X then X let Mquote=Mquote+1 X end if X let Mi=Mi+1 X end while X else X let Mquote=0 X while Mquote<>2 and Mi<>Mj X if M_tmp_where[Mi]="'" or M_tmp_where='"' X then X let Mquote=Mquote+1 X end if X let Mwhere=Mwhere clipped,M_tmp_where[Mi] X let Mi=Mi+1 X end while X end if X let Mw=Mi X end for Xend function SHAR-EOF if [ `wc -c