Program Wells_Fargo; Uses Dos,CRT,ExecSwap,FastTTT5,WinTTT5,MenuTTT5,PullTTT5,ReadTTT5; Type WFRecord=Record Description :String[40]; Path :String[35]; ProgramName :String[12]; Password :String[20]; UseEMS :Boolean; End; Const PassChar = #15; CursorRight = #205; CursorLeft = #203; CursorDown = #208; CursorUp = #200; EnterKey = #13; EscKey = #27; EndKey = #207; HomeKey = #199; DelKey = #211; Backspace = #8; InsKey = #210; Zap = #160; {Alt D to delete the field} MinInt = -32768; MaxLongInt:longint = 2147483647; MinLongInt:longint = -2147483647; MaxWord = 65535; MinWord = 0; Var wffile:file of WFRecord; num:integer; r,ar:WFRecord; Main_Choice,Choice,Error:integer; X,Y,ScanTop,ScanBot:byte; M1,MM:Menu_record; Ch:char; Done:Boolean; Cursor_X, Cursor_Y:byte; temp:String; Procedure Clang; begin sound(1500); delay(50); nosound; end; Procedure Read_Line(X,Y,L,F,B,Format:byte; Text:String); { X is X coord of first character in field Y is Y coord of field L is the maximum length of the input field F is the foreground color B is the background color Fornat Codes: 1 Any String 2 Force Upper String 3 Yes/No 4 Alphabetics only 5 Integer 6 LongInteger 7 Real 8 Word (* Maybe 9 Date (MM/DD/YY) 10 Date (DD/MM/YY) *) 11 Echo a Password Text is a string updated with the string equivalent of user input } var TempText : string; CursorPos : byte; InsertMode, Password, Alldone : boolean; FirstCharPress: boolean; Ch : char; Procedure Check_Parameters; begin TempText := Text; If length(TempText) > L then Delete(Temptext,L+1,length(TempText)-L); If not X in [1..80] then X := 1; If X + L - 1 > 80 then X := 81 - L; If not Y in [1..25] then Y := 1; If RTTT.BegCursor then CursorPos := 1 else begin If length(TempText) < L then CursorPos := length(TempText) + 1 else CursorPos := length(TempText); end; InsertMode := RTTT.Insert; Alldone := False; If Format = 11 then begin Password := true; Format := 1; end else Password := false; end; {sub Proc Check_Parameters} Function FillWhiteSpace(Str:string):string; var I : integer; begin If Password then Str := replicate(length(Str),PassChar); while length(Str) < L do Str := Str + RTTT.WhiteSpace; FillWhiteSpace := Str; end; {sub Func FillWhiteSpace} Procedure MoveTheCursor; begin GotoXY(X+CursorPos-1,Y); end; {sub Proc MoveTheCursor} Procedure Write_String; begin Fastwrite(X,Y,attr(F,B),FillWhiteSpace(TempText)); MoveTheCursor; end; Procedure Erase_Field; begin TempText := ''; CursorPos := 1; Write_String; end; Procedure Char_Backspace; begin If CursorPos > 1 then begin CursorPos := Pred(CursorPos); Delete(TempText,CursorPos,1); Write_String; end; end; {sub Proc Char_Backspace} Procedure Char_Del; begin If CursorPos <= length(TempText) then begin Delete(TempText,CursorPos,1); Write_String; end; end; {sub Proc Char_Del} Procedure Add_Char(Ch:char); begin If InsertMode then begin If length(TempText) < L then begin Insert(Ch,TempText,CursorPos); If CursorPos < L then CursorPos := Succ(CursorPos); end; end else {not insertmode} begin Delete(TempText,CursorPos,1); Insert(Ch,TempText,CursorPos); If CursorPos < L then CursorPos := Succ(CursorPos); end; {if insert} Write_String; end; {sub proc Add_Char} begin {main Procedure Read_Line} Check_Parameters; R_Null := false; (* FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot); *) If RTTT.Insert then HalfCursor else OnCursor; Write_String; FirstCharPress := true; Repeat Ch := ReadKey; (* Getkey; *) If Format in [2,3] then Ch := upcase(Ch); If Ch in RTTT.End_Chars then begin AllDone := True; If Ch <> #027 then Text := TempText; end else Case Ch of #131, {mouseright} CursorRight : begin If (CursorPos < L) and (CursorPos <= length(TempText)) then begin CursorPos := Succ(CursorPos); MoveTheCursor; end; end; #130, {mouseleft} CursorLeft : begin If CursorPos > 1 then begin CursorPos := Pred(CursorPos); MoveTheCursor; end; end; HomeKey : begin CursorPos := 1; MoveTheCursor; end; EndKey : begin If CursorPos < L then If length(TempText) < L then CursorPos := length(TempText) + 1 else CursorPos := L; MoveTheCursor; end; InsKey : If Format <> 3 then {don't allow insert on Y/N!} begin InsertMode := not InsertMode; If InsertMode then HalfCursor else OnCursor; end; DelKey : Char_Del; BackSpace : Char_Backspace; Zap : Erase_Field; #132, EscKey : If RTTT.AllowEsc then Alldone := true; #133, EnterKey : begin Alldone := true; Text := TempText; temp:=TempText; end; #33 .. #42, {! to *} #44,#47, {, /} #58 .. #64, {: to @} #91 .. #96, {[ to '} #123 .. #126 : If (Format in [1,2]) then {{ to ~} begin If FirstCharPress and RTTT.EraseDefault then Erase_Field; Add_Char(Ch); end else Clang; #43, #45 : If (Format in [1,2]) { + - } or ( (CursorPos=1) and (Format in [5,6,7])) then begin If FirstCharPress and RTTT.EraseDefault then Erase_Field; Add_Char(Ch); end else Clang; #46 : If (Format in [1,2]) {.} or ( (Pos('.',TempText)=0) and (Format = 7)) then begin If FirstCharPress and RTTT.EraseDefault then Erase_Field; Add_Char(Ch); end else Clang; #48..#57 : If (Format in [1..2,5..8]) then {0 to 9} begin If FirstCharPress and RTTT.EraseDefault then Erase_Field; Add_Char(Ch); end else Clang; #32, {space} #65..#77, {A to M} #79..#88, {O to X} #90, {Z} #97..#122 : If (Format in [1,2,4]) then {a to z} begin If FirstCharPress and RTTT.EraseDefault then Erase_Field; Add_Char(Ch); end else Clang; #78,#89 : If (Format in [1..4]) then {N Y} begin Add_Char(Ch); If Format = 3 then begin Alldone := true; Text := TempText; end; end else Clang; #128,#129 :; {absorb stray mouse movement to avoid Clang'n} else Clang; end; {case} FirstCharPress := false; Until Alldone; R_Char := Ch; If RTTT.RightJustify and (Format > 4) then begin Fastwrite(X,Y,attr(F,B),replicate(L,RTTT.Whitespace)); Fastwrite(X+L-Length(TempText),Y,attr(F,B),Text); end else Fastwrite(X,Y,attr(F,B),FillWhiteSpace(Text)); GotoXY(Cursor_X,Cursor_Y); SizeCursor(ScanTop,ScanBot); end; function exist (n:string):boolean; var f:file; i:integer; begin assign (f,n); reset (f); i:=ioresult; exist:=i=0; close (f); i:=ioresult end; function numentry:integer; begin numentry:=filesize(WFfile) end; procedure seekwffile (n:integer); begin seek (WFfile,n-1) end; procedure openwffile; var n:integer; begin n:=ioresult; assign (WFfile,'FARGO.DAT'); reset (WFfile); if ioresult<>0 then begin close (WFfile); n:=ioresult; rewrite (WFfile) end end; Procedure Grand_Opening; Begin FillScreen(1,1,80,25,white,blue,chr(176)); GrowFBox(25,10,55,17,yellow,blue,4); WriteCenter(12,15,1,'Wells Fargo Quick Menus'); WriteCenter(13,15,1,'Written By: Josh Ham'); WriteCenter(14,15,1,'Requested By: Larry Ham'); WriteCenter(16,11,1,'Quick Menus (c)1991'); Delay(3000); End; Procedure Entry_Box; Begin FillScreen(1,1,80,25,white,blue,char(176)); TextAttr:=1; GrowFBox(15,5,65,20,blue,blue,4); TextAttr:=8; For x:=17 to 66 Do Begin Gotoxy(x,21); Write(char(219)); End; For y:=6 to 21 Do Begin Gotoxy(66,y); Write(char(219)+Char(219)); End; End; Procedure EC; Begin Textbackground(7); Textcolor(0); End; Procedure EF; Begin Textbackground(1); Textcolor(11); End; Procedure Add_An_Entry; var ch:Char; a,b,c,d:string; Begin Entry_Box; Textbackground(1); TextColor(14); Gotoxy(22,6); Write('Wells Fargo Quick Menus - Add an Entry'); TextColor(9); For x:=15 to 65 Do Begin gotoxy(x,7); Write(char(196)); End; TextColor(11); OpenWfFile; num:=numentry; Gotoxy(17,9); Write('Enter Filename To Execute'); ec; Gotoxy(17,10); Write('תתתתתתתתתתתת'); ef; Gotoxy(17,12); Write('Enter Full Path To The Above File'); ec; Gotoxy(17,13); Write('תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת'); ef; Gotoxy(17,15); Write('Enter a Description Of This Entry'); ec; gotoxy(17,16); Write('תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת'); ef; gotoxy(17,18); Write('Enter a Password To Load This (Enter=None)'); ec; gotoxy(17,19); Write('תתתתתתתתתתתתתתתתתתתתת'); clang; r.programname:=''; Gotoxy(17,10);ReadLine(17,10,12,0,7,r.programname); r.programname:=temp; r.path:=''; gotoxy(17,13);ReadLine(17,13,35,0,7,r.path); r.path:=temp; r.description:=''; gotoxy(17,16);ReadLine(17,16,40,0,7,r.description); r.description:=temp; r.password:=''; gotoxy(17,19);ReadLine(17,19,20,0,7,r.password); r.password:=temp; GrowFBox(25,1,53,3,lightblue,blue,4); Clang; ef; textcolor(15); Gotoxy(27,2); Write('Save This To Disk? [Y/N]'); Repeat Ch:=ReadKey; Until (ch='Y') or (ch='y') or (ch='N') or (ch='n'); If (ch='Y') or (ch='y') Then Begin if not exist ('FARGO.DAT') then rewrite (WFfile); seekwffile(num+1); write (WFfile,r); End; ef; FillScreen(1,1,80,25,white,blue,chr(176)); Close(Wffile); End; Procedure Edit_Entry; var howmany:integer; Begin FillScreen(1,1,80,25,white,blue,chr(176)); GrowFBox(25,1,53,3,lightblue,blue,4); Clang; ef; textcolor(15); OpenWffile; howmany:=numentry; Gotoxy(27,2); Write('Edit Which Entry? [1-',howmany,']:'); gotoxy(51,2); ReadLn(howmany); seekwffile(howmany+1); read(wffile,r); FillScreen(30,5,75,15,blue,blue,chr(219)); ef; GotoXy(42,6); Write('Wells Fargo Quick Menu Editor'); ec; Gotoxy(32,8); Write('תתתתתתתתתתתת'); Gotoxy(32,10); Write('תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת'); gotoxy(32,12); Write('תתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתתת'); gotoxy(32,14); Write('תתתתתתתתתתתתתתתתתתתתת'); gotoxy(32,8); Write(r.programname); gotoxy(32,10);Write(r.path); gotoxy(32,12);Write(r.description); gotoxy(32,14);If r.password='' then Write ('N/A') Else write(r.password); readln; Close(WfFile); End; Procedure Utilitys; Begin Menu_Set(M1); With M1 do begin Heading1 := '- Wells Fargo Quick Menu Utilitys -'; Heading2 := 'Quick Menus (c)1991'; Topic[1] := ' Add a new entry'; Topic[2] := ' Edit an existing entry'; Topic[3] := ' Delete an existing entry '; Topic[4] := ' Quit Utility Section'; TotalPicks := 4; PicksPerLine := 1; Addprefix := 0; TopleftXY[1] := 0; TopleftXY[2] := 8; Boxtype := 5; If ColorScreen then begin Colors[1] := white; Colors[2] := blue; Colors[3] := lightgray; Colors[4] := red; Colors[5] := lightgray; end else begin Colors[1] := white; Colors[2] := black; Colors[3] := black; Colors[4] := lightgray; Colors[5] := white; end; AllowEsc := false; Margins := 5; end; {with M1 do} end; {Define_Menu1} Procedure Utility_Menu; Var Quit:Boolean; Begin Quit:=False; Findcursor(X,Y,ScanTop,ScanBot); Main_Choice := 1; Done:=False; FillScreen(1,1,80,25,white,blue,chr(176)); repeat Utilitys; DisplayMenu(M1,false,Main_Choice,Error); Case Main_Choice of 1:Add_An_Entry; 2:Edit_Entry; 3:Begin End;{Delete_An_Entry;} 4:Quit:=True; end; until Quit; FillScreen(1,1,80,24,white,blue,chr(176)); main_choice:=1; End; Begin Grand_Opening; Utility_Menu; End.