| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588 |
- 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
|