Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/GET10.ZIP/GETDEMO.PAS

Pascal/Delphi Source File | 1988-11-09 | 9.7 KB | 366 lines

Program GetDemo;
{
  This program is intended to demonstrate the use of some GET procedures.
  Refer to GETDEMO.DOC for details.

  Once you've run this and explored a little, try making some changes.
  Try changing "dollars" to "SwissFrancs" and recompiling e.g. You'll
  find the currency symbol will change, it's position will change, the
  decimal point will change to a comma and the thousands delimiter will
  change to period -- all automatically. You might change DateFormat to
  European at the same time and observe the effect on subfield validation.
  Note what happens when YearFormat is changed from NY to YY. Observe
  what happens to numeric field sizes when ValidationOverride is true,
  when RightJustifyNumberEntry is true, etc. Have fun! P.O'N
}
Uses Crt, Qwik, Getvars, Get, GetFns;

Const
   max_overdraft          = 999999;
   minimum_avg_balance    = 500;
   minimum_charge         = 2;
   transaction_charge     = 0.25;

var
   transactions: integer;

   children:     shortint;

   charges,
   balance,
   avg_balance,
   overdraft:    real;

   deposit,
   mortgage,
   retirement,
   loan,
   otherAC:      boolean;

   first_name,
   initial,
   last_name,
   street_address,
   suite_no,
   city, state,
   zip, phone,
   ssn, comment,

   testcalcstr,
   password,
   balance_time,
   date_of_birth,
   balance_date: string;


procedure setup_test_data;
{
  Note:

  Separator characters in a COMPOSITE string ('/' in date and ':' in time)
  ARE part of the string. Punctuating characters in all other strings are
  not part of the string if they are display only -- entered in the picture
  for the string rather than the string itself. Thus, in this example, "(",
  ")" and " " are not part of the telephone number string AS STORED.
}
begin
  first_name     := 'Zorba';
  initial        := 'T';
  last_name      := 'Greek';
  street_address := '8 Franklin Ave';
  suite_no       := 'Apt 1';
  city           := 'Athens';
  state          := 'OH';
  zip            := '457011112';
  phone          := '6145946401';
  ssn            := '123456789';
  date_of_birth  := '01/01/60';
  balance_date   := '01/01/88';
  balance_time   := '12:00';
  password       := '1abc';
  balance        := 256.32;
  avg_balance    := 123.12;
  overdraft      := 2500;
  transactions   := 0;

  if avg_balance >= minimum_avg_balance then
    charges := 0
  else charges := minimum_charge + transactions * transaction_charge;

  children       := 0;
  deposit        := true;
  mortgage       := false;
  retirement     := true;
  loan           := false;
  otherAC        := false;
  comment        := 'Charges applied if average balance less ' +
                    'than minimum balance is: mimimum charge ' +
                    'plus transactions x transaction charge.';
end;


procedure getscreen (target: integer);

Const

    lastfield = 25;   {no. of the last field on the screen}

var I,
    field:            integer;
    lastedit:         word;
    action:           edit;

    AllFieldsDisplayOnly,
    OldPaintingFields,
    T,F,
    HeartsContent:    boolean;
    text_fieldnum:    numstring;

    cursor_attr,
    dattr,
    pattr:            byte;

    DisplayOnlyMap:   array[1..255] of boolean;

    previousfield,
    nextfield:        array[1..255] of byte;
    fieldprompt:      array[1..lastfield] of string[80];
    testchar:         char;


procedure upfield;
begin
  if field > 1 then dec(field)
    else if FieldWrap then field := lastfield;

  if DisplayOnlyMap[field] then
    upfield;
end;

procedure downfield;
begin
  if field < lastfield then inc(field)
  else if FieldWrap then field := 1;

  if DisplayOnlyMap[field] then
    downfield;
end;

procedure getfield(field: byte);
var DisplayOnly,
    SavePaint:    boolean;
{
  PaintingFields is switched on temporarily if a field is display only
}
begin
    str(field,text_fieldnum);
    SavePaint := PaintingFields;

    if not PaintingFields then
      begin
        if DisplayOnlyMap[field] then
          PaintingFields := true;
        info(fieldprompt[field]);
      end;

    case field of
      1: getstr('Last name ',3,1,last_name, 'Xx',25,1);
      2: getstr('Initial ',3,38,initial,'X',1,1);
      3: getstr('First name ',3,49,first_name,'Xx',20,1);
      4: getstr('Street address ',5,1,street_address,'Xx',42,1);
      5: getstr('Suite No. ',5,60,suite_no,'Xx',10,0);
      6: getstr('City ',7,1,city,'Xx',22,1);
      7: getstr('State ',7,30,state,'XX',2,3);
      8: getstr('Zip ',7,40,zip,'99999+9999',9,3);
      9: getstr('Tel. ',7,56,phone,'(999)B999-9999',10,2);
     10: getdatestr('Date of birth ',9,1,date_of_birth,3);
     11: getshortint('No. of children ',9,27, 0,99, pattr,dattr,children,'0');
     12: getstr('Social Security No. ',9,47,ssn,'999-99-9999',9,3);

     13:  begin
            PasswordField := T;
            getstr('Password ',11,1,password,'9x',4,0); {9x: documentation}
            PasswordField := F;
          end;

     14:  getreal('Account balance ',11,16,
                     -abs(overdraft),99999.99,dollars,pattr,dattr,balance,'0');

     15: getdatestr('on ',11,49,balance_date,2);
     16: gettimestr('at ',11,64,balance_time,2);

     17: getreal('Overdraft limit ',
                  13,1,0,max_overdraft,dollars,pattr,dattr,overdraft,'0');

     18: getreal('Average balance this month ',13,33,
                 -abs(overdraft),999999.99,dollars,pattr,dattr,avg_balance,'');

     19: getinteger('Transactions this month ',15,1,
                    0,9999,pattr,dattr,transactions,'0');

     20: getbool
           ('Accounts: Deposit    ',17,1,deposit);
     21: getbool('Mortgage   ',18,11,mortgage);
     22: getbool('Retirement ',19,11,retirement);
     23: getbool('Loan       ',20,11,loan);
     24: getbool('Other      ',21,11,otherAC);

     25: getstr('Comment ',18,30,comment,
                'x@'+ #39 + '\N@' + #40 + '\N@' + #40, {picture}
                120,0);
    end; {case}

{
  Calculated field, depends on fields 18 and 19:
}

  if field in [18,19] then
    begin
      PaintingFields := true;
      if avg_balance >= minimum_avg_balance then
        charges := 0
      else charges := minimum_charge + transactions * transaction_charge;
      getreal('Charges this month    ',15,33,
               0,0,dollars,pattr,dattr,charges,'0');
    end;


  PaintingFields := SavePaint;
end;

procedure get_input;
var exit_requested: boolean;
begin
  exit_requested := false;
  getfield(field);
  action := get_edit(command); {what was the last command?}

  case action of {amend this list as required}

    help:          begin
                     altwrite(1,1,AttrNM,AttrBO,'~',
                     '~Help~ on field ~' + text_fieldnum +
                     '~? You must be joking~!~ ' +
                     'Press ~Esc~ to exit');
                   end;

    escapefrom:    HeartsContent := true;
    tabback,
    leftchar:      field := previousfield[field];
    tabover,
    rightchar:     field := nextfield[field];
    goto_top:      field := 1;
    goto_bottom:   field := lastfield;
    upchar:        upfield;

    post_letter,   {will exit if AutoTab and field is complete}
    enter_default,
    carriage_return,
    downchar:      downfield;
    exit_screen:   exit_requested := true;
  end; {case}

  if (field > lastfield) or exit_requested then
    begin
      getresponse('OK so far ~Y~/~N~? ',CharacterSet[YesAndNo].CharSet,
                  24,1,false,testchar,'Y');
      HeartsContent := upcase(testchar) = 'Y';
      if not HeartsContent and (field > lastfield) then
        field := lastfield;
    end;
end;


begin {getscreen}

  fillchar(DisplayOnlyMap,sizeof(DisplayOnlyMap),0);

  pattr       := Default_pattr;       {field prompt attribute}
  dattr       := Default_dattr;       {field data attribute}
  cursor_attr := Default_cursor_attr; {cursor attribute in strings}

  field := 1;
  T := true;
  F := not T;

  if (target < 1) or (target > lastfield) then
    target := 1;
{
  q&d method of determining horizontal neighbouring fields
}
  for I := 1 to lastfield do
    begin
     nextfield[I] := succ(I);
     previousfield[I] := pred(I);
    end;
  nextfield[lastfield] := 1;
  previousfield[1] := lastfield;
{
  initialise field prompts
}
  for I := 1 to lastfield do
    begin
      str(I,text_fieldnum);;
      fieldprompt[I] := 'This is field no ' + text_fieldnum +
                        ' Press ~Esc~ to exit';
    end;


  DisplayOnlyMap[18]   := true;
  AllFieldsDisplayOnly := false; {see upfield/downfield recursion}


  {1st paint screen}

  ClrScr;
  PaintingFields := true;

  for field := 1 to lastfield do
    getfield(field);

  PaintingFields := false;
  HeartsContent  := false;
  field          := target;
  cp             := 1;      {cursor position in string}

  {now look for input}

  if not AllFieldsDisplayOnly then
    repeat
      get_input
    until HeartsContent;

  SetCursor (CursorOn or CursorInitial);
end;


procedure setup_global_variables;
begin
  DateFormat              := American;
  YearFormat              := NY;
  ValidationOverride      := not true;
  RightJustifyNumberEntry := not true;
  StringFieldWrap         := true;
  FieldWrap               := true;
  tabsize                 := 0;
end;


procedure finish_up;
{
  Reset video mode to what we started with (e.g. CO40)
}
begin
  clrscr;
  if QVideoMode <> LastVideoMode then
    TextMode (LastVideoMode + hi(LastMode));
end;


begin
  setup_global_variables;
  setup_test_data;
  getscreen(1);
  finish_up;
end.