Listing: 1 IMPLEMENTATION MODULE DBUtils; 2 (* 3 * ModBase 4 * Release 3.0 5 * (c) Copyright 1986 - 1991 PMI 6 Copyright 1988 - 1991 John McMonagle 7 * P.O. Box 8402 8 * Green Bay Wi 53308 9 * All Rights Reserved 10 * by Ed Ross 11 *) 12 13 FROM BigSets IMPORT ExclCh, InclCh; 14 FROM ControlUtils IMPORT ChangeField, Control, Input, 15 ReadNextInput,ReadInput,AddStrField; 16 FROM DspFiles IMPORT ReadDisplayFrame; 17 FROM EnvironUtils IMPORT GetDate; 18 FROM DateFunctions IMPORT Date, DateToStr, StrToDate; 19 FROM HandleIO IMPORT BlockRead, BlockWrite, CloseHandle, CreateFile, 20 FileExists, FileOffSet, OpenFile, SetFilePtr; 21 FROM FramePainter IMPORT RedrawField, ShowDisplayFrame; 22 FROM M2Strings IMPORT Length,Assign,Delete; 23 FROM LowLevel IMPORT Fill; 24 FROM HandleIO IMPORT OpenFile,CloseHandle; ***** ^ duplicate identifier ***** ^ duplicate identifier ***** ^ duplicate identifier 25 FROM NumTypes IMPORT Real8; 26 FROM StrConv IMPORT ReturnedCard,StrToReal,CardinalToStr,RealToStr; 27 FROM ScrnTypes IMPORT AFrameName, DispCode, DisplayFrame, InitDisplayFrame, 28 InputFieldPtr,ImageElement,InputFieldRecord, IntCode,ImageElmtPtr, 29 DisplayFile; 30 FROM ScrnUtl1 IMPORT FieldListTotal, GetFieldRec, GetFieldText, 31 PutFieldRec,CurrentField,GetImagePtr,NumberOfImages,ResetFieldPtr, 32 GetFieldImagePtr,GetFieldPtr; 33 FROM ScrnUtl2 IMPORT CloseDisplayFrame; 34 FROM StrEdit IMPORT CrunchBlanks,LeftJustify,Center; 35 FROM StringIO IMPORT ErrorMessage,WriteEol,WriteStr; 36 FROM SYSTEM IMPORT ADR; 37 FROM UserOps IMPORT AKeyHandler, ScreenKeySet, TheKeyHandler; 38 IMPORT VWindows; 39 FROM GenLists IMPORT GenList,NewList,ListInsert,StrCode; 40 41 42 VAR 43 OldKey :AKeyHandler; 44 Today : Date; 45 Str1,Str2 : ARRAY[0..8] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 46 47 48 49 PROCEDURE SelectServices(VAR SerList : GenList); 50 VAR 51 DF : DisplayFrame; 52 NxtFrame : AFrameName; 53 ReturnVal: ARRAY[0..40] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 54 Row : CARDINAL; 55 Drive : CHAR; 56 Card : CARDINAL; 57 PathName : ARRAY[0..63] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 58 Str : ARRAY[0..12] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 59 FileName : AFrameName; 60 EM : ErrorMessage; 61 ImageRec: ImageElement; 62 FullTableName : ARRAY[0..63] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 63 BEGIN 64 65 END SelectServices; ***** ^ not supported yet 66 67 68 PROCEDURE GetSelected(VAR TheList : GenList; DF : DisplayFrame); 69 VAR 70 J : CARDINAL; 71 Image : ImageElmtPtr; 72 str :ARRAY[0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 73 (* FieldPtr : InputFieldPtr;*) 74 BEGIN 75 NewList(TheList); ***** ^ not supported yet ***** ^ not supported yet 76 FOR J := 1 TO FieldListTotal(DF) DO ***** ^ not supported yet ***** ^ not supported yet 77 GetImagePtr(DF, J,Image); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 IF Image^.text[0] = CHR(251) (* if checked with sq root sign *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 79 THEN 80 Assign(Image^.text,str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 81 Delete(str,0,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 (* GetFieldPtr(DF,J,FieldPtr); *) 83 ListInsert(str,StrCode,TheList,100); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 84 END; 85 END; 86 END GetSelected; ***** ^ not supported yet 87 88 89 PROCEDURE NewKeyHandler( DF : DisplayFrame; VAR Key : CARDINAL; 90 VAR NxtFrame : AFrameName); 91 VAR 92 Image : ImageElmtPtr; 93 C : CARDINAL; 94 BEGIN 95 OldKey(DF, Key, NxtFrame); (* process the keys first *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 IF Key = 32 (* if the space bar was hit *) 97 THEN 98 C := CurrentField(DF); ***** ^ not supported yet ***** ^ not supported yet 99 GetImagePtr(DF, C,Image); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 100 IF Image^.text[0] = CHR(251) (* if checked with sq root sign *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 101 THEN Image^.text[0] := ' ' ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 102 ELSE Image^.text[0] := CHR(251); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 103 END; 104 RedrawField(DF,C,TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 105 END; 106 END NewKeyHandler; ***** ^ not supported yet 107 108 109 PROCEDURE SelectFromScreen(VAR DF : DisplayFrame); 110 BEGIN 111 OldKey := TheKeyHandler; ***** ^ not supported yet ***** ^ not supported yet 112 TheKeyHandler := NewKeyHandler; ***** ^ not supported yet ***** ^ not supported yet 113 ShowDisplayFrame(DF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 InclCh(ScreenKeySet,' '); (* look for space bar *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 Control(DF); ***** ^ not supported yet ***** ^ not supported yet 116 ExclCh(ScreenKeySet,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 117 TheKeyHandler := OldKey; ***** ^ not supported yet ***** ^ not supported yet 118 END SelectFromScreen; ***** ^ not supported yet 119 120 121 122 123 124 125 PROCEDURE AddFldTypes(VAR DF : DisplayFrame; Col,Row: CARDINAL; 126 Text : ARRAY OF CHAR;Len: CARDINAL; Type : CHAR); ***** ^ not supported yet 127 128 (* copy of add menu item from control utils *) 129 130 VAR 131 FieldRec : InputFieldRecord; 132 133 134 BEGIN 135 AddStrField(DF,Col,Row,Text,Len); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 GetFieldRec( DF, FieldListTotal(DF), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 137 FieldRec ); ***** ^ not supported yet 138 CASE Type OF 139 IntCode : FieldRec.typ := IntCode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 140 FieldRec.iMax := 20; ***** ^ not supported yet ***** ^ not supported yet 141 FieldRec.iMin := 0; ***** ^ not supported yet ***** ^ not supported yet 142 |DispCode : FieldRec.typ := DispCode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 143 END; (* end case of *) 144 PutFieldRec( FieldRec, DF, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 FieldListTotal(DF) ); ***** ^ not supported yet ***** ^ not supported yet 146 147 END AddFldTypes; ***** ^ not supported yet 148 149 150 151 152 153 154 PROCEDURE PrintFrame(DF : DisplayFrame; Handle : CARDINAL); 155 (* Given a display frame created by adding menu items or string items 156 print it to the report printer*) 157 158 CONST 159 FF = CHR(12); ***** ^ undeclared identifier ***** ^ not supported yet 160 VAR 161 J : CARDINAL; 162 Cnt : CARDINAL; 163 Str : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 164 Lines : CARDINAL; 165 FldImagePnt : ImageElmtPtr; 166 FirstLine : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 167 EM : CARDINAL; 168 169 170 171 PROCEDURE PrintHeader(Handle : CARDINAL); 172 VAR M : CARDINAL; 173 BEGIN 174 FOR M := 0 TO 6 DO 175 WriteEol(Handle,PrintTitle[M]); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 176 END; 177 WriteEol(Handle,''); ***** ^ not supported yet ***** ^ not supported yet 178 WriteEol(Handle,FirstLine); ***** ^ not supported yet ***** ^ not supported yet 179 Fill(ADR(Str),78,'-'); (* dash line *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 180 WriteEol(Handle,Str); ***** ^ not supported yet ***** ^ not supported yet 181 Lines := 50; 182 183 END PrintHeader; ***** ^ not supported yet 184 185 186 BEGIN 187 188 Cnt := NumberOfImages(DF); ***** ^ not supported yet ***** ^ not supported yet 189 WriteStr(Handle,027C+'C'+66C); (* set lines per page *) ***** ^ not supported yet ***** ^ arithmetic operand must be numeric ***** ^ not supported yet 190 GetFieldImagePtr(DF,1,FldImagePnt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 191 Assign(FldImagePnt^.text,FirstLine ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 192 ResetFieldPtr(DF); ***** ^ not supported yet ***** ^ not supported yet 193 PrintHeader(Handle); ***** ^ not supported yet ***** ^ not supported yet 194 FOR J := 1 TO Cnt-1 DO 195 IF (J MOD Lines) = 0 196 THEN 197 WriteStr(Handle,FF); (* form feed *) ***** ^ not supported yet ***** ^ not supported yet 198 PrintHeader(Handle); ***** ^ not supported yet ***** ^ not supported yet 199 END; 200 ReadNextInput(DF,Str,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 201 WriteEol(Handle,Str); ***** ^ not supported yet ***** ^ not supported yet 202 END; 203 204 END PrintFrame; ***** ^ not supported yet 205 206 PROCEDURE GetDateRange(VAR D1, D2 : Date; PMIScreens : DisplayFile); 207 VAR 208 DF : DisplayFrame; 209 BEGIN 210 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 211 ReadDisplayFrame(PMIScreens,DF,'DateRange'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 212 D1 := Today; ***** ^ not supported yet ***** ^ not supported yet 213 D1.mo := 1; (* jan 1st of this year *) ***** ^ not supported yet ***** ^ not supported yet 214 D1.day := 1; ***** ^ not supported yet ***** ^ not supported yet 215 ChangeDateField(DF,D1,'Date1'); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 216 ChangeDateField(DF,Today,'Date2'); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 217 ShowDisplayFrame(DF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 218 Control(DF); ***** ^ not supported yet ***** ^ not supported yet 219 ReadDateField(DF,D1,'Date1'); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 220 ReadDateField(DF,D2,'Date2'); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 221 CloseDisplayFrame(DF); ***** ^ not supported yet ***** ^ not supported yet 222 END GetDateRange; ***** ^ not supported yet 223 224 225 PROCEDURE ReadCardField(DF : DisplayFrame; VAR TheCard : CARDINAL; 226 FldName : ARRAY OF CHAR); ***** ^ not supported yet 227 VAR S : ARRAY [0..10] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 228 B : BOOLEAN; 229 BEGIN 230 ReadInput(DF,S,FldName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 231 TheCard := ReturnedCard(S); ***** ^ not supported yet ***** ^ not supported yet 232 233 END ReadCardField; ***** ^ not supported yet 234 235 PROCEDURE ReadRealField(DF : DisplayFrame; VAR TheReal : Real8; 236 FldName : ARRAY OF CHAR); ***** ^ not supported yet 237 VAR 238 S : ARRAY [0..15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 239 B : BOOLEAN; 240 BEGIN 241 ReadInput(DF,S,FldName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 242 B := StrToReal(S,0,TheReal); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 243 END ReadRealField; ***** ^ not supported yet 244 245 PROCEDURE ChangeCardField(DF : DisplayFrame; TheCard : CARDINAL; 246 FldName : ARRAY OF CHAR); ***** ^ not supported yet 247 VAR 248 S : ARRAY[0..7] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 249 BEGIN 250 251 CardinalToStr(TheCard,5,S); ***** ^ not supported yet ***** ^ not supported yet 252 CrunchBlanks(S); ***** ^ not supported yet ***** ^ not supported yet 253 ChangeField(DF,S,FldName,TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 254 255 END ChangeCardField; ***** ^ not supported yet 256 257 PROCEDURE ChangeRealField(DF : DisplayFrame; TheReal : Real8; 258 FldName : ARRAY OF CHAR); ***** ^ not supported yet 259 VAR 260 S : ARRAY[0..15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 261 BEGIN 262 263 RealToStr(TheReal,2,8,S); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 264 CrunchBlanks(S); ***** ^ not supported yet ***** ^ not supported yet 265 ChangeField(DF,S,FldName,TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 266 END ChangeRealField; ***** ^ not supported yet 267 268 269 PROCEDURE ReadDateField( DF : DisplayFrame; VAR D : Date; 270 FldName : ARRAY OF CHAR); ***** ^ not supported yet 271 VAR 272 S : ARRAY [0..15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 273 Ok : BOOLEAN; 274 BEGIN 275 ReadInput(DF,S,FldName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 276 StrToDate(S,D,Ok); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 277 END ReadDateField; ***** ^ not supported yet 278 279 PROCEDURE ChangeDateField(VAR DF : DisplayFrame; D : Date; 280 FldName : ARRAY OF CHAR); ***** ^ not supported yet 281 VAR 282 S : ARRAY[0..15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 283 B : BOOLEAN; 284 BEGIN 285 DateToStr(D,S,B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 286 ChangeField(DF,S,FldName,TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 287 END ChangeDateField; ***** ^ not supported yet 288 289 PROCEDURE BoolExists(B : BOOLEAN) : CHAR; 290 (* returns an * if the boolean is true - for change field *) 291 (* this is used to signal on the screen that some condition exists *) 292 BEGIN 293 IF B 294 THEN RETURN '*' 295 ELSE RETURN ' ' 296 END; 297 END BoolExists; ***** ^ not supported yet 298 BEGIN 299 GetDate(Today.mo,Today.day,Today.yr,Str1,Str2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 300 301 END DBUtils. ***** ^ not supported yet 281 errors