Power-Programmierung/CD1.mdf/pascal/library/dos/help/tphelp/tphelp.pas

Pascal/Delphi Source File | 1988-02-07 | 22.9 KB | 780 lines

{TPHELP.PAS Copyright (C) 1988, by TurboPower Software}

{$R-,S-,I-}

{Activate the following define if you have the TPPICK unit}
{ $DEFINE UsingPickUnit}

Unit TpHelp;
  {-General purpose help facility}

Interface

Uses
  Dos,
  TPDos,
  TPString,
  TPCrt,
  TPWindow
  {$IFDEF UsingPickUnit}
  , TpPick
  {$ENDIF}
  ;

CONST
  HelpId : ARRAY[0..3] OF CHAR = 'TPH0'; {Identifier at start of help file}
  NoHelpAvailable = $FFFFFFFF;    {Flag that no help is available for topic}
  MaxPagesPerSection = 21;        {Maximum number of pages of help per section}
  Attr1Toggle    = ^A;            {Character toggles special attribute 1}
  Attr2Toggle    = ^B;            {Character toggles special attribute 2}
  Attr3Toggle    = ^C;            {Character toggles special attribute 3}
  LineBrkMark    = ^M;            {Denotes end of line of help}
  PageBrkMark    = ^L;            {Denotes end of page of help}
  SectEndMark    = #0;            {Denotes end of help section}
  PickTitle : STRING[80] = ' Topics ';

TYPE
  HelpAttrType   = (FrAttr, TeAttr, HeAttr, SpAtt1, SpAtt2, SpAtt3);
  HelpAttrArray  = ARRAY[HelpAttrType] OF Byte;
  HelpAttrState  = ARRAY[SpAtt1..SpAtt3] OF BOOLEAN;
  HelpHeader =
    RECORD
      ID             : LongInt;   {Marks file as help file}
      MaxSection     : Word;      {Size of largest help section in bytes}
      ItemCnt        : Word;      {Number of help entries in index}
      NameSize       : Byte;      {Size of each entry in pick table, 0 for none}
      Width          : Byte;      {Width of help window, with frame}
    END;
  CharArray      = ARRAY[0..64000] OF CHAR; {List of names of help entries}
  HelpIndex      = ARRAY[1..16000] OF LongInt; {Index of file positions}
  CharArrayPtr   = ^CharArray;
  HelpIndexPtr   = ^HelpIndex;
  HelpHeaderPtr  = ^HelpHeader;

  HelpPtr        = ^HelpDesc;     {The user hook to the help system}
  HelpDesc =                      {Holds parameters of help system}
    RECORD
      RowH           : Byte;      {Upper left corner of help window - Row}
      ColH           : Byte;      {Upper left corner of help window - Col}
      CAttr          : HelpAttrArray; {Attributes used to draw help in color}
      MAttr          : HelpAttrArray; {Attributes used to draw help in monoc}
      Frame          : FrameArray; {Frame characters to use}
      Hdr            : HelpHeader; {Copy of header for fast reference}
      Height         : Byte;      {Height of help window, with frame}
      CASE InRAM     : BOOLEAN OF {True if help file is bound into code}
        TRUE :
          (HdrP           : HelpHeaderPtr; {Points to base of structure in RAM}
           NamP           : CharArrayPtr; {Points to pick name array in RAM}
           IndP           : HelpIndexPtr); {Points to help section index in RAM}
        FALSE :
          (Open           : BOOLEAN; {True when file is open}
           BufP           : CharArrayPtr; {Points to a buffer that will hold largest section}
           Fil            : FILE); {Untyped file variable for help}
    END;

CONST
  {Default help colors}
  HelpColorAttr : HelpAttrArray = ($71, $30, $71, $1F, $3E, $31);
  HelpMonocAttr : HelpAttrArray = ($07, $07, $0F, $70, $0F, $01);

  {Context sensitive help}
  CurrentTopic : Word = 0;        {Current help topic}
  HelpIntInstalled : BOOLEAN = FALSE; {True if interrupt handler installed}

FUNCTION OpenHelpFile(HelpFileName   : STRING;
                      XLow, YLow, YHigh : Byte;
                      VAR Help : HelpPtr) : Word;
  {-Find and open help file, returning 0 or error code, and
    an initialized help descriptor if successful}

FUNCTION OpenHelpMem(HPtr           : Pointer;
                     XLow, YLow, YHigh : Byte;
                     VAR Help : HelpPtr) : Word;
  {-Initialize help descriptor for a help structure bound into code}

PROCEDURE SetHelpPos(Help : HelpPtr; XLow, YLow, YHigh : Byte);
  {-Change the position and height of a help window}

FUNCTION ShowHelp(Help : HelpPtr; Item : Word) : BOOLEAN;
  {-Display help screen, returning true if successful}

FUNCTION ShowHelpByName(Help : HelpPtr; Name : STRING) : BOOLEAN;
  {-Display help screen for topic with pick name Name}

  {$IFDEF UsingPickUnit}
FUNCTION PickHelp(Help : HelpPtr; XLow, YLow, YHigh, PickCols : Byte) : Word;
  {-Display help pick list, returning Item number, or 0 for none}
  {$ENDIF}

PROCEDURE SetContextHelp(Help : HelpPtr; Key : Word);
  {-Install a keyboard interrupt handler to pop help when Key is pressed}

PROCEDURE RemoveHelp;
  {-Deinstall context sensitive help}

  {=========================================================================}

Implementation

TYPE
  PageIndex      = ARRAY[1..MaxPagesPerSection] OF Word;
  PageAttr       = ARRAY[1..MaxPagesPerSection] OF HelpAttrState;

  {$F+}
  FUNCTION HeapFunc(Size : Word)   : INTEGER;
    {-Return nil pointer if insufficient memory}
  BEGIN
    HeapFunc := 1;
  END;
  {$F-}

  FUNCTION GetMemCheck(VAR P; Bytes : Word) : BOOLEAN;
    {-Allocate heap space, returning true if successful}
  VAR
    SaveHeapError  : Pointer;
    Pt             : Pointer Absolute P;
  BEGIN
    {Take over heap error control}
    SaveHeapError := HeapError;
    HeapError := @HeapFunc;
    GetMem(Pt, Bytes);
    GetMemCheck := (Pt <> NIL);
    {Restore heap error control}
    HeapError := SaveHeapError;
  END;

  PROCEDURE FreeMemCheck(VAR P; Bytes : Word);
    {-Deallocate heap space}
  VAR
    Pt             : Pointer Absolute P;
  BEGIN
    IF Pt <> NIL THEN
      FreeMem(Pt, Bytes);
  END;

  FUNCTION OpenHelpFile(HelpFileName   : STRING;
                        XLow, YLow, YHigh : Byte;
                        VAR Help : HelpPtr) : Word;
    {-Find and open help file, returning 0 or error code, and
      an initialized help descriptor if successful}
  LABEL
    ErrorExit;
  VAR
    IO             : Word;
    BytesRead      : Word;
    IsOpen         : BOOLEAN;
  BEGIN
    {Initialize the result}
    Help := NIL;
    IsOpen := FALSE;

    {Find the help file}
    IF NOT ExistOnPath(HelpFileName, HelpFileName) THEN BEGIN
      OpenHelpFile := 2;
      GOTO ErrorExit;
    END;

    {Allocate space for help descriptor}
    IF NOT GetMemCheck(Help, SIZEOF(HelpDesc)) THEN BEGIN
      OpenHelpFile := 203;
      GOTO ErrorExit;
    END;

    {Initialize the help descriptor}
    WITH Help^ DO BEGIN
      {Most help information is on disk}
      InRAM := FALSE;

      {Open the help file}
      ASSIGN(Fil, HelpFileName);
      RESET(Fil, 1);
      IO := IOResult;
      IF IO <> 0 THEN BEGIN
        OpenHelpFile := IO;
        GOTO ErrorExit;
      END;
      IsOpen := TRUE;

      {Get header from file}
      BlockRead(Fil, Hdr, SIZEOF(HelpHeader), BytesRead);
      IO := IOResult;
      IF IO <> 0 THEN BEGIN
        OpenHelpFile := IO;
        GOTO ErrorExit;
      END;
      IF BytesRead <> SIZEOF(HelpHeader) THEN BEGIN
        OpenHelpFile := 100;
        GOTO ErrorExit;
      END;

      WITH Hdr DO BEGIN
        {Check file ID}
        IF ID <> LongInt(HelpId) THEN BEGIN
          {"Invalid numeric format" - used as error code for invalid ID}
          OpenHelpFile := 106;
          GOTO ErrorExit;
        END;
        {Get buffer space for reading help sections}
        IF NOT GetMemCheck(BufP, MaxSection) THEN BEGIN
          OpenHelpFile := 203;
          GOTO ErrorExit;
        END;
      END;

      {Initialize remaining fields}
      RowH := YLow;
      ColH := XLow;
      Height := YHigh-YLow+1;
      CAttr := HelpColorAttr;
      MAttr := HelpMonocAttr;
      Frame := FrameChars;
      Open := TRUE;

      {Successful initialization}
      OpenHelpFile := 0;
      Exit;
    END;

ErrorExit:
    IF IsOpen THEN BEGIN
      CLOSE(Help^.Fil);
      IsOpen := FALSE;
      IO := IOResult;
    END;
    FreeMemCheck(Help, SIZEOF(HelpDesc))
  END;

  FUNCTION OpenHelpMem(HPtr           : Pointer;
                       XLow, YLow, YHigh : Byte;
                       VAR Help : HelpPtr) : Word;
    {-Initialize help descriptor for a help structure bound into code}
  LABEL
    ErrorExit;
  BEGIN
    {Initialize the result in case of failure}
    Help := NIL;

    {Allocate space for help descriptor}
    IF NOT GetMemCheck(Help, SIZEOF(HelpDesc)) THEN BEGIN
      OpenHelpMem := 203;
      GOTO ErrorExit;
    END;

    {Initialize the help descriptor}
    WITH Help^ DO BEGIN
      {Help information is in RAM}
      InRAM := TRUE;

      {Check out header}
      HdrP := HPtr;
      Hdr := HdrP^;
      WITH Hdr DO BEGIN
        IF ID <> LongInt(HelpId) THEN BEGIN
          {"Invalid numeric format" - used as error code for invalid ID}
          OpenHelpMem := 106;
          GOTO ErrorExit;
        END;
        NamP := HPtr;
        Inc(LongInt(NamP), SIZEOF(HelpHeader));
        IndP := Pointer(NamP);
        Inc(LongInt(IndP), ItemCnt*NameSize);
      END;

      {Initialize remaining fields}
      RowH := YLow;
      ColH := XLow;
      Height := YHigh-YLow+1;
      CAttr := HelpColorAttr;
      MAttr := HelpMonocAttr;
      Frame := FrameChars;

      {Successful initialization}
      OpenHelpMem := 0;
      Exit;
    END;

ErrorExit:
    FreeMemCheck(Help, SIZEOF(HelpDesc))
  END;

  PROCEDURE SetHelpPos(Help : HelpPtr; XLow, YLow, YHigh : Byte);
    {-Change the position of a help window}
  BEGIN
    WITH Help^ DO
      IF Hdr.ID = LongInt(HelpId) THEN BEGIN
        RowH := YLow;
        ColH := XLow;
        Height := YHigh-YLow+1;
      END;
  END;

  FUNCTION GetNameString(Help : HelpPtr; Item : Word) : STRING;
    {-Return name string for help item, if any}
  VAR
    N              : ^STRING;
    S              : STRING;
    C              : CharArrayPtr;
  BEGIN
    GetNameString := '';
    WITH Help^, Hdr DO
      IF NameSize <> 0 THEN
        IF InRAM THEN BEGIN
          N := Pointer(NamP);
          Inc(LongInt(N), NameSize*(Item-1));
          GetNameString := N^;
        END ELSE IF Open THEN BEGIN
          Seek(Fil, LongInt(SIZEOF(HelpHeader))+NameSize*(Item-1));
          IF IOResult <> 0 THEN
            Exit;
          BlockRead(Fil, S, NameSize);
          IF (IOResult <> 0) THEN
            Exit;
          GetNameString := S;
        END;
  END;

  FUNCTION PaginateHelp(VAR C : CharArray; TextHgt : Word;
                        VAR P : PageIndex; VAR PA : PageAttr) : Word;
    {-Paginate help text for a single section}
  VAR
    Cpos           : Word;
    Pofs           : Word;
    Pcnt           : Word;
    Phgt           : Word;
    Done           : BOOLEAN;
    HA, LA         : HelpAttrState;

    PROCEDURE NewPage;
      {-Store information about previous page}
    BEGIN
      IF Pcnt+1 >= MaxPagesPerSection THEN
        Done := TRUE
      ELSE BEGIN
        Inc(Pcnt);                {Increment page count}
        P[Pcnt] := Pofs;          {Character offset at start of page}
        PA[Pcnt] := LA;           {Attrubute at start of page}
        Pofs := Cpos+1;           {Start of next page}
        P[Pcnt+1] := Pofs;        {Sentinel to end last page}
        Phgt := 0;                {New page has no lines}
        LA := HA;                 {Attributes at start of new page}
      END;
    END;

  BEGIN
    Pcnt := 0;
    Cpos := 0;
    Pofs := 0;
    Phgt := 0;
    FillChar(HA, SIZEOF(HelpAttrState), FALSE);
    LA := HA;
    Done := FALSE;
    REPEAT
      CASE C[Cpos] OF
        Attr1Toggle :
          HA[SpAtt1] := NOT HA[SpAtt1];
        Attr2Toggle :
          HA[SpAtt2] := NOT HA[SpAtt2];
        Attr3Toggle :
          HA[SpAtt3] := NOT HA[SpAtt3];
        LineBrkMark :
          BEGIN
            Inc(Phgt);
            IF Phgt >= TextHgt THEN
              NewPage;
          END;
        PageBrkMark :
          IF Cpos = Pofs THEN
            Inc(Pofs)
          ELSE
            NewPage;
        SectEndMark :
          BEGIN
            IF Cpos <> Pofs THEN
              NewPage;
            Done := TRUE;
          END;
      END;
      Inc(Cpos);
    UNTIL Done;
    PaginateHelp := Pcnt;
  END;

  PROCEDURE ShowPrompt(Pnum, Pcnt : Word; Row, ColMin, ColMax, Attr : Byte);
    {-Show information about help}
  CONST
    MoreMsg : STRING[13] = '  for more,';
    ExitMsg : STRING[13] = ' Esc to exit ';
  VAR
    Cpos           : Byte;
  BEGIN
    Cpos := ColMax+1-LENGTH(ExitMsg);
    IF Cpos < ColMin THEN
      {No room for any messages}
      Exit;
    FastWrite(ExitMsg, Row, Cpos, Attr);
    IF Pcnt = 1 THEN
      {No need for More message}
      Exit;
    Dec(Cpos, LENGTH(MoreMsg));
    IF Cpos < ColMin THEN
      {No room for More message}
      Exit;
    IF Pnum = 1 THEN
      MoreMsg[2] := ' '
    ELSE
      MoreMsg[2] := ^X;
    IF Pnum = Pcnt THEN
      MoreMsg[3] := ' '
    ELSE
      MoreMsg[3] := ^Y;
    FastWrite(MoreMsg, Row, Cpos, Attr);
  END;

  FUNCTION GetAttr(VAR A          : HelpAttrArray;
                   VAR AtSt : HelpAttrState) : Byte;
    {-Return attribute for current attribute state}
  BEGIN
    IF AtSt[SpAtt1] THEN
      GetAttr := A[SpAtt1]
    ELSE IF AtSt[SpAtt2] THEN
      GetAttr := A[SpAtt2]
    ELSE IF AtSt[SpAtt3] THEN
      GetAttr := A[SpAtt3]
    ELSE
      GetAttr := A[TeAttr];
  END;

  FUNCTION ToggleAttr(VAR A          : HelpAttrArray;
                      VAR AtSt       : HelpAttrState;
                      SpAtt : HelpAttrType) : Byte;
    {-Toggle attribute state and return new video attribute}
  BEGIN
    AtSt[SpAtt] := NOT AtSt[SpAtt];
    ToggleAttr := GetAttr(A, AtSt);
  END;

  PROCEDURE DrawPage(VAR C : CharArray; Pstart, Pend : Word; ColMax : Byte;
                     VAR A : HelpAttrArray; AtSt : HelpAttrState);
    {-Draw one page of help}
  CONST
    ColSt          = 2;
  VAR
    Attr           : Byte;
    Pdone          : BOOLEAN;
    Cpos           : Word;
    Row            : Byte;
    Col            : Byte;
    Ch             : CHAR;
  BEGIN
    Row := 1;
    Col := ColSt;
    Attr := GetAttr(A, AtSt);
    ClrScr;
    Cpos := Pstart;
    Pdone := FALSE;
    REPEAT
      Ch := C[Cpos];
      CASE Ch OF
        LineBrkMark :
          BEGIN
            Inc(Row);
            Col := ColSt;
          END;
        Attr1Toggle :
          Attr := ToggleAttr(A, AtSt, SpAtt1);
        Attr2Toggle :
          Attr := ToggleAttr(A, AtSt, SpAtt2);
        Attr3Toggle :
          Attr := ToggleAttr(A, AtSt, SpAtt3);
        PageBrkMark, SectEndMark :
          Pdone := TRUE;
      ELSE
        IF Col <= ColMax THEN
          FastWriteWindow(Ch, Row, Col, Attr);
        Inc(Col);
      END;
      Inc(Cpos);
      IF Cpos >= Pend THEN
        Pdone := TRUE;
    UNTIL Pdone;
  END;

  FUNCTION ShowHelp(Help : HelpPtr; Item : Word) : BOOLEAN;
    {-Display help screen, returning true if successful}
  VAR
    Done           : BOOLEAN;
    Ch             : CHAR;
    Pnum           : Word;
    Lnum           : Word;
    Pcnt           : Word;
    BytesRead      : Word;
    Fpos           : LongInt;
    W              : WindowPtr;
    A              : HelpAttrArray;
    C              : CharArrayPtr;
    P              : PageIndex;
    PA             : PageAttr;
    HeaderStr      : STRING[80];
  BEGIN
    ShowHelp := FALSE;
    IF Item = 0 THEN
      Exit;

    WITH Help^, Hdr DO BEGIN

      {Get help text into memory and initialize pointer to it}
      IF InRAM THEN BEGIN
        {Already in memory, just compute the pointer}
        C := Pointer(HdrP);
        Inc(LongInt(C), IndP^[Item]);
      END ELSE IF Open THEN BEGIN
        {On disk, first read the index}
        Seek(Fil, SIZEOF(HelpHeader)+LongInt(NameSize)*ItemCnt+SIZEOF(LongInt)*(Item-1));
        IF IOResult <> 0 THEN
          Exit;
        BlockRead(Fil, Fpos, SIZEOF(LongInt), BytesRead);
        IF (IOResult <> 0) OR (BytesRead <> SIZEOF(LongInt)) THEN
          Exit;
        {Check for available help}
        IF Fpos = NoHelpAvailable THEN
          Exit;
        {Now read the help section}
        Seek(Fil, Fpos);
        IF IOResult <> 0 THEN
          Exit;
        BlockRead(Fil, BufP^, MaxSection, BytesRead);
        IF (IOResult <> 0) OR (BytesRead = 0) THEN
          Exit;
        C := BufP;
      END ELSE
        {Help file not open}
        Exit;

      {Scan help text to find page boundaries}
      Pcnt := PaginateHelp(C^, Height-2, P, PA);

      IF Pcnt = 0 THEN
        {No help for this topic}
        Exit;

      {Set colors and frame}
      CASE LastMode AND $FF OF
        0, 2, 7 : A := MAttr;
        1, 3 : A := CAttr;
      ELSE
        Exit;
      END;
      FrameChars := Frame;

      {Display window}
      HeaderStr := GetNameString(Help, Item);
      IF LENGTH(HeaderStr) > 0 THEN
        HeaderStr := ' '+HeaderStr+' ';
      IF NOT MakeWindow(W, ColH, RowH, ColH+Width-1, RowH+Height-1,
                        TRUE, TRUE, FALSE, A[TeAttr], A[FrAttr], A[HeAttr],
                        HeaderStr) THEN
        Exit;
      IF NOT DisplayWindow(W) THEN
        Exit;
      HiddenCursor;

      {Allow user to browse help}
      Done := FALSE;
      Pnum := 1;
      Lnum := 0;
      REPEAT
        IF Pnum <> Lnum THEN BEGIN
          DrawPage(C^, P[Pnum], P[Pnum+1], Width-3, A, PA[Pnum]);
          ShowPrompt(Pnum, Pcnt, RowH+Height-1, ColH+1, ColH+Width-2, A[HeAttr]);
          Lnum := Pnum;
        END;
        CASE ReadKeyWord OF
          $011B :                 {Escape}
            Done := TRUE;
          $4700 :                 {Home}
            Pnum := 1;
          $4800, $4900 :          {Up arrow, PgUp}
            IF Pnum > 1 THEN
              Dec(Pnum);
          $4F00 :                 {End}
            Pnum := Pcnt;
          $5000, $5100 :          {Down arrow, PgDn}
            IF Pnum < Pcnt THEN
              Inc(Pnum);
        END;
      UNTIL Done;

      {Restore the screen}
      DisposeWindow(EraseTopWindow);
      ShowHelp := TRUE;
    END;
  END;

  FUNCTION GetNameBuffer(Help           : HelpPtr;
                         VAR P          : CharArrayPtr;
                         VAR SizeAlloc : Word) : BOOLEAN;
    {-Return pointer to loaded array of pick names}
  VAR
    BytesRead      : Word;
  BEGIN
    GetNameBuffer := FALSE;
    SizeAlloc := 0;
    WITH Help^, Hdr DO BEGIN
      IF InRAM THEN BEGIN
        {Already in memory, just compute the pointer}
        P := Pointer(HdrP);
        Inc(LongInt(P), SIZEOF(HelpHeader));
      END ELSE IF Open THEN BEGIN
        {On disk, first allocate space}
        IF NOT GetMemCheck(P, ItemCnt*NameSize) THEN
          Exit;
        SizeAlloc := ItemCnt*NameSize;
        {Read names into buffer}
        Seek(Fil, SIZEOF(HelpHeader));
        IF IOResult <> 0 THEN
          Exit;
        BlockRead(Fil, P^, SizeAlloc, BytesRead);
        IF (IOResult <> 0) OR (BytesRead <> SizeAlloc) THEN
          Exit;
      END ELSE
        {Help file not open}
        Exit;
    END;
    GetNameBuffer := TRUE;
  END;

  FUNCTION ShowHelpByName(Help : HelpPtr; Name : STRING) : BOOLEAN;
    {-Display help screen for topic with pick name Name}
  VAR
    P              : CharArrayPtr;
    NP             : ^STRING;
    SizeAlloc      : Word;
    I              : Word;
  BEGIN
    ShowHelpByName := FALSE;
    IF GetNameBuffer(Help, P, SizeAlloc) THEN
      WITH Help^, Hdr DO BEGIN
        {Match the name}
        Name := StUpcase(Name);
        NP := Pointer(P);
        I := 1;
        WHILE I <= ItemCnt DO BEGIN
          IF StUpcase(NP^) = Name THEN BEGIN
            {Show the help, getting status from that routine}
            ShowHelpByName := ShowHelp(Help, I);
            {Force exit}
            I := ItemCnt;
          END;
          Inc(I);
          Inc(LongInt(NP), NameSize);
        END;
      END;
    IF SizeAlloc <> 0 THEN
      FreeMem(P, SizeAlloc);
  END;

  {$IFDEF UsingPickUnit}
  VAR
    PBuff : CharArrayPtr;  {Pointer to buffer of pick names}
    NSize : Byte;          {Size of array element in pick buffer}

  {$F+}
  FUNCTION SendHelpName(Item : Word) : STRING;
    {-Pass each help item to the pick unit}
  VAR
    NP : ^STRING;
  BEGIN
    NP := pointer(PBuff);
    Inc(LongInt(NP),NSize*(Item-1));
    SendHelpName := ' '+NP^;
  END;
  {$F-}

  FUNCTION PickHelp(Help : HelpPtr; XLow, YLow, YHigh, PickCols : Byte) : Word;
    {-Display help pick list, returning Item number, or 0 for none}
  VAR
    SizeAlloc : Word;
    Choice : Word;
    PickChar : CHAR;
    XHigh : Byte;
    A : HelpAttrArray;
  BEGIN
    PickHelp := 0;
    IF GetNameBuffer(Help, PBuff, SizeAlloc) THEN
      WITH Help^, Hdr DO BEGIN
        {Set up global with NameSize}
        NSize := NameSize;

        {Choose the window width}
        XHigh := XLow+PickCols*(NSize+1)+1;
        IF XHigh > CurrentWidth THEN
          XHigh := CurrentWidth;

        {Set colors and frame}
        CASE LastMode AND $FF OF
          0, 2, 7 : A := MAttr;
          1, 3 : A := CAttr;
        ELSE
          Exit;
        END;
        FrameChars := Frame;
        TpPick.PickMatrix := PickCols;

        {Pick from list}
        IF PickWindow(@SendHelpName, ItemCnt, XLow, YLow, XHigh, YHigh, TRUE,
                      A[TeAttr], A[FrAttr], A[HeAttr], A[SpAtt1], PickTitle,
                      [#13, #27], Choice, PickChar) THEN
          IF PickChar = #13 THEN
            PickHelp := Choice;
      END;
    IF SizeAlloc <> 0 THEN
      FreeMem(PBuff, SizeAlloc);
  END;
  {$ENDIF}

CONST
  StackSize      = 2000;          {Size of stack for int 16 handler}
VAR
  SaveExit       : Pointer;       {Exit chain}
  SaveInt16      : Pointer;       {Previous int 16}
  HelpSystem     : HelpPtr;       {Help system for context sensitive help}
  HelpActive     : BOOLEAN;       {True if context sensitive help popped up}
  HelpKey        : Word;          {Scan word for help popup}
  StackSpace     : Pointer;       {Pointer to alternate stack}

  {$L TPHELP.OBJ}
  PROCEDURE Int16Handler;
    {-Handle int 16 for popup context sensitive help}
    EXTERNAL;

  PROCEDURE RemoveHelp;
    {-Deinstall context sensitive help}
  BEGIN
    IF HelpIntInstalled THEN BEGIN
      ExitProc := SaveExit;
      FreeMem(StackSpace, StackSize);
      SetIntVec($16, SaveInt16);
      HelpIntInstalled := FALSE;
    END;
  END;

  PROCEDURE SetContextHelp(Help : HelpPtr; Key : Word);
    {-Install a keyboard interrupt handler to pop help when Key is pressed}
  BEGIN
    IF NOT HelpIntInstalled THEN
      IF Help^.InRAM THEN
        IF MaxAvail >= StackSize THEN BEGIN
          GetMem(StackSpace, StackSize);
          GetIntVec($16, SaveInt16);
          SetIntVec($16, @Int16Handler);
          SaveExit := ExitProc;
          ExitProc := @RemoveHelp;
          HelpIntInstalled := TRUE;
        END;
    HelpActive := FALSE;
    HelpKey := Key;
    HelpSystem := Help;
  END;

END.