Topspeed_JPI/TS/MODBASE/SCRN2DBF.MOD

IMPLEMENTATION MODULE Scrn2DBF;
(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1991 Donald G. Fletcher
 *  (c) Copyright 1986 - 1991 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *
 *  Contributed by John McMonagle of McMonagle Software
 *  Green Bay, Wisconsin.
 *)

 (* 12/23/88 replaced LeftJustify with LeftJust to save leading blanks *)
 (* increased memosize limit to 4k *)
 (* 6/22/89 @DELETED,@RECNUM,@RECOUNT TO Frame to DBF *)

IMPORT DateFunctions;
IMPORT DBFields;
IMPORT ErrorManager;
IMPORT FieldTypes;
IMPORT GenLists;
IMPORT LowLevel;
IMPORT MemoFunctions;
IMPORT ModBase3;
IMPORT PosUtils;
IMPORT ScrnTypes;
IMPORT ScrnUtl1;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT StringIO;
IMPORT M2Strings;
IMPORT SYSTEM;
  FROM VStorage IMPORT
    DosAlloc, DosDealloc;

  CONST
    MemoSize=4000;
  PROCEDURE DEALLOCATE(VAR loc:SYSTEM.ADDRESS;size:CARDINAL);
  BEGIN
    DosDealloc(loc,size);
  END DEALLOCATE;

  PROCEDURE ALLOCATE(VAR loc:SYSTEM.ADDRESS;size:CARDINAL);
  BEGIN
    DosAlloc(loc,size);
  END ALLOCATE;

  PROCEDURE LeftJust( VAR TheStr: ARRAY OF CHAR;
      RequiredLength: CARDINAL );
    VAR strlength: CARDINAL;
    BEGIN
      strlength := M2Strings.Length( TheStr );
      IF strlength > RequiredLength THEN
        StrEdit.SetLength( TheStr, RequiredLength );
      ELSE
        WHILE strlength < RequiredLength DO
          StrEdit.Append( TheStr, ' ' );
          INC( strlength );
        END;
      END;
    END LeftJust;

  PROCEDURE FrameToDBF
            ( VAR DBF        : ModBase3.DBFile;
              VAR TheFrame   : ScrnTypes.DisplayFrame) : BOOLEAN;

  VAR
    string      : ARRAY[ 0 .. 128 ] OF CHAR;
    TotalFields,
    size,
    i,
    FieldCount,
    k,
    J           : CARDINAL;
    offby       : INTEGER;
    dumbool     : BOOLEAN;
    date        : DateFunctions.Date;
    list        : GenLists.GenList;
    text        : POINTER TO ARRAY[ 0 .. MemoSize-1 ] OF CHAR;
    FieldPtr    : ScrnTypes.InputFieldPtr;
    ImagePtr    : ScrnTypes.ImageElmtPtr;
    fldptr      : ModBase3.DBFieldPtr;

  BEGIN
    TotalFields := ScrnUtl1.FieldListTotal( TheFrame );
    fldptr:=ModBase3.FieldList(DBF);
    FieldCount := 1;
    REPEAT
      ScrnUtl1.GetFieldPtr( TheFrame, FieldCount, FieldPtr );
      IF M2Strings.Length( FieldPtr^.fnam ) # 0 THEN
        ScrnUtl1.GetFieldImagePtr( TheFrame, FieldCount, ImagePtr );
        i := ModBase3.PosOfField( DBF, FieldPtr^.fnam );
        IF i # 0 THEN
          CASE fldptr^[i].fldtype OF
            'C' :
              M2Strings.Assign( ImagePtr^.text, string );
              DBFields.Replace( DBF, i, string ); |
            'D' :
              (* as dates are to be checked in userops count and errorcheck
                are to be dropped *)
                (* should modify to use fieldptr variables *)
              IF NOT PosUtils.IsBlank( ImagePtr^.text ) THEN
                DateFunctions.StrToDate( ImagePtr^.text, date, dumbool );
                IF NOT dumbool THEN
                  RETURN FALSE
                END (* if *);
                DBFields.ReplaceD( DBF, i, date );
              ELSE
                DBFields.Replace( DBF, i, '        ' );
              END (* if *); |
            'L' :
              (* should work fine for both group and boolean fields *)
              DBFields.ReplaceL( DBF, i, FieldPtr^.selected ); |
            'M' :
              IF FieldPtr^.typ = FieldTypes.TypeCode( 'EDITOR' ) THEN
                dumbool := ScrnUtl1.ListFromEdField( TheFrame, FieldCount,
                    list );
                size := GenLists.ListLength( list );
                (* cludge because empty list has 1 element !!!*)
                IF size=1 THEN
                  GenLists.GetElmt( list, 1, string, k );
                END;
                NEW(text);
                text^ := '';
                IF (size # 0 ) AND  NOT ((size =1) AND (string[0]=0C)) THEN
                  FOR J := 1 TO size DO
                    GenLists.GetElmt( list, J, string, k );
                    StrEdit.Append( text^, string );
                    StrEdit.Append( text^, StringIO.CrLf );
                    (* for *)
                  END (* for J *);
                END (* if size *);
                MemoFunctions.ReplaceM( DBF, i, text^ );
                DISPOSE(text);
              END (* if FieldPtr *);
               |
            'N' :
              M2Strings.Assign( ImagePtr^.text, string );
              StrEdit.DeleteChar( ' ', string );
              IF M2Strings.Pos( '.', string ) > HIGH( string ) THEN
                StrEdit.Append( string, '.' );
                (* no decimal point *)
              END (* if M2Strings.Pos *);
              (* if *)
              offby := -INTEGER( fldptr^[i].decplaces ) + INTEGER(
                       M2Strings.Length( string ) )
                       - INTEGER( M2Strings.Pos( '.', string ) + 1 );
              IF offby < 0 THEN
                REPEAT
                  StrEdit.Append( string, '0' );
                  INC( offby );
                UNTIL offby = 0;
              ELSE
                StrEdit.SetLength( string, M2Strings.Length( string ) -
                    CARDINAL( offby ) );
              END (* if offby *);
              (* if *)
              IF fldptr^[i].decplaces = 0 THEN
                StrEdit.SetLength( string, M2Strings.Pos( '.', string ) );
              END (* if DBF.fieldlist^ *);
              (* if *)
              (* Right justify *)
              WHILE M2Strings.Length( string ) < fldptr^[i].size DO
                M2Strings.Concat( ' ', string, string );
                (* while *)
              END (* while M2Strings.Length *);
              DBFields.Replace( DBF, i, string );
          ELSE
          END (* case DBF.fieldlist^ *);
        END (* if i *);
      END (* if M2Strings.Length *);
      INC( FieldCount );
    UNTIL FieldCount > TotalFields;
    RETURN TRUE;
  END FrameToDBF;


  PROCEDURE DBFToFrame
            ( VAR DBF        : ModBase3.DBFile;
              VAR TheFrame   : ScrnTypes.DisplayFrame);

  VAR
    string      : ARRAY[ 0 .. 79 ] OF CHAR;
    TotalFields,
    size,
    FieldCount,
    i           : CARDINAL;
    ok          : BOOLEAN;
    date        : DateFunctions.Date;
    list        : GenLists.GenList;
    FieldPtr    : ScrnTypes.InputFieldPtr;
    ImagePtr    : ScrnTypes.ImageElmtPtr;
    Block       : SYSTEM.ADDRESS;
    fldptr      : ModBase3.DBFieldPtr;
    text        : POINTER TO ARRAY[ 0 .. MemoSize-1 ] OF CHAR;

  BEGIN
    fldptr:=ModBase3.FieldList(DBF);
    TotalFields := ScrnUtl1.FieldListTotal( TheFrame );
    FieldCount := 1;
    REPEAT
      ScrnUtl1.GetFieldPtr( TheFrame, FieldCount, FieldPtr );
      IF M2Strings.Length( FieldPtr^.fnam ) # 0 THEN
        ScrnUtl1.GetFieldImagePtr( TheFrame, FieldCount, ImagePtr );
        i := ModBase3.PosOfField( DBF, FieldPtr^.fnam );
        IF i # 0 THEN
          CASE fldptr^[i].fldtype OF
            'C' :
              ModBase3.GetField( DBF, i, string );
              size := M2Strings.Length( ImagePtr^.text );
              LeftJust( string, size );
              LowLevel.Move(SYSTEM.ADR(string),SYSTEM.ADR(ImagePtr^.text),
                 size);
              (* if *) |
            'N' :
              ModBase3.GetField( DBF, i, string );
              size := M2Strings.Length( ImagePtr^.text );
              StrEdit.RightJustify( string, size );
              LowLevel.Move(SYSTEM.ADR(string),SYSTEM.ADR(ImagePtr^.text),
                  size);
              (* if *) |
            'D' :
                (* should add code to initalize date paramaters in
                   fieldptr *)
              DBFields.GetDateField( DBF, i, date );
              DateFunctions.DateToStr( date, string, ok );
              IF NOT ok THEN
                string:='';
              END (* if ok *);
              size := M2Strings.Length( ImagePtr^.text );
              LeftJust( string, size );
              LowLevel.Move(SYSTEM.ADR(string),SYSTEM.ADR(ImagePtr^.text),
                  size);
              (* if *) |
            'L' :
              DBFields.GetLogicalField( DBF, i, FieldPtr^.selected );
              IF (FieldPtr^.typ = FieldTypes.TypeCode('BOOLEAN') ) THEN
                IF FieldPtr^.selected THEN
                  (* if boolean code mark *)
                  ImagePtr^.text[0]:=CHR(251);(* û *)
                ELSE
                  ImagePtr^.text[0]:=' ';
                END;
              END;  |
            'M' :
              IF FieldPtr^.typ = FieldTypes.TypeCode( 'EDITOR' ) THEN
                NEW( text );
               (* LowLevel.Fill( text, HIGH( text^ )+1, 0 );*)
                (* to clear block for block to list*)
                MemoFunctions.GetMemoField( DBF, i, text^ );
                GenLists.NewList(list);
                size:=M2Strings.Length( text^ );
                IF  size  # 0
                THEN
                  (* check to see  ends with crlf *)
                  IF NOT ((text^[size-2]=StringIO.CrLf[0]) AND
                   (text^[size-1]=StringIO.CrLf[1]))
                  THEN
                    StrEdit.Append(text^,StringIO.CrLf);
                    INC(size,2);
                  END;
                  (* do this so that only enough memory is kept *)
                  ALLOCATE(Block,size);
                  LowLevel.Move(text,Block,size);
                  GenLists.BlockToList( Block, size,
                                        StringIO.CrLf, StringIO.CrLf, 0,
                                        GenLists.StrCode, list );
                END (* if M2Strings.Length *);
                DISPOSE( text );
                ok := ScrnUtl1.ListToEdField( list, TheFrame, FieldCount );
              END (* if FieldPtr *);
          ELSE
          END (* case DBF.fieldlist^ *);
          (* case *)
        ELSIF PosUtils.Equal('@DELETED',FieldPtr^.fnam)
        THEN
          IF ModBase3.Deleted(DBF)
          THEN
            string:='DELETED'
          ELSE
            string:='';
          END;
          size := M2Strings.Length( ImagePtr^.text );
          LeftJust( string, size );
          LowLevel.Move(SYSTEM.ADR(string),SYSTEM.ADR(ImagePtr^.text),
             size);
        ELSIF PosUtils.Equal('@RECNO',FieldPtr^.fnam)
        THEN
          size := M2Strings.Length( ImagePtr^.text );
          StrConv.LongIntegerToStr(ModBase3.Record(DBF),size,string);
          LowLevel.Move(SYSTEM.ADR(string),SYSTEM.ADR(ImagePtr^.text),
             size);
        ELSIF PosUtils.Equal('@RECCOUNT',FieldPtr^.fnam)
        THEN
          size := M2Strings.Length( ImagePtr^.text );
          StrConv.LongIntegerToStr(ModBase3.NumberRecords(DBF),size,string);
          LowLevel.Move(SYSTEM.ADR(string),SYSTEM.ADR(ImagePtr^.text),
             size);

        END (* if i *);
        (* IF*)
      END (* if M2Strings.Length *);
      INC( FieldCount );
    UNTIL FieldCount > TotalFields;
  END DBFToFrame;

BEGIN
END Scrn2DBF.