home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILER.ZIP / PICTOFRM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  10.2 KB  |  293 lines
  1. (***************************************************************)
  2. (*                                                             *)
  3. (*        FILER A LA PASCAL DATA BASE SOURCE CODE FILE         *)
  4. (*                                                             *)
  5. (*        (C) 1985 by  John M. Harlan                          *)
  6. (*                     24000 Telegraph                         *)
  7. (*                     Southfield, MI. 48034                   *)
  8. (*                                                             *)
  9. (*     The FILER GROUP of programs is released on a "FREE      *)
  10. (*     SOFTWARE" basis.  The recipient is free to examine      *)
  11. (*     and use the software with the understanding that if     *)
  12. (*     the FILER GROUP of programs prove to be of use and      *)
  13. (*     value,  a contribution to the author is encouraged.     *)
  14. (*                                                             *)
  15. (*     While reasonable effort has been made to ensure the     *)
  16. (*     reliability of the FILER GROUP of programs, no war-     *)
  17. (*     ranty is given. The recipient uses the programs at      *)
  18. (*     his own risk  and in no event shall the author be       *)
  19. (*     liable for damages arising from their use.              *)
  20. (*                                                             *)
  21. (*                                                             *)
  22. (***************************************************************)
  23.  
  24.  
  25. PROGRAM PICTOFRM;  { ONE OF THE FILER GROUP OF PROGRAMS }
  26. { CONVERTS PICTURE OF DATA BASE SCREEN TO XXX.FRM FILE }
  27. { PICTOFRM.PAS  VERSION 2.0 }
  28. { MAY 20, 1985 }
  29.  
  30. TYPE
  31.   NAMESTR   =  STRING[12];
  32.   STRING79  =  STRING[79];
  33.  
  34. VAR
  35.   X  :  INTEGER;                  { POSITION IN SCREEN DATA LINE }
  36.   Y  :  INTEGER;                     { LABEL & DATA ARRAY NUMBER }
  37.   Z  :  INTEGER;                           { SCREEN LINE COUNTER }
  38.  
  39.   W, POINTER, LABELSTART,
  40.   LABELEND, DATASTART,DATAEND,
  41.   DECPOINTER,WHOLEDIGITS,
  42.   WHOLEEND, COMMAS, LASTLINE,
  43.   ARRAYCOUNT, BLOCKINGFACTOR              :  INTEGER;
  44.  
  45.   LAB, DATA,
  46.   ASCII, FILEEXISTS                       :  BOOLEAN;
  47.  
  48.   LINE      :  ARRAY [1..30] OF STRING79;
  49.   WORK      :  ARRAY [1..79] OF CHAR;
  50.   INFO      :  STRING79;
  51.   LABELNAME :  STRING79;
  52.   FILENAME  :  STRING[12];
  53.   CH        :  CHAR;
  54.  
  55.   LABELLENGTH, DATALEN,DATAFORM,
  56.   ROW,COLUMN                           :  ARRAY[1..32] OF INTEGER;
  57.   LBLNAME                              :  ARRAY[1..32] OF STRING79;
  58.  
  59.   SOURCE, SCREENFORM                   : TEXT;
  60. {===============================================================}
  61. {                       FUNCTION EXIST                          }
  62. {===============================================================}
  63. FUNCTION EXIST(FILENAME : NAMESTR) : BOOLEAN;
  64. VAR
  65.   FIL :  FILE;
  66. BEGIN
  67.   ASSIGN(FIL,FILENAME);
  68.   {$I-}
  69.   RESET(FIL);
  70.   {$I+}
  71.   EXIST := (IORESULT = 0)
  72. END;
  73.  
  74. {===============================================================}
  75. {                  STORE LABEL & DATA PROCEDURE                 }
  76. {===============================================================}
  77. PROCEDURE STORELABDAT;
  78. BEGIN
  79.   DATA := FALSE;
  80.   LAB := FALSE;
  81.   LBLNAME[Y] := LABELNAME;                { SAVE LABEL IN ARRAY }
  82.  
  83.   IF DECPOINTER = 0 THEN           { NO DECIMAL POINT IN NUMBER }
  84.     BEGIN
  85.       WHOLEEND := DATAEND;
  86.       DECPOINTER := DATAEND ;
  87.     END;
  88.   IF ASCII = TRUE THEN                       { ASCII DATA FOUND }
  89.     BEGIN
  90.       DATAFORM[Y] := 15;
  91.       COMMAS := 0;
  92.     END
  93.   ELSE
  94.     BEGIN   { PROCESS FOR NUMERIC DATA ONLY }
  95.       DATAFORM[Y] := DATAEND-DECPOINTER;
  96.       WHOLEDIGITS := WHOLEEND - DATASTART;
  97.       IF WHOLEDIGITS > 7 THEN COMMAS := 2
  98.       ELSE
  99.         BEGIN
  100.           IF WHOLEDIGITS >3 THEN COMMAS := 1 ELSE COMMAS := 0;
  101.         END;
  102.     END;  { IF ASCII...ELSE BEGIN }
  103.   DATALEN[Y] := DATAEND - DATASTART + 1 - COMMAS;
  104.   ROW[Y] := Z;
  105.   COLUMN[Y] := LABELSTART;
  106.   Y := Y + 1;  { INCREMENT ARRAY COUNTER }
  107.   DATAEND := 0;
  108.   DATASTART := 0;
  109.   DECPOINTER := 0;
  110.   LABELNAME := '';
  111.   ASCII := FALSE;
  112. END;
  113.  
  114. {===============================================================}
  115. {                       MAIN PROGRAM                            }
  116. {===============================================================}
  117.  
  118. BEGIN
  119.   REPEAT
  120.     CLRSCR;
  121.     GOTOXY(1,24);
  122.     WRITELN('"PICTOFRM" CONVERTS FILES FROM XXX.PIC TO XXX.FRM');
  123.     WRITELN;
  124.     WRITE('ENTER FILENAME OF PICTURE FILE : ');
  125.     READLN(FILENAME);
  126.     X := POS('.',FILENAME);
  127.     IF X <> 0 THEN FILENAME := COPY(FILENAME,1,X-1);
  128.     FILENAME := FILENAME + '.PIC';
  129.     FILEEXISTS := EXIST(FILENAME);
  130.   UNTIL FILEEXISTS = TRUE;
  131.   ASSIGN (SOURCE,FILENAME);
  132.   RESET(SOURCE);
  133.  
  134.   Z := 1;  { LINE NUMBER IN SCREEN }
  135.   CLRSCR;
  136.   WHILE NOT EOF(SOURCE) DO
  137.     BEGIN
  138.       READLN(SOURCE,LINE[Z]);
  139.       WRITELN(LINE[Z]);
  140.       Z := Z+1;
  141.     END;
  142.   LASTLINE := Z-1;
  143.   WRITE('ENTER ANY KEY TO CONTINUE ');
  144.   READ(KBD,CH);
  145.   DELLINE;
  146.   WRITELN;
  147.  
  148. {===============================================================}
  149. {                    TRANSLATE SCREEN DATA                      }
  150. {===============================================================}
  151.  
  152.   Y := 1;  { ARRAY COUNTER }
  153.   Z := 1;  { SCREEN LINE COUNTER }
  154.  
  155.     WHILE Z <= LASTLINE DO
  156.       BEGIN
  157.         DATASTART := 0;
  158.         DATAEND := 0;
  159.         DECPOINTER := 0;
  160.         LAB := FALSE;
  161.         DATA := FALSE;
  162.         LABELNAME := '';
  163.         ASCII := FALSE;
  164.  
  165.         FOR X := 1 TO LENGTH(LINE[Z]) DO
  166.           BEGIN
  167.             IF LAB = FALSE THEN
  168.               BEGIN
  169.                 IF LINE[Z][X] <> ' ' THEN
  170.                   BEGIN
  171.                     LABELSTART := X;
  172.                     LAB := TRUE;         { FIRST CHAR OF LABEL FOUND }
  173.                     LABELNAME := LABELNAME + LINE[Z][X];
  174.                   END;
  175.               END
  176.             ELSE
  177.               BEGIN                                      { LAB = TRUE}
  178.                 IF DATA = FALSE THEN             { PROCESS LABEL INFO }
  179.                   BEGIN                   { LAB = TRUE & DATA = FALSE }
  180.                     IF LINE[Z][X] = ':' THEN
  181.                       BEGIN
  182.                         DATA := TRUE;
  183.                       END
  184.                     ELSE             { WE HAVE ANOTHER CHAR OF LABEL }
  185.                       BEGIN
  186.                         LABELNAME := LABELNAME + LINE[Z][X];
  187.                       END;
  188.                   END
  189.                 ELSE                       { LAB = TRUE & DATA = TRUE }
  190.                   BEGIN                { PROCESS NUMERIC INFORMATION }
  191.                     IF DATASTART = 0 THEN
  192.                       BEGIN
  193.                         IF LINE[Z][X] <> ' ' THEN
  194.  
  195.  
  196.                           BEGIN
  197.                             DATASTART := X;
  198.                             IF UPCASE(LINE[Z][X]) IN ['A'..'Z'] THEN ASCII := TRUE;
  199.                             IF LINE[Z][X] = '.' THEN
  200.                               BEGIN
  201.                                 DECPOINTER := X;
  202.                                 WHOLEEND := X-1;
  203.                               END;
  204.                           END;
  205.  
  206.  
  207.                       END
  208.                     ELSE
  209.                       BEGIN
  210.                         IF X = LENGTH(LINE[Z]) THEN
  211.                           BEGIN
  212.                             DATAEND := X;
  213.                             STORELABDAT;            {  END OF LINE FOUND  }
  214.                           END
  215.                         ELSE
  216.                           BEGIN
  217.                             IF LINE[Z][X] = '.' THEN
  218.                               BEGIN
  219.                                 DECPOINTER := X;
  220.                                 WHOLEEND := X-1;
  221.                               END;
  222.                             IF LINE[Z][X] = ' ' THEN
  223.                               BEGIN
  224.                                 DATAEND := X-1;
  225.                                 STORELABDAT; {  SPACE AFTER LABEL FOUND  }
  226.                               END;
  227.                           END;  { IF X .. ELSE BEGIN }
  228.                       END;  { IF DATASTART .. ELSE BEGIN }
  229.                   END;  { IF DATA ... ELSE BEGIN }
  230.               END;  { IF LAB ... ELSE BEGIN }
  231.           END;  { FOR X ... BEGIN }
  232.         Z := Z + 1;
  233.       END;  { WHILE .. BEGIN }
  234.       CLOSE(SOURCE);
  235.  
  236.       X := POS('.',FILENAME);
  237.       IF X <> 0 THEN FILENAME := COPY(FILENAME,1,X-1);
  238.       FILENAME := FILENAME + '.FRM';
  239.       ASSIGN(SCREENFORM,FILENAME);
  240.       REWRITE(SCREENFORM);
  241.       ARRAYCOUNT := Y-1;
  242.  
  243.       FOR X := 1 TO Y-1 DO
  244.         BEGIN
  245.           STR(ROW[X]:3,INFO);
  246.           WRITE (SCREENFORM,'ROW',INFO);
  247.           WRITE ('ROW',INFO);
  248.           STR(COLUMN[X]:3,INFO);
  249.           WRITE (SCREENFORM,', COL',INFO);
  250.           WRITE (', COL',INFO);
  251.           STR(DATAFORM[X]:3,INFO);
  252.           WRITE (SCREENFORM,', FORM',INFO);
  253.           WRITE (', FORM',INFO);
  254.           STR(DATALEN[X]:4,INFO);
  255.           WRITE (SCREENFORM,', LEN',INFO);
  256.           WRITE (', LEN',INFO);
  257.           WRITE (SCREENFORM,', MISC ___');
  258.           WRITE (', MISC ___');
  259.           WRITELN (SCREENFORM,', LABEL >',LBLNAME[X],'<');
  260.           WRITELN (', LABEL >',LBLNAME[X],'<');
  261.         END;
  262.         WRITELN;
  263.         WRITE('ENTER ANY KEY TO CONTINUE ');
  264.         READ(KBD,CH);
  265.         DELLINE;
  266.         WRITELN;
  267. WRITELN('BEGINNING WITH A PICTURE OF THE FILE, "PICTOFRM" HAS TRANSLATED');
  268. WRITELN('THIS INFORMATION INTO AN INTERMEDIATE FORM AND STORED IT IN A');
  269. WRITELN('FILE WITH THE SAME NAME AND THE FILE EXTENSION ".FRM".');
  270. WRITELN;
  271. WRITELN('THIS FILE MAY NOW BE EDITED WITH ANY EDITOR SUCH AS WORDSTAR');
  272. WRITELN('TO REVISE THE ORDER OF THE FIELDS WITHIN THE FILE.');
  273. WRITELN;
  274. WRITELN('FINALLY, TO CONVERT THE ".FRM" INTERMEDIATE FILE INTO A ".DAT"');
  275. WRITELN('FILE THAT CAN BE USED BY THE FILER GROUP OF PROGRAMS, USE THE');
  276. WRITELN('PROGRAM "FRMTODAT".');
  277.  
  278.       Z := 0;
  279.       FOR X :=1 TO ARRAYCOUNT DO
  280.         Z := Z + DATALEN[X];
  281.       WRITELN;
  282.       WRITELN('RECORD LENGTH : ',Z,' BYTES');
  283.       BLOCKINGFACTOR := 256 DIV Z;
  284.       WRITELN('BLOCKING FACTOR : ',BLOCKINGFACTOR);
  285.       W := 256 DIV (BLOCKINGFACTOR + 1) -Z;
  286.       WRITELN('BYTES LEFT IN BLOCK : ',256-Z*BLOCKINGFACTOR);
  287.       WRITE('CHANGE RECORD LENGTH BY ',W);
  288.       WRITELN(' BYTES TO INCREASE BLOCKING FACTOR');
  289.  
  290.       CLOSE(SCREENFORM);
  291. END.
  292.  
  293.