Topspeed_JPI/TS/MODBASE/DBUTILS.MOD

IMPLEMENTATION MODULE DBUtils;
(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1991 PMI
    Copyright 1988 - 1991 John McMonagle
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *  by Ed Ross
 *)

FROM BigSets IMPORT ExclCh, InclCh;
FROM ControlUtils IMPORT ChangeField, Control, Input,
      ReadNextInput,ReadInput,AddStrField;
FROM DspFiles IMPORT ReadDisplayFrame;
FROM EnvironUtils IMPORT GetDate;
FROM DateFunctions IMPORT Date, DateToStr, StrToDate;
FROM HandleIO IMPORT BlockRead, BlockWrite, CloseHandle, CreateFile,
     FileExists, FileOffSet, OpenFile, SetFilePtr;
FROM FramePainter IMPORT RedrawField, ShowDisplayFrame;
FROM M2Strings IMPORT Length,Assign,Delete;
FROM LowLevel IMPORT Fill;
FROM HandleIO IMPORT OpenFile,CloseHandle;
FROM NumTypes IMPORT Real8;
FROM StrConv IMPORT ReturnedCard,StrToReal,CardinalToStr,RealToStr;
FROM ScrnTypes IMPORT AFrameName, DispCode, DisplayFrame, InitDisplayFrame,
      InputFieldPtr,ImageElement,InputFieldRecord, IntCode,ImageElmtPtr,
      DisplayFile;
FROM ScrnUtl1 IMPORT FieldListTotal, GetFieldRec, GetFieldText,
     PutFieldRec,CurrentField,GetImagePtr,NumberOfImages,ResetFieldPtr,
     GetFieldImagePtr,GetFieldPtr;
FROM ScrnUtl2 IMPORT CloseDisplayFrame;
FROM StrEdit IMPORT CrunchBlanks,LeftJustify,Center;
FROM StringIO IMPORT ErrorMessage,WriteEol,WriteStr;
FROM SYSTEM IMPORT ADR;
FROM UserOps IMPORT AKeyHandler, ScreenKeySet, TheKeyHandler;
IMPORT VWindows;
FROM GenLists IMPORT GenList,NewList,ListInsert,StrCode;


VAR
    OldKey :AKeyHandler;
    Today : Date;
    Str1,Str2 : ARRAY[0..8] OF CHAR;



PROCEDURE SelectServices(VAR SerList : GenList);
VAR
   DF : DisplayFrame;
   NxtFrame : AFrameName;
   ReturnVal: ARRAY[0..40] OF CHAR;
   Row : CARDINAL;
   Drive : CHAR;
   Card : CARDINAL;
   PathName : ARRAY[0..63] OF CHAR;
   Str : ARRAY[0..12] OF CHAR;
   FileName : AFrameName;
   EM : ErrorMessage;
   ImageRec: ImageElement;
   FullTableName : ARRAY[0..63] OF CHAR;
BEGIN

END SelectServices;


PROCEDURE GetSelected(VAR TheList : GenList; DF : DisplayFrame);
VAR
  J : CARDINAL;
  Image : ImageElmtPtr;
  str  :ARRAY[0..79] OF CHAR;
(*  FieldPtr : InputFieldPtr;*)
BEGIN
  NewList(TheList);
  FOR J := 1 TO FieldListTotal(DF) DO
      GetImagePtr(DF, J,Image);
      IF Image^.text[0] = CHR(251)    (* if checked with sq root sign *)
        THEN
          Assign(Image^.text,str);
          Delete(str,0,1);
	 (* GetFieldPtr(DF,J,FieldPtr); *)
	  ListInsert(str,StrCode,TheList,100);
      END;
   END;
END GetSelected;


PROCEDURE NewKeyHandler( DF : DisplayFrame; VAR Key : CARDINAL;
                         VAR NxtFrame : AFrameName);
VAR
  Image : ImageElmtPtr;	
  C : CARDINAL;		
BEGIN
  OldKey(DF, Key, NxtFrame);  (* process the keys first *)
  IF Key = 32     (* if the space bar was hit *)
    THEN
      C := CurrentField(DF);
      GetImagePtr(DF, C,Image);
      IF Image^.text[0] = CHR(251)    (* if checked with sq root sign *)
        THEN  Image^.text[0] := ' '
	ELSE  Image^.text[0] := CHR(251);
      END;
      RedrawField(DF,C,TRUE);
  END;
END NewKeyHandler;

			
PROCEDURE SelectFromScreen(VAR DF : DisplayFrame);
BEGIN
    OldKey := TheKeyHandler;
    TheKeyHandler := NewKeyHandler;
    ShowDisplayFrame(DF,0,0,0,0);
    InclCh(ScreenKeySet,' ');   (* look for space bar *)
    Control(DF);
    ExclCh(ScreenKeySet,' ');
    TheKeyHandler := OldKey;
END SelectFromScreen;






PROCEDURE AddFldTypes(VAR DF : DisplayFrame; Col,Row: CARDINAL;
          Text : ARRAY OF CHAR;Len: CARDINAL; Type : CHAR);
	
  (* copy of add menu item from control utils *)
  	
VAR
  FieldRec : InputFieldRecord;


BEGIN  	
     AddStrField(DF,Col,Row,Text,Len);
     GetFieldRec( DF, FieldListTotal(DF),
              FieldRec );
     CASE Type OF
         IntCode :  FieldRec.typ := IntCode;
                    FieldRec.iMax := 20;
	      	    FieldRec.iMin := 0;
        |DispCode : FieldRec.typ := DispCode;
     END; (* end case of *) 		
     PutFieldRec( FieldRec, DF,
              FieldListTotal(DF) );			

END AddFldTypes;






PROCEDURE PrintFrame(DF : DisplayFrame; Handle : CARDINAL);
(* Given a display frame created by adding menu items or string items
   print it to the report printer*)

CONST
  FF = CHR(12);
VAR
  J : CARDINAL;
  Cnt : CARDINAL;
  Str : ARRAY[0..80] OF CHAR;
  Lines : CARDINAL;
  FldImagePnt : ImageElmtPtr;
  FirstLine : ARRAY[0..80] OF CHAR;
  EM : CARDINAL;



PROCEDURE PrintHeader(Handle : CARDINAL);
VAR M : CARDINAL;
BEGIN
  FOR M := 0 TO 6 DO
    WriteEol(Handle,PrintTitle[M]);
  END;
  WriteEol(Handle,'');
  WriteEol(Handle,FirstLine);
  Fill(ADR(Str),78,'-');   (* dash line *)
  WriteEol(Handle,Str);
  Lines := 50;

END PrintHeader;


BEGIN

  Cnt := NumberOfImages(DF);
  WriteStr(Handle,027C+'C'+66C);   (* set lines per page *)
  GetFieldImagePtr(DF,1,FldImagePnt);
  Assign(FldImagePnt^.text,FirstLine );
  ResetFieldPtr(DF);
  PrintHeader(Handle);
  FOR J := 1 TO Cnt-1 DO
      IF (J MOD Lines) = 0
        THEN
	  WriteStr(Handle,FF);  (* form feed *)
	  PrintHeader(Handle);
	END;
      ReadNextInput(DF,Str,0);
      WriteEol(Handle,Str);
  END;

END PrintFrame;

PROCEDURE GetDateRange(VAR D1, D2 : Date; PMIScreens : DisplayFile);
VAR
  DF : DisplayFrame;
BEGIN
  InitDisplayFrame(DF,VWindows.CurrentWindow);
  ReadDisplayFrame(PMIScreens,DF,'DateRange');
  D1 := Today;
  D1.mo := 1;   (* jan 1st  of this year *)
  D1.day := 1;
  ChangeDateField(DF,D1,'Date1');
  ChangeDateField(DF,Today,'Date2');
  ShowDisplayFrame(DF,0,0,0,0);
  Control(DF);
  ReadDateField(DF,D1,'Date1');
  ReadDateField(DF,D2,'Date2');
  CloseDisplayFrame(DF);
END GetDateRange;


PROCEDURE ReadCardField(DF : DisplayFrame; VAR TheCard : CARDINAL;
                        FldName : ARRAY OF CHAR);
VAR S : ARRAY [0..10] OF CHAR;			
   B : BOOLEAN;
BEGIN
 ReadInput(DF,S,FldName);
 TheCard := ReturnedCard(S);

END ReadCardField;

PROCEDURE ReadRealField(DF : DisplayFrame; VAR TheReal : Real8;
                        FldName : ARRAY OF CHAR);
VAR
  S : ARRAY [0..15] OF CHAR;
  B : BOOLEAN;
BEGIN
 ReadInput(DF,S,FldName);			
 B := StrToReal(S,0,TheReal);
END ReadRealField;

PROCEDURE ChangeCardField(DF : DisplayFrame; TheCard : CARDINAL;
                          FldName : ARRAY OF CHAR);
VAR
  S : ARRAY[0..7] OF CHAR;
BEGIN

 CardinalToStr(TheCard,5,S);
 CrunchBlanks(S);
 ChangeField(DF,S,FldName,TRUE);
    			
END ChangeCardField;

PROCEDURE ChangeRealField(DF : DisplayFrame; TheReal : Real8;
                            FldName : ARRAY OF CHAR);
VAR
  S : ARRAY[0..15] OF CHAR;
BEGIN
    			
  RealToStr(TheReal,2,8,S);
  CrunchBlanks(S);
  ChangeField(DF,S,FldName,TRUE);			
END ChangeRealField;			


PROCEDURE ReadDateField( DF : DisplayFrame; VAR D : Date;
                        FldName : ARRAY OF CHAR);
VAR
 S : ARRAY [0..15] OF CHAR;
 Ok : BOOLEAN;
BEGIN
 ReadInput(DF,S,FldName);
 StrToDate(S,D,Ok);
END ReadDateField;

PROCEDURE ChangeDateField(VAR DF : DisplayFrame; D : Date;
                          FldName : ARRAY OF CHAR);
VAR
  S : ARRAY[0..15] OF CHAR;
  B : BOOLEAN;
BEGIN
  DateToStr(D,S,B);
  ChangeField(DF,S,FldName,TRUE);
END ChangeDateField;

PROCEDURE BoolExists(B : BOOLEAN) : CHAR;
 (* returns an * if the boolean is true - for change field *)
 (* this is used to signal on the screen that some condition exists *)
BEGIN
IF B
  THEN RETURN '*'
  ELSE RETURN ' '
END;
END BoolExists;
BEGIN
 GetDate(Today.mo,Today.day,Today.yr,Str1,Str2);

END DBUtils.