×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Arrows and highlighting

Arrows and highlighting

Arrows and highlighting

(OP)
Hey, just a few questions about arrow keys and doing the menu thing where it "highlights" a selection...

To use the arrow keys which are extended ASCII, I use this function:

FUNCTION keyread:integer;

VAR
  value:integer;

BEGIN
  value := ord(upcase(readkey));
  IF value = 0 THEN
    value := ord(readkey) + 300;
  keyread := value;
END;

This works, however, I have to press the key twice before I get a result. I cant think of why it does this nor can I work out how to get rid of it =(
Do you guys use any other function to retrieve extended ASCII that works when you press the key once? lol

OK, so with that - and I guess every othe function with the same purpose - the arrow keys are 372: Up and 380: Down.
In a CASE keyread OF <value> I have an IF.

IF y > (highest menu positon) THEN
  BEGIN
    y = y + 1
    item = item - 1
    bgcolor : white
    text    : black
    gotoxy(x{set},y)
    writeln(array[item])
    ...

That displays the highlighted item from the array "on top" of the one that wasnt highlighted.

    ...
    bgcolor(black)
    text(white)
    gotoxy(x,y-1)
    writeln(array[item-1])
  END

So that *should* write the previous selection in the "normal" colors, though it doesnt work 100% I really dont know why, If it can work once it can work twice right? lol wrong! =S
Of course, the down IF has y - 1 and item + 1 etc.

Besides it not working all the time, there is no way with that method to highlight the 1st item then clear it. Same with the last item. Again, I dont understand why. In theory that should work.

It could just be my tempramental Turbo Pascal (7.1) but Im not sure.

So there's the second plea: Highlighting techniques.

Sorry to be greedy just I dip in to this area of design occasionally and over a period of two years Ive still yet to come up with a solution that works! Yes, I am slow =P

Thanks for your time

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

Well, here's a little program I wrote a long long time ago to help me find the keycodes... works on the first push of the button :)



program key_code;
USES DOS,CRT;

VAR
  car1 : CHAR;
  car2 : CHAR;

BEGIN
  REPEAT
    CLRSCR;
    car2 := #0;
    WRITELN('Press a key');
    car1 := READKEY;
    IF KEYPRESSED THEN
      car2 := READKEY;
    WRITELN('CAR1 : ',ORD(car1),' CAR2 : ',ORD(car2));
    WRITE('Press ENTER to exit');
    car1 := READKEY;
  UNTIL car1 = #13;
END.


I hope this works for you.

RE: Arrows and highlighting

(OP)
You sir are a king!
At first I didnt think it'd work cause I couldnt see how it did the extended characters but you're crafty arent ya! car2 gives me the value and it works =D

Now all I need help with is the inverting of the colors

Woah thanks again

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

In the long run you may wish to write your own version of keypressed and readkey, because there is a fault in the crt unit that causes it to create a division by zero error on fast machines (at any rate on fast machines that are not overburdened by extra processes and general rubbish going on in the background). It's not difficult, you just need to call the appropriate dos interrupts. The fault in crt is to do with its initialisation, so the error happens if you include crt in a uses statement, even if you don't call the timing functions in crt which are what the division by zero is actually about.

But there are also many patch versions of crt around. You might even be using one, in which case sorry!

RE: Arrows and highlighting

Hi there

If you're looking for a menu driven kind of code, here's something it did for you.

Hope you'll find it useful...

Regards


Jakob


MENU.PAS-------------------------------------------------
Program Menu;

{ This code show an example of a menu driven program }
{ Use the following keys: UP, DOWN, CR/ENTER or ESC  }
{ Demo by Jakob Joergensen, jakob_dk2300@yahoo.com   }

Uses
  Crt;

Const
  TotalItems = 3;    
  { /\ How many menu item do you want? }

  MenuItem : Array [1..TotalItems] of String =('Do this', 'Do that', 'Exit');
  { /\ What are the menu items called? }

  MenuXofs = 10;
  { /\ Where do you wat the menu to be shown = X-axis? }

  MenuYofs = 3;
  { /\ Where do you wat the menu to be shown = Y-axis? }

  SelectedFC = White;
  { /\ What's the Foreground Color for selected menu item? }

  SelectedBC = Blue;
  { /\ What's the Background Color for selected menu item? }

  NormalFC = LightGray;
  { /\ What's the Foreground Color for inactive menu items? }

  NormalBC = Black;
  { /\ What's the Background Color for inactive menu items? }

  SelectorWidth = 20;
  { /\ What's the width of the selector bar? }

  UpKey = #80;
  { /\ ASCII code for the UP key }

  DownKey = #72;
  { /\ ASCII code for the DOWN key }

  EscKey = #27;
  { /\ ASCII code for the ESC key }

  CRKey = #13;
  { /\ ASCII code for the CR/ENTER key }



Procedure ShowMenu(SelectedItem : Integer);
{  This shows the menu on the screen. Selected Item number is highlighted }

Var
  CurrentItem     : Integer;
  Blanks          : Integer;
  FC, BC          : Byte;
  CurrentMenuText : String;
  CurrentMenuSize : Integer;
Begin
  For CurrentItem := 1 to TotalItems do
    Begin
      CurrentMenuText := MenuItem[CurrentItem];
      CurrentMenuSize := Length(CurrentMenuText);
      if CurrentItem = SelectedItem then
        Begin
          FC := SelectedFC;
          BC := SelectedBC;
        End
      Else
        Begin
          FC := NormalFC;
          BC := NormalBC;
        End;
      TextColor(FC);
      TextBackground(BC);
      GotoXY(MenuXofs,MenuYofs+CurrentItem-1);
      Write(CurrentMenuText);
      For Blanks := 1 to (SelectorWidth-CurrentMenuSize) do
        Write(#32);
    End;
End;

Function Selector : Char;
{  This reads the "valid keys" }

Var
  Key : Char;
Begin
  Repeat
    Key := ReadKey;
  Until Key in [UpKey,DownKey,EscKey,CRKey];
  Selector := Key;
End;


Function Navigate(KeyFunc : Char; Curr : Integer) : Integer;
{  This browses the menu selected number }

Var
  Current : Integer;
Begin
  Current := Curr;
  If KeyFunc = UpKey then
    Inc(Current);
  If KeyFunc = DownKey then
    Dec(Current);
  If Current > TotalItems then
    Current := 1;
  If Current < 1 then
    Current := TotalItems;
  Navigate := Current;
End;


Procedure DoThis;
{ Your stuff for Menu Item 1 goes here }

Begin
  ClrScr;
  WriteLn('... i'll do THIS');
  WriteLn('Press ENTER...');
  ReadLn;
  ClrScr;
End;

Procedure DoThat;
{ Your stuff for Menu Item 2 goes here }

Begin
  ClrScr;
  WriteLn('... i'll do THAT');
  WriteLn('Press ENTER...');
  ReadLn;
  ClrScr;
End;

Var
  Key : Char;
  MenuPos : Integer;
Begin
  ClrScr;
  MenuPos := 1;
  Repeat
    Repeat
      ShowMenu(MenuPos);
      Key := Selector;
      MenuPos := Navigate(Key, MenuPos);
    Until Key in [CRKey,EscKey];
    If MenuPos = 1 then
      DoThis;
    If MenuPos = 2 then
      DoThat;
  Until (Key = EscKey) or (MenuPos = TotalItems);
  TextColor(NormalFC);
  TextBackground(NormalBC);
  ClrScr;
  WriteLn('Bye now ...');
End.
------------------------------------------------------

RE: Arrows and highlighting

(OP)
Ive got 7.1 so do I still need to mess around with the who division by zero thing even though its got the updated CRT unit?

Thanks for the code dkdude... its given me 1 or 2 ideas

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

(OP)
Well, its a slight modification of my old script but this is the procedure for up/down arrows:

PROCEDURE updown(s,e,i,x:integer; VAR y:integer; st:ARRAY OF string);
{start (s) and end (e) y position of the menu; increment (i) by this much;
 y is variable so it can be used; string (st) is an array containing menu options}

VAR
  a,b   : char;
  index : integer;

BEGIN
  index := 1;
  REPEAT
    b := #0;
    a := readkey;
    IF keypressed THEN
      b := readkey;
    CASE b OF
      #72 : BEGIN
              IF y > s THEN
                BEGIN
                  index := index - 1;
                  y := y - i;
                  writeln(x,y,st[index]);
                END;
            END;
      #80 : BEGIN
              IF y < e THEN
                BEGIN
                  index := index + 1;
                  y := y + i;
                  writeln(x,y,st[index]);
                END;
            END;
    END;
  UNTIL a = #13;
END;

Just... it doesnt display everything correctly. Itll display the last few items of the array then it'll display nonsence. and mostly the up key doesnt work ='(

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

(OP)
oh, to test the up key i added textcolor(red)

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

TP 7.1 doesn't have a RTE200 patch I recently heard somewhere.

My method for Quick&Dirty menu systems was writing a procedure for each menu and using jumps:

S:
display entire menu without highlights
L1:
display first highlight
read keys: down - undo highlight and jump to next label
           up - undo highlight and jump to previous label
           enter - start respective procedure and jump to S
           escape - exit
           else - jump to S1
L2:
display second highlight
read keys: down - undo highlight and jump to L3
etc.


Of course, all this hard coding is far from clean, but it works. If you want a versatile, reusable menu system, you should program it with objects.

Regards,
Bert Vingerhoets
vingerhoetsbert@hotmail.com
http://student.vub.ac.be/~bvingerh/
Don't worry what people think about you. They're too busy wondering what you think about them.

RE: Arrows and highlighting

(OP)
I played around with dkdude's code to make it more my sytle and I cut what I didnt need etc... aaany who, ive got it to work =D yey! Thanks dkdude
And to every1 else too

Ill take a look at your code BertV =)

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

(OP)
I was playing around with the code and Ive kinda messed it up and dunno how to rectify it w/o gettin rid of what I need...

PROCEDURE menu(s:ARRAY OF string; x,y,h,m:integer);
{(s)tring, (h)ighlighted, (x) + (y) axis, (m)enu_size}

VAR
  b,c : integer; {(b)lank_space, (c)urrent}

BEGIN
  b := 0;
  FOR c := 1 TO m DO
    BEGIN
      y := y + 1;
      IF c = h THEN
        BEGIN
          textcolor(black);
          textbackground(lightgray);
          FOR b := x TO x + 20 DO
            writeln(b,y,' ');
        END
      ELSE
        BEGIN
          textcolor(lightgray);
          textbackground(black);
          FOR b := x TO x + 20 DO
            writeln(b,y,' ');
        END;
      writeln(x,y,s[c]);
    END;
END;

PROCEDURE menu2(VAR key:char; VAR y,m,z:integer);

BEGIN
  REPEAT
    key := readkey;
  UNTIL key IN [#13,#72,#80];
  CASE key OF
    #72 : y := y - 1;
    #80 : y := y + 1;
  END;
  IF y = z THEN
    y := m;
  IF y = (z + m) THEN
    y := z;
END;

What happens is when you press Up, the menu items move up and the same happens with down, the menu moves down. Hehe. Any ideas? Oh and it doesnt highlight any more.

Ive got that code in a unit and this is how I call it:

PROGRAM tst;

USES crt,gwar13;

VAR
  z,h,x,y,m:integer;
  s : ARRAY [0..8] OF string;
  key : char;

BEGIN
  clrscr(1,1,80,50);
  s[1] := 'Hi'; s[2] := 'I am'; s[3] := 'working'; s[4] := 'properly!';
  s[5] := 'Hi'; s[6] := 'I am'; s[7] := 'working'; s[8] := 'properly!';
  x := 14;
  y := 14;
  m := 8;
  h := 14;
  z := y;
  REPEAT
    menu(s,x,y,h,m);
    menu2(key,y,m,z);
  UNTIL key IN [#13];
END.

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

I suppose that writeln should be replaced by writexy?

Furthermore, since you use a sizeless array type in the header of the menu procedure, the compiler doesn't know where the indices start, which means you should start counting from 0:
FOR c := 0 TO m DO

The line y := y + 1; results in displaying the menu one line too low on the screen. Remove it and replace writexy(b,y,... by writexy(b,y+c,...

In your main loop you pass the variable y to menu2, it should be h (why?).

The initial value of h is too great, h is an index in your menu array, not a screen coordinate.

Regards,
Bert Vingerhoets
vingerhoetsbert@hotmail.com
http://student.vub.ac.be/~bvingerh/
Don't worry what people think about you. They're too busy wondering what you think about them.

RE: Arrows and highlighting

(OP)
i changed writexy to writeln. I made the changes you said and now it only displays one item from the array. Ironicly: "properly!"

When I pass h instead of z, it writes "properly!" then when you press down it writes it underneath. When you press up, it deletes the last line and when there is only one item left, it moves it up a line.
When I pass h instead of y, its goes wierd. It writes the same word but this time, it'll highlight that and the bottom of the menu (theres nothing there) then when you press up, itll [the bar] move up one. Then it dissapears never to return

I set teh FOR to FOR c := 0 TO m DO

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

Try to test menu() separately:

clrscr;
menu(s,1,1,1,7); {should display menu in top left corner with 1st item highlighted}
readln;
menu(s,1,1,2,7); {should display menu in top left corner with 2nd item highlighted}
...

When this works properly, start testing the rest.

Regards,
Bert Vingerhoets
vingerhoetsbert@hotmail.com
http://student.vub.ac.be/~bvingerh/
Don't worry what people think about you. They're too busy wondering what you think about them.

RE: Arrows and highlighting

      7.1 still has the CRT bug.  It wasn't discovered until long after they quit dealing with the dos versions.  Note that it's a lot easier to patch the offending code in the CRT unit than to replace the whole thing.

      I'm puzzled by why your original didn't work, though.  Other than the upcase I've done something very similar, although I only added 256 rather than 300.  I've been using it for more than 10 years, no problem.

Value : Word;
...
Value := Byte(ReadKey);
If Value = 0 then Value := Byte(ReadKey) + 256;

RE: Arrows and highlighting

For reading keys I always use the same construct:
ch:=readkey;
if ch=#0 then ch2:=readkey;


and if I don't need extended codes:
ch:=readkey;
if ch=#0 then readkey;


when used in a getkey function:
return (word(ch2) SHL 8) OR ch

Regards,
Bert Vingerhoets
vingerhoetsbert@hotmail.com
http://student.vub.ac.be/~bvingerh/
Don't worry what people think about you. They're too busy wondering what you think about them.

RE: Arrows and highlighting

(OP)
Good readkey info =D
Well I downloaded the patch for the CRT and it said i didnt need it so I just assumed all 7.1 had the upgrade. I also read that that was one of the reasons for releasing 7.1. If you got 7.0 you could ask Borland to send you the 7.1 CD.

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

      Borland has not released any patch for the runtime 200 problem in the CRT unit--support was long since dropped before it came to light (it takes a PII-200 or better to expose it).  You'll have to get a third-party fix for it.

RE: Arrows and highlighting

(OP)
Yeah thats what I tried and it said I already had it fixed =P

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

Although having said all that, I have a dos based program in TP 6.0 that is running on a computer bought only a couple of weeks ago, and that is way in excess of PII 200, but isn't creating a problem. Most corporate computer set ups burden the processor so heavily that the chances of it operating fast enough to discover the fault are (sadly) slim. All that extra processing power so we can keep doing things at the same rate...

Since readkey is the only bit of crt I ever use, I now have my own interrupt calls in a unit. It's only a couple of lines of code. But this is all a bit past-it now, anyway (sniff)

RE: Arrows and highlighting

(OP)
OK, ive been testing and i can now get it to highlight in the correct place when the menu is placed any where on screen BUT now for some unknown reason the keys arent working =(

PROGRAM test;

PROCEDURE writeln(x,y:byte; s:string);
{display procedure. allows frames to be placed full screen and removes the need for gotoxy}

VAR
  i,j          : word;
  color        : word;
  sreenwidth   : integer;
  screenheight : integer;

BEGIN
  IF (x = 0) OR (y = 0) THEN
    exit;
  x := x + lo(Windmin)-1;
  y := y + hi(Windmin)-1;
  IF (x > lo(windmax)) OR (y > hi(windmax)) THEN
    exit;
  IF x+length(s)-1 > lo(windmax) THEN
    s := copy(s, 1, lo(windmax)-x+1);
  sreenwidth := memw[Seg0040:$4a];
  i := ( y * SreenWidth + x ) * sizeof(word);
  color := textattr;
  color := color shl 8;
  FOR j := 1 TO length(s) DO
   BEGIN
    memw[segB800:i] := color OR ord(s[j]);
    inc(i,2);
   END;
END;

PROCEDURE clrscr(x1,y1,x2,y2:byte);

VAR
  i,y : integer;

BEGIN
  y := y1 - 1;
  REPEAT
    y := y + 1;
    FOR i := x1 TO x2 DO
      writeln(i,y,' ');
  UNTIL y = y2;
END;

PROCEDURE menu(s:ARRAY OF string; x,y,h,m:integer);
{(s)tring, (h)ighlighted // y axis, (m)enu_size}

VAR
  b,c : integer; {(b)lank_space, (c)urrent, (l)ength}

BEGIN
  m := m - 1;
  FOR c := 0 TO m DO
    BEGIN
      IF c = h - 1 THEN
        BEGIN
          textcolor(black);
          textbackground(lightgray);
        END
      ELSE
        BEGIN
          textcolor(lightgray);
          textbackground(black);
        END;
      FOR b := 1 TO 10 DO
        writeln(x+b,y,#32);
      writeln(x,y+c,s[c]);
    END;
END;

PROCEDURE menu2(VAR key:char; VAR y,m,z:integer);

BEGIN
  REPEAT
    key := readkey;
  UNTIL key IN [#13,#72,#80];
  CASE key OF
    #72 : y := y - 1;
    #80 : y := y + 1;
  END;
  IF y < z THEN
    y := m;
  IF y > (z + m) THEN
    y := z;
END;

CONST
  s : ARRAY [0..8] OF string = ('A','B','C','D','E','F','G','H','I');

VAR
  y,m,z : integer;
  key   : char;

BEGIN
  y := 1;
  m := 8;
  z := y;
  clrscr(1,1,80,50);
  menu(s,1,y,1,m);
  REPEAT
    menu2(key,y,m,z);
  UNTIL key = #13;
END.

Thats the program im using to test it and in theory it should work. =@( Can any one help me please?

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

RE: Arrows and highlighting

You replace the writeln procedure with your own version, you shouldn't do that! Besides, your version is rather complicated; a procedure writexy containing gotoxy and write should do the job perfectly.

You replace the clrscr procedure with your own version, again: you shouldn't do that! Clrscr clears the active screen window, if you want to wipe a rectangular part of the screen, you can use the window procedure to define a new window, perform a clrscr and reset the window to the full screen size.

The reason why your keys don't seem to work is that you don't react on a keypress; you adjust the y value in menu2, you stay in the main repeat-until loop and you call menu2 again. No displaying in between?!

One other remark: pressing 'P' will have the same result as pressing ArrDn and pressing 'H' will have the same effect as pressing ArrUp. Use the following:
repeat
  ch:=readkey;
  if ch=#0 then ch2:=readkey;
until (ch in [#13]) or ((ch=#0) and (ch2 in [#72,#80]));

Regards,
Bert Vingerhoets
vingerhoetsbert@hotmail.com
http://student.vub.ac.be/~bvingerh/
Don't worry what people think about you. They're too busy wondering what you think about them.

RE: Arrows and highlighting

(OP)
lmao i cant believe i just did that! ive been a lil distracted to day so um sorry for wasting your time but thanks for the readkey stuff, I was pondering woulding H and P have the same effect.
Ive used window thrice before. ... yeah I get confused with it, it was never something i particularly needed. Any who, back to the code I go =D

Thanks again

~*Gwar3k1*~
"To the pressure, everything's just like: an illusion. I'll be losing you before long..."

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close