Category : Pascal Source Code
Archive   : PULL5X.ZIP
Filename : PULLDATA.PAS

{ =========================================================================== }
{ PullData.pas - User Statistics for data-entry windows. ver 5.X, 01-07-89 }
{ }
{ This file contains all the data to configure the data-entry fields in }
{ data windows or work windows. }
{ Copyright (c) 1987-1989 James H. LeMay, All rights reserved. }
{ =========================================================================== }

{ R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ } { TP4 directives }
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-} { TP5 directives }

{$define UseMsgLineCode }

UNIT PullData;

INTERFACE

uses
Crt,Qwik,Strs,Wndw,Pull,PullDir,PullStat;

{ ================ Set up variables for data windows here: ================== }
{ Place your variables names here to interface with the menus. }
{ Careful! -- there's NO type checking for parameters in Transfer. You MUST }
{ be certain case statement, DataWndw, and TypeOfData all match. Be }
{ especially careful of string lengths that are too long. They can be no }
{ longer than DataStrSize. }
{ --------------------------------------------------------------------------- }

const
aByte: byte = 129;
aWord: word = 50000;
aShortInt: shortint = -10;
aInteger: integer = -31456;
aLongInt: longint = -123456789;
aReal: real = -24.34565E06;
aHex: string[4] = 'FF03';
aChar: char = 'Q';
aString: CrtStrType = 'This is a string';

aByte2: byte = 219;
aWord2: word = 45600;
aShortInt2: shortint = -34;
aInteger2: integer = -1100;
aLongInt2: longint = -98765432;
aReal2: real = -19.07070E12;
aHex2: string[4] = 'FFFF';
aChar2: char = 'W';
aString2: CrtStrType = 'This is another string';

Seats: byte = 4;
Years: byte = 30;
Month: byte = 1;
Day: byte = 12;
Year: integer = 1987;
PriceLimit: integer = 2000;

type
DataEntryNames = (
NoDE,aByte2DE,aWord2DE,aShortInt2DE,aInteger2DE,aLongInt2DE,aReal2DE,
aHex2DE,aChar2DE,aString2DE,FileNameDE);

var
PathName: string[67]; { for the pull-down directory }
DataEntryOattr, { Output attribute }
DataEntryIattr, { Input attribute }
DataWndwIattr, { Input attribute }
DataWndwOattr, { Output attribute }
DataWndwBattr: byte; { Border attribute }
DataWndwBrdr: Borders;


IMPLEMENTATION

{ ================ Set up your Error Message Lines here: ================== }
{ Error Messages are used for indicating that data entry was invalid or out }
{ of range. ErrMsgLine[1] is reserved for custom error messages that you }
{ can create at runtime. Messages up to InvalidEM are reserved and must }
{ match those in PULL.PAS. }
{ ------------------------------------------------------------------------- }
type
ErrMsgNames = (NoEM,UserEM,InvalidEM,PathEM,RealEM,CharEM,StrEM);

{$ifdef UseMsgLineCode }
procedure GetErrMsgs;
begin
AutoNumLock := false; { If true, turns on NumLock on with data entry }
CapsLockCol := 41; { First column for ' CAPS NUM SCROLL ' on MsgLine. }

ErrMsgLine[ord(InvalidEM)]:=' Invalid entry. ESC-acknowledge';
ErrMsgLine[ord(PathEM)] :=' Invalid path. Use [d:][path]. Press ESC.';
ErrMsgLine[ord(RealEM)] :=' Range: <=4.0e12 ESC-acknowledge';
ErrMsgLine[ord(CharEM)] :=' "?" not allowed ESC-acknowledge';
ErrMsgLine[ord(StrEM)] :=' At least 3 chars required. ESC-acknowledge';
end;

{$endif UseMsgLineCode }

procedure MakeErrMsg (Low,High: longint);
begin
{$ifdef UseMsgLineCode }
DataPad.ErrMsg := ord(UserEM);
ErrMsgLine[ord(UserEM)] :=
'Range: '+StrL(Low)+' to '+StrL(High)+'. Press ESC';
{$endif }
end;

{ ====================== Data Entry Range Checking ========================== }
{ These procedures are completely defined by the user. They may not even be }
{ necessary if the string entered is satisfactory as a valid number. The }
{ calls must be forced to FAR because they are called indirectly. }
{ "Translate" can alter each key from the keyboard before it gets evaluated. }
{ "Verify" will check the range or even completely alter the entire string. }
{ --------------------------------------------------------------------------- }

{$F+}
procedure VerifyPath;
begin
with DataPad do
begin
{$I-} ChDir (Sdata); {$I+} { Check for valid directory }
if IOresult<>0 then
ErrMsg := ord(PathEM)
else GetDir (0,PathName); { Have DOS parrot the path name }
end;
end;

procedure VerifyFileMask;
begin
with DataPad do
if Sdata='' then
Sdata:='*.*';
end;

procedure VerifyPriceLimit;
begin
with DataPad do
if ((Idata>25000) or (Idata<=0)) then
MakeErrMsg (1,25000);
end;

procedure VerifyMonth;
begin
with DataPad do
if ((Bdata=0) or (Bdata>12)) then
MakeErrMsg (1,12);
end;

procedure VerifyDay;
begin
with DataPad do
if ((Bdata=0) or (Bdata>31)) then
MakeErrMsg (1,31);
end;

procedure VerifyYear;
begin
with DataPad do
if ((Idata<1960) or (Idata>2010)) then
MakeErrMsg (1960,2010);
end;

procedure VerifyYears;
begin
with DataPad do
if ((Idata<4) or (Idata>30)) then
MakeErrMsg (4,30);
end;

{ -------------------- Work Window Data Entry Checking ---------------------- }

procedure TranslateCase;
begin
if not ExtKey then
Key := upcase(Key); { Simple upper case translation }
end;

procedure VerifyByte2;
begin
with DataPad do
if ((Bdata>200) or (Bdata=0)) then
MakeErrMsg (1,200);
end;

procedure VerifyWord2;
begin
with DataPad do
if ((Wdata>45000) or (Wdata=0)) then
MakeErrMsg (1,45000);
end;

procedure VerifyShortInt2;
begin
with DataPad do
if ((SIdata>101) or (SIdata<-50)) then
MakeErrMsg (-50,101);
end;

procedure VerifyInteger2;
begin
with DataPad do
if ((Idata>20000) or (Idata<-10000)) then
MakeErrMsg (-10000,20000);
end;

procedure VerifyLongInt2;
begin
with DataPad do
if ((Ldata>850000) or (Ldata<-1000000)) then
MakeErrMsg (-1000000,850000);
end;

procedure VerifyReal2;
begin
with DataPad do
if (Rdata>4.0e12) then
ErrMsg := ord(RealEM);
end;

procedure VerifyChar2;
begin
with DataPad do
if (Cdata='?') then
ErrMsg := ord(CharEM);
end;

procedure VerifyString2;
begin
with DataPad do
if ord(Sdata[0])<3 then
ErrMsg := ord(StrEM);
end;

{$F-}

{ ======================== GetUserDataEntry ================================= }
{ The major configurations for all menus go here. The program first clears }
{ all RECORD values to $00. The values below will set new values. Therefore, }
{ setting RECORD values to "false", nil, or the like is not necessary. }
{ --------------------------------------------------------------------------- }

{ Code saving utilities: }
procedure GetDataWndw (Index: word);
begin
DWI := Index;
TopDataWndw := DataWndw^[DWI];
end;

procedure SaveDataWndw;
begin
DataWndw^[DWI] := TopDataWndw;
end;

procedure GetDataEntry (Index: word);
begin
DEI := Index;
TopEntry := DataEntry^[DEI];
end;

procedure SaveDataEntry;
begin
DataEntry^[DEI] := TopEntry;
end;

procedure GetDataEntryStats;
begin

{ ------------- Set up your PULL-DOWN Data Windows here: ------------------ }
{ Justification will default with numbers right justified and string to }
{ the left if none is specified. }

with TopDataWndw,TopDataWndw.Entry do
begin

GetDataWndw (ord(BytesDW)); { Just gets cleared TopDataWndw }
VarAddr := @aByte;
{ TypeOfData := Bytes; } { This is the default }
Field := 3;
{ JustifyOutput := Right; } { This is the default }
{ MsgLineNum := ord(DE_ML); } { This is the default }
HelpWndwNum := ord(NumericHW);
SaveDataWndw; { Saves it in the heap }

GetDataWndw (ord(WordsDW));
VarAddr := @aWord;
TypeOfData := Words;
Field := 5;
{ JustifyOutput := Right; } { This is the default for numbers }
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(IntegersDW));
VarAddr := @aInteger;
TypeOfData := Integers;
Field := 6;
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(LongIntsDW));
VarAddr := @aLongInt;
TypeOfData := LongInts;
Field := 11;
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(RealsDW));
VarAddr := @aReal;
TypeOfData := Reals;
Field := 17;
Decimals := 8; { Neg value uses R:F. Pos value - R:F:D. }
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(CharsDW));
VarAddr := @aChar;
TypeOfData := Chars;
Field := 1;
HelpWndwNum := ord(TextHW);
SaveDataWndw;

GetDataWndw (ord(HexDW));
VarAddr := @aHex;
TypeOfData := UserNums;
Field := 4;
SetName := HexSet; { Specify set name for custom sets }
TranslateProc := @TranslateCase;
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(StringsDW));
Title := 'Enter string';
VarAddr := @aString;
TypeOfData := Strings;
Field := 25;
MaxField := pred(SizeOf(aString));
{ JustifyOutput := Left; } { This is the default for strings }
HelpWndwNum := ord(TextHW);
SaveDataWndw;

GetDataWndw (ord(PathDW));
Title := 'Enter path';
VarAddr := @PathName;
TypeOfData := Strings;
Field := 40;
MaxField := pred(SizeOf(PathName));
SetName := PathSet;
CheckRangeProc := @VerifyPath;
HelpWndwNum := ord(TextHW);
SaveDataWndw;

GetDataWndw (ord(FileMaskDW));
Title := 'Enter Mask';
VarAddr := @FileMask;
TypeOfData := Strings;
Field := 12;
MaxField := pred(SizeOf(FileMask));
SetName := MaskSet;
CheckRangeProc := @VerifyFileMask;
HelpWndwNum := ord(TextHW);
SaveDataWndw;

GetDataWndw (ord(MonthDW));
VarAddr := @Month;
{ TypeOfData := Bytes; } { This is the default. }
Field := 2;
CheckRangeProc := @VerifyMonth;
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(DayDW));
VarAddr := @Day;
{ TypeOfData := Bytes; } { This is the default. }
Field := 2;
CheckRangeProc := @VerifyDay;
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(YearDW));
VarAddr := @Year;
TypeOfData := Integers;
Field := 4;
CheckRangeProc := @VerifyYear;
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

GetDataWndw (ord(YearsDW));
VarAddr := @Years;
TypeOfData := Integers;
Field := 2;
CheckRangeProc := @VerifyYears;
HelpWndwNum := ord(NumericHW);
SaveDataWndw;

end; { with }

{ ------------------------ Work Window Data Entry ------------------------- }
AutoTab := true; { After entry, tabs to next one in sequence }
DataPad.Hattr := White+CyanBG; { Optional Attribute of Data Entry hilite }
{ Use SameAttr if not desired }
with TopEntry do
begin

GetDataEntry (ord(aByte2DE));
VarAddr := @aByte2;
TypeOfData := Bytes;
Row := 14;
Col := 20;
Field := 4;
MaxField := 3;
CheckRangeProc := @VerifyByte2;
{ MsgLineNum := ord(DE_ML); } { This is the default }
HelpWndwNum := ord(NumericHW);
SaveDataEntry;

GetDataEntry (ord(aWord2DE));
VarAddr := @aWord2;
TypeOfData := Words;
Row := 15;
Col := 20;
Field := 6;
CheckRangeProc := @VerifyWord2;
HelpWndwNum := ord(NumericHW);
SaveDataEntry;

GetDataEntry (ord(aShortInt2DE));
VarAddr := @aShortInt2;
TypeOfData := ShortInts;
Row := 16;
Col := 20;
Field := 4;
CheckRangeProc := @VerifyShortInt2;
HelpWndwNum := ord(NumericHW);
SaveDataEntry;

GetDataEntry (ord(aInteger2DE));
VarAddr := @aInteger2;
TypeOfData := Integers;
Row := 17;
Col := 20;
Field := 6;
CheckRangeProc := @VerifyInteger2;
HelpWndwNum := ord(NumericHW);
SaveDataEntry;

GetDataEntry (ord(aLongInt2DE));
VarAddr := @aLongInt2;
TypeOfData := LongInts;
Row := 18;
Col := 20;
Field := 12;
CheckRangeProc := @VerifyLongInt2;
HelpWndwNum := ord(NumericHW);
SaveDataEntry;

GetDataEntry (ord(aReal2DE));
VarAddr := @aReal2;
TypeOfData := Reals;
Row := 19;
Col := 20;
Field := 17;
CheckRangeProc := @VerifyReal2;
HelpWndwNum := ord(NumericHW);
SaveDataEntry;

GetDataEntry (ord(aHex2DE));
VarAddr := @aHex2;
TypeOfData := UserNums;
Row := 14;
Col := 50;
Field := 4;
SetName := HexSet;
TranslateProc := @TranslateCase;
HelpWndwNum := ord(NumericHW);
SaveDataEntry;

GetDataEntry (ord(aChar2DE));
VarAddr := @aChar2;
TypeOfData := Chars;
Row := 15;
Col := 50;
Field := 1;
CheckRangeProc := @VerifyChar2;
HelpWndwNum := ord(TextHW);
SaveDataEntry;

GetDataEntry (ord(aString2DE));
VarAddr := @aString2;
TypeOfData := Strings;
Row := 16;
Col := 50;
Field := 20;
MaxField := pred(sizeof(aString2));
CheckRangeProc := @VerifyString2;
HelpWndwNum := ord(TextHW);
SaveDataEntry;

GetDataEntry (ord(FileNameDE));
VarAddr := @FileName;
TypeOfData := Strings;
Row := 17;
Col := 50;
Field := 12;
MaxField := pred(sizeof(FileName));
SetName := FileNameSet;
HelpWndwNum := ord(TextHW);
SaveDataEntry;
end;

end; { procedure GetDataEntryStats }

{ =================== Data Entry Initialization Code ======================== }
{ The following code initializes all of the stats for the data entry windows }
{ and the work window data entry fields. There is no need to edit this }
{ Except for the default colors in SetDefaultColors. }
{ --------------------------------------------------------------------------- }

procedure AllocateHeap;
begin
if HeapOK (sizeof(DataWndws)) then
GetMem (DataWndw,SizeOf(DataWndws));
fillchar (DataWndw^,SizeOf(DataWndws),0);
if HeapOK (sizeof(DataEntries)) then
GetMem (DataEntry,SizeOf(DataEntries));
fillchar (DataEntry^,SizeOf(DataEntries),0);
end;

procedure SetDefaultColors;
begin
{ ------------------ Set up your colors and borders here: ---------------- }
DataEntryIattr := Yellow+MagentaBG; { Input attribute }
DataEntryOattr := Black+LightGrayBG; { Output attribute }
DataWndwIattr := Black+BrownBG; { Input attribute }
DataWndwOattr := Yellow+BlackBG; { Output attribute }

DataWndwBattr := Black+BrownBG; { Border attribute }
DataWndwBrdr := HdoubleBrdr;
end;

procedure InitDataColors;
var i: word;
begin
for i:=1 to NumOfDataWndws do
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (i);
Iattr := DataWndwIattr; { Input attribute }
Oattr := DataWndwOattr; { Output attribute }
Battr := DataWndwBattr; { Border attribute }
SaveDataWndw;
end;
for i:=1 to NumOfDataEntries do
with TopEntry do
begin
GetDataEntry (i);
Iattr := DataEntryIattr; { Input attribute }
Oattr := DataEntryOattr; { Output attribute }
SaveDataEntry;
end;
end;

function GetJustify (Justify: DirType; TOD: TypeOfDataType): DirType;
begin
if Justify=NoDir then
begin
if TOD<=UserNums then
GetJustify := Right { for nums }
else GetJustify := Left; { for chars and strings }
end
else GetJustify:=Justify;
end;

function GetSetName (SN: SetNames; TOD: TypeOfDataType): SetNames;
begin
if SN=NoSet then
case TOD of
Bytes,Words: GetSetName := UnsignedSet;
ShortInts..LongInts: GetSetName := SignedSet;
Reals: GetSetName := RealSet;
else
GetSetName := CharSet;
end
else GetSetName:=SN;
end;

procedure InitDataDefaults;
var i: word;
begin
for i:=1 to NumOfDataWndws do
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (i);
Border := DataWndwBrdr;
SetName := GetSetName (SetName,TypeOfData);
Row := 1;
Col := 2;
if MaxField=0 then
MaxField := Field;
JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
if MsgLineNum=0 then
MsgLineNum := ord(DW_ML);
SaveDataWndw;
end;
for i:=1 to NumOfDataEntries do
with TopEntry do
begin
GetDataEntry (i);
SetName := GetSetName (SetName,TypeOfData);
if MaxField=0 then
MaxField := Field;
JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
if MsgLineNum=0 then
MsgLineNum := ord(DE_ML);
SaveDataEntry;
end;
end;

BEGIN
AllocateHeap;
SetDefaultColors;
InitDataColors;
{$ifdef UseMsgLineCode }
GetErrMsgs;
{$endif }
GetDataEntryStats;
InitDataDefaults;
END.