PROGRAM DISK_DIR_DB( INPUT,OUTPUT ) ; CONST {$I GEMCONST.PAS} Desk_Title = 3 ; { The index of the "desk" item in the menu bar } TYPE {$I gemtype.pas} S = FILE OF TEXT; FILE_NAME_TYPE = PACKED ARRAY [1..64] OF BYTE; BUF_TYPE = PACKED ARRAY [ 0..255 ] OF CHAR; BUFI_TYPE = INTEGER; VAR OUTPUT_FILE : S; OUT_FILE : S; BLdn : ARRAY [0..1100] OF STRING[4]; BLAT : ARRAY [0..1100] OF STRING[2]; BLname : ARRAY [0..1100] OF STRING[14]; BLdate : ARRAY [0..1100] OF STRING[10]; BLfold : ARRAY [0..1100] OF STRING[14]; BLcomm : ARRAY [0..1100] OF STRING[26]; SINDX : ARRAY [0..1100] OF INTEGER; TEMP_BLdn : ARRAY [0..1100] OF STRING[4]; TEMP_BLAT : ARRAY [0..1100] OF STRING[2]; TEMP_BLname : ARRAY [0..1100] OF STRING[14]; TEMP_BLdate : ARRAY [0..1100] OF STRING[10]; TEMP_BLfold : ARRAY [0..1100] OF STRING[14]; PINDX : ARRAY [0..1100] OF INTEGER; SLINE : STRING ; Sline1 : string; Sline2 : string; Sline3 : string; Sline4 : string; Sline5 : string; title_line, info_line1, info_line2, info_line3, info_line4, info_line5, info_line6 :STR255; LINE_COUNT,COUNT,LAST_DISK : INTEGER; menu : Menu_Ptr ; last_sx,last_sy,last_sw,last_sh,wx,wy,ww,wh, txt_line,Txt_line1,Btn_a,Btn_b,Btn_c,p_name,ok,Cancel : INTEGER; txtln,txtln1,txtln2,btn_na,btn_ty,btn_da,btn_di,btn_fo,btn_co, ok1,cancel1,ok_button,info_item, btn_d, btn_e, btn_f, btn_g, btn_h, btn_i, btn_j, btn_k, btn_l, btn_m, btn_n, btn_o, btn_p, mc_line1, mc_line2, mc_line3, mc_line4, mc_line5, mc_line6 : integer; ACB : DIALOG_PTR; ACB_PROMT,ACB_PROMT1,ACB_PROMT2,ACB_PROMT3,ACB_GET,ACB_CANCEL, ACB_BOX1,ACB_BOX2,ACB_BOX21,ACB_BOX3,ACB_BOX4,ACB_BOX41, ACB_BOX5,ACB_BOX6,ACB_BOX61,ACB_BOX7,ACB_BOX8,ACB_BOX81 : INTEGER; Add_box,sort_box : Dialog_Ptr ; dialog :array [1..6] of Dialog_Ptr ; info_box : dialog_ptr; wtitle,wititle,wstitle : window_title; button, ok_btn, cancel_btn, prompt_item,GET_item : ARRAY [1..6] of Integer; CW,CH,CUR_LOC,N,SX,SY,SH,SW,bw,bh, dummy,handle,file_title,edit_title,SEARCH_TITLE,PRINT_TITLE,style_title, qt_item,stype_item,sdate_item,sname_item,sdnum_item,Sfnd_item,SFOLD_ITEM, flag1,COMB_ITEM,PRINTD_ITEM,PRINTP_ITEM,sort_item,BLANK_ITEM : INTEGER; BLANK1_ITEM,PRINTA_ITEM,PRINTC_ITEM,PRINTS_ITEM : integer; BLANK2_ITEM,BLANK3_ITEM,BLANK4_ITEM,BLANK5_ITEM,stat_ITEM,layout_ITEM, CHANGE_ITEM,COM_ITEM,open_item,close_item,white_item,black_item,ADD_item, LAST_LINE,w_options,vslsize,del_item,X,BLANK6_ITEM : integer ; help_title, item41, item42, item43, item44, item45, item46, item47, item48, item49, item50, item51, item52, item53, item54, item55, item56, item57, item58, item60, b_state, blank7_item,blank8_item,blank9_item : integer; PRNT_COUNT : INTEGER; alert1,PATH_STRING,SHW_BOX_STR,DNSTR,TOTL,LEFT,FOLDER : str255 ; FULL_NAME,PATH_NM,PATH_NM1 : PATH_NAME ; YN,COM_FLAG,ADD_FLAG,CANCEL_BOX,title_bar,COLOR_FLAG, SEARCH_FLAG,BUFFER_FLAG : BOOLEAN ; scrn_size,total_lines : REAL; first_flag, timer_flag, adrive, bdrive, cdrive, ddrive, edrive, fdrive, gdrive, hdrive, idrive, jdrive, kdrive, ldrive, mdrive, ndrive, odrive, pdrive : boolean; {$I gemsubs} { and that ".PAS" is default } FUNCTION gem_create( VAR fname : PATH_NAME ; mode : integer ) : integer; GEMDOS( $3C ) ; FUNCTION gem_open( VAR fname : PATH_NAME ; mode : integer ) : integer; GEMDOS( $3D ) ; PROCEDURE gem_close( handle : integer ) ; GEMDOS( $3E ) ; FUNCTION gem_read( handle : integer ; nbytes : long_integer ; VAR buf : BUF_TYPE ) : long_integer ; GEMDOS( $3F ) ; FUNCTION gem_readI( handle : integer ; nbytes : long_integer ; VAR buf : BUFI_TYPE ) : long_integer ; GEMDOS( $3F ) ; FUNCTION gem_write( handle : integer ; nbytes : long_integer ; VAR buf : BUF_TYPE ) : long_integer ; GEMDOS( $40 ) ; FUNCTION gem_writeI( handle : integer ; nbytes : long_integer ; VAR buf : BUFI_TYPE ) : long_integer ; GEMDOS( $40 ) ; PROCEDURE gem_seek( nbytes : long_integer ; handle, mode : integer ) ; GEMDOS( $42 ) ; FUNCTION drivmap : long_integer; BIOS(10); FUNCTION GETREZ : INTEGER; XBIOS($4); PROCEDURE SETSCREEN(LOGADR,PHYSADR : LONG_INTEGER; REZ : INTEGER); XBIOS($5); PROCEDURE SYSTEM_DRIVES; VAR X,y : LONG_INTEGER; z,xx : integer; BEGIN x := drivmap; y := x & $0000ffff; z := int(y); xx := z & $0001; if xx <> 0 then adrive := true else adrive := false; xx := z & $0002; if xx <> 0 then bdrive := true else bdrive := false; xx := z & $0004; if xx <> 0 then cdrive := true else cdrive := false; xx := z & $0008; if xx <> 0 then ddrive := true else ddrive := false; xx := z & $0010; if xx <> 0 then edrive := true else edrive := false; xx := z & $0020; if xx <> 0 then fdrive := true else fdrive := false; xx := z & $0040; if xx <> 0 then gdrive := true else gdrive := false; xx := z & $0080; if xx <> 0 then hdrive := true else hdrive := false; xx := z & $0100; if xx <> 0 then idrive := true else idrive := false; xx := z & $0200; if xx <> 0 then jdrive := true else jdrive := false; xx := z & $0400; if xx <> 0 then kdrive := true else kdrive := false; xx := z & $0800; if xx <> 0 then ldrive := true else ldrive := false; xx := z & $1000; if xx <> 0 then mdrive := true else mdrive := false; xx := z & $2000; if xx <> 0 then ndrive := true else ndrive := false; xx := z & $4000; if xx <> 0 then odrive := true else odrive := false; xx := z & $8000; if xx <> 0 then pdrive := true else pdrive := false; END; PROCEDURE INIT_MENU; BEGIN menu := New_Menu( 62, ' About MENU ' ) ; file_title := Add_MTitle( menu, ' File ' ) ; SEARCH_title := Add_MTitle( menu, ' Search \ Sort ' ) ; PRINT_title := Add_MTitle( menu, ' Print ' ) ; STYLE_TITLE := ADD_MTITLE( MENU, ' Style ' ) ; HELP_TITLE := ADD_MTITLE( MENU, ' Help ' ) ; open_item := Add_MItem( menu, file_title, ' OPEN FILE ' ) ; close_item := Add_MItem( menu, file_title, ' SAVE FILE ' ) ; BLANK1_item := Add_MItem( menu, file_title, '----------------' ) ; ADD_item := Add_MItem( menu, FILE_title, ' ADD FILES ' ) ; del_item := Add_MItem( menu, FILE_title, ' DELETE FILE ' ) ; BLANK2_item := Add_MItem( menu, file_title, '----------------' ) ; COM_item := Add_MItem( menu, FILE_title, ' ADD COMMENTS ' ) ; item60 := Add_MItem( menu, FILE_title, ' EDIT COMMENT ' ) ; BLANK_item := Add_MItem( menu, file_title, '----------------' ) ; qt_item := Add_MItem( menu, file_title, ' QUIT PROGRAM ' ) ; SNAME_item := Add_MItem( menu, search_title, ' by NAME ' ) ; STYPE_item := Add_MItem( menu, search_title, ' by TYPE ' ) ; sdate_item := Add_MItem( menu, search_title, ' by DATE ' ) ; sdnum_item := Add_MItem( menu, search_title, ' by DISK # ' ) ; sFOLD_item := Add_MItem( menu, search_title, ' by FOLDER ' ) ; COMB_item := Add_MItem( menu, search_title, ' by COMMENTS ' ) ; BLANK3_item := Add_MItem( menu, search_title, '----------------' ) ; PRINTA_item := Add_MItem( menu, SEARCH_title, ' BLOCK SEARCH ' ) ; Sfnd_item := Add_MItem( menu, search_title, ' FIND PATH ' ) ; blank4_item := Add_MItem( menu, search_title, '----------------' ) ; sort_item := Add_MItem( menu, search_title, ' SORT ' ) ; PRINTD_item := Add_MItem( menu, PRINT_title, ' PRINT ALL ' ) ; PRINTP_item := Add_MItem( menu, PRINT_title, ' PRINT BUFFER ' ) ; blank6_item := Add_MItem( menu, PRINT_title, '----------------' ) ; PRINTC_item := Add_MItem( menu, PRINT_title, ' ERASE BUFFER ' ) ; white_item := Add_MItem( menu, style_title, ' DEFAULT COLORS ' ) ; black_item := Add_MItem( menu, style_title, ' INVERSE COLORS ' ) ; blank5_item := Add_MItem( menu, STYLE_title, '------------------' ) ; STAT_item := Add_MItem( menu, STYLE_title, ' STATUS LINE ' ) ; layout_item := Add_MItem( menu, STYLE_title, ' LAYOUT LINE ' ) ; ITEM41 := Add_MItem( menu, HELP_title, ' OPEN FILE ' ) ; ITEM42 := Add_MItem( menu, HELP_title, ' SAVE FILE ' ) ; ITEM43 := Add_MItem( menu, HELP_title, ' ADD FILES ' ) ; ITEM44 := Add_MItem( menu, HELP_title, ' DELETE FILE ' ) ; ITEM45 := Add_MItem( menu, HELP_title, ' COMMENT ' ) ; item58 := Add_MItem( menu, HELP_title, ' EDIT COMMENT ' ) ; ITEM46 := Add_MItem( menu, HELP_title, ' QUIT PROGRAM ' ) ; BLANK7_ITEM := Add_MItem( menu, HELP_title, '------------------' ) ; ITEM47 := Add_MItem( menu, HELP_title, ' SEARCH ' ) ; ITEM48 := Add_MItem( menu, HELP_title, ' BLOCK SEARCH ' ) ; ITEM49 := Add_MItem( menu, HELP_title, ' FIND PATH ' ) ; ITEM50 := Add_MItem( menu, HELP_title, ' SORT ' ) ; BLANK8_ITEM := Add_MItem( menu, HELP_title, '------------------' ) ; ITEM51 := Add_MItem( menu, HELP_title, ' PRINT ALL ' ) ; ITEM52 := Add_MItem( menu, HELP_title, ' PRINT BUFFER ' ) ; ITEM53 := Add_MItem( menu, HELP_title, ' ERASE BUFFER ' ) ; BLANK9_ITEM := Add_MItem( menu, HELP_title, '------------------' ) ; ITEM54 := Add_MItem( menu, HELP_title, ' DEFAULT COLORS ' ) ; ITEM55 := Add_MItem( menu, HELP_title, ' INVERSE COLORS ' ) ; ITEM56 := Add_MItem( menu, HELP_title, ' STATUS LINE ' ) ; ITEM57 := Add_MItem( menu, HELP_title, ' LAYOUT LINE ' ) ; Draw_Menu( menu ) ; MENU_DISABLE(MENU,BLANK_ITEM); MENU_DISABLE(MENU,BLANK1_ITEM); MENU_DISABLE(MENU,BLANK2_ITEM); MENU_DISABLE(MENU,BLANK3_ITEM); MENU_DISABLE(MENU,BLANK4_ITEM); MENU_DISABLE(MENU,BLANK5_ITEM); MENU_DISABLE(MENU,BLANK6_ITEM); MENU_DISABLE(MENU,BLANK7_ITEM); MENU_DISABLE(MENU,BLANK8_ITEM); MENU_DISABLE(MENU,BLANK9_ITEM); MENU_CHECK(MENU,LAYOUT_ITEM,TRUE); title_bar := false; COM_FLAG := false; END; (* str - Convert the integer in the parameter 'n' to a string in 's'. The string may consist of a minus sign ('-'), followed by up to 5 digits of the number. The string will be the minimal length which will hold the number (i.e., leading plus signs and leading zeros will NOT appear in the final string!). *) PROCEDURE str( n: integer; VAR s: str255 ); VAR digit, (* Holds each digit value of 'n' as it is created *) divisor, (* Division by this is used to find each digit *) i: integer; (* Index in string at which to put next character *) leading: boolean; (* True, if the next digit will be the leading digit *) (* add_char - Add a single character to the string, incrementing the curren index. *) PROCEDURE add_char( c: char ); BEGIN i := i + 1; s[i] := c; END; BEGIN (* str - main routine *) i := 0; (* Start at the beginning of the string *) IF n < 0 THEN (* If the number is negative, add a minus sign *) BEGIN add_char( '-' ); n := -n; END; (* Now divide the number by decreasing divisors to form each digit-- the divisor starts at 10000, since this is the maximum power of 10 which will fit into a positive integer. *) divisor := 10000; leading := true; WHILE divisor > 0 DO BEGIN (* Get the next digit value. If the digit is not zero, or the digit will not be the leading digit, then add it to the string (this inhibits the addition of leading zeros). *) digit := n DIV divisor; IF (digit <> 0) OR NOT( leading ) THEN BEGIN add_char( chr(digit + ord('0')) ); leading := false; END; (* Throw away the part of the number just used, and decrease the divisor so we will get the next digit next time. *) n := n MOD divisor; divisor := divisor DIV 10; END; (* At this point, if the index is still zero, then we didn't add any characters to the string! The original number must have been zero, so just add that single character. *) IF i = 0 THEN add_char( '0' ); (* Finally, set the length of the string to the final index value. *) s[0] := chr(i); END; Procedure infobox; var str1 : str255; BUTTON : INTEGER; INFO_BOX : DIALOG_PTR; INFO_ITEM, OK_BUTTON : INTEGER; SF : INTEGER; begin sf := System_Font; str1 := ' THE MENU '; STR1[1] := CHR(14); STR1[2] := CHR(15); STR1[15] := CHR(14); STR1[16] := CHR(15); Info_Box := New_Dialog(17,0,0,40,20); info_item := Add_DItem(Info_Box,G_Text,None,2,1,36,1,0,$1180); Set_DText(Info_Box,info_item,STR1,sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,3,36,1,0,$1180); Set_DText(Info_Box,info_item,'by M.F. HOLLENBECK',sf,TE_Center); STR1 := 'Copyright 1987'; str1[11] := chr(189); info_item := Add_DItem(Info_Box,G_Text,None,2,5,36,1,0,$1180); Set_DText(Info_Box,info_item,str1,sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,7,36,1,0,$1180); Set_DText(Info_Box,info_item,'Version 1.0',sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,9,36,1,0,$1180); Set_DText(Info_Box,info_item,'from Future Software Systems',sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,10,36,1,0,$1180); Set_DText(Info_Box,info_item,'21125 Chatsworth st.',sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,11,36,1,0,$1180); Set_DText(Info_Box,info_item,'Chatsworth Ca. 91311',sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,12,36,1,0,$1180); Set_DText(Info_Box,info_item,'(818)-341-8681',sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,14,36,1,0,$1180); Set_DText(Info_Box,info_item,'PLACED IN THE PUBLIC DOMAIN',sf,TE_Center); info_item := Add_DItem(Info_Box,G_Text,None,2,15,36,1,0,$1180); Set_DText(Info_Box,info_item,'NOT FOR RESALE',sf,TE_Center); ok_button := Add_DItem(Info_Box,G_Button,Selectable|Exit_Btn|Default, 15,17,8,2,2,$1180); Set_DText(Info_Box,ok_button,'OK',sf,TE_Center); Center_Dialog(Info_Box); button := Do_Dialog(Info_Box,0); End_Dialog(Info_Box); Delete_Dialog(Info_Box); end; PROCEDURE upercase(var str1 : str255); var i,j : integer; begin for i := 1 to length(str1) do begin if str1[i] IN ['a'..'z'] then begin j := ord(str1[i]) - ord('a') + ord('A'); str1[i] := chr(j); end; end; end; procedure data_box; var sf : integer; button : integer; begin Info_Box := New_Dialog(30,0,0,62,11); sf := System_Font; info_item := Add_DItem(Info_Box,G_Text,None,2,1,58,1,0,$1180); Set_DText(Info_Box,info_item,title_line,sf,TE_center); mc_line1 := Add_DItem(Info_box,g_text,none,2,4,50,1,0,$1180); set_dtext(info_box,mc_line1,info_line1,sf,te_left); mc_line2 := Add_DItem(Info_box,g_text,none,2,5,50,1,0,$1180); set_dtext(info_box,mc_line2,info_line2,sf,te_left); mc_line3 := Add_DItem(Info_box,g_text,none,2,6,50,1,0,$1180); set_dtext(info_box,mc_line3,info_line3,sf,te_left); mc_line4 := Add_DItem(Info_box,g_text,none,2,7,50,1,0,$1180); set_dtext(info_box,mc_line4,info_line4,sf,te_left); mc_line5 := Add_DItem(Info_box,g_text,none,2,8,50,1,0,$1180); set_dtext(info_box,mc_line5,info_line5,sf,te_left); mc_line6 := Add_DItem(Info_box,g_text,none,2,9,50,1,0,$1180); set_dtext(info_box,mc_line6,info_line6,sf,te_left); ok_button := Add_DItem(Info_Box,G_Button,Selectable|Exit_Btn|Default, 54,4,4,6,0,$1180); Set_DText(Info_Box,ok_button,'OK',sf,TE_Center); Center_Dialog(Info_Box); button := Do_Dialog(Info_Box,0); End_Dialog(Info_Box); Delete_Dialog(Info_Box); end; Procedure item41_proc; begin title_line := 'The " OPEN " Menu item'; info_line1 := 'This menu selection will LOAD directory files from'; info_line2 := 'the disk. '; info_line3 := ' '; info_line4 := ' CAUTION '; info_line5 := 'Take care that the file you choose is a valid '; info_line6 := 'directory file or an ERROR may result. '; data_box; end; Procedure item42_proc; begin title_line := 'The " SAVE AS " Menu item'; info_line1 := 'This menu selection allows you to save the current'; info_line2 := 'directory in memory to a disk file. '; info_line3 := ' '; info_line4 := ' CAUTION '; info_line5 := 'Try to use a ".DIR" extention on the filename you '; info_line6 := 'choose '; data_box; end; Procedure item43_proc; begin title_line := 'The " ADD " Menu item'; info_line1 := 'Adding directories to the data base is very simple'; info_line2 := 'the first box you see will ask for a disk number '; info_line3 := 'enter a number from 1 to 1000 and mark the disk '; info_line4 := 'you are going to catalog with this number. '; info_line5 := 'THIS STEP IS VERY IMPORTANT if you forget to mark '; info_line6 := 'the disk you will have trouble finding it latter. '; data_box; title_line := 'The " ADD " Menu item continued...'; info_line1 := 'after you have entered the number of the disk and '; info_line2 := 'marked it, insert the disk in the drive of your '; info_line3 := 'choice. ( if you are working with a hard disk '; info_line4 := 'try to catalogue it first. Make drive "C" number 1'; info_line5 := 'drive "D" number two etc. After you have finished'; info_line6 := 'the hard disks then do the floppies. ) '; data_box; title_line := 'The " ADD " Menu item continued...'; info_line1 := 'the next box will ask for you to choose a drive '; info_line2 := 'THE MENU will allow you to search any drive that '; info_line3 := 'is active at the time the program was started. '; info_line4 := 'Just click the mouse button on the drive you wish '; info_line5 := 'to search and click the OK button. If you wish to '; info_line6 := 'CANCEL the operation click on the CANCEL button. '; data_box; title_line := 'The " ADD " Menu item continued...'; info_line1 := 'THE MENU will now search the disk you selected and'; info_line2 := 'add its contents to the data base. '; info_line3 := 'If the COMMENTS menu item is checked the program '; info_line4 := 'will but up another box asking for a comment. You '; info_line5 := 'have a choice of any of the 12 predefined comments'; info_line6 := 'or you can enter your own. '; data_box; title_line := 'The " ADD " Menu item continued...'; info_line1 := 'This box will be reapeated untill all the files '; info_line2 := 'are commented. '; info_line3 := 'If you change the files on a disk and want to '; info_line4 := 'update the data base simply reread the disk with '; info_line5 := 'the same disk number and THE MENU will automaticly'; info_line6 := 'update the data base. '; data_box; end; Procedure item44_proc; begin title_line := 'The " DELETE " Menu item'; info_line1 := 'This menu selection will allow you to delete a '; info_line2 := 'file from the data base. Just click on this menu '; info_line3 := 'item and enter the filename you want deleted. '; info_line4 := ' CAUTION '; info_line5 := 'Make sure you enter the filename exactly as it '; info_line6 := 'appears in the data base. '; data_box; end; Procedure item45_proc; begin title_line := 'The " COMMENT " Menu item'; info_line1 := ' '; info_line2 := ' '; info_line3 := ' '; info_line4 := 'If this item is checked the computer will prompt '; info_line5 := 'you for comments after the directory has been read'; info_line6 := 'into memory. '; data_box; end; Procedure item46_proc; begin title_line := 'The " QUIT " Menu item'; info_line1 := 'This menu selection will ask if you are sure you '; info_line2 := 'you want to quit. If you answer yes it will stop '; info_line3 := 'the program and return you to the desktop. '; info_line4 := ' '; info_line5 := ' CAUTION '; info_line6 := 'MAKE SURE YOU HAVE SAVED THE FILE IN MEMORY FIRST '; data_box; end; Procedure item47_proc; begin title_line := ' SEARCHING THE DATA BASE '; info_line1 := 'You can search the data base by any one of the six'; info_line2 := 'catagories. (NAME, TYPE, DATE, FOLDER, DISK # AND '; info_line3 := 'COMMENTS ) Just click on the field you want to '; info_line4 := 'search on and follow the promts. The file if found'; info_line5 := 'will appear just below the title bar on the window'; info_line6 := 'The search is a CONTAINS search so you dont have '; data_box; title_line := ' SEARCHING THE DATA BASE cont. '; info_line1 := 'enter the full name. the computer will show the '; info_line2 := 'first occurance of that file. and the window will '; info_line3 := 'position itself so that the file is the top one '; info_line4 := 'listed on the screen. EXAMPLE if you sort by TYPE '; info_line5 := 'and then search for .PRG the computer will move '; info_line6 := 'the window to the fist file with a .PRG extention.'; data_box; title_line := ' SEARCHING THE DATA BASE cont. '; info_line1 := 'If a file is found the computer will ask if you '; info_line2 := 'want to add it to the print buffer for latter '; info_line3 := 'printing this can be usefull if you want to list '; info_line4 := 'only a few files to the printer or disk. '; info_line5 := ' '; info_line6 := ' '; data_box; end; Procedure item48_proc; begin title_line := 'The " BLOCK SEARCH " Menu item'; info_line1 := 'This menu selection functions about the same as '; info_line2 := 'the single search except it does not move the '; info_line3 := 'window and it will continue the search returning '; info_line4 := 'all files that match. '; info_line5 := ' '; info_line6 := ' '; data_box; end; Procedure item49_proc; begin title_line := 'The " FIND PATH " Menu item'; info_line1 := 'This menu selection is probably one of the most '; info_line2 := 'useful funtions in the program. If you have allot '; info_line3 := 'of disks or a hard disk with allot of files you '; info_line4 := 'can use this function to find a particular file. '; info_line5 := 'it will show the file and complete path on the '; info_line6 := 'information bar. IE: disk #25 FOLDER1\FOLDER2\FILE'; data_box; end; Procedure item50_proc; begin title_line := 'The " SORT " Menu item'; info_line1 := 'This menu selection will sort your data base by '; info_line2 := 'any of the six fields ( NAME, DATE, DISK #, FOLDER'; info_line3 := 'TYPE AND COMMENTS ). '; info_line4 := ' CAUTION '; info_line5 := 'A FULL DATA BASE CAN TAKE AS MUCH AS 30 SECONDS TO'; info_line6 := 'SORT. '; data_box; end; Procedure item51_proc; begin title_line := 'The " PRINT ALL " Menu item'; info_line1 := 'This menu selection will allow you to print the '; info_line2 := 'entire data base to the printer or if you prefure '; info_line3 := 'to the disk for use with your favorite word proc. '; info_line4 := ' CAUTION '; info_line5 := ' MAKE SURE YOUR PRINTER IS CONNECTED '; info_line6 := ' '; data_box; end; Procedure item52_proc; begin title_line := 'The " PRINT BUFFER " Menu item'; info_line1 := 'This menu selection will print only the file in '; info_line2 := 'print buffer to your printer or to disk. '; info_line3 := 'As an example if you want to just print all the '; info_line4 := 'files with a ".PRG" extention you would first use '; info_line5 := 'the BLOCK SEARCH function and put all the files in'; info_line6 := 'the print buffer then choose this option. '; data_box; end; Procedure item53_proc; begin title_line := 'The " ERASE BUFFER " Menu item'; info_line1 := 'This menu selection will clear the print buffer. '; info_line2 := ' '; info_line3 := ' '; info_line4 := ' CAUTION '; info_line5 := 'THIS FUNCTION WILL CLEAR THE ENTIRE BUFFER MAKE '; info_line6 := 'SURE YOU HAVE PRINTED THE BUFFER BEFORE CLEARING. '; data_box; end; Procedure item54_proc; begin title_line := 'The " DEFAULT COLORS " Menu item'; info_line1 := 'This menu selection will show the screen in the '; info_line2 := 'default colors that were in memory when you loaded'; info_line3 := 'the program. '; info_line4 := ' '; info_line5 := ' '; info_line6 := ' '; data_box; end; Procedure item55_proc; begin title_line := 'The " INVERSE COLORS " Menu item'; info_line1 := 'This menu selection will invert the colors on the '; info_line2 := 'screen IE: white becomes black and black becomes '; info_line3 := 'white. '; info_line4 := ' NOTE '; info_line5 := 'On a color system black will be blue because it is'; info_line6 := 'easier on the eyes. '; data_box; end; Procedure item56_proc; begin title_line := 'The " STATUS LINE " Menu item'; info_line1 := 'This menu selection will change the information '; info_line2 := 'bar just below the title bar to show the status of'; info_line3 := 'the data base. '; info_line4 := ' '; info_line5 := ' '; info_line6 := ' '; data_box; end; Procedure item57_proc; begin title_line := 'The " LAYOUT LINE " Menu item'; info_line1 := 'This menu selection will change the information '; info_line2 := 'bar located just below the title bar to show the '; info_line3 := 'layout of the screen. '; info_line4 := ' '; info_line5 := ' '; info_line6 := ' '; data_box; end; Procedure item58_proc; begin title_line := 'The " EDIT COMMENT " Menu item'; info_line1 := 'This menu selection will allow you to change the '; info_line2 := 'comment field of any filename in the data base. '; info_line3 := 'Just click on this menu item and a box will appear'; info_line4 := 'on the screen asking for the filename. '; info_line5 := ' CAUTION '; info_line6 := ' THE FILENAME MUST BE AN EXACT MATCH. '; data_box; title_line := 'The " EDIT COMMENT " Menu item cont...'; info_line1 := 'After you have entered the filename click on the '; info_line2 := 'OK button. The comments box will appear on the '; info_line3 := 'screen. The current comment if any will appear on '; info_line4 := 'the editable line on the bottom of the box. If you'; info_line5 := 'want to change the comment just backspace over it '; info_line6 := 'and reenter what you want it to say or you can '; data_box; title_line := 'The " EDIT COMMENT " Menu item cont...'; info_line1 := 'click on any one of the predefined comments. If '; info_line2 := 'you choose not to change the comment just hit '; info_line3 := 'return on the keyboard and the field will be left '; info_line4 := 'unchanged. '; info_line5 := 'NOTE: THIS FUNCTION WILL SEARCH FOR ALL '; info_line6 := ' OCCURENCES OF A FILE. '; data_box; title_line := 'The " EDIT COMMENT " Menu item cont...'; info_line1 := 'Another way to edit a comment field is to double '; info_line2 := 'click the mouse pointer over the filename of your '; info_line3 := 'choice. A dialog box will appear asking if you '; info_line4 := 'like to place the file in the print buffer or edit'; info_line5 := 'the comment field. If you choose comment follow '; info_line6 := 'previous instructions. '; data_box; end; PROCEDURE SAVE_DB; VAR HANDLE,X,Y,Z,Q,F,F1 : INTEGER; NBYTES,ERR : LONG_INTEGER; BUF : BUF_TYPE; FN : STR255; BEGIN IF GET_IN_FILE(PATH_NM,FULL_NAME) THEN BEGIN FN := FULL_NAME; X := 0; Y := 1; WHILE X <= LENGTH(FN) DO BEGIN FULL_NAME[X] := FN[Y]; X := X +1; Y := Y +1; END; FULL_NAME[X] := CHR(0); HANDLE := GEM_CREATE(FULL_NAME,0); NBYTES := 3; BUF[0] := 'D'; BUF[1] := 'I'; BUF[2] := 'R'; ERR := GEM_WRITE(HANDLE,NBYTES,BUF); NBYTES := 2; ERR := GEM_WRITEI(HANDLE,NBYTES,LAST_LINE); ERR := GEM_WRITEI(HANDLE,NBYTES,LAST_DISK); IF TITLE_BAR = FALSE THEN F := 1 ELSE F := 2; IF COLOR_FLAG THEN F1 := 1 ELSE F1 := 2; ERR := GEM_WRITEI(HANDLE,NBYTES,F); ERR := GEM_WRITEI(HANDLE,NBYTES,F1); IF ERR >= 0 THEN BEGIN FOR X := 0 TO LAST_LINE DO BEGIN FOR Q := 0 TO 85 DO BUF[Q] := ' '; Z := 0; FOR Y := 1 TO LENGTH(BLDN[SINDX[X]]) DO BEGIN BUF[Z] := BLDN[SINDX[X],Y]; Z := Z +1; END; Z := 5; FOR Y := 1 TO LENGTH(BLAT[SINDX[X]]) DO BEGIN BUF[Z] := BLAT[SINDX[X],Y]; Z := Z +1; END; Z := 8; FOR Y := 1 TO LENGTH(BLNAME[SINDX[X]]) DO BEGIN BUF[Z] := BLNAME[SINDX[X],Y]; Z := Z +1; END; Z := 23; FOR Y := 1 TO LENGTH(BLDATE[SINDX[X]]) DO BEGIN BUF[Z] := BLDATE[SINDX[X],Y]; Z := Z +1; END; Z := 34; FOR Y := 1 TO LENGTH(BLFOLD[SINDX[X]]) DO BEGIN BUF[Z] := BLFOLD[SINDX[X],Y]; Z := Z +1; END; Z := 49; FOR Y := 1 TO LENGTH(BLCOMM[SINDX[X]]) DO BEGIN BUF[Z] := BLCOMM[SINDX[X],Y]; Z := Z +1; END; NBYTES := 80; ERR := GEM_WRITE(HANDLE,NBYTES,BUF) END; END; GEM_CLOSE(HANDLE); END; END; PROCEDURE QSORT( START,TOP,X : INTEGER ); TYPE STANDARY = ARRAY [0..1000] OF STRING[26]; SUBARY = ARRAY [0..4] OF STRING[26]; VAR sarray : array [0..1000] of string[26]; PROCEDURE XFER(TOP,FIELD : INTEGER); VAR I,X,Y,Z : INTEGER; TEMP : STRING[30]; BEGIN CASE FIELD OF 1: FOR I := 0 TO TOP DO SARRAY[SINDX[I]] := BLDN[SINDX[I]]; 2: FOR I := 0 TO TOP DO SARRAY[SINDX[I]] := BLNAME[SINDX[I]]; 3: FOR I := 0 TO TOP DO BEGIN TEMP[1] := BLDATE[SINDX[I],7]; TEMP[2] := BLDATE[SINDX[I],8]; TEMP[3] := BLDATE[SINDX[I],1]; TEMP[4] := BLDATE[SINDX[I],2]; TEMP[5] := BLDATE[SINDX[I],4]; TEMP[6] := BLDATE[SINDX[I],5]; TEMP[0] := CHR(6); SARRAY[SINDX[I]] := TEMP; END; 4: FOR I := 0 TO TOP DO SARRAY[SINDX[I]] := BLFOLD[SINDX[I]]; 5: FOR I := 0 TO TOP DO SARRAY[SINDX[I]] := BLCOMM[SINDX[I]]; 6: FOR I := 0 TO TOP DO BEGIN X := POS( '.',BLNAME[SINDX[I]] ); IF X = 0 THEN TEMP := ' ' ELSE BEGIN Y := LENGTH( BLNAME[SINDX[I]] ); Z := 1; WHILE X <= Y DO BEGIN TEMP[Z] := BLNAME[SINDX[I],X]; X:= X+1; Z:= Z+1; END; TEMP[0] := CHR(Z - 1); END; SARRAY[SINDX[I]] := TEMP; END; END; END; PROCEDURE SWAP( A,B : INTEGER ); VAR C : INTEGER; BEGIN C := SINDX[A]; SINDX[A] := SINDX[B]; SINDX[B] := C; END; PROCEDURE BSORT(START,TOP:INTEGER; VAR ARRY : STANDARY ); VAR INDEX : INTEGER; SWITCHED : BOOLEAN; BEGIN REPEAT SWITCHED := FALSE; FOR INDEX := START TO TOP -1 DO BEGIN IF ARRY[sindx[INDEX]] > ARRY[sindx[INDEX+1]] THEN BEGIN SWAP(INDEX,INDEX+1); SWITCHED := TRUE; END; END; UNTIL SWITCHED = FALSE; END; PROCEDURE BSORTA(START,TOP:INTEGER; VAR ARRY: SUBARY); VAR INDEX : INTEGER; SWITCHED : BOOLEAN; BEGIN REPEAT SWITCHED := FALSE; FOR INDEX := START TO TOP -1 DO BEGIN IF ARRY[INDEX] > ARRY[INDEX+1] THEN BEGIN SWAP(INDEX,INDEX+1); SWITCHED := TRUE; END; END; UNTIL SWITCHED = FALSE; END; PROCEDURE FINDMED(START,TOP:INTEGER;VAR ARRY: STANDARY ); VAR MIDDLE : INTEGER; SORTED : ARRAY [0..4] OF STRING[26]; BEGIN MIDDLE := (START + TOP) DIV 2; SORTED[1] := ARRY[SINDX[START]]; SORTED[2] := ARRY[SINDX[TOP]]; SORTED[3] := ARRY[SINDX[MIDDLE]]; BSORTA(1,3,SORTED); IF SORTED[3] = ARRY[SINDX[MIDDLE]] THEN SWAP(SINDX[START],SINDX[MIDDLE]) ELSE IF SORTED[2] = ARRY[SINDX[TOP]] THEN SWAP(SINDX[START],SINDX[TOP]); END; PROCEDURE SORTSECTION( START,TOP : INTEGER ); VAR SWAPUP : BOOLEAN; S,E,M : INTEGER; BEGIN IF START- TOP < 20 THEN BSORT(START,TOP,SARRAY) ELSE BEGIN FINDMED(START,TOP,SARRAY); SWAPUP := TRUE; S := START; E := TOP; M := START; WHILE E > S DO BEGIN IF SWAPUP = TRUE THEN BEGIN WHILE (SARRAY[SINDX[E]] >= SARRAY[SINDX[M]]) AND (E>M) DO E := E-1; IF E > M THEN BEGIN SWAP(SINDX[E],SINDX[M]); M := E; END; SWAPUP := FALSE; END ELSE BEGIN WHILE (SARRAY[SINDX[S]] <= SARRAY[SINDX[M]]) AND (S= 14 THEN TL := TL - 14; IF TL > 0 THEN BEGIN ADJ := 1000 / TL; J := CUR_LOC; VSP := ROUND(J * ADJ); WIND_SET(HANDLE,WF_VSLIDE,VSP,DUMMY,DUMMY,DUMMY); END; END; END; PROCEDURE SIZE_WINDOW( HANDLE : INTEGER ); BEGIN SET_WSIZE( HANDLE,LAST_SX,LAST_SY,LAST_SW,LAST_SH ); last_sx := wx; last_sy := wy; last_sw := ww; last_sh := wh; wind_get(handle,wf_prevxywh,wx,wy,ww,wh); WORK_RECT( HANDLE,SX,SY,SW,SH ); VSSIZE( TOTAL_LINES ); VSPOS( CUR_LOC ); END; PROCEDURE MOVE_WINDOW( HANDLE,X,Y,W,H : INTEGER ); BEGIN last_sx := wx; last_sy := wy; last_sw := ww; last_sh := wh; SET_WSIZE( HANDLE, X, Y, W, H ); WORK_RECT( HANDLE,SX,SY,SW,SH ); wind_get(handle,wf_prevxywh,wx,wy,ww,wh); END; PROCEDURE CLOSE_BTN(HANDLE : INTEGER ); VAR ALERT23 :STR255; BEGIN ALERT23 := '[2][ARE YOU SURE YOU WANT TO QUIT ?][ NO | YES ]'; FLAG1 := DO_ALERT(ALERT23,1); END; PROCEDURE SET_TITLE_BAR( X : INTEGER ); VAR Y : INTEGER; STR1,STR2,STR3,STR4,STR5,STR6 : STR255; BEGIN CASE X OF 1: BEGIN WItitle := ' D# |F |FILENAME |DATE |FOLDER |COMMENTS.... '; Set_WInfo(Handle,WItitle); MENU_CHECK(MENU,LAYOUT_ITEM,TRUE); MENU_CHECK(MENU,STAT_ITEM,FALSE); TITLE_BAR := FALSE; END; 2: BEGIN STR(LAST_LINE ,TOTL); Y := 1000 - LAST_LINE; STR(Y,LEFT); STR1 := 'TOTAL FILES > '; STR2 := ' |CURENT LINE > '; STR5 := ' |FREE SPACE > '; STR3 := ' |LAST DISK # > '; STR(LAST_DISK,STR6); STR(CUR_LOC,STR4); WITITLE := CONCAT(STR1,TOTL,STR2,STR4,STR3,STR6,STR5,LEFT); Set_WInfo(Handle,WItitle); MENU_CHECK(MENU,LAYOUT_ITEM,FALSE); MENU_CHECK(MENU,STAT_ITEM,TRUE); TITLE_BAR := TRUE; END; END; END; PROCEDURE PRNT_SCR; VAR N,MAX,LP,ADJ,ch1,cnt : INTEGER; BEGIN hide_mouse; ch1 := BH; MAX := SH DIV BH ; ADJ := SY + CH1 - 2; paint_rect(sx-1,sy-4,sw+1,sh+4); cnt := cur_loc; FOR N := 0 TO MAX DO BEGIN LP := (CH1 * N) + ADJ ; DRAW_STRING(SX,LP,BLdn[SINDX[cnt]]) ; DRAW_STRING(SX+(5*CW),LP,BLAT[SINDX[cnt]]) ; DRAW_STRING(SX+(8*cw),LP,BLname[SINDX[cnt]]) ; DRAW_STRING(SX+(22*cw),LP,BLdate[SINDX[cnt]]) ; DRAW_STRING(SX+(32*cw),LP,BLfold[SINDX[cnt]]) ; DRAW_STRING(SX+(48*cw),LP,BLcomm[SINDX[cnt]]) ; cnt := cnt + 1; END; IF TITLE_BAR = FALSE THEN SET_TITLE_BAR(1); IF TITLE_BAR = TRUE THEN SET_TITLE_BAR(2); show_mouse; END; PROCEDURE ADD_COM_BOX ; VAR PSA,PSB,PSC : STR255; begin PSA := '_________________________'; PSB := 'XXXXXXXXXXXXXXXXXXXXXXXXX'; PSC := ''; ACB := NEW_DIALOG(21,0,0,45,19); ACB_PROMT1 := ADD_DITEM(ACB,G_STRING,NONE,5,1,0,0,0,0); SET_DTEXT(ACB,ACB_PROMT1,'FILENAME:',SYSTEM_FONT,TE_LEFT); ACB_PROMT := ADD_DITEM(ACB,G_STRING,NONE,20,1,0,0,0,0); SET_DTEXT(ACB,ACB_PROMT,'--------------',SYSTEM_FONT,TE_LEFT); ACB_PROMT2 := ADD_DITEM(ACB,G_STRING,NONE,5,3,0,0,0,0); SET_DTEXT(ACB,ACB_PROMT2,'Choose a Comment :',SYSTEM_FONT,TE_LEFT); ACB_BOX1 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,5,5,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX1,'GAME/ENT',SYSTEM_FONT,TE_CENTER); ACB_BOX2 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,17,5,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX2,'ART/VID ',SYSTEM_FONT,TE_CENTER); ACB_BOX21 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,29,5,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX21,'DEMO',SYSTEM_FONT,TE_CENTER); ACB_BOX3 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,5,7,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX3,'UTILITY ',SYSTEM_FONT,TE_CENTER); ACB_BOX4 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,17,7,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX4,'TELECOM ',SYSTEM_FONT,TE_CENTER); ACB_BOX41 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,29,7,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX41,'DATA',SYSTEM_FONT,TE_CENTER); ACB_BOX5 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,5,9,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX5,'LANGUAGE',SYSTEM_FONT,TE_CENTER); ACB_BOX6 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,17,9,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX6,'DOCUMENT',SYSTEM_FONT,TE_CENTER); ACB_BOX61 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,29,9,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX61,'DESK ACC',SYSTEM_FONT,TE_CENTER); ACB_BOX7 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,5,11,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX7,'BUSINESS',SYSTEM_FONT,TE_CENTER); ACB_BOX8 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,17,11,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX8,'FOLDER',SYSTEM_FONT,TE_CENTER); ACB_BOX81 := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,29,11,10,1,-1,$1180); SET_DTEXT(ACB,ACB_BOX81,'NONE',SYSTEM_FONT,TE_CENTER); ACB_PROMT3 := ADD_DITEM(ACB,G_STRING,NONE,5,13,0,0,0,0); SET_DTEXT(ACB,ACB_PROMT3,'or enter your own :',SYSTEM_FONT,TE_LEFT); ACB_GET := ADD_DITEM(ACB,G_FTEXT,DEFAULT,5,15,25,1,0,$1180); SET_DEDIT(ACB,ACB_GET,PSA,PSB,SHW_BOX_STR,SYSTEM_FONT,TE_CENTER); ACB_CANCEL := ADD_DITEM(ACB,G_BUTTON,SELECTABLE|EXIT_BTN,5,17,35,1,-1,$1180); SET_DTEXT(ACB,ACB_CANCEL,'-------CANCEL--------',SYSTEM_FONT,TE_CENTER); END; FUNCTION SHOW_COM_BOX( NAME : STR255 ): BOOLEAN; BEGIN ADD_COM_BOX; SET_DTEXT(ACB,ACB_PROMT,NAME,SYSTEM_FONT,TE_LEFT); CENTER_DIALOG(ACB); DUMMY := DO_DIALOG(ACB,ACB_GET); GET_DEDIT(ACB,ACB_GET,SHW_BOX_STR); IF OBJ_STATE(ACB,ACB_GET) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_GET,NONE,TRUE); SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX1) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX1,NONE,TRUE); SHW_BOX_STR := 'GAMES AND ENTERTAINMENT'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX2) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX2,NONE,TRUE); SHW_BOX_STR := 'ART / VIDEO'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX21) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX21,NONE,TRUE); SHW_BOX_STR := 'DEMONSTRATION PROGRAM'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX3) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX3,NONE,TRUE); SHW_BOX_STR := 'UTILITY PROGRAM'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX4) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX4,NONE,TRUE); SHW_BOX_STR := 'TELECOM PROGRAM'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX41) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX41,NONE,TRUE); SHW_BOX_STR := 'DATA FILE'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX5) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX5,NONE,TRUE); SHW_BOX_STR := 'PROGRAMMING LANGUAGE'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX6) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX6,NONE,TRUE); SHW_BOX_STR := 'DOCUMENT FILE'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX61) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX61,NONE,TRUE); SHW_BOX_STR := 'DESK ACCESSORY PROGRAM'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX7) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX7,NONE,TRUE); SHW_BOX_STR := 'BUSINESS APPLICATION'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX8) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX8,NONE,TRUE); SHW_BOX_STR := 'SYSTEM FOLDER'; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_BOX81) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_BOX81,NONE,TRUE); SHW_BOX_STR := ' '; SHOW_COM_BOX := TRUE; END; IF OBJ_STATE(ACB,ACB_CANCEL) & SELECTED <> 0 THEN BEGIN OBJ_SETSTATE(ACB,ACB_CANCEL,NONE,TRUE); SHOW_COM_BOX := FALSE; END; UPERCASE(SHW_BOX_STR); END_DIALOG(ACB); DELETE_DIALOG(ACB); END; PROCEDURE ADDCOM; VAR X : INTEGER; FLAG,Y : BOOLEAN; BEGIN IF COM_FLAG THEN BEGIN SHW_BOX_STR := ''; FLAG := TRUE; X := CUR_LOC; REPEAT Y := SHOW_COM_BOX(BLNAME[X]); IF Y = TRUE THEN BEGIN BLCOMM[X] := SHW_BOX_STR; END ELSE FLAG := FALSE; X := X + 1; IF X = LAST_LINE THEN FLAG := FALSE; UNTIL FLAG = FALSE; SET_CLIP(SX,SY,SW,SH); PRNT_SCR; END; END; PROCEDURE SEARCH(X : INTEGER); VAR Y,Z :INTEGER; BEGIN IF LAST_LINE >= 2 THEN BEGIN Y:= CUR_LOC +1; SEARCH_FLAG := FALSE; CASE X OF 1: BEGIN REPEAT Z := POS(SHW_BOX_STR,BLNAME[SINDX[Y]]); IF Z <> 0 THEN BEGIN CUR_LOC := Y; Y := LAST_LINE; SEARCH_FLAG := TRUE; END ELSE BEGIN Y := Y + 1; IF Y > LAST_LINE THEN Y := LAST_LINE; END; UNTIL Y = LAST_LINE; END; 2: BEGIN REPEAT Z := POS(SHW_BOX_STR,BLNAME[SINDX[Y]]); IF Z <> 0 THEN BEGIN CUR_LOC := Y; Y := LAST_LINE; SEARCH_FLAG := TRUE; END ELSE BEGIN Y := Y + 1; IF Y > LAST_LINE THEN Y := LAST_LINE; END; UNTIL Y = LAST_LINE; END; 3: BEGIN INSERT('/',SHW_BOX_STR,3); INSERT('/',SHW_BOX_STR,6); REPEAT Z := POS(SHW_BOX_STR,BLDATE[SINDX[Y]]); IF Z <> 0 THEN BEGIN CUR_LOC := Y; Y := LAST_LINE; SEARCH_FLAG := TRUE; END ELSE BEGIN Y := Y + 1; IF Y > LAST_LINE THEN Y := LAST_LINE; END; UNTIL Y = LAST_LINE; END; 4: BEGIN REPEAT Z := POS(SHW_BOX_STR,BLDN[SINDX[Y]]); IF Z <> 0 THEN BEGIN CUR_LOC := Y; Y := LAST_LINE; SEARCH_FLAG := TRUE; END ELSE BEGIN Y := Y + 1; IF Y > LAST_LINE THEN Y := LAST_LINE; END; UNTIL Y = LAST_LINE; END; 5: BEGIN REPEAT Z := POS(SHW_BOX_STR,BLFOLD[SINDX[Y]]); IF Z <> 0 THEN BEGIN CUR_LOC := Y; Y := LAST_LINE; SEARCH_FLAG := TRUE; END ELSE BEGIN Y := Y + 1; IF Y > LAST_LINE THEN Y := LAST_LINE; END; UNTIL Y = LAST_LINE; END; 6: BEGIN REPEAT Z := POS(SHW_BOX_STR,BLCOMM[SINDX[Y]]); IF Z <> 0 THEN BEGIN CUR_LOC := Y; Y := LAST_LINE; SEARCH_FLAG := TRUE; END ELSE BEGIN Y := Y + 1; IF Y > LAST_LINE THEN Y := LAST_LINE; END; UNTIL Y = LAST_LINE; END; END; END; END; PROCEDURE PUT_IN_BUF( DNSTR,ATMRK,NAMES,DATESTR,FOLDER : STR255); BEGIN TEMP_BLdn[COUNT] := DNSTR; TEMP_BLAT[COUNT] := ATMRK; TEMP_BLname[COUNT] := names; TEMP_BLdate[COUNT] := DATESTR; IF FOLDER = '' THEN TEMP_BLfold[COUNT] := '--------------' ELSE TEMP_BLFOLD[COUNT] := FOLDER; COUNT := COUNT +1; END; PROCEDURE XFER_CHECK; VAR X,Z : INTEGER; BEGIN IF (LINE_COUNT + COUNT) <= 1000 THEN BEGIN ADD_FLAG := TRUE; CUR_LOC := LINE_COUNT; FOR X:= 0 TO COUNT -1 DO BEGIN BLDN[LINE_COUNT] := TEMP_BLDN[X]; BLAT[LINE_COUNT] := TEMP_BLAT[X]; BLNAME[LINE_COUNT] := TEMP_BLNAME[X]; BLDATE[LINE_COUNT] := TEMP_BLDATE[X]; BLFOLD[LINE_COUNT] := TEMP_BLFOLD[X]; LINE_COUNT := LINE_COUNT +1; END; TOTAL_LINES := LINE_COUNT; LAST_LINE := LINE_COUNT; END ELSE BEGIN Z := DO_ALERT('[3][THIS DISK EXCEEDS|THE 1000 FILE LIMIT][ ABORT ]',1); ADD_FLAG := FALSE; END; END; FUNCTION COMPARE(X,Y,Z : INTEGER) : BOOLEAN; BEGIN COMPARE := FALSE; CASE Z OF 1: IF TEMP_BLDN[X] = BLDN[Y] THEN COMPARE := TRUE; 2: IF TEMP_BLAT[X] = BLAT[Y] THEN COMPARE := TRUE; 3: IF TEMP_BLNAME[X] = BLNAME[Y] THEN COMPARE := TRUE; 4: IF TEMP_BLDATE[X] = BLDATE[Y] THEN COMPARE := TRUE; 5: IF TEMP_BLFOLD[X] = BLFOLD[Y] THEN COMPARE := TRUE; END; END; PROCEDURE DEL_FILE( Y : INTEGER ); VAR X,Z : INTEGER; BEGIN FOR X := Y TO LAST_LINE DO BEGIN BLDN[X] := BLDN[X +1]; BLAT[X] := BLAT[X +1]; BLNAME[X] := BLNAME[X +1]; BLDATE[X] := BLDATE[X +1]; BLFOLD[X] := BLFOLD[X +1]; BLCOMM[X] := BLCOMM[X +1]; END; LINE_COUNT := LINE_COUNT -1; END; PROCEDURE COMP_FILES; VAR C,FLAG : BOOLEAN; Y,X : INTEGER; BEGIN X := 0; Y := 0; C := FALSE; FLAG := TRUE; FOR Y := 0 TO LAST_LINE DO BEGIN REPEAT C := COMPARE(X,Y,1); IF C = TRUE THEN BEGIN DEL_FILE(Y); FLAG := FALSE; END; UNTIL C = FALSE; END; IF FLAG THEN LAST_DISK := LAST_DISK + 1; END; PROCEDURE G_DIR; TYPE fn_range = 1..14 ; fnd_range = 1..255; fname = PACKED ARRAY [ fn_range ] OF char ; frec = PACKED RECORD reserved : PACKED ARRAY [ 0..19 ] OF byte ; resvd2 : byte ; attrib : byte ; time_stamp : integer ; date_stamp : integer ; size : long_integer ; name : fname ; END ; PATH_NAME = PACKED ARRAY [1..255] OF CHAR; VAR r : frec ; i : fnd_range; names,QUT : string[14]; file_map : array [0..80]of array [0..20] of string[14]; attrib_map : array [0..80]of array [0..20] of byte; map_point : array [0..20] of integer; depth,index,x,y,LINDEX : integer; path : path_name ; FN_FLAG : ARRAY[0..20] OF BOOLEAN; LAST_FN : ARRAY[0..20] OF STRING [14]; INBUF : STRING; PROCEDURE set_dta( VAR buf : frec ) ; GEMDOS( $1a ) ; FUNCTION get_first( VAR path : path_name ; search_attrib :integer ):integer ; GEMDOS( $4e ) ; FUNCTION get_next : integer ; GEMDOS( $4f ) ; PROCEDURE EXT_RTN; BEGIN IF ( index <> 0 ) AND ( depth <> 0 ) then begin depth := depth - 1; end; END; PROCEDURE ADD_TO_PATH; VAR PTH : STRING; PTH1 : CHAR; I,X : INTEGER; BEGIN PTH1 := '\'; X := POS('*',PATH_STRING); INSERT(pth1,path_string,X); INSERT(FILE_MAP[INDEX,DEPTH],path_string,X ); FOR i := 1 TO length( path_string ) DO path[i] := path_string[i] ; path[ length(path_string) + 1] := CHR(0); LINDEX := LINDEX + 1; FN_FLAG[LINDEX] := TRUE; LAST_FN[LINDEX] := FILE_MAP[INDEX,DEPTH]; END; PROCEDURE DEL_FROM_PATH; VAR PTH : STRING; I,X : INTEGER; BEGIN IF FN_FLAG[LINDEX] THEN BEGIN X := POS('*',PATH_STRING); Y := X - (LENGTH(LAST_FN[LINDEX])+1); DELETE(path_string,Y,LENGTH(LAST_FN[LINDEX]) + 1); FOR i := 1 TO length( path_string ) DO path[i] := PATH_STRING[i] ; path[ length( path_string ) + 1] := CHR(0); FN_FLAG[LINDEX] := FALSE; LAST_FN[LINDEX] := ''; LINDEX := LINDEX - 1; END; END; PROCEDURE HNDL_FILE( VAR r : frec ); VAR I,DATE,DATEM,DATED,DATEY,A,B : INTEGER; names,ATMRK : str255; DATESTR,DM,DD,DY,FOLDER :STR255; BEGIN names := ''; A := 32; B := 512; WITH r DO begin i := 1; while ( i <= 14 ) AND ( name[i] <> CHR(0)) DO begin names[i] := name[i]; i := i + 1; end; names[0] := CHR(i-1); DATE := DATE_STAMP; DATEM := DATE; DATED := DATE; DATEY := DATE; IF (NAMEs <> '.') AND (NAMEs <> '..') THEN BEGIN ATTRIB_MAP[index,DEPTH] := ATTRIB; FILE_MAP[INDEX,DEPTH] := NAMES; i := 1; IF ATTRIB = $10 THEN ATMRK := '* ' ELSE ATMRK := ' '; DATEM := DATE & $1E0; DATEM := SHR(DATEM,5); DATEY := DATE & $FE00; DATEY := SHR(DATEY,9); DATED := DATE & $1F; DATEY := DATEY+80; STR(DATEM,DM); STR(DATEY,DY); STR(DATED,DD); A:= LENGTH(DD); B:= LENGTH(DM); IF A = 1 THEN INSERT('0',DD,1); IF B = 1 THEN INSERT('0',DM,1); DATESTR := CONCAT(DM,'/',DD,'/',DY); FOLDER := LAST_FN[LINDEX]; PUT_IN_BUF(dnstr,atmrk,names,datestr,FOLDER); INDEX := INDEX + 1; end; end; end; PROCEDURE GF_LOOP; FORWARD; PROCEDURE GET_FILES; BEGIN WHILE ( INDEX <> 0) OR (DEPTH <> 0) DO BEGIN IF GET_FIRST( PATH,$10 ) < 0 THEN EXT_RTN ELSE REPEAT HNDL_FILE( r ); UNTIL GET_NEXT < 0; INDEX := INDEX - 1; GF_LOOP; END; END; PROCEDURE GF_LOOP; BEGIN WHILE ( INDEX <> 0) OR ( DEPTH <> 0) DO BEGIN IF ATTRIB_MAP[INDEX,DEPTH] = $10 THEN BEGIN MAP_POINT[DEPTH] := INDEX; ADD_TO_PATH; DEPTH := DEPTH + 1; INDEX := 1; GET_FILES; END ELSE BEGIN INDEX := INDEX - 1; IF INDEX > 0 THEN GF_LOOP else begin depth := depth - 1; index := map_point[depth]; del_from_path; index := index - 1; gf_loop; end; end; end; END; BEGIN FOR i := 1 TO length( path_string ) DO path[i] := path_string[i] ; path[ length(path_string)+1 ] := chr(0) ; for x := 0 to 80 do BEGIN for y := 0 to 20 do begin file_map[x,y] := ''; attrib_map[x,y] := 0; end end; FOR X := 0 TO 20 DO BEGIN LAST_FN[X] := ''; FN_FLAG[X] := FALSE; END; LINDEX := 0; depth := 1; index := 1; LINE_COUNT := LAST_LINE; COUNT := 0; for x := 0 to 20 do begin map_point[x] := 1; end; ADD_FLAG := FALSE; set_dta( r ) ; get_files; IF COUNT <> 0 THEN BEGIN COMP_FILES; XFER_CHECK; END; END; PROCEDURE DO_REDRAW( MX, MY, MW, MH : INTEGER ) ; VAR RX,RY,RW,RH : INTEGER ; BEGIN Hide_Mouse; BEGIN_UPDATE; First_Rect( handle,RX,RY,RW,RH ) ; WHILE (RW <> 0) AND (RH <> 0) DO BEGIN IF RECT_INTERSECT( MX,MY,MW,MH,RX,RY,RW,RH ) THEN BEGIN SET_CLIP(RX,RY,RW,RH); PRNT_SCR; END; NEXT_RECT( handle,RX,RY,RW,RH ); END; END_UPDATE; Show_Mouse; END; PROCEDURE COM_CHECK; BEGIN IF COM_FLAG = TRUE THEN MENU_CHECK(MENU,COM_ITEM,FALSE) ELSE MENU_CHECK(MENU,COM_ITEM,TRUE); IF COM_FLAG THEN COM_FLAG := FALSE ELSE COM_FLAG := TRUE ; END; PROCEDURE Dialog_BOX( x : INTEGER ) ; VAR Promt_str,PSa,PSb,PSc : ARRAY [1..6] OF str255 ; BEGIN Promt_str[1] := 'Please Enter NAME :'; PSa[1] := '____________'; PSb[1] := 'XXXXXXXXXXXX'; PSc[1] := ''; Promt_str[2] := 'Please Enter TYPE :'; PSa[2] := 'FILE.___'; PSb[2] := 'FFF'; PSc[2] := ''; Promt_str[3] := 'Please Enter DATE :'; PSa[3] := '__/__/__'; PSb[3] := '999999'; PSc[3] := '031786'; Promt_str[4] := 'Please Enter DISK # :'; PSa[4] := 'DISK NUMBER : ____'; PSb[4] := '9999'; PSc[4] := '0001'; Promt_str[5] := 'Please Enter NAME :'; PSa[5] := '____________'; PSb[5] := 'XXXXXXXXXXXX'; PSc[5] := ''; Promt_str[6] := 'Please Enter COMMENTS :'; PSa[6] := '_________________________'; PSb[6] := 'XXXXXXXXXXXXXXXXXXXXXXXXX'; PSc[6] := ''; dialog[x] := New_Dialog( 4, 0, 0, 30, 8 ) ; prompt_item[x] := Add_DItem( dialog[x], G_String, None, 2, 1, 0, 0, 0, 0 ) ; Set_DText( dialog[x], prompt_item[x], Promt_str[x] , System_Font, TE_Left ) ; GET_item[x] := Add_DItem( dialog[x], G_FText, None, 2, 3, 25, 1, 0, $1180 ); Set_DEdit( dialog[x], GET_item[x], PSa[x], PSb[x], PSc[x], System_Font, TE_Center ) ; ok_btn[x] := Add_DItem( dialog[x], G_Button, Selectable|Exit_Btn|Default, 2, 5, 8, 2, 2, $1180 ) ; Set_DText( dialog[x], ok_btn[x], 'OK', System_Font, TE_Center ) ; cancel_btn[x] := Add_DItem( dialog[x], G_Button, Selectable|Exit_Btn, 16, 5, 8, 2, 2, $1180 ) ; Set_DText( dialog[x], cancel_btn[x], 'Cancel', System_Font, TE_Center ) ; END ; PROCEDURE Show_TYPE_box( X : INTEGER ) ; BEGIN Center_Dialog(dialog[X]); button[X] := Do_Dialog(dialog[X],get_item[X]); IF Obj_State(dialog[X],ok_btn[X]) & selected <>0 THEN BEGIN Obj_Setstate(dialog[X],ok_btn[X],none,true); cancel_box := false; END; IF Obj_State(dialog[X],cancel_btn[X]) & selected <>0 THEN BEGIN Obj_Setstate(dialog[X],cancel_btn[X],none,true); cancel_box := true; END; End_dialog(dialog[X]); GET_DEDIT(DIALOG[X],GET_ITEM[X],SHW_BOX_STR); upercase(shw_box_str); END; Procedure item60_proc; var x : integer; str1 : str255; test,t : boolean; begin if last_line >= 1 then begin show_type_box(1); if cancel_box = false then begin str1 := shw_box_str; x := 0; test := false; repeat if blname[x] = str1 then begin shw_box_str := blcomm[x]; t := show_com_box(blname[x]); blcomm[x] := shw_box_str; test := true; end; x := x + 1; until x = last_line; if not test then dummy := do_alert('[1][File NOT found][ OK ]',1) else begin SET_CLIP(SX,SY,SW,SH); PRNT_SCR; end; end; end; end; PROCEDURE set_add_box; BEGIN Add_Box := New_Dialog(25,0,0,32,17); txt_line := Add_DItem(Add_Box,G_text,none,2,2,28,1,0,$1180); Set_DText(Add_Box,txt_line,'Chose Drive!',System_Font,TE_Center); Btn_a := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 3,4,5,1,1,$1180); Set_DText(Add_box,Btn_a,'A:',System_Font,TE_Center); Btn_b := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 10,4,5,1,1,$1180); Set_DText(Add_box,Btn_b,'B:',System_Font,TE_Center); Btn_c := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 17,4,5,1,1,$1180); Set_DText(Add_box,Btn_c,'C:',System_Font,TE_Center); Btn_d := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 24,4,5,1,1,$1180); Set_DText(Add_box,Btn_d,'D:',System_Font,TE_Center); Btn_e := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 3,6,5,1,1,$1180); Set_DText(Add_box,Btn_e,'E:',System_Font,TE_Center); Btn_f := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 10,6,5,1,1,$1180); Set_DText(Add_box,Btn_f,'F:',System_Font,TE_Center); Btn_g := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 17,6,5,1,1,$1180); Set_DText(Add_box,Btn_g,'G:',System_Font,TE_Center); Btn_h := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 24,6,5,1,1,$1180); Set_DText(Add_box,Btn_h,'H:',System_Font,TE_Center); Btn_i := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 3,8,5,1,1,$1180); Set_DText(Add_box,Btn_i,'I:',System_Font,TE_Center); Btn_j := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 10,8,5,1,1,$1180); Set_DText(Add_box,Btn_j,'J:',System_Font,TE_Center); Btn_k := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 17,8,5,1,1,$1180); Set_DText(Add_box,Btn_k,'K:',System_Font,TE_Center); Btn_l := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 24,8,5,1,1,$1180); Set_DText(Add_box,Btn_l,'L:',System_Font,TE_Center); Btn_m := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 3,10,5,1,1,$1180); Set_DText(Add_box,Btn_m,'M:',System_Font,TE_Center); Btn_n := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 10,10,5,1,1,$1180); Set_DText(Add_box,Btn_n,'N:',System_Font,TE_Center); Btn_o := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 17,10,5,1,1,$1180); Set_DText(Add_box,Btn_o,'O:',System_Font,TE_Center); Btn_p := Add_DItem(Add_Box,G_button,Selectable|radio_btn, 24,10,5,1,1,$1180); Set_DText(Add_box,Btn_p,'P:',System_Font,TE_Center); p_name := Add_DItem( add_box, G_FText, None, 3, 12, 18, 1, 0, $1180 ); Set_DEdit( add_box, p_name,'Path:_______________','PPPPPPPPPPPPPP', '\*.*', System_Font, TE_Center ) ; ok := Add_DItem( Add_box, G_Button, Selectable|Exit_Btn|Default, 3, 14, 8, 2, 1, $1180 ) ; Set_DText( Add_Box, ok, 'OK', System_Font, TE_Center ) ; cancel := Add_DItem( Add_Box, G_Button, Selectable|Exit_Btn, 21, 14, 8, 2, 1, $1180 ) ; Set_DText( Add_Box, cancel, 'Cancel', System_Font, TE_Center ) ; if adrive then obj_setstate(add_box,btn_a,shadowed|selected,false) else obj_setstate(add_box,btn_a,disabled,false); if bdrive then obj_setstate(add_box,btn_b,shadowed,false) else obj_setstate(add_box,btn_b,disabled,false); if cdrive then obj_setstate(add_box,btn_c,shadowed,false) else obj_setstate(add_box,btn_c,disabled,false); if ddrive then obj_setstate(add_box,btn_d,shadowed,false) else obj_setstate(add_box,btn_d,disabled,false); if edrive then obj_setstate(add_box,btn_e,shadowed,false) else obj_setstate(add_box,btn_e,disabled,false); if fdrive then obj_setstate(add_box,btn_f,shadowed,false) else obj_setstate(add_box,btn_f,disabled,false); if gdrive then obj_setstate(add_box,btn_g,shadowed,false) else obj_setstate(add_box,btn_g,disabled,false); if hdrive then obj_setstate(add_box,btn_h,shadowed,false) else obj_setstate(add_box,btn_h,disabled,false); if idrive then obj_setstate(add_box,btn_i,shadowed,false) else obj_setstate(add_box,btn_i,disabled,false); if jdrive then obj_setstate(add_box,btn_j,shadowed,false) else obj_setstate(add_box,btn_j,disabled,false); if kdrive then obj_setstate(add_box,btn_k,shadowed,false) else obj_setstate(add_box,btn_k,disabled,false); if ldrive then obj_setstate(add_box,btn_l,shadowed,false) else obj_setstate(add_box,btn_l,disabled,false); if mdrive then obj_setstate(add_box,btn_m,shadowed,false) else obj_setstate(add_box,btn_m,disabled,false); if ndrive then obj_setstate(add_box,btn_n,shadowed,false) else obj_setstate(add_box,btn_n,disabled,false); if odrive then obj_setstate(add_box,btn_o,shadowed,false) else obj_setstate(add_box,btn_o,disabled,false); if pdrive then obj_setstate(add_box,btn_p,shadowed,false) else obj_setstate(add_box,btn_p,disabled,false); obj_setstate(add_box,ok,outlined,false); if adrive then obj_setstate(add_box,cancel,outlined,false); END; PROCEDURE Add_Dir; VAR Button1 : INTEGER; str1,str2 : string[255]; BEGIN Center_Dialog(Add_Box); button1 := Do_Dialog(Add_Box,p_name); IF Obj_State(Add_Box,ok) & selected <>0 THEN BEGIN Obj_Setstate(Add_Box,ok,outlined,true); ADD_FLAG := TRUE; END; IF Obj_State(Add_Box,cancel) & selected <>0 THEN BEGIN Obj_Setstate(Add_Box,cancel,outlined,true); ADD_FLAG := FALSE; END; End_dialog(Add_Box); STR1 := 'A:'; IF OBJ_STATE(ADD_BOX,BTN_A) & SELECTED <> 0 THEN STR1 := 'A:'; IF OBJ_STATE(ADD_BOX,BTN_B) & SELECTED <> 0 THEN STR1 := 'B:'; IF OBJ_STATE(ADD_BOX,BTN_C) & SELECTED <> 0 THEN STR1 := 'C:'; IF OBJ_STATE(ADD_BOX,BTN_D) & SELECTED <> 0 THEN STR1 := 'D:'; IF OBJ_STATE(ADD_BOX,BTN_E) & SELECTED <> 0 THEN STR1 := 'E:'; IF OBJ_STATE(ADD_BOX,BTN_F) & SELECTED <> 0 THEN STR1 := 'F:'; IF OBJ_STATE(ADD_BOX,BTN_G) & SELECTED <> 0 THEN STR1 := 'G:'; IF OBJ_STATE(ADD_BOX,BTN_H) & SELECTED <> 0 THEN STR1 := 'H:'; IF OBJ_STATE(ADD_BOX,BTN_I) & SELECTED <> 0 THEN STR1 := 'I:'; IF OBJ_STATE(ADD_BOX,BTN_J) & SELECTED <> 0 THEN STR1 := 'J:'; IF OBJ_STATE(ADD_BOX,BTN_K) & SELECTED <> 0 THEN STR1 := 'K:'; IF OBJ_STATE(ADD_BOX,BTN_L) & SELECTED <> 0 THEN STR1 := 'L:'; IF OBJ_STATE(ADD_BOX,BTN_M) & SELECTED <> 0 THEN STR1 := 'M:'; IF OBJ_STATE(ADD_BOX,BTN_N) & SELECTED <> 0 THEN STR1 := 'N:'; IF OBJ_STATE(ADD_BOX,BTN_O) & SELECTED <> 0 THEN STR1 := 'O:'; IF OBJ_STATE(ADD_BOX,BTN_P) & SELECTED <> 0 THEN STR1 := 'P:'; GET_DEDIT(ADD_BOX,P_NAME,STR2); PATH_STRING := CONCAT(STR1,STR2); END; PROCEDURE SET_SORT_BOX; BEGIN Sort_Box := New_Dialog(22,0,0,26,14); txtln := Add_DItem(Sort_Box,G_text,none,2,1,10,1,0,$1180); Set_DText(Sort_Box,txtln,'Chose a ',System_Font,TE_Center); txtln1 := Add_DItem(Sort_Box,G_text,none,2,2,10,1,0,$1180); Set_DText(Sort_Box,txtln1,'FIELD to',System_Font,TE_Center); txtln2 := Add_DItem(Sort_Box,G_text,none,2,3,10,1,0,$1180); Set_DText(Sort_Box,txtln2,'Sort on.',System_Font,TE_Center); Btn_na := Add_DItem(Sort_Box,G_button,Selectable|radio_btn, 14,1,10,1,1,$1180); Set_DText(Sort_box,Btn_na,'NAME',System_Font,TE_Center); Btn_ty := Add_DItem(Sort_Box,G_button,Selectable|radio_btn, 14,3,10,1,1,$1180); Set_DText(Sort_box,Btn_ty,'TYPE',System_Font,TE_Center); Btn_da := Add_DItem(Sort_Box,G_button,Selectable|radio_btn, 14,5,10,1,1,$1180); Set_DText(Sort_box,Btn_da,'DATE',System_Font,TE_Center); Btn_di := Add_DItem(Sort_Box,G_button,Selectable|radio_btn, 14,7,10,1,1,$1180); Set_DText(Sort_box,Btn_di,'DISK #',System_Font,TE_Center); Btn_fo := Add_DItem(Sort_Box,G_button,Selectable|radio_btn, 14,9,10,1,1,$1180); Set_DText(Sort_box,Btn_fo,'FOLDER',System_Font,TE_Center); Btn_co := Add_DItem(Sort_Box,G_button,Selectable|radio_btn, 14,11,10,1,1,$1180); Set_DText(Sort_box,Btn_co,'COMMENTS',System_Font,TE_Center); ok1 := Add_DItem( Sort_box, G_Button, Selectable|Exit_Btn|Default, 2,6, 8, 2, 1, $1180 ) ; Set_DText( Sort_Box, ok1, 'OK', System_Font, TE_Center ) ; cancel1 := Add_DItem( Sort_Box, G_Button, Selectable|Exit_Btn, 2,10, 8, 2, 1, $1180 ) ; Set_DText( Sort_Box, cancel1, 'Cancel', System_Font, TE_Center ) ; obj_setstate(Sort_box,btn_na,shadowed|selected,false); obj_setstate(Sort_box,btn_ty,shadowed,false); obj_setstate(Sort_box,btn_da,shadowed,false); obj_setstate(Sort_box,btn_di,shadowed,false); obj_setstate(Sort_box,btn_fo,shadowed,false); obj_setstate(Sort_box,btn_co,shadowed,false); END; PROCEDURE Sort_type; VAR Button1,DUMMY : INTEGER; BEGIN dummy := 0; Center_Dialog(Sort_Box); button1 := Do_Dialog(Sort_Box,DUMMY); IF Obj_State(Sort_Box,ok1) & selected <>0 THEN BEGIN Obj_Setstate(Sort_Box,ok1,none,true); cancel_box := false; END; IF Obj_State(Sort_Box,cancel1) & selected <>0 THEN BEGIN Obj_Setstate(Sort_Box,cancel1,none,true); cancel_box := true; END; End_dialog(Sort_Box); if cancel_box = false then begin SET_WINFO(HANDLE,WSTITLE); IF OBJ_STATE(SORT_BOX,BTN_NA) & SELECTED <> 0 THEN QSORT(0,LAST_LINE -1,2); IF OBJ_STATE(SORT_BOX,BTN_DA) & SELECTED <> 0 THEN QSORT(0,LAST_LINE -1,3); IF OBJ_STATE(SORT_BOX,BTN_DI) & SELECTED <> 0 THEN QSORT(0,LAST_LINE -1,1); IF OBJ_STATE(SORT_BOX,BTN_FO) & SELECTED <> 0 THEN QSORT(0,LAST_LINE -1,4); IF OBJ_STATE(SORT_BOX,BTN_CO) & SELECTED <> 0 THEN QSORT(0,LAST_LINE -1,5); IF OBJ_STATE(SORT_BOX,BTN_TY) & SELECTED <> 0 THEN QSORT(0,LAST_LINE -1,6); IF TITLE_BAR = FALSE THEN SET_TITLE_BAR(1); IF TITLE_BAR = TRUE THEN SET_TITLE_BAR(2); end; END; FUNCTION CHOOSE_BOX : INTEGER; VAR Button1,DUMMY : INTEGER; BEGIN dummy := 0; Center_Dialog(Sort_Box); button1 := Do_Dialog(Sort_Box,DUMMY); IF Obj_State(Sort_Box,ok1) & selected <>0 THEN BEGIN Obj_Setstate(Sort_Box,ok1,none,true); cancel_box := false; END; IF Obj_State(Sort_Box,cancel1) & selected <>0 THEN BEGIN Obj_Setstate(Sort_Box,cancel1,none,true); cancel_box := true; END; End_dialog(Sort_Box); if cancel_box = false then begin IF OBJ_STATE(SORT_BOX,BTN_NA) & SELECTED <> 0 THEN CHOOSE_BOX := 1; IF OBJ_STATE(SORT_BOX,BTN_DA) & SELECTED <> 0 THEN CHOOSE_BOX := 3; IF OBJ_STATE(SORT_BOX,BTN_DI) & SELECTED <> 0 THEN CHOOSE_BOX := 4; IF OBJ_STATE(SORT_BOX,BTN_FO) & SELECTED <> 0 THEN CHOOSE_BOX := 5; IF OBJ_STATE(SORT_BOX,BTN_CO) & SELECTED <> 0 THEN CHOOSE_BOX := 6; IF OBJ_STATE(SORT_BOX,BTN_TY) & SELECTED <> 0 THEN CHOOSE_BOX := 2; end; END; PROCEDURE SCR_BLACK; BEGIN TEXT_COLOR(0); line_COLOR(0); paint_COLOR(2); SET_CLIP(SX,SY,SW,SH); HIDE_MOUSE; PRNT_SCR; SHOW_MOUSE; COLOR_FLAG := FALSE; END; PROCEDURE SCR_WHITE; BEGIN TEXT_COLOR(1); line_COLOR(1); paint_COLOR(0); SET_CLIP(SX,SY,SW,SH); HIDE_MOUSE; PRNT_SCR; SHOW_MOUSE; COLOR_FLAG := TRUE; END; PROCEDURE ARROW_RTN(HANDLE,X : INTEGER); VAR CW,CH,BW,BH : INTEGER; MAX : REAL; BEGIN SYS_FONT_SIZE(CW,CH,BW,BH); WORK_RECT(HANDLE,SX,SY,SW,SH); MAX := SH DIV BH; CASE X OF 0: BEGIN CUR_LOC := CUR_LOC - TRUNC(MAX); IF CUR_LOC < 0 THEN CUR_LOC := 0; SET_CLIP(SX,SY,SW,SH); PRNT_SCR; VSPOS( CUR_LOC ); END; 1: BEGIN CUR_LOC := CUR_LOC + TRUNC(MAX); IF CUR_LOC > (TOTAL_LINES -14) THEN CUR_LOC := TRUNC(TOTAL_LINES -14 ); SET_CLIP(SX,SY,SW,SH); PRNT_SCR; VSPOS( CUR_LOC ); END; 2: BEGIN CUR_LOC := CUR_LOC - 1; IF CUR_LOC < 0 THEN CUR_LOC := 0; SET_CLIP(SX,SY,SW,SH); PRNT_SCR; VSPOS( CUR_LOC ); END; 3: BEGIN CUR_LOC := CUR_LOC + 1; IF CUR_LOC > (TOTAL_LINES -14) THEN CUR_LOC := TRUNC(TOTAL_LINES -14 ); SET_CLIP(SX,SY,SW,SH); VSPOS( CUR_LOC ); PRNT_SCR; END; 4: ; 5: ; 6: ; 7: ; END; END; PROCEDURE VSLIDER ( HANDLE,MOVED : INTEGER ); VAR A : INTEGER; MVD,ADJ : REAL; BEGIN ADJ := 1000 / TOTAL_LINES; MVD := MOVED; CUR_LOC := ROUND(MVD / ADJ); IF CUR_LOC >= 14 THEN CUR_LOC := CUR_LOC - 14; SET_CLIP(SX,SY,SW,SH); PRNT_SCR; VSPOS( CUR_LOC ); END; PROCEDURE PRINT_B; VAR X,DUMMY : INTEGER; BLOCK,ALERT1 : STR255; BEGIN alert1 := '[3][Make sure your printer is connected.][ OK | CANCEL ]'; dummy := Do_alert( alert1, 1); IF DUMMY = 1 THEN BEGIN IF BUFFER_FLAG THEN BEGIN REWRITE(OUTPUT_FILE,'PRN:'); BLOCK :='D# |F |FILENAME |DATE |FOLDER |COMMENTS.... '; WRITELN(OUTPUT_FILE,BLOCK); FOR X := 0 TO (PRNT_COUNT -1) DO BEGIN BLOCK := ' '; INSERT(BLDN[PINDX[X]],BLOCK,1); INSERT(BLAT[PINDX[X]],BLOCK,5); INSERT(BLNAME[PINDX[X]],BLOCK,8); INSERT(BLDATE[PINDX[X]],BLOCK,22); INSERT(BLFOLD[PINDX[X]],BLOCK,32); INSERT(BLCOMM[PINDX[X]],BLOCK,48); BLOCK[0] := CHR(80); WRITELN(OUTPUT_FILE,BLOCK); END; END ELSE DUMMY := DO_ALERT('[1][BUFFER EMPTY][ CANCEL ]',1); END; END; PROCEDURE PRINT_D; VAR X,Y : INTEGER; BLOCK,ALERT1,FN : STR255; BEGIN IF GET_IN_FILE(PATH_NM1,FULL_NAME) THEN BEGIN REWRITE(OUT_FILE,FULL_NAME); BLOCK :='D# |F |FILENAME |DATE |FOLDER |COMMENTS.... '; WRITELN(OUT_FILE,BLOCK); FOR X := 0 TO TRUNC(TOTAL_LINES) DO BEGIN BLOCK := ' '; INSERT(BLDN[SINDX[X]],BLOCK,1); INSERT(BLAT[SINDX[X]],BLOCK,5); INSERT(BLNAME[SINDX[X]],BLOCK,8); INSERT(BLDATE[SINDX[X]],BLOCK,22); INSERT(BLFOLD[SINDX[X]],BLOCK,32); INSERT(BLCOMM[SINDX[X]],BLOCK,48); BLOCK[0] := CHR(75); WRITELN(OUT_FILE,BLOCK); END; CLOSE(OUT_FILE); END; END; PROCEDURE PRINT_D1; VAR X,Y : INTEGER; BLOCK,ALERT1,FN : STR255; BEGIN IF BUFFER_FLAG THEN BEGIN IF GET_IN_FILE(PATH_NM1,FULL_NAME) THEN BEGIN REWRITE(OUT_FILE,FULL_NAME); BLOCK :='D# |F |FILENAME |DATE |FOLDER |COMMENTS.... '; WRITELN(OUT_FILE,BLOCK); FOR X := 0 TO (PRNT_COUNT -1) DO BEGIN BLOCK := ' '; INSERT(BLDN[PINDX[X]],BLOCK,1); INSERT(BLAT[PINDX[X]],BLOCK,5); INSERT(BLNAME[PINDX[X]],BLOCK,8); INSERT(BLDATE[PINDX[X]],BLOCK,22); INSERT(BLFOLD[PINDX[X]],BLOCK,32); INSERT(BLCOMM[PINDX[X]],BLOCK,48); BLOCK[0] := CHR(75); WRITELN(OUT_FILE,BLOCK); END; CLOSE(OUT_FILE); END; END ELSE X := DO_ALERT('[3][BUFFER EMPTY][ CANCEL ]',1); END; PROCEDURE PRINT_P; VAR X,DUMMY : INTEGER; BLOCK,ALERT1 : STR255; BEGIN alert1 := '[3][Make sure your printer is connected.][ OK | CANCEL ]'; dummy := Do_alert( alert1, 1); IF DUMMY = 1 THEN BEGIN REWRITE(OUTPUT_FILE,'PRN:'); BLOCK :='D# |F |FILENAME |DATE |FOLDER |COMMENTS.... '; WRITELN(OUTPUT_FILE,BLOCK); FOR X := 0 TO TRUNC(TOTAL_LINES) DO BEGIN BLOCK := ' '; INSERT(BLDN[SINDX[X]],BLOCK,1); INSERT(BLAT[SINDX[X]],BLOCK,5); INSERT(BLNAME[SINDX[X]],BLOCK,8); INSERT(BLDATE[SINDX[X]],BLOCK,22); INSERT(BLFOLD[SINDX[X]],BLOCK,32); INSERT(BLCOMM[SINDX[X]],BLOCK,48); BLOCK[0] := CHR(80); WRITELN(OUTPUT_FILE,BLOCK); END; END; END; PROCEDURE PRINT_S; VAR A,Y,Z,V,ANS : INTEGER; FLAG,T : BOOLEAN; STR,STR1 : STR255; BEGIN V := PRNT_COUNT; A := CHOOSE_BOX; IF A = 6 THEN T := SHOW_COM_BOX('--------------') ELSE SHOW_TYPE_BOX(A); IF CANCEL_BOX = FALSE THEN BEGIN Y := CUR_LOC; REPEAT FLAG := FALSE; Z := CUR_LOC; SEARCH(A); IF SEARCH_FLAG = TRUE THEN BEGIN STR1 :='FOUND...... '; CASE A OF 1: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]]); 2: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]]); 3: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLDATE[SINDX[CUR_LOC]]); 4: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLDN[SINDX[CUR_LOC]]); 5: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLFOLD[SINDX[CUR_LOC]]); 6: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLCOMM[SINDX[CUR_LOC]]); END; SET_WINFO(HANDLE,STR); ANS := DO_ALERT('[1][ADD TO PRINT BUFFER ?][ YES | NO ]',1); IF ANS = 1 THEN BEGIN PINDX[PRNT_COUNT] := SINDX[CUR_LOC]; PRNT_COUNT := PRNT_COUNT +1; BUFFER_FLAG := TRUE; END; FLAG := TRUE; END; UNTIL FLAG = FALSE; CUR_LOC := Y; END; IF PRNT_COUNT = V THEN A := DO_ALERT('[3][NO FILES FOUND][ CANCEL ]',1); END; PROCEDURE PRINT( X : INTEGER ); VAR A : INTEGER; BEGIN A := DO_ALERT('[2][WHERE WOULD YOU LIKE TO PRINT][ PRINTER | DISK ]',1); CASE X OF 1: BEGIN IF A = 1 THEN PRINT_P ELSE PRINT_D; END; 2: BEGIN IF A = 1 THEN PRINT_B ELSE PRINT_D1; END; END; END; PROCEDURE PRINT_CLEAR; VAR X : INTEGER; BEGIN X := DO_ALERT ('[2][ARE YOU SURE YOU WANT|THE PRINT BUFFER CLEARED][ YES | NO WAY ]',2); IF X = 1 THEN BEGIN PRNT_COUNT := 0; BUFFER_FLAG := FALSE; FOR X := 0 TO 1100 DO PINDX[X] := X; X := DO_ALERT('[1][THE PRINT BUFFER HAS BEEN ERASED][ OK ]',1); END; END; PROCEDURE PRINT_QUERY; VAR ANSWER : INTEGER; BEGIN ANSWER := DO_ALERT( '[2][WOULD YOU LIKE TO ADD|THIS FILE TO THE|PRINT BUFFER][ YES | NO ]',1); IF ANSWER = 1 THEN BEGIN PINDX[PRNT_COUNT] := SINDX[CUR_LOC]; PRNT_COUNT := PRNT_COUNT + 1; BUFFER_FLAG := TRUE; END; END; PROCEDURE P_SCRN; BEGIN SET_CLIP(SX,SY,SW,SH); PRNT_SCR; VSPOS( CUR_LOC ); END; PROCEDURE SRCH_T(X : INTEGER); VAR TEMP : INTEGER; STR,STR1 : STR255; T : BOOLEAN; begin SHW_BOX_STR := ''; IF X = 6 THEN T := SHOW_COM_BOX('--------------') ELSE SHOW_TYPE_BOX(X); IF CANCEL_BOX = FALSE THEN BEGIN TEMP := CUR_LOC; SEARCH(X); IF TEMP <> CUR_LOC THEN BEGIN STR1 :='FOUND...... '; CASE X OF 1: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]]); 2: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]]); 3: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLDATE[SINDX[CUR_LOC]]); 4: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLDN[SINDX[CUR_LOC]]); 5: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLFOLD[SINDX[CUR_LOC]]); 6: STR := CONCAT(STR1,BLNAME[SINDX[CUR_LOC]],' ',BLCOMM[SINDX[CUR_LOC]]); END; SET_WINFO(HANDLE,STR); PRINT_QUERY; P_SCRN; END; END; end; PROCEDURE MAN_DELETE; VAR X,Y : INTEGER; BEGIN Y := CUR_LOC; SHOW_TYPE_BOX(1); IF CANCEL_BOX = FALSE THEN BEGIN SEARCH(1); X := CUR_LOC; DEL_FILE(SINDX[X]); CUR_LOC := Y; LAST_LINE := LINE_COUNT; P_SCRN; END; END; FUNCTION CHECK_FOLDER( X : INTEGER) : BOOLEAN; VAR STR : STR255; BEGIN CHECK_FOLDER := FALSE; STR := BLFOLD[SINDX[X]]; IF STR <> '--------------' THEN BEGIN FOLDER := STR; CHECK_FOLDER := TRUE; END; END; FUNCTION SRCH( FOLDER : STR255; VAR X : INTEGER ) : BOOLEAN; VAR Y : INTEGER; BEGIN Y := 0; SRCH := FALSE; REPEAT IF FOLDER = BLNAME[SINDX[Y]] THEN BEGIN IF BLDN[SINDX[X]] = BLDN[SINDX[Y]] THEN BEGIN FOLDER := BLNAME[SINDX[Y]]; X := Y; SRCH := TRUE; Y := LAST_LINE -1; END; END; Y := Y +1; UNTIL Y = LAST_LINE; END; PROCEDURE SRCH_PATH; VAR X,TEMP : INTEGER; Q,FLD,FLAG : BOOLEAN; STR,STR1 : STR255; BEGIN SHOW_TYPE_BOX(1); TEMP := CUR_LOC; STR := ' ********** FILE NOT FOUND **********'; SEARCH(1); IF SEARCH_FLAG THEN BEGIN X := CUR_LOC; STR := BLNAME[SINDX[X]]; STR1 := BLDN[SINDX[X]]; REPEAT FLAG := FALSE; FLD := CHECK_FOLDER(X); IF FLD THEN BEGIN INSERT('\',STR,1); INSERT(FOLDER,STR,1); Q := SRCH(FOLDER,X); IF Q THEN BEGIN FLAG := TRUE; END; END; UNTIL FLAG = FALSE; END; CUR_LOC := TEMP; P_SCRN; IF SEARCH_FLAG = TRUE THEN BEGIN INSERT(' ',STR,1); INSERT(STR1,STR,1); INSERT('PATH = DISK # ',STR,1); END; SET_WINFO(HANDLE,STR); X := DO_ALERT('[3][PATH IS ON TITLE BAR][ OK ]',1); END; PROCEDURE ADD_FILES; BEGIN SHOW_TYPE_BOX(4); IF CANCEL_BOX = FALSE THEN BEGIN DNSTR := SHW_BOX_STR; ADD_DIR; IF ADD_FLAG THEN begin G_DIR; IF ADD_FLAG = TRUE THEN BEGIN VSSIZE( TOTAL_LINES ); P_SCRN; ADDCOM; IF TITLE_BAR = TRUE THEN SET_TITLE_BAR(2); END; end; END; END; PROCEDURE FIX_SPACE; VAR X,Y : INTEGER; STR : STRING; BEGIN STR := ' '; FOR X := 0 TO LAST_LINE DO BEGIN Y := POS(STR,BLNAME[SINDX[X]]); IF Y <> 0 THEN BLNAME[X,0] := CHR(Y -1); Y := POS(STR,BLFOLD[SINDX[X]]); IF Y <> 0 THEN BLFOLD[X,0] := CHR(Y -1); END; END; PROCEDURE LOAD_DB; VAR HANDLE,X,Y,Z,Q,BAR_FLAG,COL_FLAG : INTEGER; NBYTES,ERR : LONG_INTEGER; BUF : BUF_TYPE; FN : STR255; BEGIN IF GET_IN_FILE(PATH_NM,FULL_NAME) THEN BEGIN FN := FULL_NAME; X := 0; Y := 1; WHILE X <= LENGTH(FN) DO BEGIN FULL_NAME[X] := FN[Y]; X := X +1; Y := Y +1; END; FULL_NAME[X] := CHR(0); HANDLE := GEM_OPEN(FULL_NAME,0); IF HANDLE >= 0 THEN BEGIN NBYTES := 3; ERR := GEM_READ(HANDLE,NBYTES,BUF); IF (BUF[0] = 'D') AND (BUF[1] = 'I') AND (BUF[2] = 'R') THEN BEGIN NBYTES := 2; ERR := GEM_READI(HANDLE,NBYTES,LAST_LINE); ERR := GEM_READI(HANDLE,NBYTES,LAST_DISK); ERR := GEM_READI(HANDLE,NBYTES,BAR_FLAG); ERR := GEM_READI(HANDLE,NBYTES,COL_FLAG); IF ERR >= 0 THEN BEGIN FOR X := 0 TO LAST_LINE DO BEGIN NBYTES := 80; ERR := GEM_READ(HANDLE,NBYTES,BUF); Z := 0; FOR Y := 1 TO 4 DO BEGIN BLDN[X,Y] := BUF[Z]; Z := Z +1; END; BLDN[X,0] := CHR(4); Z := 5; FOR Y := 1 TO 2 DO BEGIN BLAT[X,Y] := BUF[Z]; Z := Z +1; END; BLAT[X,0] := CHR(2); Z := 8; FOR Y := 1 TO 14 DO BEGIN BLNAME[X,Y] := BUF[Z]; Z := Z +1; END; BLNAME[X,0] := CHR(14); Z := 23; FOR Y := 1 TO 10 DO BEGIN BLDATE[X,Y] := BUF[Z]; Z := Z +1; END; BLDATE[X,0] := CHR(10); Z := 34; FOR Y := 1 TO 14 DO BEGIN BLFOLD[X,Y] := BUF[Z]; Z := Z +1; END; BLFOLD[X,0] := CHR(14); Z := 49; FOR Y := 1 TO 26 DO BEGIN BLCOMM[X,Y] := BUF[Z]; Z := Z +1; END; BLCOMM[X,0] := CHR(26); END; END; GEM_CLOSE(HANDLE); TOTAL_LINES := LAST_LINE; CUR_LOC := 0; FOR X := 0 TO 1100 DO SINDX[X] := X; FIX_SPACE; VSSIZE( TOTAL_LINES ); VSPOS(CUR_LOC); IF COL_FLAG = 1 THEN SCR_WHITE ELSE SCR_BLACK; SET_TITLE_BAR(BAR_FLAG); END ELSE BEGIN GEM_CLOSE(HANDLE); DUMMY := DO_ALERT('[1][THIS IS NOT A DIRECTORY FILE][ CANCEL ]',1); END; END ELSE Z := DO_ALERT('[2][DISK ERROR CHECK DISK AND TRY AGAIN][ CANCEL ]',1); END; END; PROCEDURE Do_Menu( title, item : integer ) ; VAR alert11,ALERT23 : Str255 ; ANUM,N : INTEGER; BEGIN ALERT11 := '[0][PROGRAM WRITEN BY| MIKE HOLLENBECK| IN O.S.S| PERSONAL PASCAL][ OK ]'; ALERT23 := '[2][ARE YOU SURE YOU WANT TO QUIT ?][ NO | YES ]'; PATH_NM := 'A:\*.DIR'; PATH_NM1 := 'A:\*.DOC'; IF TITLE = DESK_TITLE THEN infobox; IF TITLE = FILE_TITLE THEN BEGIN IF ITEM = OPEN_ITEM THEN load_db; IF ITEM = CLOSE_ITEM THEN SAVE_DB; IF ITEM = ADD_ITEM THEN ADD_FILES; IF ITEM = DEL_ITEM THEN MAN_DELETE; IF ITEM = COM_ITEM THEN COM_CHECK; IF ITEM = ITEM60 THEN ITEM60_PROC; IF ITEM = QT_ITEM THEN FLAG1 := DO_ALERT(ALERT23,1); END; IF TITLE = SEARCH_TITLE THEN BEGIN IF ITEM = SNAME_ITEM THEN SRCH_T(1); IF ITEM = STYPE_ITEM THEN SRCH_T(2); IF ITEM = SDATE_ITEM THEN SRCH_T(3); IF ITEM = SDNUM_ITEM THEN SRCH_T(4); IF ITEM = Sfnd_ITEM THEN SRCH_PATH; IF ITEM = SFOLD_ITEM THEN SRCH_T(5); IF ITEM = COMB_ITEM THEN SRCH_T(6); IF ITEM = PRINTA_ITEM THEN PRINT_S; IF ITEM = sort_item THEN BEGIN sort_type ; SET_CLIP(SX,SY,SW,SH); PRNT_SCR; END; END; IF TITLE = PRINT_TITLE THEN BEGIN IF ITEM = PRINTD_ITEM THEN PRINT(1); IF ITEM = PRINTP_ITEM THEN PRINT(2); IF ITEM = PRINTC_ITEM THEN PRINT_CLEAR; END; IF TITLE = STYLE_TITLE THEN BEGIN IF ITEM = WHITE_ITEM THEN SCR_WHITE; IF ITEM = BLACK_ITEM THEN SCR_BLACK; IF ITEM = stat_ITEM THEN set_title_bar(2); IF ITEM = layout_ITEM THEN set_title_bar(1); END; IF TITLE = HELP_TITLE THEN BEGIN if item = item41 then item41_proc; if item = item42 then item42_proc; if item = item43 then item43_proc; if item = item44 then item44_proc; if item = item45 then item45_proc; if item = item46 then item46_proc; if item = item47 then item47_proc; if item = item48 then item48_proc; if item = item49 then item49_proc; if item = item50 then item50_proc; if item = item51 then item51_proc; if item = item52 then item52_proc; if item = item53 then item53_proc; if item = item54 then item54_proc; if item = item55 then item55_proc; if item = item56 then item56_proc; if item = item57 then item57_proc; if item = item58 then item58_proc; END; Menu_Normal( menu, title ) ; END ; Procedure get_line(mx,my : integer); var adj,start,x,l_num : integer; str1,str2,str3,STR4 : str255; T : BOOLEAN; begin if last_line > 0 then begin adj := sy + 2; start := my - adj; x := start div bh; l_num := x + cur_loc; if l_num < last_line then begin STR1 := BLNAME[SINDX[L_NUM]]; STR2 := '[1]['; STR3 := ' | |ADD TO PRINT BUFFER OR |EDIT COMMENT ?][ BUF | COM | CANCEL ]'; STR4 := CONCAT(STR2,STR1,STR3); DUMMY := DO_ALERT(STR4,3); CASE DUMMY OF 1: BEGIN PINDX[PRNT_COUNT] := SINDX[L_NUM]; PRNT_COUNT := PRNT_COUNT + 1; BUFFER_FLAG := TRUE; END; 2: BEGIN shw_box_str := blcomm[sindx[l_num]]; T := show_com_box(blname[sindx[l_num]]); blcomm[sindx[l_num]] := shw_box_str; SET_CLIP(SX,SY,SW,SH); PRNT_SCR; END; 3: ; END; end; end; end; Procedure btn_event(mx,my : integer); var str1,str2,str3 : str255; begin case b_state of 0: begin if first_flag then begin b_state := 1; end else begin first_flag := true; end; end; 1: begin if first_flag then begin get_line(mx,my); first_flag := false; b_state := 1; end else begin b_state := 0; first_flag := true; end; end; end; end; Procedure tim_event; begin first_flag := false; b_state := 1; end; PROCEDURE Event_Loop ; VAR which,mouse_x,mouse_y : integer ; msg : Message_Buffer ; BEGIN MSG[0] := 0; REPEAT which := Get_Event( E_Message|E_button|E_timer, 1, b_state, 1, 2000, false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg, dummy, dummy, dummy, mouse_x, mouse_y, dummy ) ; IF (which & E_Message) <> 0 THEN BEGIN Case Msg[0] of MN_Selected: Do_Menu( msg[3], msg[4] ) ; WM_Redraw: DO_REDRAW(MSG[4],MSG[5],MSG[6],MSG[7]) ; WM_Arrowed: ARROW_RTN(MSG[3],MSG[4]); WM_Vslid: VSLIDER( MSG[3],MSG[4]); WM_topped: ; WM_closed: CLOSE_BTN( MSG[3] ); WM_Fulled: size_window( msg[3] ) ; WM_Hslid : ; WM_Sized: MOVE_WINDOW( MSG[3],MSG[4],MSG[5],MSG[6],MSG[7] ); WM_MOVED: MOVE_WINDOW( MSG[3],MSG[4],MSG[5],MSG[6],MSG[7] ); END; END; if (which & E_Button) <> 0 then btn_event(mouse_x,mouse_y); if (which & E_timer) <> 0 then tim_event; UNTIL flag1 = 2; END ; BEGIN IF Init_Gem >= 0 THEN BEGIN IF GETREZ <> 0 THEN BEGIN b_state := 1; first_flag := false; init_mouse; HIDE_MOUSE; flag1 := 0; system_drives; INIT_MENU; w_options := $FD3; WTitle := '>> The Menu <<'; WItitle := ' D# |F |FILENAME |DATE |FOLDER |COMMENTS.... '; wstitle :=' *** SORTING ***'; Handle := New_Window(w_options,WTitle,0,0,0,0); Open_Window(Handle,0,0,0,0); Set_WInfo(Handle,WItitle); SYS_FONT_SIZE(CW,CH,bw,bh) ; WORK_RECT(HANDLE,SX,SY,SW,SH) ; wind_get(handle,wf_prevxywh,wx,wy,ww,wh); last_sx := wx; last_sy := wy; last_sw := ww; last_sh := wh; CUR_LOC := 0; scrn_size := sh div bh; total_lines := scrn_size; VSSIZE( TOTAL_LINES ); LAST_LINE := 0; LAST_DISK := 0; wind_set(handle,wf_hslsize,1000,dummy,dummy,dummy); SET_CLIP(SX,SY,SW,SH) ; DRAW_MODE(2); SET_COLOR(2,0,0,1000); TEXT_COLOR(1); line_COLOR(1); COLOR_FLAG := TRUE; paint_COLOR(0); FOR N := 1 to 6 DO DIALOG_BOX(N); Set_Add_Box; set_sort_box; ADD_COM_BOX; FOR X := 0 TO 1100 DO BEGIN SINDX[X] := X; PINDX[X] := -1; BLDN[X] := ' '; BLAT[X] := ' '; BLNAME[X] := ' '; BLDATE[X] := ' '; BLFOLD[X] := ' '; END; PRNT_COUNT := 0; BUFFER_FLAG := FALSE; SHOW_MOUSE; infobox; Event_Loop ; Close_Window(Handle); Erase_Menu( menu ) ; SET_COLOR(2,1000,0,0); END ELSE DUMMY := DO_ALERT('[3][THIS PROGRAM REQUIRES | MED OR HI REZ ][ OK ]',1); Exit_Gem ; END ; END. <<ÿÿÿÿÿÿÿÿÿðð?ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþ€€~">>ÿÿÿÿÿÿÿÿÿðð?ÿÿÿÿÿÿÿÿÿÿÿÿÿÿ