home *** CD-ROM | disk | FTP | other *** search
- (*******************************************************************)
- (* *)
- (* This program demonstrates some of the capabilities of EM3270 *)
- (* a set of Turbo Pascal procedures for screen handling pat- *)
- (* terned after the IBM 3270 family of terminals. *)
- (* *)
- (* The routines are Copyrighted (C) 1984-1986 by Piedmont *)
- (* Specialty Software, P. O. Box 6637, Macon, GA 31208, and *)
- (* are distributed as "user supported software", also called *)
- (* "shareware". You are free to copy, distribute, and use these *)
- (* procedures as long as you do not change them or use them in *)
- (* any commercial software product; that is, any program you *)
- (* sell to someone else. If you find these routines useful, a *)
- (* contribution of $20.00, payable to Piedmont Specialty Soft- *)
- (* ware at the above address, would be in order and appreciated *)
- (* *)
- (* Commercial licenses for the use of EM3270 are available. *)
- (* Contact PSS at the above address, or call (912) 474-2318 *)
- (* for details. *)
- (* *)
- (* THIS PROGRAM REQUIRES TURBO PASCAL VERSION 3 TO COMPILE. *)
- (* EM3270 COMPILES PROPERLY UNDER VERSION 2 OR 3 *)
- (* *)
- (*******************************************************************)
-
-
-
-
- Program EMDEMO;
-
- {$V-} (* <--- ABSOLUTELY NECESSARY!!! *)
-
- Const
- MaxFields = 96; (* <--- ABSOLUTELY NECESSARY!!! *)
-
- {$I EM3270.INC}
-
- Type
- VRec = Record
- Name : String[25];
- Addr1 : String[35];
- Addr2 : String[35];
- City : String[20];
- State : String[2];
- ZIP : String[5];
- End;
-
- FRec = Record
- Memb : String[5];
- Name : String[25];
- BDM : String[2];
- BDD : String[2];
- BDY : String[2];
- DJM : String[2];
- DJD : String[2];
- DJY : String[2];
- Stat : String[1];
- BPAC : String[3];
- BPEX : String[3];
- BPNU : String[4];
- BPX : String[4];
- HPAC : String[3];
- HPEX : String[3];
- HPNU : String[4];
- Addr1 : String[35];
- Addr2 : String[35];
- City : String[20];
- State : String[2];
- ZIP : String[5];
- End;
-
- Const
- Spaces : String[35] = ' ';
-
- Var
- FK : AID; (* Must have at least one var of type AID *)
- Attr : Byte;
- VRcd : Vrec;
- FRcd : Array[1..10] of FRec;
- Mem,
- LastM : Integer;
-
-
- (************************)
- (* The WELCOME Screen *)
- (************************)
-
- Procedure WelcomeScreen;
-
- Const
- Please : String[27] = 'PLEASE ENTER YOUR PASSWORD:';
-
- Var
- Password : String[8];
-
- Begin
- NewScreen; (* Clear screen and heap *)
-
- (* Write the prompts to the screen *)
-
- WritePrompt (23,1,Dim,35,'WELCOME TO THE EM3270 DEMONSTRATION');
- WritePrompt (1,3,Dim,79,
- 'EM3270 is a collection of TURBO PASCAL procedures providing full screen editing');
- WritePrompt (1,4,Dim,75,
- 'facilities patterned after the IBM 3270 family of terminals. The "PASSWORD"');
- WritePrompt (1,5,Dim,78,
- 'data entry field below is an example of an INVISIBLE field. If you press ENTER');
- WritePrompt (1,6,Dim,78,
- 'without keying any data into it, you will see an example of a BLINK attribute,');
- WritePrompt (1,7,Dim,78,
- 'an effective edit error highlighting technique. Next key a password (anything)');
- WritePrompt (1,8,Dim,78,
- 'and notice the effect of the INVISIBLE attribute as you key. Press ENTER after');
- WritePrompt (1,9,Dim,75,
- 'keying the password and see it echoed to the screen - proving that the data');
- WritePrompt (1,10,Dim,57,
- 'from an INVISIBLE field is really available to a program.');
- WritePrompt (11,13,Dim,27,Please);
-
- (* Initialize the data field (bright, invisible) *)
-
- WriteField (39,13,Invisible,8,' ');
-
- (* Put Cursor in field 1 and get data *)
-
- Repeat
- ReadScreen (1,FK);
- Until FK in [Enter,Escape];
- If FK = Escape then Exit;
-
- (* Retrieve the entered data *)
-
- GetField (1,Password,Attr);
- While Password = ' ' do
- Begin
- WritePrompt (11,13,Dim+Blinking,27,Please);
- Repeat
- ReadScreen (1,FK);
- Until FK in [Enter,Escape];
- If FK = Escape then Exit;
- GetField (1,Password,Attr);
- End;
-
- (* Display the entered password *)
-
- GotoXY (11,15); (* Note that normal TURBO screen output *)
- SetVid (Dim); (* can be intermixed with EM3270 I/O *)
- Write ('The password you entered was ',Password);
- WritePrompt (11,17,0,41,'Press ENTER to continue; Esc to terminate');
-
- Repeat ReadScreen (1,FK) until FK in [Enter,Escape];
-
- End; (* of WelcomeScreen procedure *)
-
- (**************)
- (* Screen 2 *)
- (**************)
-
- Procedure Screen2;
-
- Begin
-
- (* Set the default colors *)
-
- BrightBG := Red;
- BrightFG := Yellow;
- DimBG := Blue;
- DimFG := White;
-
- NewScreen; (* Clear the screen and heap *)
-
- (* Display all the prompts *)
-
- WritePrompt (1,1,Dim,79,
- 'There are four data entry fields at the bottom of this screen. Two are "bright"');
- WritePrompt (1,2,Dim,77,
- 'and two are "dim". If you are running this program with a color monitor, dim');
- WritePrompt (1,3,Dim,78,
- 'fields are white on blue and bright fields are yellow on red. The default col-');
- WritePrompt (1,4,Dim,78,
- 'ors are controlled by the BYTE variables BrightBG, BrightFG, DimBG, and DimFG.');
- WritePrompt (1,5,Dim,76,
- 'The foreground (letter) colors can also be controlled on an individual field');
- WritePrompt (1,6,Dim,36,'basis through the use of attributes.');
- WritePrompt (38,6,0,24,'This is a bright prompt.');
- WritePrompt (63,6,Dim,17,'All other prompts');
- WritePrompt (1,7,Dim,8,'are dim.');
- WritePrompt (10,7,Dim+Cyan,47,'This is a dim prompt with an attribute of CYAN.');
- WritePrompt (58,7,Dim,19,'If you have a mono-');
- WritePrompt (1,8,Dim,75,
- 'chrome monitor, dim is white on black and bright is inverse video (always).');
- WritePrompt (1,10,Dim,76,
- 'In normal usage, prompts are dim and data fields are bright. Dim data fields');
- WritePrompt (1,11,Dim,75,
- 'cause the problems shown below. With them you must either show the user the');
- WritePrompt (1,12,Dim,78,
- 'field limits with some delimiter character (as with field 2) or make her guess');
- WritePrompt (1,13,Dim,78,
- 'at the field length (as in field 4). Play with these fields to become familiar');
- WritePrompt (1,14,Dim,75,
- 'with the cursor control keys: Right Arrow, Left Arrow, NewLine (PgDn), Tab,');
- WritePrompt (1,15,Dim,39,'and BackTab (Backspace or shifted Tab).');
- WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
- WritePrompt (4,22,Dim,66,
- 'F1: Vertical Screen F2: Horizontal Screen F3: Free Form Screen');
- WritePrompt (4,23,Dim,14,'Esc: Terminate');
- GotoXY (40,17); (* Write the *)
- Write (':'); (* field delimiters *)
- GotoXY (61,17); (* for data field 2 *)
- Write (':');
-
- (* Initialize the data fields *)
-
- WriteField (11,17,0,20,'THIS IS FIELD 1');
- WriteField (41,17,Dim,20,'THIS IS FIELD 2');
- WriteField (11,18,0,20,'THIS IS FIELD 3');
- WriteField (41,18,Dim,25,'THIS IS FIELD 4');
-
- (* Wait for AID key *)
-
- Repeat ReadScreen (1,FK) until FK in [Escape,F1,F2,F3];
-
- End;
-
- (*********************)
- (* Vertical Screen *)
- (*********************)
-
- Procedure VerticalScreen;
-
- Procedure UpStr (Var Str : ScreenLine);
- Var I : Integer;
- Begin
- For I := 1 to Length(Str) do Str[I] := UpCase(Str[I]);
- End;
-
- Begin
-
- (* Set the default colors *)
-
- BrightBG := Blue;
- BrightFG := Yellow;
- DimBG := Red;
- DimFG := White;
-
- NewScreen; (* Clear the screen and heap *)
-
- (* Display all the prompts *)
-
- WritePrompt (15,1,Dim,53,
- 'THIS IS AN EXAMPLE OF A VERTICAL SINGLE RECORD SCREEN');
- WritePrompt (36,3,Dim,4,'NAME');
- WritePrompt (26,4,Dim,14,'ADDRESS LINE 1');
- WritePrompt (26,5,Dim,14,'ADDRESS LINE 2');
- WritePrompt (36,6,Dim,4,'CITY');
- WritePrompt (35,7,Dim,5,'STATE');
- WritePrompt (37,8,Dim,3,'ZIP');
- WritePrompt (1,10,Dim,79,
- 'Vertical format screens are typically used for records that have long fields or');
- WritePrompt (1,11,Dim,78,
- 'too many fields to fit on one line. Balancing prompts and data fields around a');
- WritePrompt (1,12,Dim,78,
- 'central vertical line makes for an easy to read, highly productive screen. The');
- WritePrompt (1,13,Dim,78,
- 'disadvantage of a vertical format is that the operator can only key one record');
- WritePrompt (1,14,Dim,76,
- 'per screen. This can be counterproductive in a mainframe application, but on');
- WritePrompt (1,15,Dim,32,'PC''s it is generally no problem.');
- WritePrompt (1,17,Dim,77,
- 'Enter some data into this screen and press ENTER. The program will convert it');
- WritePrompt (1,18,Dim,76,
- 'to upper case and rewrite it, illustrating the RewriteField procedure. These');
- WritePrompt (1,19,Dim,76,
- 'large fields are also good for practicing the use of Ins, Del, and EraseEOF.');
- WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
- WritePrompt (4,22,Dim,66,
- 'F1: Vertical Screen F2: Horizontal Screen F3: Free Form Screen');
- WritePrompt (4,23,Dim,14,'Esc: Terminate');
-
- With VRcd do
- Begin
-
- (* Initialize the data fields *)
-
- WriteField (41,3,0,25,Name);
- WriteField (41,4,0,35,Addr1);
- WriteField (41,5,0,35,Addr2);
- WriteField (41,6,0,20,City);
- WriteField (41,7,0,2,State);
- WriteField (41,8,0,5,ZIP);
-
- (* Retrieve and rewrite screen fields *)
-
- Repeat
- ReadScreen (1,FK);
- If FK = Enter Then
- Begin
- GetField (1,Name,Attr);
- UpStr (Name);
- RewriteField (1,Name,0);
- GetField (2,Addr1,Attr);
- UpStr (Addr1);
- RewriteField (2,Addr1,0);
- GetField (3,Addr2,Attr);
- UpStr (Addr2);
- RewriteField (3,Addr2,0);
- GetField (4,City,Attr);
- UpStr (City);
- RewriteField (4,City,0);
- GetField (5,State,Attr);
- UpStr (State);
- RewriteField (5,State,0);
- GetField (6,ZIP,Attr);
- UpStr (ZIP);
- RewriteField (6,ZIP,0);
- End;
- until FK in [Escape,F1,F2,F3];
- End; (* of With *)
- End; (* of procedure VerticalScreen *)
-
-
- (***********************)
- (* Horizontal Screen *)
- (***********************)
-
- Procedure HorizontalScreen;
-
- Var I : Integer;
-
- Begin
-
- (* Set the default colors *)
-
- BrightBG := Black;
- BrightFG := Yellow;
- DimBG := Magenta;
- DimFG := Yellow;
-
- NewScreen; (* Clear the screen and heap *)
-
- (* Display all the prompts *)
-
- WritePrompt (14,1,Dim,54,
- 'THIS IS AN EXAMPLE OF A HORIZONTAL MULTI RECORD SCREEN');
- WritePrompt (1,3,Dim,4,'ITEM');
- WritePrompt (17,3,Dim,15,'CATALOG PRICE');
- WritePrompt (62,3,Dim,9,'WAREHOUSE');
- WritePrompt (1,4,Dim,78,
- 'NBR. QUANTITY NUMBER EACH DESCRIPTION LOCATION STATUS');
- WritePrompt (1,17,Dim,73,
- 'Horizontal format screens are used for entry of multiple identical format');
- WritePrompt (1,18,Dim,75,
- 'transactions, such as items on an order. The NewLine (PgDn) key is handy on');
- WritePrompt (1,19,Dim,76,
- 'this type of screen for quickly reaching a specific record. The demo program');
- WritePrompt (1,20,Dim,63,
- 'does absolutely nothing with the data you enter on this screen.');
- WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
- WritePrompt (4,22,Dim,66,
- 'F1: Vertical Screen F2: Horizontal Screen F3: Free Form Screen');
- WritePrompt (4,23,Dim,14,'Esc: Terminate');
-
- (* Initialize the fields *)
-
- For I := 1 to 12 do
- Begin
- GotoXY (2,I+4);
- SetVid (Dim);
- Write (I:2);
- WriteField (9,I+4,0,5,' ');
- WriteField (17,I+4,0,7,' ');
- WriteField (27,I+4,0,6,' ');
- WriteField (35,I+4,0,25,' ');
- WriteField (62,I+4,0,2,' ');
- WriteField (65,I+4,0,3,' ');
- WriteField (69,I+4,0,1,' ');
- WriteField (75,I+4,0,2,' ');
- End;
-
- (* Do data entry *)
-
- Repeat ReadScreen (1,FK) until FK in [Escape,F1,F2,F3];
-
- End;
-
-
- (**********************)
- (* Free Form Screen *)
- (**********************)
-
- Procedure FreeFormScreen;
-
- Type
- WindowLit = Array[1..16] of String[62];
-
- Const
- Windo : WindowLit =
- ('╔════════════════════════════════════════════════════════════╗',
- '║ A free form screen is the least desirable format because ║',
- '║ it usually has a cluttered look. For large records with ║',
- '║ many fields, however, it is frequently the only choice. ║',
- '║ ║',
- '║ With this screen the program simulates a file maintenance ║',
- '║ program. You can add or change records, browse forward or ║',
- '║ backward, or do indexed file retrieval. See the instruc- ║',
- '║ tion panel for function key usage. The file isn''t real. It ║',
- '║ is held in RAM and consists of ten records maximum. ║',
- '║ ║',
- '║ Note that the area code fields are "out of sequence" on ║',
- '║ the screen and provided with defaults. ║',
- '║ ║',
- '║ PRESS ANY KEY TO CONTINUE ║',
- '╚════════════════════════════════════════════════════════════╝');
-
-
- Var
- Key : String[5];
- I : Integer;
- At : Byte;
-
- Procedure Prompts; (* Display all the prompts *)
- Begin
- WritePrompt (21,1,Dim,40,
- 'THIS IS AN EXAMPLE OF A FREE FORM SCREEN');
- WritePrompt (1,3,Dim,14,'MEMBER # NAME');
- WritePrompt (38,3,Dim,31,'BIRTH DATE DATE JOINED STATUS');
- WritePrompt (41,4,0,4,'/ /');
- WritePrompt (54,4,0,4,'/ /');
- WritePrompt (9,6,Dim,28,'PHONE (B) ( ) - EXT');
- WritePrompt (9,7,Dim,20,'PHONE (H) ( ) -');
- WritePrompt (11,8,Dim,8,'ADDRESS');
- WritePrompt (39,10,Dim,1,',');
- WritePrompt (17,12,Dim,48,'╔══════════════════════════════════════════════╗');
- WritePrompt (17,13,Dim,48,'║ Alt-F1: Add Record Alt-F2: Change Record ║');
- WritePrompt (17,14,Dim,48,'║ Alt-F3: Next Record Alt-F4: Previous Record ║');
- WritePrompt (17,15,Dim,48,'║ Alt-F5: Find Member Alt-F10: HELP ║');
- WritePrompt (17,16,Dim,48,'╚══════════════════════════════════════════════╝');
- WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
- WritePrompt (4,22,Dim,66,
- 'F1: Vertical Screen F2: Horizontal Screen F3: Free Form Screen');
- WritePrompt (4,23,Dim,14,'Esc: Terminate');
- End;
-
- Procedure RetrieveRcd; (* Get all the fields from the screen *)
- Begin
- With FRcd[Mem] do
- Begin
- GetField (1,Memb,Attr);
- GetField (2,Name,Attr);
- GetField (3,BDM,Attr);
- GetField (4,BDD,Attr);
- GetField (5,BDY,Attr);
- GetField (6,DJM,Attr);
- GetField (7,DJD,Attr);
- GetField (8,DJY,Attr);
- GetField (9,Stat,Attr);
- GetField (10,BPEX,Attr);
- GetField (11,BPNU,Attr);
- GetField (12,BPX,Attr);
- GetField (13,HPEX,Attr);
- GetField (14,HPNU,Attr);
- GetField (15,Addr1,Attr);
- GetField (16,Addr2,Attr);
- GetField (17,City,Attr);
- GetField (18,State,Attr);
- GetField (19,ZIP,Attr);
- GetField (20,BPAC,Attr);
- GetField (21,HPAC,Attr);
- End;
- End;
-
- Procedure DisplayRcd;
- Begin
- With FRcd[Mem] do
- Begin
- RewriteField (1,Memb,0);
- RewriteField (2,Name,0);
- RewriteField (3,BDM,0);
- RewriteField (4,BDD,0);
- RewriteField (5,BDY,0);
- RewriteField (6,DJM,0);
- RewriteField (7,DJD,0);
- RewriteField (8,DJY,0);
- RewriteField (9,Stat,0);
- RewriteField (10,BPEX,0);
- RewriteField (11,BPNU,0);
- RewriteField (12,BPX,0);
- RewriteField (13,HPEX,0);
- RewriteField (14,HPNU,0);
- RewriteField (15,Addr1,0);
- RewriteField (16,Addr2,0);
- RewriteField (17,City,0);
- RewriteField (18,State,0);
- RewriteField (19,ZIP,0);
- RewriteField (20,BPAC,0);
- RewriteField (21,HPAC,0);
- End;
- End;
-
-
- Begin
- (* Set the default colors *)
-
- BrightBG := Magenta;
- BrightFG := Yellow;
- DimBG := Cyan;
- DimFG := Yellow;
-
- NewScreen; (* Clear the screen and heap *)
-
- Prompts;
-
- (* Initialize the data fields *)
-
- With FRcd[Mem] do
- Begin
- WriteField (2,4,0,5,Memb);
- WriteField (11,4,0,25,Name);
- WriteField (39,4,0,2,BDM);
- WriteField (42,4,0,2,BDD);
- WriteField (45,4,0,2,BDY);
- WriteField (52,4,0,2,DJM);
- WriteField (55,4,0,2,DJD);
- WriteField (58,4,0,2,DJY);
- WriteField (65,4,0,1,Stat);
- WriteField (25,6,0,3,BPEX);
- WriteField (29,6,0,4,BPNU);
- WriteField (38,6,0,4,BPX);
- WriteField (25,7,0,3,HPEX);
- WriteField (29,7,0,4,HPNU);
- WriteField (19,8,0,35,Addr1);
- WriteField (19,9,0,35,Addr2);
- WriteField (19,10,0,20,City);
- WriteField (41,10,0,2,State);
- WriteField (45,10,0,5,ZIP);
- WriteField (20,6,0,3,BPAC);
- WriteField (20,7,0,3,HPAC);
- End;
-
- Repeat
- ReadScreen (1,FK);
- Case FK of
- F11 : If LastM >= 10 Then
- Begin
- GotoXY (1,25);
- LowVid(0);
- Write ('File full - cannot add');
- End
- Else
- Begin
- GetField (1,Key,Attr);
- If Key = ' ' Then
- Begin
- GotoXY (1,25);
- LowVid(0);
- Write ('Invalid key - cannot add');
- ClrEol;
- End
- Else
- Begin
- I := 1;
- While (I <= LastM) and (Key <> FRcd[I].Memb) do I := I + 1;
- If I<= LastM Then
- Begin
- GotoXY (1,25);
- Write ('Duplicate key - cannot add');
- ClrEol;
- End
- Else
- Begin
- LastM := LastM + 1;
- Mem := LastM;
- RetrieveRcd;
- GotoXY (1,25);
- LowVid(0);
- Write ('Record Added');
- ClrEol;
- End;
- End;
- End;
-
- F12 : Begin
- GetField (1,Key,Attr);
- If Key = ' ' Then
- Begin
- GotoXY (1,25);
- LowVid(0);
- Write ('Invalid Key - cannot change');
- ClrEol;
- End
- Else
- Begin
- I := 1;
- While (I <= LastM) and (FRcd[I].Memb <> Key) do I := I + 1;
- If (I <= LastM) and (I <> Mem) Then
- Begin
- GotoXY (1,25);
- LowVid(0);
- Write ('Duplicate Key - Cannot change');
- ClrEol;
- End
- Else
- Begin
- RetrieveRcd;
- GotoXY (1,25);
- LowVid(0);
- Write ('Record');
- If Key <> FRcd[Mem].Memb then Write (' and Key');
- Write (' Changed');
- ClrEol;
- End;
- End;
- End;
-
- F13 : If Mem >= LastM Then
- Begin
- GotoXY (1,25);
- LowVid(0);
- Write ('End of File');
- ClrEol;
- End
- Else
- Begin
- Mem := Mem + 1;
- DisplayRcd;
- GotoXY (1,25);
- LowVid(0);
- ClrEol;
- End;
-
- F14 : If Mem <= 1 Then
- Begin
- GotoXY (1,25);
- LowVid(0);
- Write ('Beginning of File');
- ClrEol;
- End
- Else
- Begin
- Mem := Mem - 1;
- DisplayRcd;
- GotoXY (1,25);
- LowVid(0);
- ClrEol;
- End;
-
- F15 : Begin
- GetField (1,Key,Attr);
- I := 1;
- While (I <= LastM) and (Key <> FRcd[I].Memb) do I := I + 1;
- If I > LastM Then
- Begin
- GotoXY (1,25);
- LowVid(0);
- Write ('Not in File');
- ClrEol;
- End
- Else
- Begin
- Mem := I;
- DisplayRcd;
- GotoXY (1,25);
- LowVid(0);
- ClrEol;
- End;
- End;
-
- F20 : Begin
- BrightBG := Blue;
- At := White;
- ConvAttr (At, Attr);
- For I := 1 to 16 do PutLine (10,I+5,Attr,Windo[I]);
- Repeat until KeyPressed;
- BrightBG := Magenta;
- ClrScr;
- Prompts;
- DisplayRcd;
- End;
- End;
-
- Until FK in [Escape,F1,F2,F3];
- End;
-
- (*******************************)
- (* MAINLINE CODE BEGINS HERE *)
- (*******************************)
-
- Begin
-
- InitScreen; (* <--- ABSOLUTELY NECESSARY!!! *)
-
- WelcomeScreen;
- If FK = Escape then Halt;
-
- Screen2;
-
- With VRcd do
- Begin
- Name := Spaces;
- Addr1 := Spaces;
- Addr2 := Spaces;
- City := Spaces;
- State := Spaces;
- ZIP := Spaces;
- End;
-
- Mem := 1;
- LastM := 0;
- With FRcd[Mem] do
- Begin
- Memb := Spaces;
- Name := Spaces;
- BDM := Spaces;
- BDD := Spaces;
- BDY := Spaces;
- DJM := Spaces;
- DJD := Spaces;
- DJY := Spaces;
- Stat := Spaces;
- BPAC := '101';
- BPEX := Spaces;
- BPNU := Spaces;
- BPX := Spaces;
- HPAC := '101';
- HPEX := Spaces;
- HPNU := Spaces;
- Addr1 := Spaces;
- Addr2 := Spaces;
- City := Spaces;
- State := Spaces;
- ZIP := Spaces;
- End;
-
- While Not (FK = Escape) do
- Case FK of
- F1 : VerticalScreen;
- F2 : HorizontalScreen;
- F3 : FreeFormScreen;
- End;
-
- End.