IMPLEMENTATION MODULE ScrnUtl1; (* * REPERTOIRE * Release 1.6 * By Charles Bradford and Cole Brecheen * (c) Copyright 1985-1992 PMI * Green Bay, Wisconsin * All rights reserved * (414) 468-6040 * * $Header: D:/logfiles/mods/scrnutl1.mov 1.5 10 Mar 1991 15:32:22 coleb $ * *) IMPORT ErrorNames; IMPORT GenLists; IMPORT ListUtils; IMPORT M2Strings; IMPORT MsColors; IMPORT NumTypes; IMPORT PosUtils; IMPORT Rectangles; IMPORT ScrnTypes; IMPORT StrConv; IMPORT StrEdit; IMPORT SYSTEM; IMPORT UserOps; IMPORT VEditor; IMPORT VWindows; VAR Initialized : BOOLEAN; PROCEDURE Init(); BEGIN IF Initialized THEN RETURN; ELSE Initialized := TRUE; END; ErrorNames.Init(); GenLists.Init(); ListUtils.Init(); M2Strings.Init(); MsColors.Init(); NumTypes.Init(); PosUtils.Init(); Rectangles.Init(); ScrnTypes.Init(); StrConv.Init(); StrEdit.Init(); UserOps.Init(); VEditor.Init(); VWindows.Init(); END Init; CONST Bit15 = 15; (*most significant bit*) Bit14 = 14; (*next most significant*) AfterLastElmt = 65535; TYPE VariantType = RECORD CASE : CARDINAL OF 1: c: CARDINAL; | 2: l, h: CHAR; | 3: b: BITSET; END END; PROCEDURE AbsFieldCol( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ): INTEGER; VAR tmp: CARDINAL; ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); (* Diagnostics.diagC( 'ImagePtr^.col', ImagePtr^.col ); *) tmp := ImagePtr^.col; DecodeWord( tmp ); (* Diagnostics.diagC( 'TheFrame^.startcol', TheFrame^.startcol ); Diagnostics.diagC( 'TheFrame^.ColsScrolled', TheFrame^.ColsScrolled ); *) RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startcol)) - INTEGER(TheFrame^.ColsScrolled); END AbsFieldCol; PROCEDURE AbsFieldRow( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ): INTEGER; VAR tmp: CARDINAL; ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); (* Diagnostics.diagC( 'ImagePtr^.row', ImagePtr^.row ); *) tmp := ImagePtr^.row; DecodeWord( tmp ); (* IF (tmp + TheFrame^.startrow) < TheFrame^.RowsScrolled THEN END; Diagnostics.diagC( 'ImagePtr^.row', tmp ); Diagnostics.diagC( 'TheFrame^.startrow', TheFrame^.startrow ); Diagnostics.diagC( 'TheFrame^.RowsScrolled', TheFrame^.RowsScrolled ); *) RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startrow)) - INTEGER(TheFrame^.RowsScrolled); END AbsFieldRow; PROCEDURE AllFieldsThisType( TheFrame: ScrnTypes.DisplayFrame; TheType: CHAR ): BOOLEAN; VAR FieldCount, LastField: CARDINAL; CountingDispFields: BOOLEAN; typ : CHAR; BEGIN FieldCount := 1; CountingDispFields := TheType = ScrnTypes.DispCode; LastField := FieldListTotal( TheFrame ); WHILE (FieldCount <= LastField) DO typ := FieldType(TheFrame, FieldCount); IF (typ # TheType) THEN IF NOT CountingDispFields THEN IF typ # ScrnTypes.DispCode THEN RETURN FALSE; END; ELSE RETURN FALSE; END; END; INC( FieldCount ); END; RETURN TRUE; END AllFieldsThisType; PROCEDURE BoxFrame( TheFrame: ScrnTypes.DisplayFrame; Active: BOOLEAN ); VAR TheBoxStr: VWindows.BoxStr; BEGIN IF Active THEN TheBoxStr := TheFrame^.EntryBox; ELSE TheBoxStr := TheFrame^.ExitBox; END; IF TheBoxStr[0] # 0C THEN SetBorderColors( TheFrame ); VWindows.DrawBox( TheFrame^.WindowHandle, TheBoxStr, TheFrame^.startcol + 1, TheFrame^.startrow + 1, TheFrame^.endcol + 1, TheFrame^.endrow + 1 ); IF TheFrame^.Caption[0] # 0C THEN WriteBetween( TheFrame^.WindowHandle, TheFrame^.Caption, TheFrame^.startcol + 1, TheFrame^.startrow + 1, TheFrame^.endcol + 1, TheFrame^.endcol + 1 ); END; END; END BoxFrame; PROCEDURE BoxInFrame( TheFrame: ScrnTypes.DisplayFrame ): BOOLEAN; BEGIN RETURN (TheFrame^.EntryBox[0] # 0C) OR (TheFrame^.ExitBox[0] # 0C); END BoxInFrame; PROCEDURE ChoiceNumber( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr; BEGIN GetFieldPtr( TheFrame, TheField, FieldPtr ); RETURN FieldPtr^.GroupID; END ChoiceNumber; PROCEDURE CoordsInField( TheFrame: ScrnTypes.DisplayFrame; TheField, TheCol, TheRow: CARDINAL ): BOOLEAN; VAR c1, r1, c2, r2: CARDINAL; BEGIN c1 := VirtualFieldCol( TheFrame, TheField ); IF (TheCol < c1) THEN RETURN FALSE; END; r1 := VirtualFieldRow( TheFrame, TheField ); IF (TheRow < r1) THEN RETURN FALSE; END; c2 := c1 + FieldWidth( TheFrame, TheField ) - 1; IF (TheCol > c2) THEN RETURN FALSE; END; r2 := r1 + FieldHeight( TheFrame, TheField ) - 1; IF (TheRow > r2) THEN RETURN FALSE; END; RETURN TRUE; END CoordsInField; PROCEDURE CurrentField( TheFrame: ScrnTypes.DisplayFrame ): CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetFieldImagePtr( TheFrame, TheFrame^.CurrentField, ImagePtr ); (*Make sure the list pointers are correct.*) RETURN TheFrame^.CurrentField; END CurrentField; PROCEDURE DecodeByte( VAR AnyByte: SYSTEM.BYTE ); BEGIN IF CHAR(AnyByte) = 377C THEN AnyByte := SYSTEM.BYTE(0C); ELSIF CHAR(AnyByte) = 0C THEN ErrorNames.WarningName( 'EncodErr' ); END; END DecodeByte; PROCEDURE DecodeImageRec( VAR TheImageRec: ScrnTypes.ImageElement ); BEGIN DecodeWord( TheImageRec.row ); DecodeWord( TheImageRec.col ); DecodeWord( TheImageRec.field ); DecodeByte( TheImageRec.foreg ); DecodeByte( TheImageRec.backg ); DecodeByte( TheImageRec.atrb ); END DecodeImageRec; PROCEDURE DecodeWord( VAR AnyWord: SYSTEM.WORD ); VAR v: VariantType; BEGIN v.c := CARDINAL(AnyWord); IF Bit14 IN v.b THEN v.l := 0C; EXCL( v.b, Bit14 ); END; IF Bit15 IN v.b THEN v.h := 0C; END; AnyWord := SYSTEM.WORD(v.c); END DecodeWord; PROCEDURE EncodeByte( VAR AnyByte: SYSTEM.BYTE ); BEGIN IF CHAR(AnyByte) = 0C THEN AnyByte := SYSTEM.BYTE(377C); ELSIF CHAR(AnyByte) = 377C THEN ErrorNames.WarningName( 'EncodErr' ); END; END EncodeByte; PROCEDURE EncodeImageRec( VAR TheImageRec: ScrnTypes.ImageElement ); BEGIN EncodeWord( TheImageRec.row ); EncodeWord( TheImageRec.col ); EncodeWord( TheImageRec.field ); EncodeByte( TheImageRec.foreg ); EncodeByte( TheImageRec.backg ); EncodeByte( TheImageRec.atrb ); END EncodeImageRec; PROCEDURE EncodeWord( VAR AnyWord: SYSTEM.WORD ); VAR v: VariantType; BEGIN v.c := CARDINAL(AnyWord); IF v.c > 04000H THEN ErrorNames.WarningName( 'EncodErr' ); END; IF (v.h = 0C) THEN INCL( v.b, Bit15 ); END; IF (v.l = 0C) THEN INCL( v.b, Bit14 ); v.l := 377C; END; AnyWord := SYSTEM.WORD(v.c); END EncodeWord; PROCEDURE EntirelyVisible( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN; (* This procedure tells you whether TheField is entirely visible within TheFrame. *) VAR FirstVirtualColVisible, FirstVirtualRowVisible, VirtualPromptRow, LastVirtualColVisible, LastVirtualRowVisible, c1, r1, c2, r2: INTEGER; BEGIN c1 := INTEGER( VirtualFieldCol( TheFrame, TheField ) ); r1 := INTEGER( VirtualFieldRow( TheFrame, TheField ) ); c2 := c1 + INTEGER(FieldWidth( TheFrame, TheField )) - 1; r2 := r1 + INTEGER(FieldHeight( TheFrame, TheField )) - 1; FirstVirtualColVisible := INTEGER(TheFrame^.ColsScrolled) + 1; FirstVirtualRowVisible := (INTEGER(TheFrame^.RowsScrolled) + 1) + INTEGER(TheFrame^.headline); LastVirtualColVisible := TheFrame^.endcol - TheFrame^.startcol + 1 + TheFrame^.ColsScrolled; LastVirtualRowVisible := TheFrame^.endrow - TheFrame^.startrow + 1 + TheFrame^.RowsScrolled; IF BoxInFrame( TheFrame ) THEN (*There's a box in the window, so we have to adjust our numbers.*) IF TheFrame^.headline = 0 THEN (*But we don't have to adjust FirstVirtualRowVisible if there's a headline because we've added headline above, and the box takes up one of the lines in it.*) INC( FirstVirtualRowVisible ); END; INC( FirstVirtualColVisible ); DEC( LastVirtualRowVisible ); DEC( LastVirtualColVisible ); END; (*First determine whether it's entirely visible along its width.*) IF (c1 < FirstVirtualColVisible) OR (c2 > LastVirtualColVisible) THEN RETURN FALSE; END; (*Then determine whether it's entirely visible along its height.*) IF UserOps.DoPrompting THEN VirtualPromptRow := INTEGER(TheFrame^.RowsScrolled + UserOps.PromptRow) - INTEGER(TheFrame^.startrow); IF (r1 <= VirtualPromptRow) AND (r2 >= VirtualPromptRow) THEN RETURN FALSE; END; END; IF (r1 < FirstVirtualRowVisible) OR (r2 > LastVirtualRowVisible) THEN RETURN FALSE; END; RETURN TRUE; END EntirelyVisible; PROCEDURE FieldEntered( TheFrame: ScrnTypes.DisplayFrame; TheCol, TheRow: CARDINAL ): BOOLEAN; (*Scans the field list to determine whether these cursor coordinates are inside any field. If so, sets TheFrame^.CurrentField to the number of the entered field and returns TRUE.*) VAR cnt, ListEnd: CARDINAL; BEGIN cnt := 1; ListEnd := FieldListTotal( TheFrame ); LOOP IF cnt > ListEnd THEN RETURN FALSE; END; IF CoordsInField( TheFrame, cnt, TheCol, TheRow ) THEN TheFrame^.CurrentField := cnt; RETURN TRUE; END; INC( cnt ); END; END FieldEntered; PROCEDURE FieldGroupTotal( TheFrame: ScrnTypes.DisplayFrame ): CARDINAL; VAR ListEnd, ListCnt, GroupCnt: CARDINAL; FieldPtr: ScrnTypes.InputFieldPtr; BEGIN ListEnd := FieldListTotal( TheFrame ); ListCnt := 1; GroupCnt := 0; WHILE ListCnt <= ListEnd DO GetFieldPtr( TheFrame, ListCnt, FieldPtr ); IF (FieldPtr^.typ = ScrnTypes.DispCode) THEN (* Do nothing *) ELSIF (FieldPtr^.typ # ScrnTypes.GroupMember) THEN INC( GroupCnt ); ELSIF NOT (FieldPtr^.GroupID > 1) THEN INC( GroupCnt ); END; INC( ListCnt ); END; RETURN GroupCnt; END FieldGroupTotal; PROCEDURE FieldHeight( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr; BEGIN IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN GetFieldPtr( TheFrame, TheField, FieldPtr ); RETURN (FieldPtr^.Row2 - VirtualFieldRow( TheFrame, TheField) ) + 1; ELSE RETURN 1; END; END FieldHeight; PROCEDURE FieldImageNum( TheFrame: ScrnTypes.DisplayFrame; FieldNumber: CARDINAL ): CARDINAL; VAR ImagePtr: ScrnTypes.InputFieldPtr; BEGIN GetFieldPtr( TheFrame, FieldNumber, ImagePtr ); RETURN ImagePtr^.ImageNum; END FieldImageNum; PROCEDURE FieldIsBlank( TheFrame: ScrnTypes.DisplayFrame; FieldName: ARRAY OF CHAR; VAR FieldNumber: CARDINAL ): BOOLEAN; (*Pass this routine a DisplayFrame (normally this will be MainFrame) and a FieldName that appears somewhere in that frame, and it tells you whether the field is blank, and what its position is in the list of fields for the frame.*) VAR TmpPtr: ScrnTypes.InputFieldPtr; ImageRec: ScrnTypes.ImageElement; BEGIN IF NOT FindField( TheFrame, FieldName, TmpPtr, ImageRec ) THEN RETURN FALSE; END; FieldNumber := FieldNum( TheFrame, FieldName ); RETURN PosUtils.IsBlank( ImageRec.text ); END FieldIsBlank; PROCEDURE FieldListTotal( TheFrame: ScrnTypes.DisplayFrame ): CARDINAL; BEGIN IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN RETURN 0; ELSE RETURN GenLists.ListLength( TheFrame^.FieldList ); END; END FieldListTotal; PROCEDURE FieldWidth( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr; ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN GetFieldPtr( TheFrame, TheField, FieldPtr ); RETURN (FieldPtr^.Col2 - VirtualFieldCol( TheFrame, TheField) ) + 1; ELSE GetFieldImagePtr( TheFrame, TheField, ImagePtr ); RETURN M2Strings.Length( ImagePtr^.text ); END; END FieldWidth; PROCEDURE FieldType( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ): CHAR; VAR FieldPtr: ScrnTypes.InputFieldPtr; BEGIN GetFieldPtr( TheFrame, FieldNum, FieldPtr ); RETURN FieldPtr^.typ; END FieldType; PROCEDURE FindField( TheFrame: ScrnTypes.DisplayFrame; FieldName: ARRAY OF CHAR; VAR FieldPtr: ScrnTypes.InputFieldPtr; VAR ImageRec: ScrnTypes.ImageElement ): BOOLEAN; VAR spot : CARDINAL; BEGIN spot := FieldNum( TheFrame, FieldName ); IF spot = 0 THEN RETURN FALSE; ELSE RETURN FindFieldNum( TheFrame, spot, FieldPtr, ImageRec ); END; END FindField; PROCEDURE FindFieldNum( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr; VAR ImageRec: ScrnTypes.ImageElement ): BOOLEAN; BEGIN IF FieldNum > FieldListTotal(TheFrame) THEN RETURN FALSE; END; GetFieldPtr( TheFrame, FieldNum, FieldPtr ); GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec ); RETURN TRUE; END FindFieldNum; PROCEDURE FirstMember( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): CARDINAL; (* Pass this routine any field number that's a GroupMember, and it returns the number of the first field in the group. To be called only for GroupMember fields. *) VAR TmpPtr: ScrnTypes.InputFieldPtr; FieldNum: CARDINAL; BEGIN FieldNum := TheField; GetFieldPtr( TheFrame, FieldNum, TmpPtr ); WHILE TmpPtr^.GroupID > 1 DO DEC( FieldNum ); GetFieldPtr( TheFrame, FieldNum, TmpPtr ); END; RETURN FieldNum; END FirstMember; PROCEDURE GetCardField( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR TheCard: CARDINAL ); VAR tmpstr: ARRAY [0..79] OF CHAR; BEGIN GetFieldText( TheFrame, TheField, tmpstr ); IF NOT StrConv.StrToCardinal( tmpstr, 0, TheCard ) THEN TheCard := 0; END; END GetCardField; PROCEDURE GetEdField( FrameRec: ScrnTypes.DisplayFrame; FieldNum: CARDINAL; VAR TheList: GenLists.GenList ); VAR TmpRec: ScrnTypes.InputFieldRecord; BEGIN GetFieldRec( FrameRec, FieldNum, TmpRec ); IF TmpRec.typ = ScrnTypes.EditorCode THEN GenLists.GetChildList( FrameRec^.EdFieldList, TmpRec.EdFieldNum, TheList ); ELSE ErrorNames.WarningName( 'BadFld' ); END; END GetEdField; PROCEDURE GetEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum: CARDINAL; VAR TheList: GenLists.GenList; VAR Rec: VEditor.AnEdControlRec ); VAR FieldRec: ScrnTypes.InputFieldRecord; ImageRec: ScrnTypes.ImageElement; BEGIN GetFieldRec( FrameRec, FieldNum, FieldRec ); GetFieldImageRec( FrameRec, FieldNum, ImageRec ); IF FieldRec.typ # ScrnTypes.EditorCode THEN ErrorNames.WarningName( 'BadFld' ); RETURN; END; GenLists.GetChildList( FrameRec^.EdFieldList, FieldRec.EdFieldNum, TheList ); VEditor.InitEdRec( Rec ); Rec.Col1 := ImageRec.col + FrameRec^.startcol - FrameRec^.ColsScrolled; Rec.Row1 := ImageRec.row + FrameRec^.startrow - FrameRec^.RowsScrolled; Rec.Col2 := FieldRec.Col2 + FrameRec^.startcol - FrameRec^.ColsScrolled; Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow - FrameRec^.RowsScrolled; (*We adjust the col and row coordinates to absolute window coordinates.*) Rec.TextRow1 := FieldRec.TextRow1; Rec.CursorCol := FieldRec.CursorCol; Rec.CursorRow := FieldRec.CursorRow; Rec.MaxLines := FieldRec.MaxLines; Rec.ChangeMade := FieldRec.ChangeMade; Rec.ReadOnly := FieldRec.ReadOnly; Rec.FrameRec := FrameRec; WITH FrameRec^ DO (* set colors to pointer bar *) Rec.EntryForeColor := pbfor; Rec.EntryBackColor := pbbak; Rec.EntryAttrib := pbatrb; END; Rec.ExitForeColor := ImageRec.foreg; Rec.ExitBackColor := ImageRec.backg; Rec.ExitAttrib := ImageRec.atrb; Rec.EntryBox := 0; Rec.ExitBox := 0; Rec.DoCounting := FALSE; Rec.Col2 := FieldRec.Col2 + FrameRec^.startcol -FrameRec^.ColsScrolled; Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow - FrameRec^.RowsScrolled END GetEdRec; PROCEDURE GetFrameLinks( FrameRec: ScrnTypes.DisplayFrame; VAR FrameAbove, FrameBelow, FrameLeft, FrameRight: ScrnTypes.AFrameName ); VAR lngth : CARDINAL; BEGIN FrameAbove[0] := 0C; FrameBelow[0] := 0C; FrameLeft[0] := 0C; FrameRight[0] := 0C; IF NOT GenLists.Initialized( FrameRec^.LinkedFrames ) THEN RETURN; END; lngth := GenLists.ListLength( FrameRec^.LinkedFrames ); IF lngth >= 1 THEN ListUtils.GetStr( FrameRec^.LinkedFrames, 1, FrameAbove ); END; IF lngth >= 2 THEN ListUtils.GetStr( FrameRec^.LinkedFrames, 2, FrameBelow ); END; IF lngth >= 3 THEN ListUtils.GetStr( FrameRec^.LinkedFrames, 3, FrameLeft ); END; IF lngth >= 4 THEN ListUtils.GetStr( FrameRec^.LinkedFrames, 4, FrameRight ); END; END GetFrameLinks; PROCEDURE GetFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame ); BEGIN GenLists.GetChildList( TheFrame^.self, 5, TheFrame^.DataList ); GenLists.GetChildList( TheFrame^.self, 6, TheFrame^.PromptList ); GenLists.GetChildList( TheFrame^.self, 7, TheFrame^.HelpList ); GenLists.GetChildList( TheFrame^.self, 8, TheFrame^.EdFieldList ); GenLists.GetChildList( TheFrame^.self, 9, TheFrame^.FieldList ); GenLists.GetChildList( TheFrame^.self, 10, TheFrame^.ImageList ); GenLists.GetChildList( TheFrame^.self, 11, TheFrame^.LinkedFrames ); END GetFrameLists; PROCEDURE GetFieldDataList( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR FieldDataList: GenLists.GenList ): BOOLEAN; VAR FieldPtr: ScrnTypes.InputFieldPtr; TmpList: GenLists.GenList; cnt1, TypeCode : CARDINAL; FieldDataListFound : BOOLEAN; TmpName: ARRAY [0..79] OF CHAR; BEGIN GenLists.NilList( FieldDataList ); IF NOT GenLists.Initialized( TheFrame^.DataList ) THEN RETURN FALSE; END; FieldDataListFound := FALSE; GetFieldPtr( TheFrame, TheField, FieldPtr ); cnt1 := GenLists.ListLength( TheFrame^.DataList ); WHILE (cnt1 > 1) AND (NOT FieldDataListFound) DO IF ListUtils.TypeCheck(TheFrame^.DataList,cnt1)=GenLists.ListCode THEN GenLists.GetElmt( TheFrame^.DataList, cnt1 - 1, TmpName, TypeCode ); IF PosUtils.Equal( TmpName, FieldPtr^.fnam ) THEN GenLists.GetChildList( TheFrame^.DataList, cnt1, FieldDataList ); FieldDataListFound := TRUE; DEC( cnt1 ); (* skip over the field name *) END; END; DEC( cnt1 ); END; RETURN FieldDataListFound; END GetFieldDataList; PROCEDURE GetFieldImagePtr( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr ); VAR FieldPtr: ScrnTypes.InputFieldPtr; BEGIN GetFieldPtr( TheFrame, TheField, FieldPtr ); GetImagePtr( TheFrame, FieldPtr^.ImageNum, ImagePtr ); END GetFieldImagePtr; PROCEDURE GetFieldImageRec( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement ); VAR FieldPtr: ScrnTypes.InputFieldPtr; BEGIN GetFieldPtr( TheFrame, TheField, FieldPtr ); GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec ); END GetFieldImageRec; PROCEDURE GetFieldPtr( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr ); VAR TmpSize, TypeCode: CARDINAL; BEGIN GenLists.GetElmtAdr( TheFrame^.FieldList, TheField, FieldPtr, TmpSize, TypeCode ); END GetFieldPtr; PROCEDURE GetFieldRec( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR FieldRec: ScrnTypes.InputFieldRecord ); VAR TypeCode: CARDINAL; BEGIN GenLists.GetElmt( TheFrame^.FieldList, TheField, FieldRec, TypeCode ); END GetFieldRec; PROCEDURE GetFieldText( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR TheText: ARRAY OF CHAR ); VAR ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetFieldImagePtr( TheFrame, TheField, ImagePtr ); M2Strings.Assign( ImagePtr^.text, TheText ); END GetFieldText; PROCEDURE GetImagePtr( TheFrame: ScrnTypes.DisplayFrame; ImageNum: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr ); VAR TmpSize, TypeCode: CARDINAL; BEGIN GenLists.GetElmtAdr( TheFrame^.ImageList, ImageNum, ImagePtr, TmpSize, TypeCode ); END GetImagePtr; PROCEDURE GetImageRec( TheFrame: ScrnTypes.DisplayFrame; ImageNum: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement ); VAR TypeCode: CARDINAL; BEGIN GenLists.GetElmt( TheFrame^.ImageList, ImageNum, ImageRec, TypeCode ); DecodeImageRec( ImageRec ); END GetImageRec; PROCEDURE GetIntField( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR TheInt: INTEGER ); VAR tmpstr: ARRAY [0..79] OF CHAR; BEGIN GetFieldText( TheFrame, TheField, tmpstr ); IF NOT StrConv.StrToInteger( tmpstr, 0, TheInt ) THEN TheInt := 0; END; END GetIntField; PROCEDURE GetLongIntField( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR TheLongInt: LONGINT ); VAR tmpstr: ARRAY [0..79] OF CHAR; BEGIN GetFieldText( TheFrame, TheField, tmpstr ); IF NOT StrConv.StrToLongInteger( tmpstr, 0, TheLongInt ) THEN TheLongInt := NumTypes.L0; END; END GetLongIntField; PROCEDURE GetVisibleArea( TheFrame: ScrnTypes.DisplayFrame; VAR VisibleArea: Rectangles.ARectangle ); (* Gets physical screen coordinates of visible part of frame. *) BEGIN Rectangles.DefineRectangle( VisibleArea, TheFrame^.startcol, TheFrame^.startrow, TheFrame^.endcol, TheFrame^.endrow ); INC( VisibleArea.col1 ); INC( VisibleArea.row1 ); INC( VisibleArea.col2 ); INC( VisibleArea.row2 ); IF BoxInFrame( TheFrame ) THEN INC( VisibleArea.col1 ); INC( VisibleArea.row1 ); DEC( VisibleArea.col2 ); DEC( VisibleArea.row2 ); END; IF UserOps.DoPrompting AND ((INTEGER(UserOps.PromptRow) = VisibleArea.row2) OR (INTEGER(UserOps.PromptRow) = VisibleArea.row2 - 1)) THEN VisibleArea.row2 := UserOps.PromptRow - 1; END; END GetVisibleArea; PROCEDURE InputFieldsAbove( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN; (*We use this to determine whether a scrolling window ought to be scrolled all the way to the top of the frame--it should if there are no input fields above it.*) VAR SavedRow: CARDINAL; BEGIN SavedRow := VirtualFieldRow( TheFrame, TheField ); DEC( TheField ); LOOP IF TheField = 0 THEN RETURN FALSE; ELSIF SavedRow > VirtualFieldRow( TheFrame, TheField ) THEN IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN RETURN TRUE; END; END; DEC( TheField ); END; END InputFieldsAbove; PROCEDURE InputFieldsBelow( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN; VAR ListEnd, SavedRow : CARDINAL; BEGIN SavedRow := VirtualFieldRow( TheFrame, TheField ); ListEnd := FieldListTotal( TheFrame ); INC( TheField ); LOOP IF TheField > ListEnd THEN RETURN FALSE; ELSIF SavedRow < VirtualFieldRow( TheFrame, TheField ) THEN IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN RETURN TRUE; END; END; INC( TheField ); END; END InputFieldsBelow; PROCEDURE InputFieldsToLeft( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN; VAR SavedCol : CARDINAL; BEGIN SavedCol := VirtualFieldCol( TheFrame, TheField ); DEC( TheField ); LOOP IF TheField = 0 THEN RETURN FALSE; ELSIF SavedCol > VirtualFieldCol( TheFrame, TheField ) THEN IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN RETURN TRUE; END; END; DEC( TheField ); END; END InputFieldsToLeft; PROCEDURE InputFieldsToRight( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN; VAR ListEnd, SavedCol : CARDINAL; BEGIN SavedCol := VirtualFieldCol( TheFrame, TheField ); ListEnd := FieldListTotal( TheFrame ); INC( TheField ); LOOP IF TheField > ListEnd THEN RETURN FALSE; ELSIF SavedCol < VirtualFieldCol( TheFrame, TheField ) THEN IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN RETURN TRUE; END; END; INC( TheField ); END; END InputFieldsToRight; PROCEDURE ListFromEdField( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; VAR TheList: GenLists.GenList ): BOOLEAN; VAR FieldRec: ScrnTypes.InputFieldRecord; BEGIN GetFieldRec( TheFrame, TheField, FieldRec ); IF (FieldRec.typ = ScrnTypes.EditorCode) AND (FieldRec.EdFieldNum > 0) THEN GenLists.GetChildList( TheFrame^.EdFieldList, FieldRec.EdFieldNum, TheList ); RETURN GenLists.Initialized( TheList); ELSE RETURN FALSE; END; END ListFromEdField; PROCEDURE ListToEdField( TheList: GenLists.GenList; TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN; VAR FieldRec: ScrnTypes.InputFieldRecord; BEGIN GetFieldRec( TheFrame, TheField, FieldRec ); IF (FieldRec.typ = ScrnTypes.EditorCode) AND (FieldRec.EdFieldNum > 0) THEN GenLists.ListReplace( TheList, GenLists.ListCode, TheFrame^.EdFieldList, FieldRec.EdFieldNum ); RETURN TRUE; ELSE RETURN FALSE; END; END ListToEdField; PROCEDURE MakeFieldDataList( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL; FieldDataList: GenLists.GenList ); VAR TmpList: GenLists.GenList; FieldPtr: ScrnTypes.InputFieldPtr; BEGIN IF NOT GetFieldDataList( TheFrame, TheField, TmpList ) THEN GetFieldPtr( TheFrame, TheField, FieldPtr ); GenLists.ListInsert( FieldPtr^.fnam, GenLists.StrCode, TheFrame^.DataList, AfterLastElmt ); GenLists.ListInsert( FieldDataList, GenLists.ListCode, TheFrame^.DataList, AfterLastElmt ); END; END MakeFieldDataList; PROCEDURE NumberOfChoices( TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ): CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr; BEGIN GetFieldPtr( TheFrame, TheField, FieldPtr ); RETURN FieldPtr^.GroupSize; END NumberOfChoices; PROCEDURE NumberOfImages( TheFrame: ScrnTypes.DisplayFrame ): CARDINAL; BEGIN IF NOT GenLists.Initialized( TheFrame^.ImageList ) THEN RETURN 0; ELSE RETURN GenLists.ListLength( TheFrame^.ImageList ); END; END NumberOfImages; PROCEDURE FieldNum( TheFrame: ScrnTypes.DisplayFrame; FieldName: ARRAY OF CHAR ): CARDINAL; (*Takes a field name and returns its number; 0 means name not found.*) VAR ListEnd, cnt : CARDINAL; msg: ARRAY [0..79] OF CHAR; TmpPtr: ScrnTypes.InputFieldPtr; BEGIN StrEdit.CAPstr(FieldName); (* make search case-insensitive *) StrEdit.DeleteChar( ' ', FieldName ); (*Delete all blanks from FieldName--ScreenCompile deletes them from the actual field names.*) cnt := 1; ListEnd := FieldListTotal( TheFrame ); WHILE cnt <= ListEnd DO GetFieldPtr( TheFrame, cnt, TmpPtr ); IF PosUtils.Equal( FieldName, TmpPtr^.fnam ) THEN TheFrame^.CurrentField := cnt; RETURN cnt; ELSE INC( cnt ); END; END; (* Commented out on 6 Dec 88. StrEdit.AssignStr( ' is not a field in frame ', msg ); StrEdit.Append( msg, TheFrame^.ThisFrame ); M2Strings.Insert( FieldName, msg, 0 ); IF TheFrame^.FromFile # NIL THEN StrEdit.Append( msg, ' of file ' ); StrEdit.Append( msg, TheFrame^.FromFile^.name ); END; ErrorManager.WARN( msg ); *) RETURN 0; END FieldNum; PROCEDURE PartOutside( FrameRec: ScrnTypes.DisplayFrame; VAR VisibleArea: Rectangles.ARectangle; direction: VWindows.Compass ): CARDINAL; VAR height, width, VHeight : CARDINAL; BEGIN height := (VisibleArea.row2 - VisibleArea.row1) + 1; width := (VisibleArea.col2 - VisibleArea.col1) + 1; CASE direction OF VWindows.South: WITH FrameRec^ DO IF NOT BoxInFrame(FrameRec) THEN VHeight := VirtualHeight - headline ELSIF headline = 0 THEN (* compensate for bottom line of box *) VHeight := VirtualHeight - 1; ELSE (* compensation for top and bottom lines of box cancel *) VHeight := VirtualHeight - headline; END (* if no box *); IF (VHeight - RowsScrolled) <= height THEN RETURN 0; ELSE RETURN (VHeight - height) - RowsScrolled; END; END (* with FrameRec^ *); | VWindows.North: RETURN FrameRec^.RowsScrolled; | VWindows.East: IF (FrameRec^.VirtualWidth - FrameRec^.ColsScrolled) <= width THEN RETURN 0; END; RETURN (FrameRec^.VirtualWidth - width) - FrameRec^.ColsScrolled; | VWindows.West: RETURN FrameRec^.ColsScrolled; END; RETURN 0; END PartOutside; PROCEDURE PutEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum: CARDINAL; VAR TheList: GenLists.GenList; VAR Rec: VEditor.AnEdControlRec ); (*Note that this does not update the column and row coordinates stored in the field list and image list. That's intentional. The EdControlRec has to have absolute window coordinates, not frame-relative coordinates.*) VAR FieldRec: ScrnTypes.InputFieldRecord; BEGIN GetFieldRec( FrameRec, FieldNum, FieldRec ); IF FieldRec.typ # ScrnTypes.EditorCode THEN ErrorNames.WarningName( 'BadFld' ); RETURN; END; GenLists.ListReplace( TheList, GenLists.ListCode, FrameRec^.EdFieldList, FieldRec.EdFieldNum ); FieldRec.TextRow1 := Rec.TextRow1; FieldRec.CursorCol := Rec.CursorCol; FieldRec.CursorRow := Rec.CursorRow; FieldRec.MaxLines := Rec.MaxLines; FieldRec.ChangeMade := Rec.ChangeMade; FieldRec.ReadOnly := Rec.ReadOnly; PutFieldRec( FieldRec, FrameRec, FieldNum ); END PutEdRec; PROCEDURE PutFieldImageRec( ImageRec: ScrnTypes.ImageElement; VAR TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ); BEGIN EncodeImageRec( ImageRec ); GenLists.ListReplace( ImageRec, GenLists.StrCode, TheFrame^.ImageList, FieldImageNum(TheFrame, TheField) ); END PutFieldImageRec; PROCEDURE PutFieldRec( VAR FieldRec: ScrnTypes.InputFieldRecord; VAR TheFrame: ScrnTypes.DisplayFrame; TheField: CARDINAL ); VAR cnt, ImageListEnd: CARDINAL; ImageRec: ScrnTypes.ImageElement; BEGIN IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN GenLists.NewList( TheFrame^.FieldList ); PutFrameLists( TheFrame ); (* Make sure the new FieldList gets inserted into TheFrame's .self list. *) END; IF TheField <= GenLists.ListLength( TheFrame^.FieldList ) THEN GenLists.ListReplace( FieldRec, ScrnTypes.FieldTypeCode, TheFrame^.FieldList, TheField ); ELSE GenLists.ListInsert( FieldRec, ScrnTypes.FieldTypeCode, TheFrame^.FieldList, TheField ); (* Now everything in the ImageList with a FieldNum greater than or equal to TheField has to have its field number incremented. *) ImageListEnd := NumberOfImages( TheFrame ); FOR cnt := 1 TO ImageListEnd DO GetImageRec( TheFrame, cnt, ImageRec ); IF ImageRec.field > TheField THEN INC( ImageRec.field ); EncodeImageRec( ImageRec ); GenLists.ListReplace( ImageRec, GenLists.StrCode, TheFrame^.ImageList, cnt ); END; END; END; END PutFieldRec; PROCEDURE PutFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame ); BEGIN GenLists.ListReplace( TheFrame^.DataList, GenLists.ListCode, TheFrame^.self, 5 ); GenLists.ListReplace( TheFrame^.PromptList, GenLists.ListCode, TheFrame^.self, 6 ); GenLists.ListReplace( TheFrame^.HelpList, GenLists.ListCode, TheFrame^.self, 7 ); GenLists.ListReplace( TheFrame^.EdFieldList, GenLists.ListCode, TheFrame^.self, 8 ); GenLists.ListReplace( TheFrame^.FieldList, GenLists.ListCode, TheFrame^.self, 9 ); GenLists.ListReplace( TheFrame^.ImageList, GenLists.ListCode, TheFrame^.self, 10 ); GenLists.ListReplace( TheFrame^.LinkedFrames, GenLists.ListCode, TheFrame^.self, 11 ); END PutFrameLists; PROCEDURE RelativeFieldCol( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ): CARDINAL; VAR vcol : CARDINAL; BEGIN vcol := VirtualFieldCol( TheFrame, FieldNum ); (* IF vcol < TheFrame^.ColsScrolled THEN Diagnostics.diagC( 'Scrolling error. vcol', vcol ); END; *) RETURN vcol - TheFrame^.ColsScrolled; END RelativeFieldCol; PROCEDURE RelativeFieldRow( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ): CARDINAL; VAR vrow : CARDINAL; BEGIN vrow := VirtualFieldRow( TheFrame, FieldNum ); (* IF vrow < TheFrame^.RowsScrolled THEN Diagnostics.diagC( 'Scrolling error. RowsScrolled', TheFrame^.RowsScrolled ); Diagnostics.diagC( 'Scrolling error. vrow', vrow ); END; *) RETURN vrow - TheFrame^.RowsScrolled; END RelativeFieldRow; PROCEDURE ResetFieldPtr( VAR TheFrame: ScrnTypes.DisplayFrame); VAR dumptr: ScrnTypes.InputFieldPtr; BEGIN TheFrame^.CurrentField := 0; GetFieldPtr( TheFrame, 1, dumptr ); END ResetFieldPtr; PROCEDURE SelectedChar( TheFrame: ScrnTypes.DisplayFrame ): CHAR; VAR FieldRec: ScrnTypes.InputFieldRecord; BEGIN GetFieldRec( TheFrame, TheFrame^.CurrentField, FieldRec ); IF FieldRec.typ = ScrnTypes.GotoCode THEN IF FieldRec.MenuKey <= 255 THEN RETURN CHR(FieldRec.MenuKey); END; ELSIF FieldRec.typ = ScrnTypes.GroupMember THEN IF FieldRec.ChoiceKey <= 255 THEN RETURN CHR(FieldRec.ChoiceKey); END; END; RETURN 0C; END SelectedChar; PROCEDURE SetBorderColors( TheFrame: ScrnTypes.DisplayFrame ); BEGIN VWindows.SetForeColor( TheFrame^.WindowHandle, TheFrame^.bordfor ); VWindows.SetBackColor( TheFrame^.WindowHandle, TheFrame^.bordbak ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, TheFrame^.bordatrb ); END SetBorderColors; PROCEDURE SetCurrentField( VAR TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ); VAR ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN IF (FieldNum < 1) OR (FieldNum > FieldListTotal(TheFrame)) THEN RETURN; END; GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); (*Make sure the list pointers are correct.*) TheFrame^.CurrentField := FieldNum; END SetCurrentField; PROCEDURE SetFieldColors( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ); VAR ImageRec: ScrnTypes.ImageElement; BEGIN GetFieldImageRec( TheFrame, FieldNum, ImageRec ); VWindows.SetForeColor( TheFrame^.WindowHandle, ImageRec.foreg ); VWindows.SetBackColor( TheFrame^.WindowHandle, ImageRec.backg ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, ImageRec.atrb ); END SetFieldColors; PROCEDURE SetMessageColors( TheFrame: ScrnTypes.DisplayFrame ); BEGIN VWindows.SetForeColor( TheFrame^.WindowHandle, TheFrame^.msgfor ); VWindows.SetBackColor( TheFrame^.WindowHandle, TheFrame^.msgbak ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, TheFrame^.msgatrb ); END SetMessageColors; PROCEDURE SetNormalColors( TheFrame: ScrnTypes.DisplayFrame ); BEGIN VWindows.SetForeColor( TheFrame^.WindowHandle, TheFrame^.normfor ); VWindows.SetBackColor( TheFrame^.WindowHandle, TheFrame^.normbak ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, TheFrame^.normatrb ); END SetNormalColors; PROCEDURE SetPointerBarColors( TheFrame: ScrnTypes.DisplayFrame ); BEGIN VWindows.SetForeColor( TheFrame^.WindowHandle, TheFrame^.pbfor ); VWindows.SetBackColor( TheFrame^.WindowHandle, TheFrame^.pbbak ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, TheFrame^.pbatrb ); END SetPointerBarColors; PROCEDURE SetPromptColors( TheFrame: ScrnTypes.DisplayFrame ); BEGIN VWindows.SetForeColor( TheFrame^.WindowHandle, TheFrame^.promfor ); VWindows.SetBackColor( TheFrame^.WindowHandle, TheFrame^.prombak ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, TheFrame^.promatrb ); END SetPromptColors; PROCEDURE SetSelCharColors( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ); VAR fore : MsColors.AColor; attr : MsColors.AMonoAttribute; ImageRec: ScrnTypes.ImageElement; BEGIN GetFieldImageRec( TheFrame, FieldNum, ImageRec ); CASE ORD(ImageRec.foreg) OF 0, 3 : fore := MsColors.red; | 1, 2, 4..7 : fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) + 8) ); | 8..15: fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) - 1) ); END; IF ImageRec.atrb # MsColors.bold THEN attr := MsColors.bold; ELSE attr := MsColors.plain; END; IF fore = TheFrame^.pbbak THEN IF fore <= 2C THEN fore := CHR( ORD(fore) + 3 ); ELSE fore := CHR( ORD(fore) - 3 ); END; END; VWindows.SetForeColor( TheFrame^.WindowHandle, fore ); VWindows.SetBackColor( TheFrame^.WindowHandle, ImageRec.backg ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, attr ); END SetSelCharColors; PROCEDURE SetSelectionColors( TheFrame: ScrnTypes.DisplayFrame ); BEGIN VWindows.SetForeColor( TheFrame^.WindowHandle, TheFrame^.selfor ); VWindows.SetBackColor( TheFrame^.WindowHandle, TheFrame^.selbak ); VWindows.SetMonoAttr( TheFrame^.WindowHandle, TheFrame^.selatrb ); END SetSelectionColors; PROCEDURE VirtualFieldCol( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ): CARDINAL; VAR tmp: CARDINAL; ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); tmp := ImagePtr^.col; DecodeWord( tmp ); RETURN tmp; END VirtualFieldCol; PROCEDURE VirtualFieldRow( TheFrame: ScrnTypes.DisplayFrame; FieldNum: CARDINAL ): CARDINAL; VAR tmp: CARDINAL; ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetFieldImagePtr( TheFrame, FieldNum, ImagePtr ); tmp := ImagePtr^.row; DecodeWord( tmp ); RETURN tmp; END VirtualFieldRow; PROCEDURE VirtualImageCol( TheFrame: ScrnTypes.DisplayFrame; ImageNum: CARDINAL ): CARDINAL; VAR tmp: CARDINAL; ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetImagePtr( TheFrame, ImageNum, ImagePtr ); tmp := ImagePtr^.col; DecodeWord( tmp ); RETURN tmp; END VirtualImageCol; PROCEDURE VirtualImageRow( TheFrame: ScrnTypes.DisplayFrame; ImageNum: CARDINAL ): CARDINAL; VAR tmp: CARDINAL; ImagePtr: ScrnTypes.ImageElmtPtr; BEGIN GetImagePtr( TheFrame, ImageNum, ImagePtr ); tmp := ImagePtr^.row; DecodeWord( tmp ); RETURN tmp; END VirtualImageRow; PROCEDURE WhichChoiceKey( TheFrame: ScrnTypes.DisplayFrame; OneOfTheFields: CARDINAL ): CARDINAL; VAR TmpPtr: ScrnTypes.InputFieldPtr; FieldNum: CARDINAL; BEGIN IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN RETURN 0; END; FieldNum := FirstMember( TheFrame, OneOfTheFields ); REPEAT GetFieldPtr( TheFrame, FieldNum, TmpPtr ); IF TmpPtr^.selected THEN RETURN TmpPtr^.ChoiceKey; ELSE INC( FieldNum ); END; UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize; RETURN 0; END WhichChoiceKey; PROCEDURE WhichChoiceNum( TheFrame: ScrnTypes.DisplayFrame; OneOfTheFields: CARDINAL ): CARDINAL; VAR TmpPtr: ScrnTypes.InputFieldPtr; FieldNum: CARDINAL; BEGIN IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN RETURN 0; END; FieldNum := FirstMember( TheFrame, OneOfTheFields ); REPEAT GetFieldPtr( TheFrame, FieldNum, TmpPtr ); IF TmpPtr^.selected THEN RETURN TmpPtr^.GroupID; ELSE INC( FieldNum ); END; UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize; RETURN FirstMember( TheFrame, OneOfTheFields ); END WhichChoiceNum; PROCEDURE WriteBetween( TheWindow: VWindows.AWindowHandle; TheStr: ARRAY OF CHAR; col1, row1, col2, row2: CARDINAL ); (*Used for writing centered captions on frame borders.*) VAR lngth, width: CARDINAL; BEGIN lngth := M2Strings.Length( TheStr ); width := (col2 - col1) - 1; IF lngth > width THEN StrEdit.SetLength( TheStr, width ); lngth := width; END; VWindows.DrawStr( TheWindow, col1 + ((width - lngth) DIV 2) + 1, row1, SYSTEM.ADR(TheStr), lngth ); END WriteBetween; PROCEDURE WriteScrollMarks( TheFrame: ScrnTypes.DisplayFrame ); BEGIN WITH TheFrame^ DO IF NOT BoxInFrame( TheFrame ) THEN (*There's no box around the window, so we don't have any place to put our scroll marks.*) RETURN; END; IF (VirtualHeight > (endrow - startrow) + 1) THEN VWindows.SetScrollRange( TheFrame^.WindowHandle, VWindows.SbVert, TheFrame^.startrow + 1, TheFrame^.endrow + 1 ); VWindows.SetScrollPos( TheFrame^.WindowHandle, VWindows.SbVert, TheFrame^.RowsScrolled ); END; IF (VirtualWidth > (endcol - startcol) + 1) THEN VWindows.SetScrollRange( TheFrame^.WindowHandle, VWindows.SbHorz, TheFrame^.startcol + 1, TheFrame^.endcol + 1 ); VWindows.SetScrollPos( TheFrame^.WindowHandle, VWindows.SbHorz, TheFrame^.ColsScrolled ); END; (*If neither of the two preceding IF's were executed, the frame fits entirely within the window; no need to write scroll marks.*) END; END WriteScrollMarks; BEGIN Initialized := FALSE; Init(); END ScrnUtl1.