Arrows and highlighting

[gwar2k1]

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 &quot;on top&quot; 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 &quot;normal&quot; 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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[realm174]

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.

 

[gwar2k1]

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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[lionelhill]

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!

 

[dkdude]

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

[tt]
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 &quot;valid keys&quot; }

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.
------------------------------------------------------
[/tt]

 

[gwar2k1]

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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[gwar2k1]

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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[gwar2k1]

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

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

 

[Bertv100]

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.

 

[gwar2k1]

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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[gwar2k1]

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) + 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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[Bertv100]

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.

 

[gwar2k1]

i changed writexy to writeln. I made the changes you said and now it only displays one item from the array. Ironicly: &quot;properly!&quot;

When I pass h instead of z, it writes &quot;properly!&quot; 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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[Bertv100]

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.

 

[LorenPechtel]

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;

 

[Bertv100]

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.

 

[gwar2k1]

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*~
&quot;To the pressure, everything's just like: an illusion. I'll be losing you before long...&quot;

 

[LorenPechtel]

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.

 

[gwar2k1]

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

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

 

[lionelhill]

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)