Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/READSTR.ZIP/READ.MOD

Text File | 1986-08-27 | 44.9 KB | 1,440 lines

Procedure ReadString(Option:char;
                     AutoClear,InsertStatusLine,SetCposTo1onEntry,
                     Floater,DeadColorsOnExit:Boolean;
                     HelpLine,HelpNum,X,Y:Byte;
                     ScanExitSet:ByteSetType;
                     Var Scan:Byte;
                     AsciiExitSet:CharSetType;
                     Var Ascii:char;
                     Var CPos:Byte;
                     Var Z:String80;
                     Mask:String80);
Const
 EndTag=#7;
 LocalExitSet:ByteSetType=[ArrowLfKey,ArrowRtKey,HomeKey,EndKey,BkSpKey,
                           DelKey,CtrlBkSpKey,CtrlDelKey];
Var
 OverBuff:String[80];
 I,MaxLen,MPos:Byte;
 MaskLen:Byte absolute Mask;
 ZLen:Byte absolute Z;
 OLen:Byte absolute OverBuff;
 Activity:Boolean;

   Procedure GotoCpos;
   Var Zpos:Byte;
   Begin
    MPos:=0; ZPos:=0;
    While ZPos<Cpos Do
      Begin
       MPos:=Succ(MPos);
       If mask[MPos] in ValidMaskTokenSet then ZPos:=Succ(ZPos);
      End;
    GotoXY(X+Pred(MPos),Y);
   End;

   Procedure ZWrite(Floater:Boolean);
   Var OldZLen,MaskPos,ZPos:Byte;
   Begin
    While (OLen>0) and (MaxLen>ZLen) Do
      Begin
       Z:=Z+OverBuff[1];
       Delete(OverBuff,1,1);
      End;
    OldZLen:=ZLen;
    If (MaxLen-ZLen>0) and Floater then Z:=Z+EndTag;
    If MaxLen-ZLen>0 then Z:=Z+Spaces(MaxLen-ZLen);
    ZPos:=0;
    For MaskPos:=1 to MaskLen do
       Case mask[MaskPos] of
          '!','#','&','*'..'+','/','<'..'@','['..'^','{'..'~':
             Begin
              BInc(ZPos);
              QWrite(Z[ZPos],X+pred(MaskPos),Y,0,0);
             End;
          Else QWrite(Mask[MaskPos],X+pred(MaskPos),Y,0,0);
       End; {case}
    ZLen:=OldZLen;
    If option<>'W' then GotoCpos;
   End;

   Procedure FunctionKey;
   Begin
    Case Scan of
        ArrowRtKey:If (Cpos<Succ(Zlen)) and (Cpos<MaxLen) then
                     Begin
                      Cpos:=Succ(Cpos); GotoCpos;
                      Scan:=0;
                     End;
       ArrowLfKey:If Cpos<>1 then
                    Begin
                     If (Cpos=Succ(ZLen)) and (Z[ZLen]=' ') then
                       Begin
                        Delete(Z,Zlen,1);
                        Cpos:=Pred(Cpos);
                        ZWrite(Floater);
                       End
                     Else
                       Begin
                        Cpos:=Pred(Cpos);
                        GotoCpos;
                       End;
                     Scan:=0;
                    End;
       HomeKey:If Cpos>1 then
                 Begin
                  Cpos:=1; GotoCpos;
                  If Z[ZLen]=' ' then
                    Begin
                     Z:=RSpaceWhack(Z);
                     ZWrite(Floater);
                    End;
                  Scan:=0;
                 End;
       EndKey:If ((Cpos<succ(ZLen)) and (ZLen<MaxLen)) or (Cpos<ZLen) or (Z[ZLen]=' ') then
                Begin
                 If Z[ZLen]=' ' Then
                   Begin
                    Z:=RSpaceWhack(Z);
                    ZWrite(Floater);
                   End;
                 If ZLen<MaxLen then Cpos:=Succ(ZLen)
                 Else Cpos:=ZLen;
                 GotoCpos;
                 Scan:=0;
                End;
       BkSpKey:If Cpos>1 then
                 Begin
                  Cpos:=Pred(Cpos); Delete(Z,Cpos,1);
                  ZWrite(Floater);
                  Scan:=0;
                 End;
       DelKey:If Cpos<=ZLen then
                Begin
                 Delete(Z,Cpos,1); ZWrite(Floater);
                 Scan:=0;
                End;
       CtrlBkSpKey:If Cpos>1 then
                     Begin
                      Delete(Z,1,Pred(Cpos));
                      Cpos:=1; ZWrite(Floater);
                      Scan:=0;
                     End;
       CtrlDelKey:If Cpos<=ZLen then
                    Begin
                     Delete(Z,Cpos,ZLen-Pred(Cpos));
                     OLen:=0; ZWrite(Floater);
                     Scan:=0;
                    End;
    End; {case}
   End;

   Procedure TypeChar;
   Begin
    If Ascii in AsciiExitSet then exit;
    If not activity then
      Begin
       activity:=True;
       if AutoClear and (Cpos=1) then
         Begin
          ZLen:=0;
          CPos:=1;
         End;
      End;
    If (Cpos=MaxLen) and (Ascii=' ') and (ZLen=Pred(MaxLen)) then
      Begin
       Scan:=FullStringExit;
       Exit;
      End;
    If BitCheck(7,OldKBStatus) then
      Begin
       Insert(Ascii,Z,Cpos);
       If ZLen>MaxLen then
         Begin
          Insert(Z[ZLen],OverBuff,1);
          Delete(Z,ZLen,1);
         End;
      End
    Else
      Begin
       Z[CPos]:=Ascii;
       If Cpos>Zlen then Zlen:=Cpos;
      End;
    Cpos:=Succ(Cpos);
    If cpos>MaxLen then
      Begin
       Scan:=FullStringExit;
       Cpos:=Pred(Cpos);
      End;
    ZWrite(Floater);
   End;

Begin
 OLen:=0;
 MaxLen:=0;
 If SetCposto1onEntry then cpos:=1;
 If cpos>ZLen then cpos:=succ(ZLen);
 If option='W' then
   Begin
    For I:=1 to MaskLen do
       Case mask[I] of
          '!','#','&','*'..'+','/','<'..'@','['..'^','{'..'~':BInc(MaxLen);
       End; {case}
    If Cpos>MaxLen then Cpos:=MaxLen;
   End
 Else
   Begin
    For I:=1 to MaskLen do
      Begin
       If Mask[I] in ValidMaskTokenSet then
         Begin
          BInc(MaxLen);
          QWriteAtt(1,X+Pred(I),Y,LFCC,0);
         End
       Else QWriteAtt(1,X+Pred(I),Y,NFCC,0);
      End;
    If Cpos>MaxLen then Cpos:=MaxLen;
    ZWrite(Floater);
    Activity:=False;
    SetHelp(HelpLine,HelpNum);
    Cursor(on);
    Repeat
       ReadKey(InsertStatusLine,ScanExitSet+LocalExitSet,AsciiExitSet,
               Mask[Mpos],Scan,Ascii);
       If Ascii=#0 then FunctionKey Else TypeChar;
    Until (Scan in ScanExitSet) or (Ascii in AsciiExitSet);
    Cursor(off);
    If Z[ZLen]=' ' then Z:=RSpaceWhack(Z);
   End;
 If DeadColorsOnExit or (option='W') then QWriteAtt(MaskLen,x,y,DFCC,0);
 ZWrite(off);
End;

Procedure ReadChar(option:char;
                   DeadColorsOnExit:Boolean;
                   HelpLine,HelpNum,X,Y:Byte;
                   ScanExitSet:ByteSetType;
                   Var Scan:Byte;
                   AsciiExitSet:CharSetType;
                   Var Ascii:Char;
                   MaskSet:CharSetType;
                   Var Z:Char);
Begin
 QWrite(Z,x,y,0,1);
 If option<>'W' then
   Begin
    SetHelp(HelpLine,HelpNum);
    Cursor(on);
    Repeat
       QWriteAtt(1,x,y,LFCC,0);
       ReadKey(Off,ScanExitSet,AsciiExitSet+MaskSet,#0,Scan,Ascii);
       If Ascii in MaskSet then
         Begin
          Z:=Ascii; QWrite(Z,x,y,0,0);
          Ascii:=#0; Scan:=FullStringExit;
         End;
    Until (Scan in ScanExitSet) or (Ascii in AsciiExitSet);
    Cursor(off);
   End;
 If DeadColorsOnExit or (option='W') then QWriteAtt(1,x,y,DFCC,0);
End;

Procedure ReadReal(option:char;
                   AutoClear,InsertStatusLine,SetCposTo1onEntry,
                   NegativeNumbers,DeadColorsOnExit:Boolean;
                   HelpLine,HelpNum,X,Y:Byte;
                   ScanExitSet:ByteSetType;
                   Var Scan:Byte;
                   AsciiExitSet:CharSetType;
                   Var Ascii:char;
                   IntFLen,ManFLen:Byte; {Integral & Mantissa Field Lengths}
                   Var Cpos:Byte;
                   Var Z:Real);
Var
   IntStr,ManStr,ManMask:String[30];
   IntLen:Byte absolute IntStr;
   MaxLen,ManPos1,IntPos1,NegPos2:Byte;
   FourDigitLeader,Negative,Activity,IntegralSection:Boolean;
   AsciiMoveRightSet,NegAsciiExitSet:CharSetType;
   ScanMoveRightSet,ScanMoveLeftSet,IntScanExitSet:ByteSetType;

   Procedure WriteNegative;
   Var LNegChar,RNegChar:char;
   Begin
    If Negative then
      Begin
       LNegChar:='<';
       RNegChar:='>';
      End
    Else
      Begin
       LNegChar:=' ';
       RNegChar:=' ';
      End;
    QWrite(LNegChar,x,y,0,0);
    QWrite(RNegChar,NegPos2,y,0,0);
   End;

   Function Fpos(IntPos:Byte):Byte;
   Begin
    If (FourDigitLeader and (IntPos+4>MaxLen)) then Fpos:=MaxLen-IntPos
    Else Fpos:=IntFLen-(IntPos+(pred(IntPos) div 3));
   End;

   Procedure GotoCpos;
   Begin
    GotoXY(IntPos1+Fpos(succ(IntLen-Cpos)),Y);
    If (Cpos=0) and ((IntLen mod 3)=0) and not(FourDigitLeader and (MaxLen-(IntLen-cpos)<5)) then
       QWrite(' ',0,0,0,2);
   End;

   Procedure IntWrite;
   Var I:Byte;
   Begin
    Activity:=True;
    While (IntLen>1) and (IntStr[1]='0') and (cpos>0) Do
      Begin
       Delete(IntStr,1,1);
       Cpos:=Pred(Cpos);
      End;
    If IntLen=0 then
      Begin
       IntStr:='0';
       Cpos:=1;
      End;
    If (IntStr='0') and negativeNumbers then
       If ManStr=StringOf(ManFLen,'0') then
         Begin
          Negative:=False;
          WriteNegative;
         End;
    GotoXY(IntPos1,y);
    If MaxLen-IntLen>0 then QWrite(Spaces(Fpos(IntLen)),0,0,LFCC,2);
    For I:=1 to IntLen Do
      Begin
       QWrite(IntStr[I],0,0,LFCC,2);
       If (((IntLen-I) mod 3)=0) and (I<>IntLen) and not(FourDigitLeader and (MaxLen-IntLen=0) and (I=1)) then
          QWrite(',',0,0,NFCC,2);
      End;
    GotoCpos;
   End;

   Procedure GetRealStr;

      Procedure NegativeAdjust;
      Begin
       If Ascii='-' then Negative:=True Else Negative:=False;
       WriteNegative;
       Ascii:=#0;
       If IntegralSection then GotoCpos;
      End;

      Procedure GetIntStr;

         Procedure ClearMantissa;
         Begin
          If ManFLen>0 then
            Begin
             ManStr:=StringOf(ManFLen,'0');
             QWrite(ManStr,ManPos1,y,0,0);
            End;
         End;

         Procedure FunctionKey;
         Begin
          Case Scan of
              ArrowRtKey:If Cpos<Intlen then
                           Begin
                            Cpos:=Succ(Cpos);
                            GotoCpos;
                            Scan:=0;
                           End;
             ArrowLfKey:If (Cpos>1) or ((Cpos=1)and (IntLen<MaxLen)) then
                          Begin
                           Cpos:=pred(Cpos);
                           GotoCpos;
                           Scan:=0;
                          End;
             HomeKey:If (Cpos>1) or ((Cpos=1) and (IntLen<MaxLen)) then
                       Begin
                        If IntLen=MaxLen then Cpos:=1 Else Cpos:=0;
                        GotoCpos;
                        Scan:=0;
                       End;
             EndKey:If Cpos<IntLen then
                      Begin
                       Cpos:=IntLen;
                       GotoCpos;
                       Scan:=0;
                      End;
             BkSpKey:If Cpos>0 then
                       Begin
                        Delete(IntStr,Cpos,1);
                        Cpos:=Pred(Cpos);
                        IntWrite;
                        Scan:=0;
                       End;
             DelKey:If IntLen>0 then
                      Begin
                       If Cpos=IntLen then Cpos:=Pred(Cpos);
                       Delete(IntStr,Succ(Cpos),1);
                       IntWrite;
                       Scan:=0;
                      End;
             CtrlBkSpKey:If Cpos>0 then
                           Begin
                            Delete(IntStr,1,Cpos);
                            Cpos:=0;
                            IntWrite;
                            Scan:=0;
                           End;
             CtrlDelKey:If (Cpos<IntLen) or ((ManFLen>0) and (ManStr<>StringOf(ManFLen,'0'))) then
                          Begin
                           ClearMantissa;
                           If Cpos<IntLen then
                             Begin
                              IntLen:=Cpos;
                              IntWrite;
                             End;
                           Scan:=0;
                          End;
          End; {case}
          If (Cpos>0) and (IntStr[1]='0') and (IntLen>1) then IntWrite;
         End;

         Procedure TypeChar;
         Begin
          If Ascii in AsciiMoveRightSet+AsciiExitSet then Exit;
          If not activity and AutoClear and (Cpos=IntLen) then
            Begin
             IntLen:=0;
             CPos:=0;
             ClearMantissa;
            End;
          If (IntLen<MaxLen) and (BitCheck(7,OldKBStatus) or (Cpos=IntLen)) then
            Begin
             Cpos:=succ(Cpos);
             Insert(Ascii,IntStr,Cpos);
             If Cpos=MaxLen then scan:=FullStringExit;
            End
          Else
            Begin
             If cpos=0 then
               Begin
                Insert(Ascii,IntStr,1);
                Cpos:=2;
               End
             Else
               Begin
                IntStr[CPos]:=Ascii;
                If Cpos=MaxLen then scan:=FullStringExit
                Else Cpos:=Succ(Cpos);
               End;
            End;
          Ascii:=#0;
          IntWrite;
         End;

      Begin {procedure GetIntStr}
       GotoCpos;
       Repeat
          ReadKey(InsertStatusLine,ScanExitSet+IntScanExitSet+ScanMoveRightSet,
                  AsciiExitSet+AsciiMoveRightSet+NegAsciiExitSet,'&',
                  Scan,Ascii);
          If Ascii in NegAsciiExitSet then NegativeAdjust;
          If Ascii=#0 then FunctionKey Else TypeChar;
       Until (Scan in ScanExitSet+ScanMoveRightSet) or (Ascii in AsciiExitSet+AsciiMoveRightSet);
      End; {procedure GetIntStr}

      Procedure GetManStr;
      Var ManLen:Byte absolute ManStr;
      Begin
       Repeat
          ReadString('R',Off,InsertStatusLine,off,off,off,0,0,
                     ManPos1,y,ScanExitSet+ScanMoveLeftSet,Scan,
                     AsciiExitSet+NegAsciiExitSet,Ascii,Cpos,ManStr,ManMask);
          If Ascii in NegAsciiExitSet then NegativeAdjust;
       Until (Scan in ScanExitSet+ScanMoveLeftSet) or (Ascii in AsciiExitSet);
       If ManLen<ManFLen then
         Begin
          ManStr:=ManStr+StringOf(ManFLen-ManLen,'0');
          QWrite(ManStr,ManPos1,y,0,0);
         End;
      End;

      Procedure Flip;
      Begin
       IntegralSection:=Not IntegralSection;
       Scan:=0; Ascii:=#0;
      End;

      Procedure SetSectionAndCpos;
      Begin
       If Cpos=1 then
          If IntFLen>0 then
            Begin
             IntegralSection:=True;
             Cpos:=IntLen;
            End
          Else
             IntegralSection:=False
       Else
          If Cpos>Succ(ManFLen) then
            Begin
             Cpos:=pred(Cpos-ManFLen);
             IntegralSection:=True;
            End
          Else
            Begin
             Cpos:=Pred(Cpos);
             IntegralSection:=False;
            End;
      End;

   Var Dummy:Integer;
   Begin {procedure GetRealStr}
    Activity:=False;
    SetHelp(HelpLine,HelpNum); Cursor(on);
    IntScanExitSet:=[ArrowLfKey,ArrowRtKey,HomeKey,EndKey,BkSpKey,DelKey,
                     CtrlBkSpKey,CtrlDelKey];
    SetSectionAndCpos;
    Repeat
       If IntegralSection then
         Begin
          GetIntStr;
          If ((Scan in [ArrowRtKey,EndKey,FullStringExit]) or (Ascii='.')) and (ManFLen>0) then
            Begin
             If Scan=EndKey then Cpos:=ManFLen Else Cpos:=1;
             Flip;
            End;
         End
       Else
         Begin
          GetManStr;
          If (Scan in [ArrowLfKey,HomeKey]) and (IntFLen>0) then
            Begin
             If Scan=HomeKey then
                If IntLen<MaxLen then Cpos:=0 Else Cpos:=1
             Else Cpos:=IntLen;
             Flip;
            End;
         End;
    Until (Scan in ScanExitSet) or (Ascii in AsciiExitSet);
    Cursor(off);
    Val(IntStr+'.'+ManStr,Z,dummy);
    If NegativeNumbers and Negative then Z:=-Z;
    If IntegralSection then
       If Cpos=IntLen then Cpos:=1 Else Cpos:=succ(Cpos+ManFLen)
    Else
       Cpos:=Succ(cpos);
   End; {procedure GetRealStr}

   Procedure Initialize;
   Begin
    IntPos1:=x;
    ManPos1:=succ(x+IntFLen);
    If ManFLen=0 then ManPos1:=pred(ManPos1);
    If IntFLen=0 then ManPos1:=succ(ManPos1);
    If NegativeNumbers then
      Begin
       IntPos1:=succ(IntPos1);
       ManPos1:=succ(ManPos1);
       NegPos2:=ManPos1+ManFLen;
       NegAsciiExitSet:=['-','+'];
       If Z<0 then
         Begin
          Negative:=True;
          Z:=-Z;
         End
       Else Negative:=False;
       WriteNegative;
       If option<>'W' then
         Begin
          QWriteAtt(1,x,y,NFCC,0);
          QWriteAtt(1,NegPos2,y,NFCC,0);
         End;
      End
    Else
      Begin
       NegPos2:=pred(ManPos1+ManFLen);
       NegAsciiExitSet:=[];
      End;
    If SetCposTo1onEntry or (Option='W') then Cpos:=1;
    If IntFLen>0 then
      Begin
       ScanMoveLeftSet:=[ArrowLfKey,HomeKey];
       MaxLen:=IntFLen-(IntFLen div 4);
       IntStr:=LSpaceWhack(form(StringOf(20,'#'),Int(Z)));
       FourDigitLeader:=((IntFLen mod 4)=0);
       If FourDigitLeader then MaxLen:=succ(MaxLen);
       IntWrite;
      End
    Else
      Begin
       ScanMoveLeftSet:=[];
       MaxLen:=0;
       IntStr:='';
       QWrite('0',IntPos1,y,NFCC,1);
      End;
    If ManFLen>0 then
      Begin
       ScanMoveRightSet:=[ArrowRtKey,EndKey,FullStringExit];
       AsciiMoveRightSet:=['.'];
       ManStr:=form(StringOf(18,'#')+'.'+StringOf(ManFLen,'#'),Z);
       Delete(ManStr,1,19);
       QWrite('.',pred(ManPos1),y,NFCC,2);
       QWrite(ManStr,0,0,LFCC,0);
       ManMask:=StringOf(ManFLen,'&');
      End
    Else
      Begin
       ScanMoveRightSet:=[];
       AsciiMoveRightSet:=[];
       ManMask:='';
       ManStr:='';
      End;
   End;

   Procedure Finalize;
   Begin
    If (Option='W') or DeadColorsOnExit then
       QWriteAtt(succ(NegPos2-x),x,y,DFCC,0);
   End;

Begin {procedure ReadReal}
 Initialize;
 If option<>'W' then GetRealStr;
 Finalize;
End; {procedure ReadReal}

Procedure ReadInt(Option:char;
                  AutoClear,InsertStatusLine,SetCposTo1onEntry,
                  NegativeNumbers,DeadColorsOnExit:Boolean;
                  HelpLine,HelpNum,X,Y:Byte;
                  ScanExitSet:ByteSetType;
                  Var Scan:Byte;
                  AsciiExitSet:CharSetType;
                  Var Ascii:Char;
                  FieldLength:Byte;
                  Var Cpos:Byte;
                  Var Z:Integer);
Var
 TempReal:Real;
 DummyKey:Char;
Begin
 Repeat
    TempReal:=Z;
    ReadReal(Option,AutoClear,InsertStatusLine,SetCposTo1onEntry,
             NegativeNumbers,DeadColorsOnExit,HelpLine,HelpNum,X,Y,
             ScanExitSet,Scan,AsciiExitSet,Ascii,FieldLength,0,
             Cpos,TempReal);
    If scan=EscKey then TempReal:=Z;
    If Not((TempReal<32767) and (TempReal>-32767)) then
      Begin
       PopUpArray[1]:='You must use a smaller number.';
       PopUpArray[2]:=ToContinue;
       PopNote(1,1,DummyKey);
      End;
 Until (TempReal<32767) and (TempReal>-32767);
 Z:=Round(TempReal);
End;

Procedure ReadByte(Option:char;
                   AutoClear,InsertStatusLine,SetCposTo1onEntry,
                   DeadColorsOnExit:Boolean;
                   HelpLine,HelpNum,X,Y:Byte;
                   ScanExitSet:ByteSetType;
                   Var Scan:Byte;
                   AsciiExitSet:CharSetType;
                   Var Ascii:Char;
                   FieldLength:Byte;
                   Var Cpos:Byte;
                   Var Z:Byte);
Var
 TempInt:Integer;
 DummyKey:Char;
Begin
 Repeat
    TempInt:=Z;
    ReadInt(Option,AutoClear,InsertStatusLine,SetCposTo1onEntry,
             Off,DeadColorsOnExit,HelpLine,HelpNum,X,Y,
             ScanExitSet,Scan,AsciiExitSet,Ascii,FieldLength,
             Cpos,TempInt);
    If scan=EscKey then TempInt:=Z;
    If Not(TempInt in [0..255]) then
      Begin
       PopUpArray[1]:='You must use a smaller number.';
       PopUpArray[2]:=ToContinue;
       PopNote(1,1,DummyKey);
      End;
 Until TempInt in [0..255];
 Z:=TempInt;
End;

Procedure ReadDate(Option:char;
                   SetCposTo1onEntry:Boolean;
                   HelpLine,HelpNum,
                   x,y:byte;
                   ScanExitSet:ByteSetType;
                   Var Scan:Byte;
                   AsciiExitSet:CharSetType;
                   Var Ascii:char;
                   Var CPos:Byte;
                   Var Jul:JulType;
                   OtherMode:Byte;  {1=day of week, 2=TFN, 3=both, 0=None}
                   RoundYear:Char);      { RoundYear : 'F'=Forward  }
                                         {             'B'=Backward }
                                         {             'N'=Nearest  }
Const
 DateScanExitSet:ByteSetType=[ArrowRtKey,ArrowLfKey,BkSpKey,EscKey];
 NextSectionAsciiSet:CharSetType=['/','-','+','\','.',','];
 StartOver=255;
Var
 Greg,OldGreg:GregType;
 dummy:Integer;
 Section:Byte;
 key1,PKey:char;
 TFN,MTWTFSS,NoDate:Boolean;
 DateAsciiExitSet,AsciiOtherSet:CharSetType;

   Function DateString(Month,Day:Byte;Year:Integer):String10;
   Begin
    Case Year of
       0:DateString:='TFN      ';
       1..7:DateString:=LeftText(DayName[Year],9);
       Else DateString:=form('@@',Month)+'-'+form('@@',Day)+'-'+form('@@',(Year mod 100));
    End; {case}
   End;

   Procedure WriteDate;
   Begin
    QWrite(DateString(Greg.Month,Greg.Day,Greg.Year),x,y,0,0);
   End;

   Procedure SetNormalColorMode;
   Begin
    QWriteAtt(8,x,y,LFCC,0);
    QWriteAtt(1,x+2,y,NFCC,0);
    QWriteAtt(1,x+5,y,NFCC,0);
    QWrite(' ',x+8,y,7,0);
   End;

   Procedure GetOther_StageTwo;
   Var
    AsciiWeekSet:CharSetType;
    FirstChar:Char;

      Procedure FinishUp;
      Begin
       Greg.Day:=OldGreg.Day;
       Greg.Month:=OldGreg.Month;
       WriteDate;
       Ascii:=#0; Scan:=FullStringExit;
      End;

      Procedure GetOther_StageThree;
      Var NumericSet:CharSetType;
      Begin
       QWrite(Ascii+' ',x,y,LFCC,0);
       QWrite(Spaces(6),x+2,y,NFCC,0);
       QWrite(' ',x+8,y,7,0);
       GotoXY(succ(x),y);
       If Ascii='T' then
          If TFN then AsciiWeekSet:=['U','H','F']
          Else AsciiWeekSet:=['U','H']
       Else AsciiWeekSet:=['A','U'];
       If NoDate then NumericSet:=[] Else NumericSet:=['0'..'9'];
       FirstChar:=Ascii;
       ReadKey(off,ScanExitSet+[ArrowLfKey,BkSpKey],
               AsciiExitSet+AsciiWeekSet+NumericSet,#0,scan,Ascii);
       If Ascii in AsciiWeekSet then
         Begin
          Case Ascii of
             'H':Greg.Year:=4;
             'F':Greg.Year:=0;
             'A':Greg.Year:=6;
             'U':If FirstChar='T' then Greg.Year:=2
                 Else Greg.Year:=7;
          End; {case}
          FinishUp;
         End
       Else
         Begin
          If Scan in [ArrowLfKey,BkSpKey] then Scan:=StartOver;
          Greg:=OldGreg;
          WriteDate;
         End;
      End;

   Begin {procedure GetOther_StageTwo}
    If Not MTWTFSS then
      Begin
       Greg.Year:=0;
       FinishUp;
      End
    Else
      Begin
       If Ascii in ['M','W','F'] then
         Begin
          Case Ascii of
             'M':Greg.Year:=1;
             'W':Greg.Year:=3;
             'F':Greg.Year:=5;
          End; {case}
          FinishUp;
         End
       Else
          GetOther_StageThree;
      End;
   End;

   Procedure GetDate;

      Procedure CheckDate;
      Begin
       If (Greg.Month in [4,6,9,11]) and (Greg.Day=31) then
         Begin
          PopUpArray[1]:=MonthName[Greg.Month]+' has only 30 days in it.';
          PopUpArray[2]:=ToTryAgain;
          PopUpArray[3]:=ToChangeTo+DateString(Greg.Month,30,Greg.Year)+'.';
          PopUpArray[4]:=ToChangeTo+DateString(succ(Greg.Month),1,Greg.Year)+'.';
          PopUpArray[5]:=ToChangeTo+DateString(OldGreg.Month,OldGreg.Day,OldGreg.Year)+' (default).';
          PopUpKey[2]:='A';
          PopUpKey[3]:='B';
          PopUpKey[4]:='C';
          PopNote(1,4,PKey);
          Case PKey of
             #0:Begin
                  section:=0;
                  scan:=0;
                 End;
             'A':Begin
                  Greg.Day:=30;
                  WriteDate;
                 End;
             'B':Begin
                  Greg.Day:=1;
                  Greg.Month:=succ(Greg.Month);
                  WriteDate;
                 End;
             'C':Begin
                  Greg:=OldGreg;
                  WriteDate;
                 End;
          End; {case}
         End;
       If (Greg.Month=2) and ((Greg.Day>29) or ((Greg.Day=29) and ((Greg.Year mod 4)<>0))) then
         Begin
          If (Greg.Year mod 4)>0 then
            Begin
             PopUpArray[1]:='There are only 28 days';
             PopUpArray[2]:='in February this year.';
             PopUpArray[3]:=ToTryAgain;
             PopUpArray[4]:=ToChangeTo+DateString(3,Greg.Day-28,Greg.Year)+'.';
             PopUpArray[5]:=ToChangeTo+DateString(2,28,Greg.Year)+'.';
             PopUpArray[6]:=ToChangeTo+DateString(OldGreg.Month,OldGreg.Day,OldGreg.Year)+' (default).';
             PopUpKey[2]:='A';
             PopUpKey[3]:='B';
             PopUpKey[4]:='C';
             PopNote(2,4,PKey);
             Case PKey of
                #0:Begin
                    section:=0;
                    scan:=0;
                   End;
                'A':Begin
                     Greg.Month:=3;
                     Greg.Day:=Greg.Day-28;
                     WriteDate;
                    End;
                'B':Begin
                     Greg.Day:=28;
                     WriteDate;
                    End;
                'C':Begin
                     Greg:=OldGreg;
                     WriteDate;
                    End;
             End; {case}
            End
          Else
            Begin
             PopUpArray[1]:='There are never more than';
             PopUpArray[2]:='29 days in February.';
             PopUpArray[3]:=ToTryAgain;
             PopUpArray[4]:=ToChangeTo+DateString(3,Greg.Day-29,Greg.Year)+'.';
             PopUpArray[5]:=ToChangeTo+DateString(2,29,Greg.Year)+'.';
             PopUpArray[6]:=ToChangeTo+DateString(OldGreg.Month,OldGreg.Day,OldGreg.Year)+' (default).';
             PopUpKey[2]:='A';
             PopUpKey[3]:='B';
             PopUpKey[4]:='C';
             PopNote(2,4,PKey);
             Case PKey of
                #0:Begin
                    section:=0;
                    scan:=0;
                   End;
                'A':Begin
                     Greg.Month:=3;
                     Greg.Day:=Greg.Day-29;
                     WriteDate;
                    End;
                'B':Begin
                     Greg.Day:=29;
                     WriteDate;
                    End;
                'C':Begin
                     Greg:=OldGreg;
                     WriteDate;
                    End;
             End; {case}
            End; {else}
         End; {if}
      End; {procedure}

      Procedure CheckMonth(GivenMonth:String2);
      Begin
       Greg.Month:=ByteVal(GivenMonth);
       If not(Greg.Month in [1..12]) then
         Begin
          WriteDate;
          PopUpArray[1]:='The number '+form('@@',Greg.Month)+' is not recognized as a';
          PopUpArray[2]:='valid month.  You must enter a number in';
          PopUpArray[3]:='the range of 1 (Jan) through 12 (Dec).';
          PopUpArray[4]:=ToContinue;
          PopNote(3,1,PKey);
          section:=0;
          scan:=0;
          Greg.Month:=OldGreg.Month;
         End;
       WriteDate;
      End;

      Procedure CheckDay(GivenDay:String2);
      Begin
       Greg.Day:=ByteVal(GivenDay);
       If not(greg.Day in [1..31]) then
         Begin
          WriteDate;
          PopUpArray[1]:='There cannot be '+form('@@',Greg.Day)+' days';
          PopUpArray[2]:='in any month.';
          PopUpArray[3]:=ToContinue;
          PopNote(2,1,PKey);
          section:=3;
          scan:=0;
          Greg.Day:=OldGreg.Day;
         End;
       WriteDate;
      End;

      Procedure CheckYear(GivenYear:String2);
      var Dif:Integer;
      Begin
       val(GivenYear,Greg.Year,dummy);
       If RoundYear='F' then
         Begin
          if length(givenYear)=1 then
            Begin
             Greg.Year:=Greg.Year+(OldGreg.Year div 10)*10-20;
             While Greg.Year<OldGreg.Year Do Greg.Year:=Greg.Year+10;
            End
          Else
            Begin
             Greg.Year:=Greg.Year+(OldGreg.Year div 100)*100-200;
             While Greg.Year<OldGreg.Year Do Greg.Year:=Greg.Year+100;
            End;
         End; {If}
       If RoundYear='B' then
         Begin
          if Length(GivenYear)=1 then
           Begin
            Greg.Year:=Greg.Year+(OldGreg.Year div 10)*10+20;
            While Greg.Year>OldGreg.Year Do Greg.Year:=Greg.Year-10;
           End
          Else
            Begin
             Greg.Year:=Greg.Year+(OldGreg.Year div 100)*100+200;
             While Greg.Year>OldGreg.Year Do Greg.Year:=Greg.Year-100;
            End;
         End;
       If RoundYear='N' then
         Begin
          If Length(GivenYear)=1 then
            Begin
             Dif:=Greg.Year-(OldGreg.Year mod 10);
             If Dif=0 then Greg.Year:=OldGreg.Year;
             If Abs(Dif) in [1..4] then Greg.Year:=OldGreg.Year+Dif;
             If Dif in [6..9] then Greg.Year:=OldGreg.Year-10+Dif;
             If -Dif in [6..9] then Greg.Year:=OldGreg.Year+10+Dif;
             If Abs(Dif)=5 then
               Begin
                PopUpArray[1]:='The correct year cannot be determined';
                PopUpArray[2]:='with the information given.  Both the';
                PopUpArray[3]:='future and previous years ending in '+form('#',Greg.Year);
                PopUpArray[4]:='are exactly five years from the default';
                PopUpArray[5]:='year given.';
                PopUpArray[6]:=ToTryAgain;
                PopUpArray[7]:=ToChangeTo+form('####',OldGreg.Year+5)+' (future).';
                PopUpArray[8]:=ToChangeTo+form('####',OldGreg.Year-5)+' (previous).';
                PopUpArray[9]:=ToChangeTo+form('####',OldGreg.Year)+' (default).';
                PopUpKey[2]:='F';
                PopUpKey[3]:='P';
                PopUpKey[4]:='D';
                PopNote(5,4,PKey);
                Case PKey of
                   #0:Begin
                       Greg.Year:=OldGreg.Year;
                       Section:=6;
                       scan:=0;
                      End;
                   'F':Greg.Year:=OldGreg.Year+5;
                   'P':Greg.Year:=OldGreg.Year-5;
                   'D':Greg.Year:=OldGreg.Year;
                End; {case}
               End;
            End
           Else
            Begin
             Dif:=Greg.Year-(OldGreg.Year mod 100);
             If Dif=0 then Greg.Year:=OldGreg.Year;
             If Abs(Dif) in [1..49] then Greg.Year:=OldGreg.Year+Dif;
             If Dif in [51..99] then Greg.Year:=OldGreg.Year-100+Dif;
             If -Dif in [51..99] then Greg.Year:=OldGreg.Year+100+Dif;
             If Abs(Dif)=50 then
               Begin
                QWrite(GivenYear,x+6,y,0,0);
                PopUpArray[1]:='The correct year cannot be determined';
                PopUpArray[2]:='with the information given.  Both the';
                PopUpArray[3]:='future and previous years ending in '+form('##',Greg.Year);
                PopUpArray[4]:='are exactly fifty years from the default';
                PopUpArray[5]:='year given.';
                PopUpArray[6]:=ToTryAgain;
                PopUpArray[7]:=ToChangeTo+form('####',OldGreg.Year+50)+' (future).';
                PopUpArray[8]:=ToChangeTo+form('####',OldGreg.Year-50)+' (previous).';
                PopUpArray[9]:=ToChangeTo+form('####',OldGreg.Year)+' (default).';
                PopUpKey[2]:='F';
                PopUpKey[3]:='P';
                PopUpKey[4]:='D';
                PopNote(5,4,PKey);
                Case PKey of
                   #0:Begin
                       Greg.Year:=OldGreg.Year;
                       Section:=6;
                       scan:=0;
                      End;
                   'F':Greg.Year:=OldGreg.Year+50;
                   'P':Greg.Year:=OldGreg.Year-50;
                   'D':Greg.Year:=OldGreg.Year;
                End; {case}
               End;
            End
         End;
       WriteDate;
      End; {function CheckYear}

      Procedure NextSection;
      Begin
       if section in [6,7] then
         Begin
          If section=7 then checkyear(key1);
          Exit;
         End;
       scan:=0;
       if (section=1) and (key1<>'0') then Greg.Month:=ByteVal(key1);
       if (section=4) and (key1<>'0') then Greg.Day:=ByteVal(key1);
       WriteDate;
       if section in [0,1] then section:=3 else section:=6;
      End;

      Procedure PrevSection;
      Begin
       If section in [0,1] then
         Begin
          If section=1 then checkmonth(key1);
          Exit;
         End;
       scan:=0;
       if section=4 then Greg.Day:=ByteVal(key1);
       If section=7 then
         Begin
          checkyear(key1);
          If Section=6 then Exit;
         End;
       WriteDate;
       if section in [6,7] then section:=3 else section:=0;
      End;

   Begin  {procedure GetDate}
    SetNormalColorMode;
    Repeat
       GotoXY(x+section,y);
       ReadKey(off,DateScanExitSet+ScanExitSet,
               AsciiExitSet+DateAsciiExitSet,'&',scan,Ascii);
       If scan=EscKey then Greg:=OldGreg;
       If Ascii in AsciiOtherSet then
         Begin
          GetOther_StageTwo;
          If (Ascii in ['0'..'9']) or (Scan=StartOver) then
            Begin
             Ascii:=#0;
             Scan:=0;
             SetNormalColorMode;
            End;
         End
       Else
         Begin
          If (Ascii=' ') and (section in [0,3]) then Ascii:='0';
          If Ascii in ['0'..'9'] then
            Begin
             scan:=0;
             Case section of
                0,3,6:Begin
                       key1:=Ascii;
                       section:=succ(section);
                       QWrite(Key1+' ',0,0,LFCC,2);
                      End;
                1:Begin
                   Section:=3;
                   CheckMonth(key1+Ascii);
                  End;
                4:Begin
                   Section:=6;
                   CheckDay(key1+Ascii);
                  End;
                7:Begin
                   scan:=FullStringExit;
                   CheckYear(key1+Ascii);
                  End;
             End; {case}
            End {if}
          Else
            Begin
             Case scan of
                arrowrtkey:NextSection;
                arrowlfKey,
                BkSpKey:Case section of
                           1,4,7:Begin
                                  Case section of
                                     1:Greg.Month:=OldGreg.Month;
                                     4:Greg.Day:=OldGreg.Day;
                                     7:Greg.Year:=OldGreg.Year;
                                  End; {case}
                                  scan:=0;
                                  Section:=Pred(Section);
                                  QWrite(' ',x+section,y,0,0);
                                 End;
                             3,6:PrevSection;
                        End; {case}
                Else If scan in ScanExitSet then
                        Case section of
                           1:checkmonth(key1);
                           4:checkday(key1);
                           7:checkYear(key1);
                        End; {case}
             End; {case}
             If ((Ascii in NextSectionAsciiSet) and (section<6)) or
                ((Ascii=' ') and (section in [1,4])) then
               Begin
                Ascii:=#0;
                NextSection;
               End;
             If (Ascii=' ') and (section=7) then
               Begin
                Ascii:=#0;
                scan:=FullStringExit;
                NextSection;
               End;
            End; {else}
          If (scan in ScanExitSet) or (Ascii in AsciiExitSet) then CheckDate;
         End;
    Until (scan in ScanExitSet) or (Ascii in AsciiExitSet);
    WriteDate;
   End;

   Procedure GetOther;
   Begin
    Repeat
       QWriteAtt(1,x,y,LFCC,0);
       If Greg.Year=3 then QWriteAtt(8,succ(x),y,NFCC,0)
       Else QWriteAtt(7,succ(x),y,NFCC,0);
       GotoXY(x,y);
       ReadKey(off,ScanExitSet,AsciiExitSet+AsciiOtherSet,'&',scan,Ascii);
       If Ascii in AsciiOtherSet then GetOther_StageTwo;
    Until (Scan in ScanExitSet) or (Ascii in AsciiExitSet) or
          ((Ascii in ['0'..'9']) and Not NoDate);
    If Ascii in ['0'..'9'] then
      Begin
       RawDate(Greg);
       OldGreg:=Greg;
       WriteDate;
       QWrite(' ',x+8,y,7,0);
       GetDate;
      End;
   End;

Begin  {procedure ReadDate}
 JulToGreg(Jul,Greg);
 WriteDate;
 If option<>'W' then
   Begin
    SetHelp(HelpLine,HelpNum); cursor(on);
    OldGreg:=Greg;
    MTWTFSS:=Bitcheck(0,OtherMode);
    TFN:=BitCheck(1,OtherMode);
    NoDate:=Bitcheck(2,OtherMode);
    AsciiOtherSet:=[];
    If TFN then AsciiOtherSet:=['T'];
    If MTWTFSS then AsciiOtherSet:=['M','T','W','F','S'];
    DateAsciiExitSet:=AsciiOtherSet+NextSectionAsciiSet;
    If SetCposto1onEntry then Cpos:=1;
    Section:=Pred(Cpos);
    If Greg.Year>10 then GetDate Else GetOther;
    Cpos:=Succ(Section);
    GregToJul(Greg,Jul); cursor(off);
   End; {else}
 If Greg.Year=3 then QWriteAtt(9,x,y,DFCC,0)
 Else
   Begin
    QWriteAtt(8,x,y,DFCC,0);
    QWrite(' ',x+8,y,7,0);
   End;
End; {procedure ReadDate}

Procedure ReadTime(Option:char;
                   SetCposTo1onEntry,MilitaryTime:Boolean;
                   Omissions, { bit 0 = hours, bit 2 = seconds }
                   HelpLine,HelpNum,X,Y:Byte;
                   ScanExitSet:ByteSetType;
                   Var Scan:Byte;
                   AsciiExitSet:CharSetType;
                   Var Ascii:Char;
                   Var Cpos:Byte;
                   Var DayPart:Integer);
Const
 AsciiMeridiemSet:CharSetType=['A','P'];
 AsciiMoveRightSet:CharSetType=[':','.',',','-','/'];
 ScanMoveRightSet:ByteSetType=[ArrowRtKey,EndKey,FullStringExit];
 ScanMoveLeftSet:ByteSetType=[ArrowLfKey,HomeKey];
Var
 HourStr,MinuteStr,SecondStr:String[2];
 Clock:ClockType;
 Section,MeridiemPos:Byte;
 PM,Seconds,Hours:Boolean;

   Procedure WriteTime;
   Var TempString:String[10];
   Begin
    TempString:=TimeString(Clock,MilitaryTime);
    If Not Seconds then Delete(TempString,6,3);
    If hours then
      Begin
       If TempString[1]=' ' then TempString[1]:='0';
       HourStr:=TempString;
      End
    Else Delete(TempString,1,3);
    QWrite(TempString,x,y,0,0);
   End;

   Procedure GetTime;
   Var dummykey:char;

      Procedure AMPM;

         Procedure AdjustHour;
         Begin
          WriteTime;
          Ascii:=#0;
         End;

      Begin
       If (Ascii='P') and (Clock.Hour in [0..11]) then
         Begin
          Clock.Hour:=Clock.Hour+12;
          PM:=True;
          AdjustHour;
         End;
       If (Ascii='A') and (Clock.Hour in [12..23]) then
         Begin
          Clock.Hour:=Clock.Hour-12;
          PM:=False;
          AdjustHour;
         End;
      End;

      Procedure GetHour;
      Var OldHourStr:String[2];
      Begin
       OldHourStr:=HourStr;
       Repeat
          ReadString('R',On,Off,Off,Off,Off,0,0,x,y,ScanExitSet+ScanMoveRightSet,
                   Scan,AsciiExitSet+AsciiMeridiemSet+AsciiMoveRightSet,Ascii,
                   Cpos,HourStr,'&&');
          If (HourStr='') or (Scan=EscKey) then HourStr:=OldHourStr;
          Clock.Hour:=ByteVal(HourStr);
          If Clock.Hour>23 then
            Begin
             PopUpArray[1]:='There are only 24 hours in a day';
             If MilitaryTime then PopUpArray[2]:='(0 through 23).'
             Else PopUpArray[2]:='(12am through 11pm).';
             PopUpArray[3]:=ToContinue;
             PopNote(2,1,dummykey);
             HourStr:=OldHourStr;
             cpos:=1;
            End;
       Until Clock.Hour<24;
       If (not MilitaryTime) and PM and (Clock.Hour<12) then
          Clock.Hour:=Clock.Hour+12;
       If (Clock.Hour=12) and (not PM) and (not MilitaryTime) then
          clock.Hour:=0;
       If Clock.Hour in [12..23] then PM:=True Else PM:=False;
       WriteTime;
      End;

      Procedure GetMinute;
      Var
       TScanMoveRightSet,TScanMoveLeftSet:ByteSetType;
       OldMinuteStr:String[2];
       Xofs:Byte;
      Begin
       OldMinuteStr:=MinuteStr;
       If seconds then TScanMoveRightSet:=ScanMoveRightSet
       Else TScanMoveRightSet:=[];
       If hours then
         Begin
          TScanMoveLeftSet:=ScanMoveLeftSet;
          Xofs:=3;
         End
       Else
         Begin
          TScanMoveLeftSet:=[];
          Xofs:=0;
         End;
       Repeat
          ReadString('R',On,Off,Off,Off,Off,0,0,x+Xofs,y,
                     ScanExitSet+TScanMoveLeftSet+TScanMoveRightSet,Scan,
                     AsciiExitSet+AsciiMeridiemSet+AsciiMoveRightSet,Ascii,
                     Cpos,MinuteStr,'&&');
          If (MinuteStr='') or (Scan=EscKey) then MinuteStr:=OldMinuteStr;
          Clock.Minute:=ByteVal(MinuteStr);
          If Clock.Minute>59 then
            Begin
             PopUpArray[1]:='There are only 60 minutes';
             PopUpArray[2]:='in an hour (0 through 59).';
             PopUpArray[3]:=ToContinue;
             PopNote(2,1,dummykey);
             MinuteStr:=OldMinuteStr;
             cpos:=1;
            End;
       Until Clock.Minute<60;
       MinuteStr:=form('@@',Clock.Minute);
       WriteTime;
      End;

      Procedure GetSecond;
      Var
       OldSecondStr:String[2];
       Xofs:Byte;
      Begin
       OldSecondStr:=SecondStr;
       If hours then Xofs:=6 Else Xofs:=3;
       Repeat
          ReadString('R',On,Off,Off,Off,Off,0,0,x+Xofs,y,ScanExitSet+ScanMoveLeftSet,
                     Scan,AsciiExitSet+AsciiMeridiemSet,Ascii,Cpos,SecondStr,'&&');
          If (SecondStr='') or (Scan=EscKey) then SecondStr:=OldSecondStr;
          Clock.Second:=ByteVal(SecondStr);
          If Clock.Second>59 then
            Begin
             PopUpArray[1]:='There are only 60 seconds';
             PopUpArray[2]:='in a minute (0 through 59).';
             PopUpArray[3]:=ToContinue;
             PopNote(2,1,dummykey);
             SecondStr:=OldSecondStr;
             cpos:=1;
            End;
       Until Clock.Second<60;
       If (clock.Second mod 5)<>0 then
         Begin
          Clock.Second:=((Clock.Second+2) div 5)*5;
          If Clock.Second=60 then Clock.Second:=55;
          Beep;
         End;
       SecondStr:=form('@@',Clock.Second);
       WriteTime;
      End;

   Begin
    SetHelp(HelpLine,HelpNum);
    QWriteAtt(5,x,y,LFCC,0);
    QWriteAtt(1,x+2,y,NFCC,0);
    If seconds and hours then
      Begin
       QWriteAtt(1,x+5,y,NFCC,0);
       QWriteAtt(2,x+6,y,LFCC,0);
      End;
    If Not MilitaryTime then
      Begin
       QWriteAtt(2,x+MeridiemPos,y,NFCC,0);
       If Clock.Hour>11 then PM:=True Else PM:=False;
      End;
    MinuteStr:=form('@@',Clock.Minute);
    SecondStr:=form('@@',Clock.Second);
    If SetCposTo1onEntry then
      Begin
       Cpos:=1;
       If Hours then Section:=1 Else Section:=2;
      End
    Else
      Begin
       section:=succ(Cpos) div 2;
       If not hours then BInc(section);
       If odd(Cpos) then Cpos:=1 Else Cpos:=2;
      End;
    Repeat
       Case section of
          1:GetHour;
          2:GetMinute;
          3:GetSecond;
       End; {case}
       If Ascii in (AsciiMeridiemSet) then AMPM;
       If ((Ascii in AsciiMoveRightSet) or (Scan in ScanMoveRightSet)) and
          ((Seconds and (section=2)) or (section=1)) then
         Begin
          Section:=succ(section);
          Ascii:=#0;
          Scan:=0;
          Cpos:=1;
         End;
       If (Scan in ScanMoveLeftSet) and
          (((section=2) and hours) or (section=3)) then
         Begin
          Section:=pred(section);
          Scan:=0;
          Cpos:=1;
         End;
    Until (Scan in ScanExitSet) or (Ascii in AsciiExitSet);
    Cpos:=(pred(section)*2)+Cpos;
    If not hours then
      Begin
       Cpos:=Cpos-2;
       Clock.Hour:=0;
      End;
    If not seconds then Clock.second:=0;
    ClockToDayPart(Clock,DayPart);
   End;

Begin
 DayPartToClock(DayPart,Clock);
 Hours:=not BitCheck(0,Omissions); Seconds:=not BitCheck(2,Omissions);
 If not hours then
   Begin
    MilitaryTime:=True;
    Seconds:=True;
   End;
 If seconds and hours then MeridiemPos:=8 Else MeridiemPos:=5;
 WriteTime;
 If option<>'W' then GetTime;
 QWriteAtt(MeridiemPos,x,y,DFCC,0);
 If Not MilitaryTime then QWriteAtt(2,x+MeridiemPos,y,DFCC,0);
End;