Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FILER.ZIP/FILER3.PAS

Pascal/Delphi Source File | 1985-11-18 | 9.5 KB | 287 lines

{================================================================}
{                   GET DATA RECORD PROCEDURE                    }
{================================================================}
PROCEDURE GETDATAREC;
  BEGIN
    CALCULATE;
    IF DISKRECORD <> DISKRECNOWINMEM THEN
      BEGIN
        IF FILERECCHGD = TRUE THEN
          BEGIN
            IF DISKRECNOWINMEM > NBRDISKRECUSED THEN
              BEGIN                 { GET NEXT AVAILABLE RECORD }
                SEEK(SOURCE,NBRDISKRECUSED+2);
                NBRDISKRECUSED := DISKRECNOWINMEM;
              END
            ELSE
              BEGIN
                SEEK(SOURCE,DISKRECNOWINMEM);
              END;
            BLOCKWRITE(SOURCE,GETDATA,2);  {SAVE CHANGED DATA}
            FILERECCHGD := FALSE;
            CHANGEDATE := TRUE;
          END;

        IF DISKRECORD <= NBRDISKRECUSED THEN
          BEGIN
            SEEK(SOURCE,DISKRECORD);
            BLOCKREAD(SOURCE,GETDATA,2);         {  RECORD DATA  }
         END
        ELSE FILLCHAR(GETDATA[1],256,' '); {SPACES FOR EMPTY REC }

       DISKRECNOWINMEM := DISKRECORD;
      END;
  END;
{================================================================}
{              PRINT LABEL AND DATA PROCEDURE                    }
{================================================================}
PROCEDURE PRINTLABDAT( Z : INTEGER );
VAR
  W  :  INTEGER;

  BEGIN
    IF ROW[Z] <23 THEN
      BEGIN
        GOTOXY(COLUMN[Z],ROW[Z]);
        FOR W := LABELPOSN[Z] TO LABELPOSN[Z+1]-1 DO
        WRITE (LBL[W]);
        ANS := '';
        GETDATAFROMARRAY(ANS);
        IF DATAFORM[Z] <> ASCII THEN EDIT(ANS);
        WRITE(': ' + ANS);
      END;
  END;
{================================================================}
{                 DISPLAY ONE RECORD PROCEDURE                   }
{================================================================}
PROCEDURE DISPLAYREC;
BEGIN
  CLRSCR;
  FOR Z := 1 TO FIELDPERRECORD DO
  PRINTLABDAT(Z);
  GOTOXY(70,23);
  WRITE('RECORD ',DATARECORD);
  LASTRECUSED := DATARECORD;
END;
{================================================================}
{                 FIELD DATA MESSAGE PROCEDURE                   }
{================================================================}
PROCEDURE FIELDDATAMSG;
BEGIN
  GOTOXY(1,24);
  WRITE('FIELD DATA EDIT MODE     [ USE WORDSTAR EDIT ');
  WRITE('COMMANDS ]       F1 = RECORD DONE');
END;
{================================================================}
{                  DELETE RECORD PROCEDURE                       }
{================================================================}
PROCEDURE DELETEREC;
  BEGIN
    GOTOXY(1,24);
    CLREOL;
    WRITE('OK TO DELETE (Y/N)  ');
    READ(KBD,CH);
    IF CH IN ['Y','y'] THEN
      BEGIN
        FILLCHAR(GETDATA[PRECBYTE+1],RCDLEN,' ');
        FILERECCHGD := TRUE;
        DISPLAYREC;
      END;
   END;
{================================================================}
{                   ENTER TARGET PROCEDURE                       }
{================================================================}
PROCEDURE ENTERTARGET;
BEGIN
  GOTOXY(1,24);
  WRITE('ENTER TARGET : ');
  CLREOL;
  TARGET := '';
  KEYIN(TARGET,16,24,20);
  CASE CH1 OF
    #67,#68 :
          BEGIN
            TARGET := LASTTARGET;
            GOTOXY(16,24);
            REVVIDEO;
            WRITE(TARGET);
            REGVIDEO;
          END
    ELSE  { CASE TARGET[1] OF }
          BEGIN
            LASTTARGET := TARGET;
          END;
    END;  { CASE TARGET[1] OF }
END;
{================================================================}
{                  ENTER FIELD DATA PROCEDURE                    }
{================================================================}
PROCEDURE ENTERFIELD;
VAR
  W     :  INTEGER;

BEGIN
  Z := 1;
  REPEAT
    BEGIN
      GETDATAFROMARRAY(ANS);
      KEYIN(ANS,COLUMN[Z]+LABELLENGTH[Z]+2,ROW[Z],DATALEN[Z]);
      CASE CH OF

        '\'    :
          BEGIN                 { PROCESS BACKSLASH COMMANDS }
            PRINTLABDAT(Z);
            GOTOXY(1,23);
            WRITE('FIELD NAME...');
            ENTERTARGET;
            DELLINE;
            Z := 0;
            REPEAT
              Z := Z + 1;
              ANS := '';
              FOR W := LABELPOSN[Z] TO LABELPOSN[Z+1]-1 DO
              ANS := ANS + LBL[W];
              POSN := POS(TARGET,ANS);
              IF Z = FIELDPERRECORD THEN
                BEGIN
                  IF POSN = 0 THEN
                    BEGIN
                      Z := 1;
                      POSN := 1;
                    END;
                END;
            UNTIL POSN <> 0;
            GOTOXY(1,23);
            WRITE('             ');
            FIELDDATAMSG;
          END;

        ^R  :                        { ^R = MOVE TO TOP OF FIELD }
          BEGIN
            PRINTLABDAT(Z);
            STOREDATAINARRAY;
            FILERECCHGD := TRUE;
            Z := 1;
          END;

        #27 :
          BEGIN
            CASE CH1 OF

            #59 :              { F1 KEY FOR HOME TO RECORD MODE }
               BEGIN
                 STOREDATAINARRAY;
                 FILERECCHGD := TRUE;
                 PRINTLABDAT(Z);
                 Z := FIELDPERRECORD + 1;          { HOME KEY   }
               END;


            #64 :                      { F6 = UP ARROW FUNCTION }
               BEGIN
                 STOREDATAINARRAY;
                 FILERECCHGD := TRUE;
                 PRINTLABDAT(Z);
                 IF Z>1 THEN Z := Z-1              { UP ARROW   }
                 ELSE Z := FIELDPERRECORD;
               END;

            #60,#66 :         { F2 = LINE FEED, F6 = DOWN ARROW }
               BEGIN
                 STOREDATAINARRAY;
                 FILERECCHGD := TRUE;
                 PRINTLABDAT(Z);
                 Z := Z+1;             { LINE FEED & DOWN ARROW }
               END;



            #67,#68  :            { UP [F9] OR DOWN [F10] SEARCH }
               BEGIN
                 W := Z;   { SAVE FIELD NUMBER }
                 CONDITION := FALSE;
                 GOTOXY(1,23);
                 IF CH1 = #68 THEN
                   BEGIN
                     INCR := 1;
                     WRITE('SEARCH UP...');
                     IF DATARECORD = NBRRECUSED THEN CONDITION := TRUE;
                   END
                 ELSE
                   BEGIN
                     INCR := -1;
                     WRITE('SEARCH DOWN...');
                     IF DATARECORD = 1 THEN CONDITION := TRUE;
                   END;
                 ENTERTARGET;
                 IF LENGTH(TARGET)>0 THEN
                   BEGIN
                     IF DATAFORM[Z] <> ASCII THEN
                       BEGIN
                         IF (TARGET[1] = '>') OR (TARGET[1]='<') THEN
                           BEGIN
                             SEARCHTYPE := TARGET[1];
                             TARGET := COPY(TARGET,2,LENGTH(TARGET)-1);
                           END
                         ELSE SEARCHTYPE := '=';
                         STRINGTOREAL(TARGET,TARGETVALUE,CODE);
                       END;
                     WHILE CONDITION = FALSE DO
                       BEGIN
                         DATARECORD := DATARECORD + INCR;
                         GETDATAREC;
                         GOTOXY(70,23);
                         CLREOL;
                         WRITE('RECORD ',DATARECORD);
                         GETDATAFROMARRAY(ANS);
                         IF DATAFORM[Z] <> ASCII THEN
                           BEGIN
                             STRINGTOREAL(ANS,NUMVALUE,CODE);
                             CASE SEARCHTYPE OF
                               '>' : IF NUMVALUE>TARGETVALUE THEN
                                     CONDITION := TRUE;
                               '<' : IF NUMVALUE<TARGETVALUE THEN
                                     CONDITION := TRUE;
                               '=' : IF NUMVALUE = TARGETVALUE THEN
                                     CONDITION := TRUE;
                             END; { CASE SEARCHTYPE }
                           END
                         ELSE
                           BEGIN
                             POSN := POS(TARGET,ANS);
                             IF POSN <> 0 THEN CONDITION := TRUE;
                           END;
                         IF DATARECORD >= NBRRECUSED THEN CONDITION := TRUE;
                         IF DATARECORD <= 1 THEN CONDITION := TRUE;
                         IF KEYPRESSED = TRUE THEN
                           BEGIN
                            CONDITION := TRUE;
                            ABORTCHAR := TRUE;
                           END;
                       END; { WHILE CONDITION... }
                     DISPLAYREC;
                   END
                 ELSE
                   BEGIN
                     GOTOXY(1,23);
                     WRITE('              ');
                   END;
                 FIELDDATAMSG;
                 Z := W;   { RESTORE FIELD NUMBER }
               END;  { CASE OF ^L (UP ARROW) OR ^H (DOWN ARROW) }


            END;  { CASE OF #27 }
          END;  { #27 BEGIN }
      ELSE { CASE CH OF }
          BEGIN
            STOREDATAINARRAY;
            FILERECCHGD := TRUE;
            PRINTLABDAT(Z);
            Z := Z+1;
          END;  { ELSE BEGIN }
      END; { CASE CH OF }
    END; {REPEAT BEGIN }
  UNTIL Z > FIELDPERRECORD;
END;