asked on

Turbo Pascal v.7 Records.

To EE,
I received an EditString Function from 'EE' embedded in a program using an 'Array' format. Great! I can extend the fields of input with prompts as I want making various adjustments.
My question now is: I want to apply this EditString to two procedures- 'Income' & 'Expenditure' in my college project. Both are of 'Record type' containing several fields with prompts but no Arrays.
I again want to allow the user to move within their entered text using the 'arrow keys' and 'back space key to edit out any errors they have left in the lines above or below before exiting and saving the record.
Best wishes.........Chrisbee.

My name is Mud

{$P+}
USES
CRT;
CONST
ARRIBA: BOOLEAN = FALSE;
ABAJO: BOOLEAN = FALSE;
LLENO: BOOLEAN = FALSE;
OKDONE: BOOLEAN = FALSE;
_FONDO: BYTE = 1;
_PLANO: BYTE = 4;
XM: INTEGER = 80;
YM: INTEGER = 25;
X1V: INTEGER = 1;
Y1V: INTEGER = 1;
X2V: INTEGER = 80;
Y2V: INTEGER = 25;
INTVIDEO = $10;
VGA_IN = $3DA;
VGA_VS = $08;
TYPE
PUNCHEQUE = ^CHEQUEDAT;
CHEQUEDAT = RECORD
DUM: CHAR;
PNU: STRING[10];
PCH: STRING[30];
CAN: STRING[4];
LOC: STRING[6];
PRO: STRING[20];
DOC: STRING[6];
FEC: STRING[8];
SUP: STRING[30];
END;
VAR
D: CHEQUEDAT;
KEY: CHAR;
SV: WORD;

FUNCTION SEGVID: WORD;
BEGIN
IF MEM[$0000:$0449] = 7 THEN
SEGVID:=$B000
ELSE
SEGVID:=$B800
END;

PROCEDURE WWRITE(X,Y: INTEGER; S: STRING; PPLANO,FONDO,CUANTAS: INTEGER);
VAR
W: WORD;
I,J,ATRCOL,LEN: INTEGER;
C: CHAR;

PROCEDURE WWWRITE(C: CHAR);
BEGIN
ATRCOL:=(FONDO SHL 4)+PPLANO;
W:=((Y-1)*XM+(X-1))*2; MEMW[SV:W]:=(ATRCOL SHL 8)+ORD(C)
END;

BEGIN
LEN:=LENGTH(S);
FOR J:=1 TO CUANTAS DO
FOR I:=1 TO LEN DO
BEGIN
IF (((X >= X1V) AND (X <= X2V)) AND ((Y >= Y1V) AND (Y <= Y2V))) THEN
BEGIN
C:=S[I];
WWWRITE(C)
END;
X:=X+1
END
END;

PROCEDURE RREAD(X,Y,LONG,PPLANO,FONDO: INTEGER; VAR DATO: STRING);
VAR
SPECIAL: CHAR;
L,L2,I: INTEGER;
C: CHAR;
NOM1: STRING;
BEGIN
I:=LENGTH(DATO); C:=#32; NOM1:=DATO; GOTOXY(X+I,Y); LLENO:=FALSE;
REPEAT
{None}
UNTIL KEYPRESSED;
WWRITE(X,Y,#32,PPLANO,FONDO,LONG);
REPEAT
IF KEYPRESSED THEN
BEGIN
C:=READKEY; GOTOXY(X+I+1,Y); L:=LENGTH(NOM1);
CASE C OF
#0: BEGIN
IF KEYPRESSED THEN
SPECIAL:=READKEY;
CASE SPECIAL OF
#71: BEGIN
I:=0;
GOTOXY(X+I,Y)
END;
#79: BEGIN
I:=L;
GOTOXY(X+I,Y)
END;
#72: BEGIN
ARRIBA:=TRUE;
ABAJO:=FALSE;
I:=LONG
END;
#80: BEGIN
ARRIBA:=FALSE;
ABAJO:=TRUE;
I:=LONG
END;
#75: IF I >= 1 THEN
BEGIN
I:=I-1;
GOTOXY(X+I,Y);
END
ELSE
GOTOXY(X+I,Y);
#77: IF I < L-1 THEN
BEGIN
I:=I+1;
GOTOXY(X+I,Y);
END
ELSE
GOTOXY(X+I,Y);
#83: IF I <= L THEN
BEGIN
DELETE(NOM1,I+1,1);
C:=#32;
WWRITE(X,Y,NOM1+' ',PPLANO,FONDO,1);
GOTOXY(X+I,Y)
END
END
END;
#27: BEGIN
OKDONE:=TRUE;
I:=LONG
END;
#13: BEGIN
ABAJO:=TRUE;
I:=LONG;
END;
#8:
BEGIN { <RETRO> }
IF I >= 1 THEN
BEGIN
DELETE(NOM1,I,1);
I:=I-1;
C:=#32;
WWRITE(X,Y,NOM1+' ',PPLANO,FONDO,1);
GOTOXY(X+I,Y)
END
ELSE
BEGIN
GOTOXY(X,Y);
C:=#32
END;
END;
ELSE
BEGIN
IF I < LONG THEN
BEGIN
L2:=LENGTH(NOM1);
IF L2 >= LONG THEN
BEGIN
WRITE(^G^G^G);
END
ELSE
BEGIN
I:=I+1;
INSERT(C,NOM1,I)
END
END
ELSE IF I >= LONG THEN
BEGIN
I:=LONG;
LLENO:=TRUE
END;
END { Letras }
END
END;
WWRITE(X,Y,NOM1,PPLANO,FONDO,1)
UNTIL I=LONG;
DATO:=NOM1
END;

PROCEDURE CURSOR(ONOFF: INTEGER); Assembler;
ASM
CMP ONOFF,0
JNE @BRINCA1
MOV AH,$01
MOV CL,$20
MOV CH,$20
INT INTVIDEO
JMP @OK
@BRINCA1:
CMP ONOFF,1
JNE @BRINCA2
MOV AH,$01
MOV CL,$07;
MOV CH,$06;
INT INTVIDEO
JMP @OK
@BRINCA2:
MOV AH,$01
MOV CL,$07
MOV CH,$00
INT INTVIDEO
@OK:
END;

PROCEDURE PON_ALTAS;
VAR
D: CHEQUEDAT;
BEGIN
ClrScr;
{LIMPIA_VENTANA;}
{PON_LETRAS(1);}
WWRITE(4,12,'Part Num: ',WHITE,_FONDO,1);
WWRITE(14,12,' ',WHITE,BLACK,10);
WWRITE(4,14,'Articulo: ',WHITE,_FONDO,1);
WWRITE(14,14,' ',WHITE,BLACK,30);
WWRITE(4,16,'Cantidad: ',WHITE,_FONDO,1);
WWRITE(14,16,' ',WHITE,BLACK,4);
WWRITE(4,18,'Encargado: ',WHITE,_FONDO,1);
WWRITE(14,18,' ',WHITE,BLACK,30);
WWRITE(47,12,'Programa: ',WHITE,_FONDO,1);
WWRITE(57,12,' ',WHITE,BLACK,20);
WWRITE(46,14,'Localidad: ',WHITE,_FONDO,1);
WWRITE(57,14,' ',WHITE,BLACK,6);
WWRITE(46,16,'Documento: ',WHITE,_FONDO,1);
WWRITE(57,16,' ',WHITE,BLACK,6);
WWRITE(50,18,'Fecha: ',WHITE,_FONDO,1);
WWRITE(57,18,' ',WHITE,BLACK,8);
{SETXYWINDOW(1,1,80,25);
FILLCHAR(D,SIZEOF(CHEQUEDAT),#0);
IF INTRO_DATOS(D) THEN
BEGIN
FILLEMPTYDATA(D);
J:=2;
DBFBUFFER[1]:=#32;
FOR I:=1 TO 8 DO
BEGIN
MOVE(PTR(SEG(D),OFS(D)+J)^,
PTR(SEG(DBFBUFFER),OFS(DBFBUFFER)+DBFCONTENTSTART[I]-1)^,
DBFLENGTHS[I]);
J:=J+DBFLENGTHS[I]+1;
END;
DBFHEADING.RECORDCOUNT:=DBFHEADING.RECORDCOUNT+1;
WRITEDBFHEADER;
WRITEDBFRECORD(DBFHEADING.RECORDCOUNT);
END;}
END;

FUNCTION INTRO_DATOS(VAR DUMMY: CHEQUEDAT): BOOLEAN;
VAR
CANTIDAD: REAL;
ERROR: INTEGER;
SELECTOR: BYTE;
OK: BOOLEAN;
BEGIN
CURSOR(1); SELECTOR:=1; OK:=FALSE; OKDONE:=FALSE; KEY:=#0;
REPEAT
CASE SELECTOR OF
1: RREAD(14,12,10,15,0,DUMMY.PNU);
2: RREAD(14,14,30,15,0,DUMMY.PCH);
3: RREAD(14,16,4,15,0,DUMMY.CAN);
4: RREAD(14,18,30,15,0,DUMMY.SUP);
5: RREAD(57,12,20,15,0,DUMMY.PRO);
6: RREAD(57,14,6,15,0,DUMMY.LOC);
7: RREAD(57,16,6,15,0,DUMMY.DOC);
8: RREAD(57,18,8,15,0,DUMMY.FEC);
END;
IF (SELECTOR = 3) AND (DUMMY.CAN <> '') THEN
BEGIN
VAL(DUMMY.CAN,CANTIDAD,ERROR);
IF ERROR <> 0 THEN
BEGIN
WWRITE(14,16,' ',BLACK,BLACK,4);
ARRIBA:=FALSE; ABAJO:=FALSE; WRITE(^G^G^G); DUMMY.CAN:='';
END
END;
{ELSE IF SELECTOR = 5 THEN}
IF ARRIBA AND (SELECTOR > 1) THEN
BEGIN
DEC(SELECTOR); ARRIBA:=FALSE
END;
IF ABAJO AND (SELECTOR < 8) THEN
BEGIN
INC(SELECTOR); ABAJO:=FALSE
END
ELSE IF ABAJO AND (SELECTOR = 8) THEN
BEGIN
OKDONE:=TRUE; ABAJO:=FALSE
END;
IF LLENO THEN
BEGIN
IF SELECTOR = 8 THEN
BEGIN
OKDONE:=TRUE; LLENO:=FALSE
END
ELSE
BEGIN
OKDONE:=FALSE; INC(SELECTOR)
END
END;
IF OKDONE THEN
BEGIN
IF ((DUMMY.PNU = '') AND (DUMMY.PCH = '') AND
(DUMMY.CAN = '') AND (DUMMY.SUP = '') AND
(DUMMY.PRO = '') AND (DUMMY.LOC = '') AND
(DUMMY.DOC = '') AND (DUMMY.FEC = '')) THEN
BEGIN
KEY:=#27;
END;
WRITE(^G^G^G);
REPEAT
{IF ODD(_S) THEN}
WWRITE(24,22,' ~~~ Datos Correctos (S/N) ~~~ ',12,_PLANO,1)
{ELSE
WWRITE(24,22,' ~~~ Datos Correctos (S/N) ~~~ ',14,_PLANO,1)};
IF KEYPRESSED THEN
BEGIN
KEY:=READKEY; KEY:=UPCASE(KEY)
END
UNTIL (KEY = 'S') OR (KEY = 'N') OR (KEY = #27);
WWRITE(26,22,' ',12,6,28);
IF KEY = 'N' THEN
BEGIN
OK:=FALSE; OKDONE:=FALSE; KEY:=#0;
END
ELSE IF KEY = #27 THEN
OK:=TRUE
ELSE IF KEY = 'S' THEN
BEGIN
OK:=TRUE; OKDONE:=FALSE
END;
WWRITE(24,22,' ',_PLANO+8,_PLANO,32);
END;
UNTIL OK;
IF KEY = 'S' THEN INTRO_DATOS:=TRUE
ELSE INTRO_DATOS:=FALSE;
END;

Begin
SV:=SegVid;
Pon_Altas;
Intro_Datos(D);
End.

chrisbee

ASKER

I am Greatful to 'WhatBoy' for the time he spent writing this answer down But I cannot visibly make out from the code what language his variables are in. At My Level of programming, and with the greatest of respect, I need it in English and basic Pascal v.7. I will however, post the question again and hope for an equal answer of magnitude to that he has given me

Hypo

Hello Chrisbee... This EditString, was it the one I sent you??? If you haven't modifyed that function too much, you should be able to use it with records aswell... aslong as you parse a string-variable to the function it should work propertly.

Plz, If it doesn't work, I want to take a look at your record...

chrisbee

ASKER

To Hypo!

Great to hear from you. Yes it is the string you sent me and what great fun I had with it. I still have the original EditString you wrote and will keep a copy of that as a master, However in my project I have two files- file of Income, and file of expenditure I don't have arrays in these (Iv'e chosen not to) However, both files contain records of user inputed transactions into the various named fields ie;

Income-
date-
month-
salary-
miscIn-
from-
WkNo- (primary key)
TransNo- (secondary key)

Expenditure is similar. I have almost succeeded but have got in a muddle halfway through so having the master copy I reloaded again to your original copy but alas got into the same muddle but a little further on.

I can use the edstring you gave me by adding to the fields or decreasing the fields and have clipped the inputs from deleting the prompt areas - I also isolated the function from the main prog
and turned the main program into a procedure which I can call up. It works great but only in arrays at the moment. I was watching for your name to come up on screen again to ask you how to adapt it for records. There's 75 points on offer here for you.(bit more generous)
similar to last time, I would like procedures or functions in test harness so I can keep re-useing. I would send you my code attempts but can't see how to attach them.
Best wishes............chrisbee.

Hypo

Hello Chrisbee...
You can send me your code to my E-mail

Anyway, It should work with all strings... I guess it's not the EditString that's the problem. Anyway, If you'll send me your code I'll make and post an example, as you requested, wich will show you how you could use it in your program.

My EMail: Niclas_flysjo@Hotmail.com

/Hypo

Hypo

{Here's an example!}
{$G+}
Program EditStrings;
uses crt;

type TTColor = record
Active,
Inactive : word;
end;

type TCustomer = record
Name : string;
Address : array[1..2] of string;
Town,
Country,
PostCode : string;
Income : longint;
end;

Const TColor : TTColor = (Active:10; Inactive:10);

var Customer : array[0..7] of TCustomer;
Lp,CLp : integer;
Ec : byte;
Key : byte;
Ext : boolean;

TStr : String;
TCde : Integer;
TOld : longint;

Procedure GetKey;
begin
Key := ord(readkey);
if Key = 0 then begin
Key := ord(readkey);
Ext := true;
end else Ext := false;
end;

Function EditString(var S : string; Wx,Wy,MaxLen : word) : byte;
var
Pos,
ECode : byte;
Insrt : Boolean;
T : string;

Procedure ClearLine(X,Y,Len : word; Col : byte); assembler;
asm
MOV AX,SegB800
MOV ES,AX
MOV AX,Y
MOV DI,Y
SHL AX,4
SHL DI,6
ADD DI,AX
ADD DI,X
ADD DI,DI
MOV AH,Col
MOV CX,Len
MOV AL,32
REP STOSW
end;

procedure NormalCursor; assembler;
asm
MOV AH,01;
MOV CH,4;
MOV CL,5;
INT 10h;
end;

procedure InsertCursor; assembler;
asm
MOV AH,01;
MOV CH,0;
MOV CL,8;
INT 10h;
end;

begin
Insrt := False;
T := S;
TextColor(Lo(TColor.Active));
TextBackground(Hi(TColor.Active));
Pos := Length(T);
repeat

GotoXy(Wx,Wy); { Update string on Screen }
Write(T);
ClearLine(Wx+Length(T)-1,Wy-1,MaxLen-Length(T),Lo(TColor.Active)+Hi(TColor.Active) shl 4);
GotoXy(Wx+Pos,Wy);

GetKey; { Check for and handle Keypress }
If Ext then begin
If (Key = 71) then Pos := 0;
If (Key = 79) then Pos := Length(T);
If (Key = 77) and (Pos < Length(T)) then inc(Pos);
If (Key = 75) and (Pos > 0) then dec(Pos);
If (Key = 83) then delete(T,Pos+1,1);
If (Key = 82) then begin
Insrt := not Insrt;
If Insrt then InsertCursor else NormalCursor;
end;
end else begin
If (Key = 8) and (Pos > 0) then begin delete(T,Pos,1); dec(Pos); end;
If (Key > 31) then begin
If Insrt and (Pos < Length(T)) then begin
T[Pos+1] := chr(Key);
inc(Pos);
end else if Length(T) < MaxLen then begin
insert(chr(Key),T,Pos+1);
inc(Pos);
end;
end;
end;
{ Exit loop if keypress = Escap, Enter, Tab, Up arrow or Down arrow }
until (Key = 27) or (Key = 13) or (Key = 9)
or (Ext and ((Key = 72) or (Key = 80)));

If Key = 27 then begin T := S; ECode := 4; end else
If Key = 13 then Ecode := 0 else
If Key = 9 then Ecode := 1 else
If Key = 72 then Ecode := 2 else
If Key = 80 then Ecode := 3;

TextColor(Lo(TColor.InActive));
TextBackground(Hi(TColor.InActive));
GotoXy(Wx,Wy);
Write(T);
ClearLine(Wx+Length(T)-1,Wy-1,MaxLen-Length(T),Lo(TColor.InActive)+Hi(TColor.InActive) shl 4);
If Insrt then NormalCursor;
EditString := ECode;
S := T;
end;

begin
clrscr;
TColor.Active := 15+1 shl 8; { Set Active/Inactive textcolors }
TColor.InActive := 7;
TextColor(TColor.InActive);
TextBackground(Hi(TColor.InActive));
GotoXY(1,4);
Writeln(' Name : ');
Writeln(' Income : ');
Writeln(' Address 1 : ');
Writeln(' Address 2 : ');
Writeln(' Town : ');
Writeln(' Country : ');
Writeln(' PostCode : ');
GotoXY(16,4);
CLp := 0;
repeat
GetKey;
If Ext then begin
If Key = 72 then dec(lp);
If Key = 80 then inc(lp);
If Key = 73 then inc(CLp);
If Key = 81 then dec(CLp);
If Lp < 0 then Lp := 6 else if Lp > 6 then Lp := 0;
CLp := CLp and 7;
If (Key = 81) or (Key = 73) then begin
GotoXY(16,4); Write('':40); GotoXY(16,4); Writeln(Customer[CLp].Name);
GotoXY(16,5); Write('':40); GotoXY(16,5); Writeln(Customer[CLp].Income);
GotoXY(16,6); Write('':40); GotoXY(16,6); Writeln(Customer[CLp].Address[1]);
GotoXY(16,7); Write('':40); GotoXY(16,7); Writeln(Customer[CLp].Address[2]);
GotoXY(16,8); Write('':40); GotoXY(16,8); Writeln(Customer[CLp].Country);
GotoXY(16,9); Write('':40); GotoXY(16,9); Writeln(Customer[CLp].Town);
GotoXY(16,10);Write('':40); GotoXY(16,10);Writeln(Customer[CLp].PostCode);
GotoXy(1,1); Write('Customer # ',CLp);
end;
GotoXy(16,4+Lp);
end else begin
If Key = 13 then repeat
If Lp = 1 then begin
TOld := Customer[CLp].Income;
str(Customer[CLp].Income,TStr);
Ec := EditString(TStr,16,4+Lp,40);
Val(TStr,Customer[CLp].Income,TCde);
If TCde <> 0 then Customer[CLp].Income := TOld;
GotoXY(16,4+Lp); Writeln('':40);
GotoXY(16,4+Lp); Writeln(Customer[CLp].Income);
GotoXY(16,4+Lp);
end else Case Lp of
0 : Ec := EditString(Customer[CLp].Name ,16,4+Lp,40);
2 : Ec := EditString(Customer[CLp].Address[1],16,4+Lp,40);
3 : Ec := EditString(Customer[CLp].Address[2],16,4+Lp,40);
4 : Ec := EditString(Customer[CLp].Town ,16,4+Lp,40);
5 : Ec := EditString(Customer[CLp].Country ,16,4+Lp,40);
6 : Ec := EditString(Customer[CLp].PostCode ,16,4+Lp,40);
end;
If (Ec = 1) or (Ec = 3) then inc(Lp);
If (Ec = 2) then dec(Lp);
If Lp < 0 then Lp := 6 else if Lp > 6 then Lp := 0;
until (Ec = 0) or (Ec = 4);
end;
until (Key = 27);
Textbackground(0);
end.

ASKER CERTIFIED SOLUTION

Hypo

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

chrisbee

ASKER

Hi Hypo!

Thanks so much for the quick reply. I am now going to sit a nd study what you have written for me and learn a bit more. I'm getting there slowly. I shall save your entire program then experiment with a copy in testharness.
My data sheet for the income file input will look like this:-

Date:
Month;
Salary
Payer:
MiscIn: (miscelaneous income)
Total:
WkNo:
TranNo:
InDel:
The expenditure will be similar. The Date will be a little more complicated as I have written and validated a procedure for the user to input the date which I want to call up in the record.

Thanks again for all your help- I shall be back...........Chrisbee.

chrisbee

ASKER

To Hypo!

Thanks for the tips on records. I studied your prog and have written both of my input procedures- 'TIncome'=RECORD' and 'TEXpend=RECORD'
It looks pretty impressive but needs further study as I can't get it to compile yet but we are getting nearer. I think the problem is to do with the fact that I didn't need the arrays and have declared all the fields the same way.

If I hit difficulties again may I show the code to you for some comments, however I shall have a go first to try and crack it on my own- I have a while yet before the project has to be in.
Best wishes..........Chrisbee.