home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Share Gallery 1
/
share_gal_1.zip
/
share_gal_1
/
LA
/
LA010.ZIP
/
DEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1980-01-01
|
14KB
|
444 lines
Program demo;
{This program can be used standalone to enter data in
a file for later processing, or it can be incorporated
as a procedure in some other program that you develop.
Don't forget to change the first word to "Procedure"
and the last period to a semi-colon if you want to use
it as a procedure.}
Const
Windows = 8; { the number of input fields that you defined in your screen }
Wtab : array[1..Windows, 1..7] of Integer = (
(0, 7, 78, 63, 6, 66, 6),
(0, 7, 78, 59, 8, 60, 8),
(0, 7, 78, 62, 8, 63, 8),
(0, 7, 78, 65, 8, 66, 8),
(0, 7, 78, 24, 10, 49, 10),
(0, 7, 78, 60, 10, 66, 10),
(0, 7, 78, 25, 12, 27, 12),
(0, 7, 78, 39, 12, 66, 12));
{ | | | | | | |
| | | | | | |
| | | | | | |___ending 'y' coordinate
| | | | | |
| | | | | |_______ending 'x coordinate
| | | | |
| | | | |___________beginning 'y' coordinate
| | | |
| | | |_______________beginning 'x' coordinate
| | |
| | |______________________________
| |_______________ |
| | |
textcolor textbackground blink}
Type
Output_Info = Record
Delete: String[1]; {invisible field used for}
{record management }
Check_No: Integer;
Month: Integer;
Day: Integer;
Year: Integer;
Payee: String[26];
Amount: Real;
Cat: String[3];
Comment: String[28];
CR: String[1]; { invisible field used to put }
{ C/R at end of each record }
End;
Str12 = String[12];
Str80 = String[80];
Str255 = String[255];
Var
Output_File: File of Output_Info;
New_Output_File: File of Output_Info;
Old_File: File of Output_Info;
Output_Record: Output_Info;
MaxX, { max and min }
MinX, { window position }
MaxY, { expressed as X,Y }
MinY, { screen position }
Entry_Field, { used as index for window array }
X,Y, { screen coordinates }
XY, { ScrBuf array subscript }
k,i, { loop counter, subscript }
ErrorPos, { when converting string expressions to }
{ numeric expressions this variable will }
{ be zero if the conversion is successful }
{ and will indicate the postition of the }
{ non-numeric char if the conversion fails }
Current_File_Pos, { the current record of the output file }
Tone: Integer; { for beeper }
EXISTS,
BadName, { used in checking for valid file name }
Good_Char, { used in checking for valid file name }
Done_Adding, { done adding records to the data file }
Done_Reading_Kbd: Boolean;
ScrBuf: array [1..1920] of Char; { this array holds all the input }
{ data so it can be revised before}
{ the input variables are written }
{ to the data file }
TempVar: String[255]; { each of the input data fields is first }
{ converted to this temporary string, then }
{ it is converted to the proper data type }
{ i.e. INT, REAL }
Line: String[255];
File_Name: String[12];{ name of the file that will hold the data }
{ that is entered }
BackUp_File_Name: String[12];{ this name is automatically assigned by }
{ the program - it will be the same as the }
{ regular file name except it will be a }
{ .bak type file }
Init_Val_1,
Init_Val_2,
Init_Val_3,
Init_Val_4,
Init_Val_5,
Init_Val_6,
Init_Val_7,
Init_Val_8: String[255];
{$I ExtProc1.Pas}
Procedure Read_Record_and_Write_It;
Begin
Seek(Output_File,Current_File_Pos-1);
Read(Output_File,Output_Record);
If Output_Record.Delete <> 'X' Then Begin
Banner_Line;
Entry_Field:= 0;
With Output_Record Do Begin
Tab; Str(Check_No:4, TempVar); Write_It_In_A_Field(TempVar);
Tab; Str(Month:2, TempVar); Write_It_In_A_Field(TempVar);
Tab; Str(Day:2, TempVar); Write_It_In_A_Field(TempVar);
Tab; Str(Year:2, TempVar); Write_It_In_A_Field(TempVar);
Tab; TempVar:= Payee; Write_It_In_A_Field(TempVar);
Tab; Str(Amount:7:2, TempVar); Write_It_In_A_Field(TempVar);
Tab; TempVar:= Cat; Write_It_In_A_Field(TempVar);
Tab; TempVar:= Comment; Write_It_In_A_Field(TempVar);
End;
End { if output_record.delete <> x }
Else Begin
Blank_Fields;
GotoXY(2,25);
TextColor(Black);
TextBackground(LightGray);
For i:= 1 to 65 Do Write(Chr(32));
GotoXY(2,25);
Write(' This record has been deleted. (f4=undelete)');
End; { else }
End; {procedure Read_Record_and_Write_It }
{$I ExtProc2.Pas}
Procedure Write_Init_Val;
Begin
Blank_Fields;
Entry_Field:= 0;
Tab;
Write_It_In_A_Field(Init_Val_1);
Tab;
Write_It_In_A_Field(Init_Val_2);
Tab;
Write_It_In_A_Field(Init_Val_3);
Tab;
Write_It_In_A_Field(Init_Val_4);
Tab;
Write_It_In_A_Field(Init_Val_5);
Tab;
Write_It_In_A_Field(Init_Val_6);
Tab;
Write_It_In_A_Field(Init_Val_7);
Tab;
Write_It_In_A_Field(Init_Val_8);
Tone:= 8000;
End; { procedure write_init_val }
{$I ExtProc3.Pas}
Procedure WriteScreen;
Begin
TextColor(1); TextBackground(7);
Write(' ');
Write(' ');
TextColor(14); TextBackground(7);
Write(' ');
Write(' ');
Write(' ');
TextColor(0); TextBackground(3);
Write('╔═════════════════════════════════════════════════════════╗');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(3);
Write(' ');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(15); TextBackground(3);
Write(' ');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(15); TextBackground(3);
Write('CHECK NO. ');
TextColor(0); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(15); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(15); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(15); TextBackground(3);
Write(' CHECK DATE ');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('/');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('/');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(15); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(7);
Write(' ');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(15); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(7);
Write(' ');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(15); TextBackground(3);
Write('PAYEE ');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(15); TextBackground(3);
Write(' AMOUNT $');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(15); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(3);
Write(' ');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(15); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(15); TextBackground(3);
Write(' CATEGORY ');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(15); TextBackground(3);
Write('COMMENT ');
TextColor(0); TextBackground(7);
Write(' ');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(3);
Write(' ');
TextColor(0); TextBackground(3);
Write('║');
TextColor(14); TextBackground(7);
Write(' ');
TextColor(0); TextBackground(3);
Write('╚═════════════════════════════════════════════════════════╝');
TextColor(14); TextBackground(7);
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
Write(' ');
TextColor(15); TextBackground(7);
Write(' ');
Write(' ');
End; { precedure write_screen }
{$I ExtProc4.Pas}
Procedure Set_Up_Output_Record;
Begin
Repeat
Entry_Field:= 0;
Gather_Input_Info;
Strip_Spaces;
Val(TempVar, Output_Record.Check_No,ErrorPos);
If ErrorPos <> 0 Then Find_Error;
Until ErrorPos = 0;
Repeat
Entry_Field:= 1;
Gather_Input_Info;
Strip_Spaces;
Val(TempVar, Output_Record.Month,ErrorPos);
If ErrorPos <> 0 Then Find_Error;
Until ErrorPos = 0;
Repeat
Entry_Field:= 2;
Gather_Input_Info;
Strip_Spaces;
Val(TempVar, Output_Record.Day,ErrorPos);
If ErrorPos <> 0 Then Find_Error;
Until ErrorPos = 0;
Repeat
Entry_Field:= 3;
Gather_Input_Info;
Strip_Spaces;
Val(TempVar, Output_Record.Year,ErrorPos);
If ErrorPos <> 0 Then Find_Error;
Until ErrorPos = 0;
Entry_Field:= 4;
Gather_Input_Info;
OutPut_Record.Payee:= TempVar;
Repeat
Entry_Field:= 5;
Gather_Input_Info;
Strip_Spaces;
Val(TempVar, Output_Record.Amount,ErrorPos);
If ErrorPos <> 0 Then Find_Error;
Until ErrorPos = 0;
Entry_Field:= 6;
Gather_Input_Info;
OutPut_Record.Cat:= TempVar;
Entry_Field:= 7;
Gather_Input_Info;
OutPut_Record.Comment:= TempVar;
Write_To_OutPut_File;
End; { procedure set_up_output_record }
Begin { main procedure }
ClrScr;
Open_File;
Init_Val_1:= '';
Init_Val_2:= '';
Init_Val_3:= '';
Init_Val_4:= '';
Init_Val_5:= '';
Init_Val_6:= '';
Init_Val_7:= '';
Init_Val_8:= '';
For XY:= 1 to 1920 Do
ScrBuf[XY]:= Chr(32);
WriteScreen;
Banner_Line;
Write_Recno;
Done_Adding:= False;
Repeat
If Current_File_Pos = FileSize(Output_File)+1 Then Write_Init_Val;
Entry_Field:= 0;
Done_Reading_Kbd:= False;
Tab;
Repeat
ReadKbd;
Until Done_Reading_Kbd;
If not Done_Adding Then Set_Up_Output_Record;
Until Done_Adding;
Close(Output_File);
End.