Listing: 1 IMPLEMENTATION MODULE ScrnUtl1; 2 (* 3 * REPERTOIRE 4 * Release 1.6 5 * By Charles Bradford and Cole Brecheen 6 * (c) Copyright 1985-1992 PMI 7 * Green Bay, Wisconsin 8 * All rights reserved 9 * (414) 468-6040 10 * 11 * $Header: D:/logfiles/mods/scrnutl1.mov 1.5 10 Mar 1991 15:32:22 coleb $ 12 * 13 *) 14 15 IMPORT ErrorNames; 16 IMPORT GenLists; 17 IMPORT ListUtils; 18 IMPORT M2Strings; 19 IMPORT MsColors; 20 IMPORT NumTypes; 21 IMPORT PosUtils; 22 IMPORT Rectangles; 23 IMPORT ScrnTypes; 24 IMPORT StrConv; 25 IMPORT StrEdit; 26 IMPORT SYSTEM; 27 IMPORT UserOps; 28 IMPORT VEditor; 29 IMPORT VWindows; 30 31 VAR 32 Initialized : BOOLEAN; 33 34 PROCEDURE Init(); 35 BEGIN 36 IF Initialized THEN 37 RETURN; 38 ELSE 39 Initialized := TRUE; 40 END; 41 ErrorNames.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 42 GenLists.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 43 ListUtils.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 44 M2Strings.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 45 MsColors.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 46 NumTypes.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 47 PosUtils.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 Rectangles.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 49 ScrnTypes.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 50 StrConv.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 StrEdit.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 52 UserOps.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 53 VEditor.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 54 VWindows.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 55 END Init; ***** ^ not supported yet 56 57 CONST 58 Bit15 = 15; (*most significant bit*) 59 Bit14 = 14; (*next most significant*) 60 AfterLastElmt = 65535; 61 62 TYPE 63 VariantType = 64 RECORD 65 CASE : CARDINAL OF ***** ^ not supported yet ***** ^ 'POINTER' expected 66 1: c: CARDINAL; 67 | 2: l, h: CHAR; 68 | 3: b: BITSET; 69 END 70 END; 71 72 73 PROCEDURE AbsFieldCol( TheFrame: ScrnTypes.DisplayFrame; 74 FieldNum: CARDINAL ): INTEGER; 75 VAR 76 tmp: CARDINAL; 77 ImagePtr: ScrnTypes.ImageElmtPtr; 78 BEGIN 79 GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); 80 (* 81 Diagnostics.diagC( 'ImagePtr^.col', ImagePtr^.col ); 82 *) 83 tmp := ImagePtr^.col; 84 DecodeWord( tmp ); 85 (* 86 Diagnostics.diagC( 'TheFrame^.startcol', TheFrame^.startcol ); 87 Diagnostics.diagC( 'TheFrame^.ColsScrolled', TheFrame^.ColsScrolled ); 88 *) 89 RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startcol)) - 90 INTEGER(TheFrame^.ColsScrolled); 91 END AbsFieldCol; 92 93 94 PROCEDURE AbsFieldRow( TheFrame: ScrnTypes.DisplayFrame; 95 FieldNum: CARDINAL ): INTEGER; 96 VAR 97 tmp: CARDINAL; 98 ImagePtr: ScrnTypes.ImageElmtPtr; 99 BEGIN 100 GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); 101 (* 102 Diagnostics.diagC( 'ImagePtr^.row', ImagePtr^.row ); 103 *) 104 tmp := ImagePtr^.row; 105 DecodeWord( tmp ); 106 (* 107 IF (tmp + TheFrame^.startrow) < TheFrame^.RowsScrolled THEN 108 END; 109 Diagnostics.diagC( 'ImagePtr^.row', tmp ); 110 Diagnostics.diagC( 'TheFrame^.startrow', TheFrame^.startrow ); 111 Diagnostics.diagC( 'TheFrame^.RowsScrolled', TheFrame^.RowsScrolled ); 112 *) 113 114 RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startrow)) - 115 INTEGER(TheFrame^.RowsScrolled); 116 END AbsFieldRow; 117 118 119 PROCEDURE AllFieldsThisType( TheFrame: ScrnTypes.DisplayFrame; 120 TheType: CHAR ): BOOLEAN; 121 VAR 122 FieldCount, LastField: CARDINAL; 123 CountingDispFields: BOOLEAN; 124 typ : CHAR; 125 BEGIN 126 FieldCount := 1; 127 CountingDispFields := TheType = ScrnTypes.DispCode; 128 LastField := FieldListTotal( TheFrame ); 129 WHILE (FieldCount <= LastField) DO 130 typ := FieldType(TheFrame, FieldCount); 131 IF (typ # TheType) THEN 132 IF NOT CountingDispFields THEN 133 IF typ # ScrnTypes.DispCode THEN 134 RETURN FALSE; 135 END; 136 ELSE 137 RETURN FALSE; 138 END; 139 END; 140 INC( FieldCount ); 141 END; 142 RETURN TRUE; 143 END AllFieldsThisType; 144 145 146 PROCEDURE BoxFrame( TheFrame: ScrnTypes.DisplayFrame; Active: BOOLEAN ); 147 VAR 148 TheBoxStr: VWindows.BoxStr; 149 BEGIN 150 IF Active THEN 151 TheBoxStr := TheFrame^.EntryBox; 152 ELSE 153 TheBoxStr := TheFrame^.ExitBox; 154 END; 155 IF TheBoxStr[0] # 0C THEN 156 SetBorderColors( TheFrame ); 157 VWindows.DrawBox( TheFrame^.WindowHandle, TheBoxStr, 158 TheFrame^.startcol + 1, TheFrame^.startrow + 1, 159 TheFrame^.endcol + 1, TheFrame^.endrow + 1 ); 160 IF TheFrame^.Caption[0] # 0C THEN 161 WriteBetween( TheFrame^.WindowHandle, TheFrame^.Caption, 162 TheFrame^.startcol + 1, TheFrame^.startrow + 1, 163 TheFrame^.endcol + 1, TheFrame^.endcol + 1 ); 164 END; 165 END; 166 END BoxFrame; 167 168 169 PROCEDURE BoxInFrame( TheFrame: ScrnTypes.DisplayFrame ): BOOLEAN; 170 BEGIN 171 RETURN (TheFrame^.EntryBox[0] # 0C) OR (TheFrame^.ExitBox[0] # 0C); 172 END BoxInFrame; 173 174 175 PROCEDURE ChoiceNumber( TheFrame: ScrnTypes.DisplayFrame; 176 TheField: CARDINAL ): CARDINAL; 177 VAR 178 FieldPtr: ScrnTypes.InputFieldPtr; 179 BEGIN 180 GetFieldPtr( TheFrame, TheField, FieldPtr ); 181 RETURN FieldPtr^.GroupID; 182 END ChoiceNumber; 183 184 185 PROCEDURE CoordsInField( TheFrame: ScrnTypes.DisplayFrame; 186 TheField, TheCol, TheRow: CARDINAL ): BOOLEAN; 187 VAR 188 c1, r1, c2, r2: CARDINAL; 189 BEGIN 190 c1 := VirtualFieldCol( TheFrame, TheField ); 191 IF (TheCol < c1) THEN 192 RETURN FALSE; 193 END; 194 r1 := VirtualFieldRow( TheFrame, TheField ); 195 IF (TheRow < r1) THEN 196 RETURN FALSE; 197 END; 198 c2 := c1 + FieldWidth( TheFrame, TheField ) - 1; 199 IF (TheCol > c2) THEN 200 RETURN FALSE; 201 END; 202 r2 := r1 + FieldHeight( TheFrame, TheField ) - 1; 203 IF (TheRow > r2) THEN 204 RETURN FALSE; 205 END; 206 RETURN TRUE; 207 END CoordsInField; 208 209 210 PROCEDURE CurrentField( TheFrame: ScrnTypes.DisplayFrame ): 211 CARDINAL; 212 VAR 213 ImagePtr: ScrnTypes.ImageElmtPtr; 214 BEGIN 215 GetFieldImagePtr( TheFrame, TheFrame^.CurrentField, ImagePtr ); 216 (*Make sure the list pointers are correct.*) 217 RETURN TheFrame^.CurrentField; 218 END CurrentField; 219 220 221 PROCEDURE DecodeByte( VAR AnyByte: SYSTEM.BYTE ); 222 BEGIN 223 IF CHAR(AnyByte) = 377C THEN 224 AnyByte := SYSTEM.BYTE(0C); 225 ELSIF CHAR(AnyByte) = 0C THEN 226 ErrorNames.WarningName( 'EncodErr' ); 227 END; 228 END DecodeByte; 229 230 231 PROCEDURE DecodeImageRec( VAR TheImageRec: 232 ScrnTypes.ImageElement ); 233 BEGIN 234 DecodeWord( TheImageRec.row ); 235 DecodeWord( TheImageRec.col ); 236 DecodeWord( TheImageRec.field ); 237 DecodeByte( TheImageRec.foreg ); 238 DecodeByte( TheImageRec.backg ); 239 DecodeByte( TheImageRec.atrb ); 240 END DecodeImageRec; 241 242 243 PROCEDURE DecodeWord( VAR AnyWord: SYSTEM.WORD ); 244 VAR 245 v: VariantType; 246 BEGIN 247 v.c := CARDINAL(AnyWord); 248 IF Bit14 IN v.b THEN 249 v.l := 0C; 250 EXCL( v.b, Bit14 ); 251 END; 252 IF Bit15 IN v.b THEN 253 v.h := 0C; 254 END; 255 AnyWord := SYSTEM.WORD(v.c); 256 END DecodeWord; 257 258 259 PROCEDURE EncodeByte( VAR AnyByte: SYSTEM.BYTE ); 260 BEGIN 261 IF CHAR(AnyByte) = 0C THEN 262 AnyByte := SYSTEM.BYTE(377C); 263 ELSIF CHAR(AnyByte) = 377C THEN 264 ErrorNames.WarningName( 'EncodErr' ); 265 END; 266 END EncodeByte; 267 268 269 PROCEDURE EncodeImageRec( VAR TheImageRec: 270 ScrnTypes.ImageElement ); 271 BEGIN 272 EncodeWord( TheImageRec.row ); 273 EncodeWord( TheImageRec.col ); 274 EncodeWord( TheImageRec.field ); 275 EncodeByte( TheImageRec.foreg ); 276 EncodeByte( TheImageRec.backg ); 277 EncodeByte( TheImageRec.atrb ); 278 END EncodeImageRec; 279 280 281 PROCEDURE EncodeWord( VAR AnyWord: SYSTEM.WORD ); 282 VAR 283 v: VariantType; 284 BEGIN 285 v.c := CARDINAL(AnyWord); 286 IF v.c > 04000H THEN 287 ErrorNames.WarningName( 'EncodErr' ); 288 END; 289 IF (v.h = 0C) THEN 290 INCL( v.b, Bit15 ); 291 END; 292 IF (v.l = 0C) THEN 293 INCL( v.b, Bit14 ); 294 v.l := 377C; 295 END; 296 AnyWord := SYSTEM.WORD(v.c); 297 END EncodeWord; 298 299 300 PROCEDURE EntirelyVisible( TheFrame: ScrnTypes.DisplayFrame; 301 TheField: CARDINAL ): BOOLEAN; 302 (* This procedure tells you whether TheField is entirely 303 visible within TheFrame. *) 304 VAR 305 FirstVirtualColVisible, FirstVirtualRowVisible, 306 VirtualPromptRow, LastVirtualColVisible, 307 LastVirtualRowVisible, c1, r1, c2, r2: INTEGER; 308 BEGIN 309 c1 := INTEGER( VirtualFieldCol( TheFrame, TheField ) ); 310 r1 := INTEGER( VirtualFieldRow( TheFrame, TheField ) ); 311 c2 := c1 + INTEGER(FieldWidth( TheFrame, TheField )) - 1; 312 r2 := r1 + INTEGER(FieldHeight( TheFrame, TheField )) - 1; 313 FirstVirtualColVisible := INTEGER(TheFrame^.ColsScrolled) 314 + 1; 315 FirstVirtualRowVisible := (INTEGER(TheFrame^.RowsScrolled) 316 + 1) + INTEGER(TheFrame^.headline); 317 LastVirtualColVisible := TheFrame^.endcol - 318 TheFrame^.startcol + 1 + TheFrame^.ColsScrolled; 319 LastVirtualRowVisible := TheFrame^.endrow - 320 TheFrame^.startrow + 1 + TheFrame^.RowsScrolled; 321 IF BoxInFrame( TheFrame ) THEN 322 (*There's a box in the window, so we have to adjust our 323 numbers.*) 324 IF TheFrame^.headline = 0 THEN 325 (*But we don't have to adjust FirstVirtualRowVisible if 326 there's a headline because we've added headline 327 above, and the box takes up one of the lines in it.*) 328 INC( FirstVirtualRowVisible ); 329 END; 330 INC( FirstVirtualColVisible ); 331 DEC( LastVirtualRowVisible ); 332 DEC( LastVirtualColVisible ); 333 END; 334 335 (*First determine whether it's entirely visible along 336 its width.*) 337 IF (c1 < FirstVirtualColVisible) OR (c2 > 338 LastVirtualColVisible) THEN 339 RETURN FALSE; 340 END; 341 342 (*Then determine whether it's entirely visible along 343 its height.*) 344 345 IF UserOps.DoPrompting THEN 346 VirtualPromptRow := INTEGER(TheFrame^.RowsScrolled + 347 UserOps.PromptRow) - INTEGER(TheFrame^.startrow); 348 IF (r1 <= VirtualPromptRow) AND (r2 >= VirtualPromptRow) THEN 349 RETURN FALSE; 350 END; 351 END; 352 353 IF (r1 < FirstVirtualRowVisible) OR (r2 > 354 LastVirtualRowVisible) THEN 355 RETURN FALSE; 356 END; 357 358 RETURN TRUE; 359 END EntirelyVisible; 360 361 362 PROCEDURE FieldEntered( TheFrame: ScrnTypes.DisplayFrame; 363 TheCol, TheRow: CARDINAL ): BOOLEAN; 364 (*Scans the field list to determine whether these cursor 365 coordinates are inside any field. If so, sets 366 TheFrame^.CurrentField to the number of the entered field 367 and returns TRUE.*) 368 VAR 369 cnt, ListEnd: CARDINAL; 370 BEGIN 371 cnt := 1; 372 ListEnd := FieldListTotal( TheFrame ); 373 LOOP 374 IF cnt > ListEnd THEN 375 RETURN FALSE; 376 END; 377 IF CoordsInField( TheFrame, cnt, TheCol, TheRow ) THEN 378 TheFrame^.CurrentField := cnt; 379 RETURN TRUE; 380 END; 381 INC( cnt ); 382 END; 383 END FieldEntered; 384 385 386 PROCEDURE FieldGroupTotal( TheFrame: ScrnTypes.DisplayFrame ): 387 CARDINAL; 388 VAR 389 ListEnd, ListCnt, GroupCnt: CARDINAL; 390 FieldPtr: ScrnTypes.InputFieldPtr; 391 BEGIN 392 ListEnd := FieldListTotal( TheFrame ); 393 ListCnt := 1; 394 GroupCnt := 0; 395 WHILE ListCnt <= ListEnd DO 396 GetFieldPtr( TheFrame, ListCnt, FieldPtr ); 397 IF (FieldPtr^.typ = ScrnTypes.DispCode) THEN 398 (* Do nothing *) 399 ELSIF (FieldPtr^.typ # ScrnTypes.GroupMember) THEN 400 INC( GroupCnt ); 401 ELSIF NOT (FieldPtr^.GroupID > 1) THEN 402 INC( GroupCnt ); 403 END; 404 INC( ListCnt ); 405 END; 406 RETURN GroupCnt; 407 END FieldGroupTotal; 408 409 410 PROCEDURE FieldHeight( TheFrame: ScrnTypes.DisplayFrame; 411 TheField: CARDINAL ): CARDINAL; 412 VAR 413 FieldPtr: ScrnTypes.InputFieldPtr; 414 BEGIN 415 IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN 416 GetFieldPtr( TheFrame, TheField, FieldPtr ); 417 RETURN (FieldPtr^.Row2 - VirtualFieldRow( TheFrame, TheField) ) + 1; 418 ELSE 419 RETURN 1; 420 END; 421 END FieldHeight; 422 423 424 PROCEDURE FieldImageNum( TheFrame: ScrnTypes.DisplayFrame; 425 FieldNumber: CARDINAL ): CARDINAL; 426 VAR 427 ImagePtr: ScrnTypes.InputFieldPtr; 428 BEGIN 429 GetFieldPtr( TheFrame, FieldNumber, ImagePtr ); 430 RETURN ImagePtr^.ImageNum; 431 END FieldImageNum; 432 433 434 PROCEDURE FieldIsBlank( TheFrame: ScrnTypes.DisplayFrame; 435 FieldName: ARRAY OF CHAR; VAR FieldNumber: CARDINAL ): 436 BOOLEAN; 437 (*Pass this routine a DisplayFrame (normally this will be 438 MainFrame) and a FieldName that appears somewhere in that 439 frame, and it tells you whether the field is blank, and 440 what its position is in the list of fields for the frame.*) 441 VAR 442 TmpPtr: ScrnTypes.InputFieldPtr; 443 ImageRec: ScrnTypes.ImageElement; 444 BEGIN 445 IF NOT FindField( TheFrame, FieldName, TmpPtr, ImageRec ) THEN 446 RETURN FALSE; 447 END; 448 FieldNumber := FieldNum( TheFrame, FieldName ); 449 RETURN PosUtils.IsBlank( ImageRec.text ); 450 END FieldIsBlank; 451 452 453 PROCEDURE FieldListTotal( TheFrame: ScrnTypes.DisplayFrame ): 454 CARDINAL; 455 BEGIN 456 IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN 457 RETURN 0; 458 ELSE 459 RETURN GenLists.ListLength( TheFrame^.FieldList ); 460 END; 461 END FieldListTotal; 462 463 464 PROCEDURE FieldWidth( TheFrame: ScrnTypes.DisplayFrame; 465 TheField: CARDINAL ): CARDINAL; 466 VAR 467 FieldPtr: ScrnTypes.InputFieldPtr; 468 ImagePtr: ScrnTypes.ImageElmtPtr; 469 BEGIN 470 IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN 471 GetFieldPtr( TheFrame, TheField, FieldPtr ); 472 RETURN (FieldPtr^.Col2 - VirtualFieldCol( TheFrame, TheField) ) + 1; 473 ELSE 474 GetFieldImagePtr( TheFrame, TheField, ImagePtr ); 475 RETURN M2Strings.Length( ImagePtr^.text ); 476 END; 477 END FieldWidth; 478 479 480 PROCEDURE FieldType( TheFrame: ScrnTypes.DisplayFrame; FieldNum: 481 CARDINAL ): CHAR; 482 VAR 483 FieldPtr: ScrnTypes.InputFieldPtr; 484 BEGIN 485 GetFieldPtr( TheFrame, FieldNum, FieldPtr ); 486 RETURN FieldPtr^.typ; 487 END FieldType; 488 489 490 PROCEDURE FindField( TheFrame: ScrnTypes.DisplayFrame; 491 FieldName: ARRAY OF CHAR; VAR FieldPtr: 492 ScrnTypes.InputFieldPtr; VAR ImageRec: 493 ScrnTypes.ImageElement ): BOOLEAN; 494 VAR 495 spot : CARDINAL; 496 BEGIN 497 spot := FieldNum( TheFrame, FieldName ); 498 IF spot = 0 THEN 499 RETURN FALSE; 500 ELSE RETURN FindFieldNum( TheFrame, spot, FieldPtr, 501 ImageRec ); 502 END; 503 END FindField; 504 505 506 PROCEDURE FindFieldNum( TheFrame: ScrnTypes.DisplayFrame; 507 FieldNum: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr; 508 VAR ImageRec: ScrnTypes.ImageElement ): BOOLEAN; 509 BEGIN 510 IF FieldNum > FieldListTotal(TheFrame) THEN 511 RETURN FALSE; 512 END; 513 GetFieldPtr( TheFrame, FieldNum, FieldPtr ); 514 GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec ); 515 RETURN TRUE; 516 END FindFieldNum; 517 518 519 PROCEDURE FirstMember( TheFrame: ScrnTypes.DisplayFrame; 520 TheField: CARDINAL ): CARDINAL; 521 (* Pass this routine any field number that's a GroupMember, 522 and it returns the number of the first field in the group. 523 To be called only for GroupMember fields. *) 524 VAR 525 TmpPtr: ScrnTypes.InputFieldPtr; 526 FieldNum: CARDINAL; 527 BEGIN 528 FieldNum := TheField; 529 GetFieldPtr( TheFrame, FieldNum, TmpPtr ); 530 WHILE TmpPtr^.GroupID > 1 DO 531 DEC( FieldNum ); 532 GetFieldPtr( TheFrame, FieldNum, TmpPtr ); 533 END; 534 RETURN FieldNum; 535 END FirstMember; 536 537 538 PROCEDURE GetCardField( TheFrame: ScrnTypes.DisplayFrame; 539 TheField: CARDINAL; VAR TheCard: CARDINAL ); 540 VAR 541 tmpstr: ARRAY [0..79] OF CHAR; 542 BEGIN 543 GetFieldText( TheFrame, TheField, tmpstr ); 544 IF NOT StrConv.StrToCardinal( tmpstr, 0, TheCard ) THEN 545 TheCard := 0; 546 END; 547 END GetCardField; 548 549 550 PROCEDURE GetEdField( FrameRec: ScrnTypes.DisplayFrame; 551 FieldNum: CARDINAL; VAR TheList: GenLists.GenList ); 552 VAR 553 TmpRec: ScrnTypes.InputFieldRecord; 554 BEGIN 555 GetFieldRec( FrameRec, FieldNum, TmpRec ); 556 IF TmpRec.typ = ScrnTypes.EditorCode THEN 557 GenLists.GetChildList( FrameRec^.EdFieldList, TmpRec.EdFieldNum, 558 TheList ); 559 ELSE 560 ErrorNames.WarningName( 'BadFld' ); 561 END; 562 END GetEdField; 563 564 565 PROCEDURE GetEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum: 566 CARDINAL; VAR TheList: GenLists.GenList; VAR Rec: 567 VEditor.AnEdControlRec ); 568 VAR 569 FieldRec: ScrnTypes.InputFieldRecord; 570 ImageRec: ScrnTypes.ImageElement; 571 BEGIN 572 GetFieldRec( FrameRec, FieldNum, FieldRec ); 573 GetFieldImageRec( FrameRec, FieldNum, ImageRec ); 574 IF FieldRec.typ # ScrnTypes.EditorCode THEN 575 ErrorNames.WarningName( 'BadFld' ); 576 RETURN; 577 END; 578 GenLists.GetChildList( FrameRec^.EdFieldList, FieldRec.EdFieldNum, 579 TheList ); 580 VEditor.InitEdRec( Rec ); 581 Rec.Col1 := ImageRec.col + FrameRec^.startcol - FrameRec^.ColsScrolled; 582 Rec.Row1 := ImageRec.row + FrameRec^.startrow - FrameRec^.RowsScrolled; 583 Rec.Col2 := FieldRec.Col2 + FrameRec^.startcol - FrameRec^.ColsScrolled; 584 Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow - FrameRec^.RowsScrolled; 585 (*We adjust the col and row coordinates to absolute 586 window coordinates.*) 587 Rec.TextRow1 := FieldRec.TextRow1; 588 Rec.CursorCol := FieldRec.CursorCol; 589 Rec.CursorRow := FieldRec.CursorRow; 590 Rec.MaxLines := FieldRec.MaxLines; 591 Rec.ChangeMade := FieldRec.ChangeMade; 592 Rec.ReadOnly := FieldRec.ReadOnly; 593 Rec.FrameRec := FrameRec; 594 595 WITH FrameRec^ DO 596 (* set colors to pointer bar *) 597 Rec.EntryForeColor := pbfor; 598 Rec.EntryBackColor := pbbak; 599 Rec.EntryAttrib := pbatrb; 600 END; 601 Rec.ExitForeColor := ImageRec.foreg; 602 Rec.ExitBackColor := ImageRec.backg; 603 Rec.ExitAttrib := ImageRec.atrb; 604 Rec.EntryBox := 0; 605 Rec.ExitBox := 0; 606 Rec.DoCounting := FALSE; 607 Rec.Col2 := FieldRec.Col2 + 608 FrameRec^.startcol -FrameRec^.ColsScrolled; 609 Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow - 610 FrameRec^.RowsScrolled 611 END GetEdRec; 612 613 614 PROCEDURE GetFrameLinks( FrameRec: ScrnTypes.DisplayFrame; VAR 615 FrameAbove, FrameBelow, FrameLeft, FrameRight: 616 ScrnTypes.AFrameName ); 617 VAR 618 lngth : CARDINAL; 619 BEGIN 620 FrameAbove[0] := 0C; 621 FrameBelow[0] := 0C; 622 FrameLeft[0] := 0C; 623 FrameRight[0] := 0C; 624 IF NOT GenLists.Initialized( FrameRec^.LinkedFrames ) THEN 625 RETURN; 626 END; 627 lngth := GenLists.ListLength( FrameRec^.LinkedFrames ); 628 IF lngth >= 1 THEN 629 ListUtils.GetStr( FrameRec^.LinkedFrames, 1, FrameAbove ); 630 END; 631 IF lngth >= 2 THEN 632 ListUtils.GetStr( FrameRec^.LinkedFrames, 2, FrameBelow ); 633 END; 634 IF lngth >= 3 THEN 635 ListUtils.GetStr( FrameRec^.LinkedFrames, 3, FrameLeft ); 636 END; 637 IF lngth >= 4 THEN 638 ListUtils.GetStr( FrameRec^.LinkedFrames, 4, FrameRight ); 639 END; 640 END GetFrameLinks; 641 642 643 PROCEDURE GetFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame ); 644 BEGIN 645 GenLists.GetChildList( TheFrame^.self, 5, TheFrame^.DataList ); 646 GenLists.GetChildList( TheFrame^.self, 6, TheFrame^.PromptList ); 647 GenLists.GetChildList( TheFrame^.self, 7, TheFrame^.HelpList ); 648 GenLists.GetChildList( TheFrame^.self, 8, TheFrame^.EdFieldList ); 649 GenLists.GetChildList( TheFrame^.self, 9, TheFrame^.FieldList ); 650 GenLists.GetChildList( TheFrame^.self, 10, TheFrame^.ImageList ); 651 GenLists.GetChildList( TheFrame^.self, 11, TheFrame^.LinkedFrames ); 652 END GetFrameLists; 653 654 655 PROCEDURE GetFieldDataList( TheFrame: ScrnTypes.DisplayFrame; 656 TheField: CARDINAL; VAR FieldDataList: GenLists.GenList ): BOOLEAN; 657 VAR 658 FieldPtr: ScrnTypes.InputFieldPtr; 659 TmpList: GenLists.GenList; 660 cnt1, TypeCode : CARDINAL; 661 FieldDataListFound : BOOLEAN; 662 TmpName: ARRAY [0..79] OF CHAR; 663 BEGIN 664 GenLists.NilList( FieldDataList ); 665 IF NOT GenLists.Initialized( TheFrame^.DataList ) THEN 666 RETURN FALSE; 667 END; 668 FieldDataListFound := FALSE; 669 GetFieldPtr( TheFrame, TheField, FieldPtr ); 670 cnt1 := GenLists.ListLength( TheFrame^.DataList ); 671 WHILE (cnt1 > 1) AND (NOT FieldDataListFound) DO 672 IF ListUtils.TypeCheck(TheFrame^.DataList,cnt1)=GenLists.ListCode THEN 673 GenLists.GetElmt( TheFrame^.DataList, cnt1 - 1, TmpName, TypeCode ); 674 IF PosUtils.Equal( TmpName, FieldPtr^.fnam ) THEN 675 GenLists.GetChildList( TheFrame^.DataList, cnt1, FieldDataList ); 676 FieldDataListFound := TRUE; 677 DEC( cnt1 ); 678 (* skip over the field name *) 679 END; 680 END; 681 DEC( cnt1 ); 682 END; 683 RETURN FieldDataListFound; 684 END GetFieldDataList; 685 686 687 PROCEDURE GetFieldImagePtr( TheFrame: ScrnTypes.DisplayFrame; 688 TheField: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr ); 689 VAR 690 FieldPtr: ScrnTypes.InputFieldPtr; 691 BEGIN 692 GetFieldPtr( TheFrame, TheField, FieldPtr ); 693 GetImagePtr( TheFrame, FieldPtr^.ImageNum, ImagePtr ); 694 END GetFieldImagePtr; 695 696 697 PROCEDURE GetFieldImageRec( TheFrame: ScrnTypes.DisplayFrame; 698 TheField: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement ); 699 VAR 700 FieldPtr: ScrnTypes.InputFieldPtr; 701 BEGIN 702 GetFieldPtr( TheFrame, TheField, FieldPtr ); 703 GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec ); 704 END GetFieldImageRec; 705 706 707 PROCEDURE GetFieldPtr( TheFrame: ScrnTypes.DisplayFrame; 708 TheField: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr ); 709 VAR 710 TmpSize, TypeCode: CARDINAL; 711 BEGIN 712 GenLists.GetElmtAdr( TheFrame^.FieldList, TheField, 713 FieldPtr, TmpSize, TypeCode ); 714 END GetFieldPtr; 715 716 717 PROCEDURE GetFieldRec( TheFrame: ScrnTypes.DisplayFrame; 718 TheField: CARDINAL; VAR FieldRec: 719 ScrnTypes.InputFieldRecord ); 720 VAR 721 TypeCode: CARDINAL; 722 BEGIN 723 GenLists.GetElmt( TheFrame^.FieldList, TheField, 724 FieldRec, TypeCode ); 725 END GetFieldRec; 726 727 728 PROCEDURE GetFieldText( TheFrame: ScrnTypes.DisplayFrame; 729 TheField: CARDINAL; VAR TheText: ARRAY OF CHAR ); 730 VAR 731 ImagePtr: ScrnTypes.ImageElmtPtr; 732 BEGIN 733 GetFieldImagePtr( TheFrame, TheField, ImagePtr ); 734 M2Strings.Assign( ImagePtr^.text, TheText ); 735 END GetFieldText; 736 737 738 PROCEDURE GetImagePtr( TheFrame: ScrnTypes.DisplayFrame; 739 ImageNum: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr ); 740 VAR 741 TmpSize, TypeCode: CARDINAL; 742 BEGIN 743 GenLists.GetElmtAdr( TheFrame^.ImageList, ImageNum, 744 ImagePtr, TmpSize, TypeCode ); 745 END GetImagePtr; 746 747 748 PROCEDURE GetImageRec( TheFrame: ScrnTypes.DisplayFrame; 749 ImageNum: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement ); 750 VAR 751 TypeCode: CARDINAL; 752 BEGIN 753 GenLists.GetElmt( TheFrame^.ImageList, ImageNum, 754 ImageRec, TypeCode ); 755 DecodeImageRec( ImageRec ); 756 END GetImageRec; 757 758 759 PROCEDURE GetIntField( TheFrame: ScrnTypes.DisplayFrame; 760 TheField: CARDINAL; VAR TheInt: INTEGER ); 761 VAR 762 tmpstr: ARRAY [0..79] OF CHAR; 763 BEGIN 764 GetFieldText( TheFrame, TheField, tmpstr ); 765 IF NOT StrConv.StrToInteger( tmpstr, 0, TheInt ) THEN 766 TheInt := 0; 767 END; 768 END GetIntField; 769 770 771 PROCEDURE GetLongIntField( TheFrame: ScrnTypes.DisplayFrame; 772 TheField: CARDINAL; VAR TheLongInt: LONGINT ); 773 VAR 774 tmpstr: ARRAY [0..79] OF CHAR; 775 BEGIN 776 GetFieldText( TheFrame, TheField, tmpstr ); 777 IF NOT StrConv.StrToLongInteger( tmpstr, 0, TheLongInt ) THEN 778 TheLongInt := NumTypes.L0; 779 END; 780 END GetLongIntField; 781 782 783 PROCEDURE GetVisibleArea( TheFrame: ScrnTypes.DisplayFrame; VAR 784 VisibleArea: Rectangles.ARectangle ); 785 (* Gets physical screen coordinates of visible part of frame. *) 786 BEGIN 787 Rectangles.DefineRectangle( VisibleArea, 788 TheFrame^.startcol, TheFrame^.startrow, 789 TheFrame^.endcol, TheFrame^.endrow ); 790 INC( VisibleArea.col1 ); 791 INC( VisibleArea.row1 ); 792 INC( VisibleArea.col2 ); 793 INC( VisibleArea.row2 ); 794 IF BoxInFrame( TheFrame ) THEN 795 INC( VisibleArea.col1 ); 796 INC( VisibleArea.row1 ); 797 DEC( VisibleArea.col2 ); 798 DEC( VisibleArea.row2 ); 799 END; 800 IF UserOps.DoPrompting AND ((INTEGER(UserOps.PromptRow) = 801 VisibleArea.row2) OR (INTEGER(UserOps.PromptRow) = 802 VisibleArea.row2 - 1)) THEN 803 VisibleArea.row2 := UserOps.PromptRow - 1; 804 END; 805 END GetVisibleArea; 806 807 808 PROCEDURE InputFieldsAbove( TheFrame: ScrnTypes.DisplayFrame; 809 TheField: CARDINAL ): BOOLEAN; 810 (*We use this to determine whether a scrolling window 811 ought to be scrolled all the way to the top of the 812 frame--it should if there are no input fields above 813 it.*) 814 VAR 815 SavedRow: CARDINAL; 816 BEGIN 817 SavedRow := VirtualFieldRow( TheFrame, TheField ); 818 DEC( TheField ); 819 LOOP 820 IF TheField = 0 THEN 821 RETURN FALSE; 822 ELSIF SavedRow > VirtualFieldRow( TheFrame, TheField ) THEN 823 IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN 824 RETURN TRUE; 825 END; 826 END; 827 DEC( TheField ); 828 END; 829 END InputFieldsAbove; 830 831 832 PROCEDURE InputFieldsBelow( TheFrame: ScrnTypes.DisplayFrame; 833 TheField: CARDINAL ): BOOLEAN; 834 VAR 835 ListEnd, SavedRow : CARDINAL; 836 BEGIN 837 SavedRow := VirtualFieldRow( TheFrame, TheField ); 838 ListEnd := FieldListTotal( TheFrame ); 839 INC( TheField ); 840 LOOP 841 IF TheField > ListEnd THEN 842 RETURN FALSE; 843 ELSIF SavedRow < VirtualFieldRow( TheFrame, TheField ) THEN 844 IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN 845 RETURN TRUE; 846 END; 847 END; 848 INC( TheField ); 849 END; 850 END InputFieldsBelow; 851 852 853 PROCEDURE InputFieldsToLeft( TheFrame: ScrnTypes.DisplayFrame; 854 TheField: CARDINAL ): BOOLEAN; 855 VAR 856 SavedCol : CARDINAL; 857 BEGIN 858 SavedCol := VirtualFieldCol( TheFrame, TheField ); 859 DEC( TheField ); 860 LOOP 861 IF TheField = 0 THEN 862 RETURN FALSE; 863 ELSIF SavedCol > VirtualFieldCol( TheFrame, TheField ) THEN 864 IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN 865 RETURN TRUE; 866 END; 867 END; 868 DEC( TheField ); 869 END; 870 END InputFieldsToLeft; 871 872 873 PROCEDURE InputFieldsToRight( TheFrame: ScrnTypes.DisplayFrame; 874 TheField: CARDINAL ): BOOLEAN; 875 VAR 876 ListEnd, SavedCol : CARDINAL; 877 BEGIN 878 SavedCol := VirtualFieldCol( TheFrame, TheField ); 879 ListEnd := FieldListTotal( TheFrame ); 880 INC( TheField ); 881 LOOP 882 IF TheField > ListEnd THEN 883 RETURN FALSE; 884 ELSIF SavedCol < VirtualFieldCol( TheFrame, TheField ) THEN 885 IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN 886 RETURN TRUE; 887 END; 888 END; 889 INC( TheField ); 890 END; 891 END InputFieldsToRight; 892 893 894 PROCEDURE ListFromEdField( TheFrame: ScrnTypes.DisplayFrame; 895 TheField: CARDINAL; VAR TheList: GenLists.GenList ): 896 BOOLEAN; 897 VAR 898 FieldRec: ScrnTypes.InputFieldRecord; 899 BEGIN 900 GetFieldRec( TheFrame, TheField, FieldRec ); 901 IF (FieldRec.typ = ScrnTypes.EditorCode) AND 902 (FieldRec.EdFieldNum > 0) THEN 903 GenLists.GetChildList( TheFrame^.EdFieldList, FieldRec.EdFieldNum, 904 TheList ); 905 RETURN GenLists.Initialized( TheList); 906 ELSE 907 RETURN FALSE; 908 END; 909 END ListFromEdField; 910 911 912 PROCEDURE ListToEdField( TheList: GenLists.GenList; TheFrame: 913 ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN; 914 VAR 915 FieldRec: ScrnTypes.InputFieldRecord; 916 BEGIN 917 GetFieldRec( TheFrame, TheField, FieldRec ); 918 IF (FieldRec.typ = ScrnTypes.EditorCode) AND 919 (FieldRec.EdFieldNum > 0) THEN 920 GenLists.ListReplace( TheList, GenLists.ListCode, 921 TheFrame^.EdFieldList, FieldRec.EdFieldNum ); 922 RETURN TRUE; 923 ELSE 924 RETURN FALSE; 925 END; 926 END ListToEdField; 927 928 929 PROCEDURE MakeFieldDataList( TheFrame: ScrnTypes.DisplayFrame; 930 TheField: CARDINAL; FieldDataList: GenLists.GenList ); 931 VAR 932 TmpList: GenLists.GenList; 933 FieldPtr: ScrnTypes.InputFieldPtr; 934 BEGIN 935 IF NOT GetFieldDataList( TheFrame, TheField, TmpList ) THEN 936 GetFieldPtr( TheFrame, TheField, FieldPtr ); 937 GenLists.ListInsert( FieldPtr^.fnam, GenLists.StrCode, 938 TheFrame^.DataList, AfterLastElmt ); 939 GenLists.ListInsert( FieldDataList, GenLists.ListCode, 940 TheFrame^.DataList, AfterLastElmt ); 941 END; 942 END MakeFieldDataList; 943 944 945 PROCEDURE NumberOfChoices( TheFrame: ScrnTypes.DisplayFrame; 946 TheField: CARDINAL ): CARDINAL; 947 VAR 948 FieldPtr: ScrnTypes.InputFieldPtr; 949 BEGIN 950 GetFieldPtr( TheFrame, TheField, FieldPtr ); 951 RETURN FieldPtr^.GroupSize; 952 END NumberOfChoices; 953 954 955 PROCEDURE NumberOfImages( TheFrame: ScrnTypes.DisplayFrame ): 956 CARDINAL; 957 BEGIN 958 IF NOT GenLists.Initialized( TheFrame^.ImageList ) THEN 959 RETURN 0; 960 ELSE 961 RETURN GenLists.ListLength( TheFrame^.ImageList ); 962 END; 963 END NumberOfImages; 964 965 966 PROCEDURE FieldNum( TheFrame: ScrnTypes.DisplayFrame; FieldName: 967 ARRAY OF CHAR ): CARDINAL; 968 (*Takes a field name and returns its number; 0 means name 969 not found.*) 970 VAR 971 ListEnd, cnt : CARDINAL; 972 msg: ARRAY [0..79] OF CHAR; 973 TmpPtr: ScrnTypes.InputFieldPtr; 974 BEGIN 975 StrEdit.CAPstr(FieldName); 976 (* make search case-insensitive *) 977 StrEdit.DeleteChar( ' ', FieldName ); 978 (*Delete all blanks from FieldName--ScreenCompile deletes 979 them from the actual field names.*) 980 cnt := 1; 981 ListEnd := FieldListTotal( TheFrame ); 982 WHILE cnt <= ListEnd DO 983 GetFieldPtr( TheFrame, cnt, TmpPtr ); 984 IF PosUtils.Equal( FieldName, TmpPtr^.fnam ) THEN 985 TheFrame^.CurrentField := cnt; 986 RETURN cnt; 987 ELSE 988 INC( cnt ); 989 END; 990 END; 991 (* 992 993 Commented out on 6 Dec 88. 994 995 StrEdit.AssignStr( ' is not a field in frame ', msg ); 996 StrEdit.Append( msg, TheFrame^.ThisFrame ); 997 M2Strings.Insert( FieldName, msg, 0 ); 998 IF TheFrame^.FromFile # NIL THEN 999 StrEdit.Append( msg, ' of file ' ); 1000 StrEdit.Append( msg, TheFrame^.FromFile^.name ); 1001 END; 1002 ErrorManager.WARN( msg ); 1003 *) 1004 RETURN 0; 1005 END FieldNum; 1006 1007 1008 PROCEDURE PartOutside( FrameRec: ScrnTypes.DisplayFrame; VAR 1009 VisibleArea: Rectangles.ARectangle; direction: 1010 VWindows.Compass ): CARDINAL; 1011 VAR 1012 height, width, VHeight : CARDINAL; 1013 BEGIN 1014 height := (VisibleArea.row2 - VisibleArea.row1) + 1; 1015 width := (VisibleArea.col2 - VisibleArea.col1) + 1; 1016 CASE direction OF 1017 VWindows.South: 1018 WITH FrameRec^ DO 1019 IF NOT BoxInFrame(FrameRec) THEN 1020 VHeight := VirtualHeight - headline 1021 ELSIF headline = 0 THEN 1022 (* compensate for bottom line of box *) 1023 VHeight := VirtualHeight - 1; 1024 ELSE 1025 (* compensation for top and bottom lines of box cancel *) 1026 VHeight := VirtualHeight - headline; 1027 END (* if no box *); 1028 IF (VHeight - RowsScrolled) <= height THEN 1029 RETURN 0; 1030 ELSE 1031 RETURN (VHeight - height) - RowsScrolled; 1032 END; 1033 END (* with FrameRec^ *); 1034 | VWindows.North: 1035 RETURN FrameRec^.RowsScrolled; 1036 | VWindows.East: 1037 IF (FrameRec^.VirtualWidth - FrameRec^.ColsScrolled) <= width THEN 1038 RETURN 0; 1039 END; 1040 RETURN (FrameRec^.VirtualWidth - width) - FrameRec^.ColsScrolled; 1041 | VWindows.West: 1042 RETURN FrameRec^.ColsScrolled; 1043 END; 1044 RETURN 0; 1045 END PartOutside; 1046 1047 1048 PROCEDURE PutEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum: 1049 CARDINAL; VAR TheList: GenLists.GenList; VAR Rec: 1050 VEditor.AnEdControlRec ); 1051 (*Note that this does not update the column and row 1052 coordinates stored in the field list and image list. 1053 That's intentional. The EdControlRec has to have absolute 1054 window coordinates, not frame-relative coordinates.*) 1055 VAR 1056 FieldRec: ScrnTypes.InputFieldRecord; 1057 BEGIN 1058 GetFieldRec( FrameRec, FieldNum, FieldRec ); 1059 IF FieldRec.typ # ScrnTypes.EditorCode THEN 1060 ErrorNames.WarningName( 'BadFld' ); 1061 RETURN; 1062 END; 1063 GenLists.ListReplace( TheList, GenLists.ListCode, 1064 FrameRec^.EdFieldList, FieldRec.EdFieldNum ); 1065 FieldRec.TextRow1 := Rec.TextRow1; 1066 FieldRec.CursorCol := Rec.CursorCol; 1067 FieldRec.CursorRow := Rec.CursorRow; 1068 FieldRec.MaxLines := Rec.MaxLines; 1069 FieldRec.ChangeMade := Rec.ChangeMade; 1070 FieldRec.ReadOnly := Rec.ReadOnly; 1071 PutFieldRec( FieldRec, FrameRec, FieldNum ); 1072 END PutEdRec; 1073 1074 1075 PROCEDURE PutFieldImageRec( ImageRec: 1076 ScrnTypes.ImageElement; VAR TheFrame: 1077 ScrnTypes.DisplayFrame; TheField: CARDINAL ); 1078 BEGIN 1079 EncodeImageRec( ImageRec ); 1080 GenLists.ListReplace( ImageRec, GenLists.StrCode, TheFrame^.ImageList, 1081 FieldImageNum(TheFrame, TheField) ); 1082 END PutFieldImageRec; 1083 1084 1085 PROCEDURE PutFieldRec( VAR FieldRec: 1086 ScrnTypes.InputFieldRecord; VAR TheFrame: 1087 ScrnTypes.DisplayFrame; TheField: CARDINAL ); 1088 VAR 1089 cnt, ImageListEnd: CARDINAL; 1090 ImageRec: ScrnTypes.ImageElement; 1091 BEGIN 1092 IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN 1093 GenLists.NewList( TheFrame^.FieldList ); 1094 PutFrameLists( TheFrame ); 1095 (* Make sure the new FieldList gets inserted into 1096 TheFrame's .self list. *) 1097 END; 1098 IF TheField <= GenLists.ListLength( TheFrame^.FieldList ) THEN 1099 GenLists.ListReplace( FieldRec, ScrnTypes.FieldTypeCode, 1100 TheFrame^.FieldList, TheField ); 1101 ELSE 1102 GenLists.ListInsert( FieldRec, ScrnTypes.FieldTypeCode, 1103 TheFrame^.FieldList, TheField ); 1104 (* Now everything in the ImageList with a FieldNum 1105 greater than or equal to TheField has to have its 1106 field number incremented. *) 1107 ImageListEnd := NumberOfImages( TheFrame ); 1108 FOR cnt := 1 TO ImageListEnd DO 1109 GetImageRec( TheFrame, cnt, ImageRec ); 1110 IF ImageRec.field > TheField THEN 1111 INC( ImageRec.field ); 1112 EncodeImageRec( ImageRec ); 1113 GenLists.ListReplace( ImageRec, GenLists.StrCode, 1114 TheFrame^.ImageList, cnt ); 1115 END; 1116 END; 1117 END; 1118 END PutFieldRec; 1119 1120 1121 PROCEDURE PutFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame ); 1122 BEGIN 1123 GenLists.ListReplace( TheFrame^.DataList, 1124 GenLists.ListCode, TheFrame^.self, 5 ); 1125 GenLists.ListReplace( TheFrame^.PromptList, 1126 GenLists.ListCode, TheFrame^.self, 6 ); 1127 GenLists.ListReplace( TheFrame^.HelpList, 1128 GenLists.ListCode, TheFrame^.self, 7 ); 1129 GenLists.ListReplace( TheFrame^.EdFieldList, 1130 GenLists.ListCode, TheFrame^.self, 8 ); 1131 GenLists.ListReplace( TheFrame^.FieldList, 1132 GenLists.ListCode, TheFrame^.self, 9 ); 1133 GenLists.ListReplace( TheFrame^.ImageList, 1134 GenLists.ListCode, TheFrame^.self, 10 ); 1135 GenLists.ListReplace( TheFrame^.LinkedFrames, 1136 GenLists.ListCode, TheFrame^.self, 11 ); 1137 END PutFrameLists; 1138 1139 1140 PROCEDURE RelativeFieldCol( TheFrame: ScrnTypes.DisplayFrame; 1141 FieldNum: CARDINAL ): CARDINAL; 1142 VAR 1143 vcol : CARDINAL; 1144 BEGIN 1145 vcol := VirtualFieldCol( TheFrame, FieldNum ); 1146 (* 1147 IF vcol < TheFrame^.ColsScrolled THEN 1148 Diagnostics.diagC( 'Scrolling error. vcol', vcol ); 1149 END; 1150 *) 1151 RETURN vcol - TheFrame^.ColsScrolled; 1152 END RelativeFieldCol; 1153 1154 1155 PROCEDURE RelativeFieldRow( TheFrame: ScrnTypes.DisplayFrame; 1156 FieldNum: CARDINAL ): CARDINAL; 1157 VAR 1158 vrow : CARDINAL; 1159 BEGIN 1160 vrow := VirtualFieldRow( TheFrame, FieldNum ); 1161 (* 1162 IF vrow < TheFrame^.RowsScrolled THEN 1163 Diagnostics.diagC( 'Scrolling error. RowsScrolled', TheFrame^.RowsScrolled ); 1164 Diagnostics.diagC( 'Scrolling error. vrow', vrow ); 1165 END; 1166 *) 1167 RETURN vrow - TheFrame^.RowsScrolled; 1168 END RelativeFieldRow; 1169 1170 1171 PROCEDURE ResetFieldPtr( VAR TheFrame: ScrnTypes.DisplayFrame); 1172 VAR 1173 dumptr: ScrnTypes.InputFieldPtr; 1174 BEGIN 1175 TheFrame^.CurrentField := 0; 1176 GetFieldPtr( TheFrame, 1, dumptr ); 1177 END ResetFieldPtr; 1178 1179 1180 PROCEDURE SelectedChar( TheFrame: ScrnTypes.DisplayFrame ): 1181 CHAR; 1182 VAR 1183 FieldRec: ScrnTypes.InputFieldRecord; 1184 BEGIN 1185 GetFieldRec( TheFrame, TheFrame^.CurrentField, FieldRec ); 1186 IF FieldRec.typ = ScrnTypes.GotoCode THEN 1187 IF FieldRec.MenuKey <= 255 THEN 1188 RETURN CHR(FieldRec.MenuKey); 1189 END; 1190 ELSIF FieldRec.typ = ScrnTypes.GroupMember THEN 1191 IF FieldRec.ChoiceKey <= 255 THEN 1192 RETURN CHR(FieldRec.ChoiceKey); 1193 END; 1194 END; 1195 RETURN 0C; 1196 END SelectedChar; 1197 1198 1199 PROCEDURE SetBorderColors( TheFrame: ScrnTypes.DisplayFrame ); 1200 BEGIN 1201 VWindows.SetForeColor( TheFrame^.WindowHandle, 1202 TheFrame^.bordfor ); 1203 VWindows.SetBackColor( TheFrame^.WindowHandle, 1204 TheFrame^.bordbak ); 1205 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1206 TheFrame^.bordatrb ); 1207 END SetBorderColors; 1208 1209 1210 PROCEDURE SetCurrentField( VAR TheFrame: ScrnTypes.DisplayFrame; 1211 FieldNum: CARDINAL ); 1212 VAR 1213 ImagePtr: ScrnTypes.ImageElmtPtr; 1214 BEGIN 1215 IF (FieldNum < 1) OR (FieldNum > FieldListTotal(TheFrame)) THEN 1216 RETURN; 1217 END; 1218 GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); 1219 (*Make sure the list pointers are correct.*) 1220 TheFrame^.CurrentField := FieldNum; 1221 END SetCurrentField; 1222 1223 1224 PROCEDURE SetFieldColors( TheFrame: ScrnTypes.DisplayFrame; 1225 FieldNum: CARDINAL ); 1226 VAR 1227 ImageRec: ScrnTypes.ImageElement; 1228 BEGIN 1229 GetFieldImageRec( TheFrame, FieldNum, ImageRec ); 1230 VWindows.SetForeColor( TheFrame^.WindowHandle, 1231 ImageRec.foreg ); 1232 VWindows.SetBackColor( TheFrame^.WindowHandle, 1233 ImageRec.backg ); 1234 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1235 ImageRec.atrb ); 1236 END SetFieldColors; 1237 1238 1239 PROCEDURE SetMessageColors( TheFrame: ScrnTypes.DisplayFrame ); 1240 BEGIN 1241 VWindows.SetForeColor( TheFrame^.WindowHandle, 1242 TheFrame^.msgfor ); 1243 VWindows.SetBackColor( TheFrame^.WindowHandle, 1244 TheFrame^.msgbak ); 1245 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1246 TheFrame^.msgatrb ); 1247 END SetMessageColors; 1248 1249 1250 PROCEDURE SetNormalColors( TheFrame: ScrnTypes.DisplayFrame ); 1251 BEGIN 1252 VWindows.SetForeColor( TheFrame^.WindowHandle, 1253 TheFrame^.normfor ); 1254 VWindows.SetBackColor( TheFrame^.WindowHandle, 1255 TheFrame^.normbak ); 1256 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1257 TheFrame^.normatrb ); 1258 END SetNormalColors; 1259 1260 1261 PROCEDURE SetPointerBarColors( TheFrame: ScrnTypes.DisplayFrame 1262 ); 1263 BEGIN 1264 VWindows.SetForeColor( TheFrame^.WindowHandle, 1265 TheFrame^.pbfor ); 1266 VWindows.SetBackColor( TheFrame^.WindowHandle, 1267 TheFrame^.pbbak ); 1268 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1269 TheFrame^.pbatrb ); 1270 END SetPointerBarColors; 1271 1272 1273 PROCEDURE SetPromptColors( TheFrame: ScrnTypes.DisplayFrame ); 1274 BEGIN 1275 VWindows.SetForeColor( TheFrame^.WindowHandle, 1276 TheFrame^.promfor ); 1277 VWindows.SetBackColor( TheFrame^.WindowHandle, 1278 TheFrame^.prombak ); 1279 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1280 TheFrame^.promatrb ); 1281 END SetPromptColors; 1282 1283 1284 PROCEDURE SetSelCharColors( TheFrame: ScrnTypes.DisplayFrame; 1285 FieldNum: CARDINAL ); 1286 VAR 1287 fore : MsColors.AColor; 1288 attr : MsColors.AMonoAttribute; 1289 ImageRec: ScrnTypes.ImageElement; 1290 BEGIN 1291 GetFieldImageRec( TheFrame, FieldNum, ImageRec ); 1292 CASE ORD(ImageRec.foreg) OF 1293 0, 3 : 1294 fore := MsColors.red; 1295 | 1, 2, 4..7 : 1296 fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) + 8) ); 1297 | 8..15: 1298 fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) - 1) ); 1299 END; 1300 IF ImageRec.atrb # MsColors.bold THEN 1301 attr := MsColors.bold; 1302 ELSE 1303 attr := MsColors.plain; 1304 END; 1305 IF fore = TheFrame^.pbbak THEN 1306 IF fore <= 2C THEN 1307 fore := CHR( ORD(fore) + 3 ); 1308 ELSE 1309 fore := CHR( ORD(fore) - 3 ); 1310 END; 1311 END; 1312 VWindows.SetForeColor( TheFrame^.WindowHandle, 1313 fore ); 1314 VWindows.SetBackColor( TheFrame^.WindowHandle, 1315 ImageRec.backg ); 1316 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1317 attr ); 1318 END SetSelCharColors; 1319 1320 1321 PROCEDURE SetSelectionColors( TheFrame: ScrnTypes.DisplayFrame 1322 ); 1323 BEGIN 1324 VWindows.SetForeColor( TheFrame^.WindowHandle, 1325 TheFrame^.selfor ); 1326 VWindows.SetBackColor( TheFrame^.WindowHandle, 1327 TheFrame^.selbak ); 1328 VWindows.SetMonoAttr( TheFrame^.WindowHandle, 1329 TheFrame^.selatrb ); 1330 END SetSelectionColors; 1331 1332 1333 PROCEDURE VirtualFieldCol( TheFrame: ScrnTypes.DisplayFrame; 1334 FieldNum: CARDINAL ): CARDINAL; 1335 VAR 1336 tmp: CARDINAL; 1337 ImagePtr: ScrnTypes.ImageElmtPtr; 1338 BEGIN 1339 GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); 1340 tmp := ImagePtr^.col; 1341 DecodeWord( tmp ); 1342 RETURN tmp; 1343 END VirtualFieldCol; 1344 1345 1346 PROCEDURE VirtualFieldRow( TheFrame: ScrnTypes.DisplayFrame; 1347 FieldNum: CARDINAL ): CARDINAL; 1348 VAR 1349 tmp: CARDINAL; 1350 ImagePtr: ScrnTypes.ImageElmtPtr; 1351 BEGIN 1352 GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); 1353 tmp := ImagePtr^.row; 1354 DecodeWord( tmp ); 1355 RETURN tmp; 1356 END VirtualFieldRow; 1357 1358 1359 PROCEDURE VirtualImageCol( TheFrame: ScrnTypes.DisplayFrame; 1360 ImageNum: CARDINAL ): CARDINAL; 1361 VAR 1362 tmp: CARDINAL; 1363 ImagePtr: ScrnTypes.ImageElmtPtr; 1364 BEGIN 1365 GetImagePtr( TheFrame, ImageNum, ImagePtr ); 1366 tmp := ImagePtr^.col; 1367 DecodeWord( tmp ); 1368 RETURN tmp; 1369 END VirtualImageCol; 1370 1371 1372 PROCEDURE VirtualImageRow( TheFrame: ScrnTypes.DisplayFrame; 1373 ImageNum: CARDINAL ): CARDINAL; 1374 VAR 1375 tmp: CARDINAL; 1376 ImagePtr: ScrnTypes.ImageElmtPtr; 1377 BEGIN 1378 GetImagePtr( TheFrame, ImageNum, ImagePtr ); 1379 tmp := ImagePtr^.row; 1380 DecodeWord( tmp ); 1381 RETURN tmp; 1382 END VirtualImageRow; 1383 1384 1385 PROCEDURE WhichChoiceKey( TheFrame: ScrnTypes.DisplayFrame; 1386 OneOfTheFields: CARDINAL ): CARDINAL; 1387 VAR 1388 TmpPtr: ScrnTypes.InputFieldPtr; 1389 FieldNum: CARDINAL; 1390 BEGIN 1391 IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN 1392 RETURN 0; 1393 END; 1394 FieldNum := FirstMember( TheFrame, OneOfTheFields ); 1395 REPEAT 1396 GetFieldPtr( TheFrame, FieldNum, TmpPtr ); 1397 IF TmpPtr^.selected THEN 1398 RETURN TmpPtr^.ChoiceKey; 1399 ELSE 1400 INC( FieldNum ); 1401 END; 1402 UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize; 1403 RETURN 0; 1404 END WhichChoiceKey; 1405 1406 1407 PROCEDURE WhichChoiceNum( TheFrame: ScrnTypes.DisplayFrame; 1408 OneOfTheFields: CARDINAL ): CARDINAL; 1409 VAR 1410 TmpPtr: ScrnTypes.InputFieldPtr; 1411 FieldNum: CARDINAL; 1412 BEGIN 1413 IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN 1414 RETURN 0; 1415 END; 1416 FieldNum := FirstMember( TheFrame, OneOfTheFields ); 1417 REPEAT 1418 GetFieldPtr( TheFrame, FieldNum, TmpPtr ); 1419 IF TmpPtr^.selected THEN 1420 RETURN TmpPtr^.GroupID; 1421 ELSE 1422 INC( FieldNum ); 1423 END; 1424 UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize; 1425 RETURN FirstMember( TheFrame, OneOfTheFields ); 1426 END WhichChoiceNum; 1427 1428 1429 PROCEDURE WriteBetween( TheWindow: VWindows.AWindowHandle; 1430 TheStr: ARRAY OF CHAR; col1, row1, col2, row2: CARDINAL ); 1431 (*Used for writing centered captions on frame borders.*) 1432 VAR 1433 lngth, width: CARDINAL; 1434 BEGIN 1435 lngth := M2Strings.Length( TheStr ); 1436 width := (col2 - col1) - 1; 1437 IF lngth > width THEN 1438 StrEdit.SetLength( TheStr, width ); 1439 lngth := width; 1440 END; 1441 VWindows.DrawStr( TheWindow, col1 + ((width - lngth) DIV 2) + 1, 1442 row1, SYSTEM.ADR(TheStr), lngth ); 1443 END WriteBetween; 1444 1445 1446 PROCEDURE WriteScrollMarks( TheFrame: ScrnTypes.DisplayFrame ); 1447 BEGIN 1448 WITH TheFrame^ DO 1449 IF NOT BoxInFrame( TheFrame ) THEN 1450 (*There's no box around the window, so we don't have 1451 any place to put our scroll marks.*) 1452 RETURN; 1453 END; 1454 IF (VirtualHeight > (endrow - startrow) + 1) THEN 1455 VWindows.SetScrollRange( TheFrame^.WindowHandle, 1456 VWindows.SbVert, TheFrame^.startrow + 1, 1457 TheFrame^.endrow + 1 ); 1458 VWindows.SetScrollPos( TheFrame^.WindowHandle, 1459 VWindows.SbVert, TheFrame^.RowsScrolled ); 1460 END; 1461 IF (VirtualWidth > (endcol - startcol) + 1) THEN 1462 VWindows.SetScrollRange( TheFrame^.WindowHandle, 1463 VWindows.SbHorz, TheFrame^.startcol + 1, 1464 TheFrame^.endcol + 1 ); 1465 VWindows.SetScrollPos( TheFrame^.WindowHandle, 1466 VWindows.SbHorz, TheFrame^.ColsScrolled ); 1467 END; 1468 (*If neither of the two preceding IF's were 1469 executed, the frame fits entirely within the 1470 window; no need to write scroll marks.*) 1471 END; 1472 END WriteScrollMarks; 1473 1474 1475 BEGIN 1476 Initialized := FALSE; 1477 Init(); 1478 END ScrnUtl1. 45 errors