Listing: 1 IMPLEMENTATION MODULE Tables; 2 (* 3 * ModBase 4 * Release 3.0 5 * (c) Copyright 1986 - 1991 PMI 6 * P.O. Box 8402 7 * Green Bay Wi 53308 8 * All Rights Reserved 9 * by Ed Ross 10 *) 11 12 13 FROM ScrnTypes IMPORT DisplayFrame,InputFieldRecord,InitField, 14 IntCode,StringCode,RealCode,DispCode,GroupMember,InitDisplayFrame, 15 ImageElement,InputFieldPtr; 16 FROM ScrnUtl1 IMPORT PutFieldRec,PutFrameLists,GetImageRec,PutFieldRec, ***** ^ duplicate identifier 17 GetImageRec,PutFieldImageRec,GetFieldPtr; ***** ^ duplicate identifier 18 FROM ScrnUtl2 IMPORT CreateImageElement,AddImageElement,CloseDisplayFrame; 19 FROM StrEdit IMPORT SetLength,OverWrite; 20 FROM GenLists IMPORT NewList,DisposeList,GetElmt,GetElmtAdr,ListInsert, 21 ListInsertAdr,ListLength,GenList,SortList,ShellSortList; 22 FROM SYSTEM IMPORT SIZE,TSIZE, ADR,ADDRESS; 23 FROM FramePainter IMPORT ShowDisplayFrame; 24 FROM M2Strings IMPORT Length,Assign; 25 FROM NumTypes IMPORT REALToReal8; 26 FROM StrConv IMPORT IntegerToStr,RealToStr,StrToInteger,StrToReal; 27 FROM VStorage IMPORT DosAlloc,DosDealloc; 28 FROM LowLevel IMPORT Fill; 29 FROM ControlUtils IMPORT Control; 30 IMPORT VWindows; 31 IMPORT MsColors; 32 TYPE 33 Table = POINTER TO TableRec; ***** ^ undeclared identifier 34 TableRec = RECORD 35 DF : DisplayFrame; 36 Choice : ARRAY[0..15] OF CHAR; (* choice fields *) ***** ^ not supported yet ***** ^ not supported yet 37 RowDef : GenList; 38 NumberOfRows, 39 NumberOfCols : CARDINAL; 40 END; ***** ^ not supported yet 41 42 ColumDef = RECORD 43 InField : InputFieldRecord; 44 X : CARDINAL; 45 Width : CARDINAL; 46 Choice : ARRAY[0..15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 47 Title : ARRAY[0..40] OF CHAR; (* caption for top of field *) ***** ^ not supported yet ***** ^ not supported yet 48 END; ***** ^ not supported yet 49 50 51 (* these procedures are used to define the table *) 52 PROCEDURE DefineTextCol(VAR T:Table; X, Width : CARDINAL; 53 Title : ARRAY OF CHAR; DisplayOnly : BOOLEAN); ***** ^ not supported yet 54 VAR 55 Col : ColumDef; ***** ^ not supported yet 56 BEGIN 57 InitField(Col.InField); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 58 IF DisplayOnly 59 THEN Col.InField.typ := DispCode ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 ELSE Col.InField.typ := StringCode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 61 END; 62 Col.X := X; ***** ^ not supported yet ***** ^ not supported yet 63 Col.Width := Width; ***** ^ not supported yet ***** ^ not supported yet 64 Assign( Title,Col.Title); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 ListInsert(Col,1,T^.RowDef,80); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 66 67 END DefineTextCol; ***** ^ not supported yet 68 69 PROCEDURE DefineGroupCol(VAR T:Table; X,Width : CARDINAL; Title : ARRAY OF CHAR; ***** ^ not supported yet 70 Choice : ARRAY OF CHAR; MenuKey : CARDINAL; NbrOfChoice, ThisChoice : CARDINAL; ***** ^ not supported yet 71 SelectDefault: BOOLEAN ); 72 VAR 73 Col : ColumDef; ***** ^ not supported yet 74 BEGIN 75 InitField(Col.InField); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 76 Col.InField.typ := GroupMember; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 77 Col.InField.MenuKey := MenuKey; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 Col.InField.GroupSize := NbrOfChoice; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 79 Col.InField.GroupID := ThisChoice; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 Col.InField.selected := SelectDefault; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 81 Assign(Choice,Col.InField.fnam ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 Col.X := X; ***** ^ not supported yet ***** ^ not supported yet 83 Col.Width := Width; ***** ^ not supported yet ***** ^ not supported yet 84 Assign( Choice,Col.Choice); (* default text *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 85 Assign( Title,Col.Title ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 86 ListInsert(Col,1,T^.RowDef,80); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 END DefineGroupCol; ***** ^ not supported yet 88 89 PROCEDURE DefineIntegerCol(VAR T:Table; X,Width : CARDINAL; Title : ARRAY OF CHAR; ***** ^ not supported yet 90 Min, Max : LONGINT); 91 VAR 92 Col : ColumDef; ***** ^ not supported yet 93 BEGIN 94 InitField(Col.InField); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 Col.InField.typ := IntCode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 Col.InField.iMax := Max; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 97 Col.InField.iMin := Min; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 98 Col.X := X; ***** ^ not supported yet ***** ^ not supported yet 99 Col.Width := Width; ***** ^ not supported yet ***** ^ not supported yet 100 Assign( Title,Col.Title ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 101 ListInsert(Col,1,T^.RowDef,80); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 102 END DefineIntegerCol; ***** ^ not supported yet 103 104 105 PROCEDURE DefineRealCol(VAR T:Table; X,Width : CARDINAL; Title : ARRAY OF CHAR; ***** ^ not supported yet 106 Min, Max : REAL); 107 VAR 108 Col : ColumDef; ***** ^ not supported yet 109 BEGIN 110 InitField(Col.InField); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 111 Col.InField.typ := RealCode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 112 Col.InField.rMax := REALToReal8(Max); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 113 Col.InField.rMin := REALToReal8(Min); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 Col.InField.decimalPlace := 2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 116 Col.X := X; ***** ^ not supported yet ***** ^ not supported yet 117 Col.Width := Width; ***** ^ not supported yet ***** ^ not supported yet 118 Assign( Title,Col.Title ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 119 ListInsert(Col,1,T^.RowDef,80); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 120 121 END DefineRealCol; ***** ^ not supported yet 122 123 124 PROCEDURE DefineTable(VAR T:Table; Caption : ARRAY OF CHAR); ***** ^ not supported yet 125 BEGIN 126 DosAlloc(T,TSIZE(TableRec)); (* allocate the table *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 127 InitDisplayFrame(T^.DF,VWindows.CurrentWindow); (* inint the display Frame*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 128 T^.DF^.action := 'I'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 T^.DF^.headline := 3; (* the title shouldn't scroll *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 T^.DF^.selfor := MsColors.brightwhite; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 131 Assign( Caption,T^.DF^.Caption); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 132 T^.DF^.ClearAfter := TRUE; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 133 NewList( T^.DF^.FieldList ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 134 PutFrameLists( T^.DF ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 135 (*Make sure the new FieldList gets inserted into 136 TheFrame's .self list. Stole this from Cole???? *) 137 NewList(T^.RowDef); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 138 END DefineTable; ***** ^ not supported yet 139 140 141 142 PROCEDURE PutInOrder( Adr1 : ADDRESS; S1 : CARDINAL; 143 Adr2 : ADDRESS; S2:CARDINAL) : INTEGER; 144 (* before building the table make sure the thing is in correct order *) 145 VAR 146 C1, C2 : POINTER TO ColumDef; ***** ^ not supported yet 147 BEGIN 148 C1 := Adr1; ***** ^ not supported yet ***** ^ not supported yet 149 C2 := Adr2; ***** ^ not supported yet ***** ^ not supported yet 150 IF C1^.X > C2^.X ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 THEN RETURN 1 152 ELSE RETURN -1 153 END; 154 END PutInOrder; ***** ^ not supported yet 155 156 157 PROCEDURE BuildTable(VAR T:Table; NbrRows : CARDINAL); 158 (* this routine will go through the row list of the table and build the*) 159 (* The table *) 160 VAR J : CARDINAL; 161 Row : CARDINAL; 162 Col : POINTER TO ColumDef; ***** ^ not supported yet 163 TmpCol : ColumDef; ***** ^ not supported yet 164 Size,Code : CARDINAL; 165 ImgNbr : CARDINAL; 166 Str : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 167 TmpRec : ImageElement; 168 BEGIN 169 170 WITH T^ DO ***** ^ not supported yet 171 ShellSortList(RowDef,PutInOrder); (* should have been defined in order *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 172 (* but make sure - *) 173 174 NumberOfRows := NbrRows; ***** ^ undeclared identifier 175 NumberOfCols := ListLength(RowDef); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 176 177 (* at the top of the table put the title rows *) 178 FOR J := 1 TO ListLength(RowDef) DO (* add title row *) ***** ^ not supported yet ***** ^ undeclared identifier 179 GetElmt(RowDef,J,TmpCol,Code); (* get a copy of the record *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 180 TmpCol.InField.typ := 'D'; (* make it a display only *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 181 CreateImageElement(TmpRec,TmpCol.X,2,DF^.normfor,DF^.normbak, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 182 DF^.normatrb,ListLength(DF^.FieldList)+1,TmpCol.Title); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 183 184 AddImageElement(DF,TmpRec,ImgNbr); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 185 TmpCol.InField.ImageNum := ImgNbr; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 186 PutFieldRec(TmpCol.InField,DF,65535); (* stick at end*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 187 END; 188 (* add the elemets to the table *) 189 190 FOR Row := 1 TO NbrRows DO (* for each row in the table *) 191 FOR J := 1 TO ListLength(RowDef) DO (* for each colum in row *) ***** ^ not supported yet ***** ^ undeclared identifier 192 GetElmtAdr(RowDef,J,Col,Size,Code); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 193 Fill(ADR(Str),SIZE(Str),' '); (* blank fill the input string *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 194 SetLength(Str,Col^.Width); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 195 IF Col^.InField.typ = GroupMember ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 196 THEN 197 Assign(Col^.Choice,Str ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 198 END; 199 CreateImageElement(TmpRec,Col^.X,Row+3,DF^.normfor,DF^.normbak, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 200 DF^.normatrb,ListLength(DF^.FieldList)+1,Str); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 201 202 AddImageElement(DF,TmpRec,ImgNbr); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 203 Col^.InField.ImageNum := ImgNbr; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 204 PutFieldRec(Col^.InField,DF,65535); (* stick at end*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 205 END; (* end of for each col *) 206 END; (* end for each row *) 207 END; (* end with table *) ***** ^ not supported yet 208 209 210 END BuildTable; ***** ^ not supported yet 211 212 PROCEDURE ShowTable(T : Table;X1,Y1,X2,Y2: CARDINAL); 213 BEGIN 214 ShowDisplayFrame(T^.DF,X1,Y1,X2,Y2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 215 END ShowTable; ***** ^ not supported yet 216 217 PROCEDURE ControlTable(VAR T:Table;X1,Y1,X2,Y2: CARDINAL); 218 BEGIN 219 ShowDisplayFrame(T^.DF,X1,Y1,X2,Y2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 220 Control(T^.DF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 221 END ControlTable; ***** ^ not supported yet 222 223 PROCEDURE DeleteTable(VAR T:Table); 224 BEGIN 225 CloseDisplayFrame(T^.DF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 226 DisposeList(T^.RowDef); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 227 DosDealloc(T,TSIZE(TableRec)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 228 229 END DeleteTable; ***** ^ not supported yet 230 231 PROCEDURE PutCell(VAR T:Table; X,Y : CARDINAL; Cell : CellValue); ***** ^ undeclared identifier 232 (* fill a value in table - the X and Y here refer to the cell numbers *) 233 (* not to the placement on the screen *) 234 VAR 235 FieldNbr : CARDINAL; 236 Image : ImageElement; 237 FldPtr : InputFieldPtr; 238 B : BOOLEAN; 239 LL : CARDINAL; 240 Str : ARRAY[0..80] OF CHAR; (* must maintain the original length*) ***** ^ not supported yet ***** ^ not supported yet 241 BEGIN 242 LL := ListLength(T^.RowDef); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 243 FieldNbr := ((Y) * LL) + X ; (* compute field nbr*) 244 GetImageRec(T^.DF,FieldNbr,Image); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 245 GetFieldPtr(T^.DF,FieldNbr,FldPtr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 246 CASE FldPtr^.typ OF ***** ^ not supported yet ***** ^ not supported yet 247 StringCode,DispCode : ***** ^ not supported yet ***** ^ not supported yet 248 Fill(ADR(Str),SIZE(Str),' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 249 OverWrite(Cell.Str,Str,0); (* keep the length of the orignal*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 250 SetLength(Str,Length(Image.text)+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 251 Assign( Str,Image.text); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 252 |IntCode : IntegerToStr(Cell.I,Length(Image.text),Image.text); ***** ^ 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 253 |RealCode : RealToStr(Cell.R,2,Length(Image.text),Image.text); ***** ^ 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 254 |GroupMember: FldPtr^.selected := Cell.B; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 255 END; 256 PutFieldImageRec(Image,T^.DF,FieldNbr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 257 END PutCell; ***** ^ not supported yet 258 259 PROCEDURE GetCell(VAR T:Table; X,Y : CARDINAL; VAR Cell : CellValue); (* get contents of cell*) ***** ^ undeclared identifier 260 VAR 261 FieldNbr : CARDINAL; 262 Image : ImageElement; 263 FldPtr : InputFieldPtr; 264 B : BOOLEAN; 265 LL : CARDINAL; 266 BEGIN 267 LL := ListLength(T^.RowDef); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 268 FieldNbr := ((Y) * LL) + X; (* compute field nbr*) 269 GetImageRec(T^.DF,FieldNbr,Image); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 270 GetFieldPtr(T^.DF,FieldNbr,FldPtr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 271 CASE FldPtr^.typ OF ***** ^ not supported yet ***** ^ not supported yet 272 StringCode,DispCode : Assign( Image.text,Cell.Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 273 |IntCode : B := StrToInteger(Image.text,0,Cell.I); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 274 |RealCode : B := StrToReal(Image.text,0,Cell.R); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 275 |GroupMember: Cell.B := FldPtr^.selected; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 276 END; 277 278 END GetCell; ***** ^ not supported yet 279 280 PROCEDURE NumberOfRows(T : Table) : CARDINAL; 281 BEGIN 282 RETURN T^.NumberOfRows; ***** ^ not supported yet ***** ^ not supported yet 283 END NumberOfRows; ***** ^ not supported yet 284 285 PROCEDURE NumberOfCols( T : Table) : CARDINAL; 286 BEGIN 287 RETURN T^.NumberOfCols; ***** ^ not supported yet ***** ^ not supported yet 288 END NumberOfCols; ***** ^ not supported yet 289 290 END Tables. ***** ^ not supported yet 436 errors