home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
TTTDEM51.ZIP
/
IODEM6.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-07-30
|
7KB
|
229 lines
Program Illustrating_Screen_Editing;
uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, MenuTTT5, ListTTT5, IOTTT5;
var
Str1,
Str2,
Str3,
Str4,
Str5,
Str6,
Str7,
Str8,
Str9,
Str10,
Str11,
Str12 : string;
Code : integer;
Ch : char;
Procedure Get_Order_Details;
{This procedure illustrates how you can nest input screens. This is referred
to as having multiple input tables}
const
X1 = 30;
Y1 = 16;
X2 = 76;
Y2 = 22;
begin
AcTivate_Table(2); {IMPORTANT set all Io Procs to operate on table 2}
Create_Fields(3);
Allow_Beep(False);
Add_Field(1, 3, 2, 3, 2, X1 +21, Y1+1);
String_Field(1, Str10, '!!!!!!!!!!!!!!!!!!!!!!');
Add_Field(2, 1, 3, 1, 3,X1 +21, Y1+3);
String_Field(2, Str11, '###');
Add_Field(3, 2, 1, 2, 1, X1 +20, Y1+5);
String_field(3, Str12, '(##-###) ##');
SaveScreen(1); {save previous input screen}
Attrib(1,1,80,25,lightgray,black); {darken the display but still visible}
FBox(X1,Y1,X2,Y2,blue,lightgray,1);
WriteAT(X1+2,Y1+1,blue,lightgray,'Order description:');
WriteAT(X1+2,Y1+3,blue,lightgray,'Quantity:');
WriteAT(X1+2,Y1+5,blue,lightgray,'Part No:');
Process_Input(1);
Dispose_Fields;
RestoreScreen(1);
DisposeScreen(1);
Activate_Table(1); {IMPORTANT set IO procs back to table 1}
end;
Procedure Display_Options;
const
TotPicks = 4;
Width = 10;
var
T : array[1..TotPicks] of string[Width];
begin
T[1] := 'Amoco';
T[2] := 'Conoco';
T[3] := 'Texaco';
T[4] := 'Technoco';
With LTTT do
begin
AllowToggle := false;
X := 65;
Y := 3;
end;
SaveScreen(1);
WriteAT(62,7,white,lightgray,'<--');
Attrib(1,1,80,25,lightgray,black);
Show_List(T,Width,TotPicks);
RestoreScreen(1);
If L_Char= #027 then
Str2 := ''
else
Case L_Pick of
1 : Str2 := T[1];
2 : Str2 := T[2];
3 : Str2 := T[3];
4 : Str2 := T[4];
end; {Case}
end; {Proc Display_Options}
(* An alternative using menu
Procedure Display_Options(var Str :string);
var
M : Menu_Record;
Pick, Retcode : integer;
const
T1 = 'Amoco';
T2 = 'Conoco';
T3 = 'Texaco';
T4 = 'Technoco';
begin
With M do
begin
Heading1 := '';
Heading2 := '';
Topic[1] := T1;
Topic[2] := T2;
Topic[3] := T3;
Topic[4] := T4;
TotalPicks := 4;
PicksperLine := 1;
Addprefix := 0;
Margins := 0;
TopLeftXY[1] := 65;
TopLeftXy[2] := 5;
BoxType := 1;
AllowEsc := true;
Colors[1] := lightgray;
Colors[2] := black;
Colors[3] := black;
Colors[4] := lightgray;
Colors[5] := white;
end; {with M}
Pick := 1;
WriteAT(62,7,white,lightgray,'<--');
DisplayMenu(M,false,Pick,retcode);
WriteAT(62,7,white,lightgray,' ');
If Retcode <> 0 then
Str := ''
else
Case Pick of
1 : Str := T1;
2 : Str := T2;
3 : Str := T3;
4 : Str := T4;
end; {Case}
end; {Proc Display_Options}
*)
{$F+} {must be defined as far}
Procedure Special_Keys(var Ch : Char;var FieldID : Byte; var RefreshCode: byte);
begin
If (CurrentTable = 1) and (Ch = #187) and (FieldID = 2) then
begin
Display_Options;
RefreshCode := Refresh_All;
end;
If (CurrentTable = 1) and (Ch = #187) and (FieldID = 9) then
begin
Get_Order_Details;
RefreshCode := Refresh_All;
end;
end;
{F-}
begin {test program}
Str1 := '';
Str2 := '';
Str3 := '';
Str4 := '';
Str5 := '';
Str6 := 'TX';
Str7 := '';
Str8 := '';
Str9 := '';
Str10 := '';
Str11 := '';
Str12 := '';
Create_Tables(2);
Create_Fields(9);
Assign_CharHook(Special_Keys);
Define_Colors(15,4,11,1,14,4);
Allow_Beep(false);
Allow_Esc(True);
Add_Field(1, 1,2,1,2, 30,6);
String_Field(1, Str1,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');{name}
Add_Field(2, 1,3,1,3, 30,7);
String_Field(2, Str2,'*******************************');{Co.}
Add_Field(3, 2,4,2,4, 30,8);
String_Field(3, Str3,'*******************************');{ad1}
Add_Field(4, 3,5,3,5, 30,9);
String_Field(4, Str4,'*******************************');{ad2}
Add_Field(5, 4,6,4,6, 30,10);
String_Field(5, Str5,'@@@@@@@@@@@@@@@@');{city}
Add_Field(6, 4,7,5,7, 55,10);
String_Field(6, Str6,'!!');{state}
Add_Field(7, 4,8,6,8, 65,10);
String_Field(7, Str7,'#####-####');{zip}
Add_Field(8, 5,9,7,9, 30,12);
String_Field(8, Str8,'(###) ###-####'); {work Phone}
Add_Field(9, 8,1,8,1, 30,14);
String_Field(9, Str9,'#####'); {order no.}
Add_Message(1, 0,25,'Name is automatically set to capitals');
Add_Message(2, 0,25,'Enter Company Name, press F1 for a list of companies');
Add_Message(5, 0,25,'Now you can only type alphas and punctuation');
Add_Message(6, 0,25,'Default is set to Texas');
Add_Message(7, 0,25,'Zip and phone number must be numeric');
Add_Message(9, 0,25,'Press F1 to enter order details');
ClearText(1,1,80,25,red,lightgray);
Box(1,1,80,25,red,lightgray,3);
WriteCenter(2,blue,lightgray,'TechnoJocks Turbo Toolkit');
WriteCenter(3,white,lightgray,'Screen Input Routines Demonstration');
WriteAT(12,6,blue,lightgray,'Incumbents Name =>');
WriteAT(20,7,blue,lightgray,'Company =>');
WriteAT(20,8,blue,lightgray,'Address =>');
WriteAT(23,10,blue,lightgray,'City =>');
WriteAT(48,10,blue,lightgray,'State');
WriteAT(60,10,blue,lightgray,'Zip');
WriteAT(22,12,blue,lightgray,'Phone =>');
WriteAT(19,14,blue,lightgray,'Order No =>');
WriteAT(10,16,white,lightgray,'Instructions: [End to quit]');
WriteAT(10,17,blue,lightgray,'This is a mock up of a data entry screen. Simply');
WriteAT(10,18,blue,lightgray,'enter some values and press enter. Use the arrow');
WriteAT(10,19,blue,lightgray,'keys to move between fields. Note the following:');
WriteAT(10,20,white,lightgray,'End to finish entry Ins toggle insert on and off');
WriteAT(10,21,white,lightgray,'Alt-D delete current field Alt-E delete all fields');
WriteAT(10,22,white,lightgray,'Ctrl-Right shift right Ctrl-Left shift left');
WriteAT(10,23,white,lightgray,'Tab shift right Shift-Tab shift left');
Process_Input(1);
Dispose_Fields;
Clrscr;
If I_Char <> #027 then
WriteAT(1,1,white,black,'You escaped!');
WriteAT(1,24,white,black,'Run DemoTTT.exe for the main demo program');
WriteAT(1,25,white,black,'Technojocks Turbo Toolkit v5.0');
Ch := Readkey;
end.