{ ========================================================================== }
{ PullData.pas - User Statistics for data-entry windows.  var 7.0b, 09-24-93 }
{                                                                            }
{ This file contains all the data to configure the data-entry fields in      }
{ data windows or work windows.                                              }
{   Copyright (c) 1988,1993 James H. LeMay, All rights reserved.             }
{ ========================================================================== }

{$i pulldefs.inc }

UNIT PullData;

INTERFACE

uses
  Crt,Qwik,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   =   1989;
  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

uses
  {$ifdef UseStrg }
  Strg;
  {$else }
  Strs;
  {$endif }

{ ================ 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.  }
{ -------------------------------------------------------------------------- }

procedure VerifyPath; far;
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; far;
begin
  with DataPad do
    if Sdata='' then
      Sdata:='*.*';
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


{ ======================== 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(SeatsDW));
      VarAddr     := @Seats;
    { TypeOfData  := Bytes; }        { This is the default. }
      Field       := 2;
      HelpWndwNum := ord(NumericHW);
      SaveDataWndw;

      GetDataWndw (ord(PriceDW));
      VarAddr     := @PriceLimit;
      TypeOfData  := Words;
      Field       := 6;
      HelpWndwNum := ord(NumericHW);
      SaveDataWndw;

      GetDataWndw (ord(MonthDW));
      VarAddr     := @Month;
      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 }
  with DataPad do
    if QvideoMode=Mono then
         Hattr := LightGrayBG
    else 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: ---------------- }
  if QvideoMode=Mono then
    begin
      DataEntryIattr := LightGray;         { Input  attribute }
      DataEntryOattr := White;             { Output attribute }
      DataWndwIattr  := White;             { Input  attribute }
      DataWndwOattr  := LightGrayBG;       { Output attribute }
    end
  else
    begin
      DataEntryIattr := Yellow+MagentaBG;  { Input  attribute }
      DataEntryOattr := Black+LightGrayBG; { Output attribute }
      DataWndwIattr  := Black+BrownBG;     { Input  attribute }
      DataWndwOattr  := Yellow+BlackBG;    { Output attribute }
    end;
  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.