home *** CD-ROM | disk | FTP | other *** search
- procedure Hmenu(C,R:integer;Status:str255; var Ch: char);
- var
- MenuLen : integer;
- Menustr : string[79];
- MenuLtrs : string[12];
- I : array[1..20] of string[8]; { menu Items }
- counter : integer;
- begin
- Counter := 0; Set_Cap_Num(' ',' ',' ');
-
- {**** build menu Item and Prompt arrays ****}
- repeat
- Counter := Counter + 1;
- {** locate menu Item in Prompt string and assign it to I[Counter **}
- I[Counter] := Copy(P[Counter],1,Pos('.',P[Counter])-1);
- {** trim trailing blanks , if any from newly formed menu Item ** }
- I[Counter] := Copy(I[Counter],1,Pos(' ',I[Counter]+' ')-1);
- {** delete menu Item from from Prompt string **}
- Delete(P[Counter],1,Pos('.',P[Counter]));
- until (P[Counter] = ' ') or (P[Counter] = '');
- {**** last menu Item and Prompt completed ****}
-
- Menulen := Counter-1;
- MenuStr := '';
- MenuLtrs := '';
- for Counter := 1 to Menulen do
- begin
- {** the + ' ' below controls space between menu items **}
- MenuStr := MenuStr + I[Counter] + ' ';
- MenuLtrs:= MenuLtrs + Copy(I[Counter],1,1);
- end;
-
- {.pa}
- {**** begin display of Hmenu ****}
- Counter := 1;
- {** write Status string in top right corner **}
- gotoXY(1,1); clreol; GotoXY(79-length(status),1);
- textbackground(15);textcolor( 0);write(status);
- textbackground( 0);textcolor(15); writeln; clreol;
- lowvideo;
- repeat
- GotoXY(C,R);
- lowvideo;
- writeln (Menustr); {** Write menu choices string in low video **}
- clreol;
- {** find location for and write highlighted menu choice **}
- GotoXY((C-1) + pos(I[counter],MenuStr),R);
- textbackground(15);textcolor( 0);write(I[Counter]);
- textbackground( 0);textcolor(15);
- {** write Prompt for highlighted Item **}
- GoToXY(C,R+1); clreol; writeln ( P[Counter] );
- GotoXY(80,1);
- {**** get keyboard input ****}
- Read(kbd,Ch);
- if KeyPressed then Ck_edit_key(Ch);
- Ch := UpCase(Ch);
- case Ch of
- #13 : Ch := Copy(MenuLtrs,Counter,1);
- ^D,^E,#32 : Counter := Counter + 1;
- ^S,^X : Counter := Counter - 1;
- ^G : Counter := 1;
- ^O : Counter := MenuLen;
- end; {case Ch}
- if Pos(Ch,MenuLtrs) <> 0 then Counter := Pos(Ch,MenuLtrs)
- else if not (Ch in [#13,^D,^E,#32,^S,^X,^G,^O]) then beep(350,200);
- if Counter < 1 then Counter := MenuLen;
- if Counter > MenuLen then Counter := 1;
- until Pos(Ch,MenuLtrs) <> 0;
- lowvideo;
- end;