Power-Programmierung/CD1.mdf/pascal/library/dos/nicol/sti_help/sti_help.pas

Pascal/Delphi Source File | 1991-09-11 | 8.2 KB | 343 lines

unit STI_HELP;

interface

uses
  CRT,
  STI_SCRF;

procedure STI_HelpSys(FileName : string; Start : word);

implementation

Const
  MAXREFS                 = 128;

  HIGHLIGHTSYM            = '$';
  ESCAPECHAR              = '\';
  NEWPAGEVAL              = 0;
  HBEGIN                  = 1;
  HEND                    = 2;

Type
  BigBuffer = array[1..65535] of char;
  HelpIdent = record
                Name  : string[32];
                Value : word;
              end;
  HeadType  = record
                Name      : string;
                VMin      : byte;
                VMax      : byte;
                X1,X2     : byte;
                Y1,Y2     : byte;
                TextCol   : byte;
                FrameCol  : byte;
                HighCol   : byte;
                TitleCol  : byte;
                CaseSense : byte;
                FrameType : byte;
                Encrypt   : byte;
                MaxRefI   : word;
                NoRefs    : word;
              end;
  HelpItemT = record
                HelpID    : word;
                TextLen   : word;
                Refs      : array[1..MAXREFS] of word;
              end;


Var
  InFile       : file;

  Header       : HeadType;
  HelpItemBuff : HelpItemT;
  TextBuffer   : ^BigBuffer;
  Page,Select  : word;

{---------------------------------------------------------------------------}

function Open_HelpFile(FileName : string) : boolean;

begin
  assign(InFile,FileName);
  {$I-}
  reset(InFile,1);
  if IOResult <> 0 then
    Open_HelpFile := FALSE
  else
    Open_HelpFile := TRUE;
  {$I+}
end;

{---------------------------------------------------------------------------}

function MapBorder(InByte : byte) : string;

begin
  case InByte of
    34 : MapBorder := NOBORDER;
    35 : MapBorder := SPACES;
    36 : MapBorder := SINGLELINE;
    37 : MapBorder := ROUNDCORNERSINGLE;
    38 : MapBorder := BIGBLOCK;
    39 : MapBorder := THICKTOPTHINSIDES;
    40 : MapBorder := THICKDIAGONALCORNER;
    else MapBorder := SINGLELINE;
  end;{case}
end;

{---------------------------------------------------------------------------}

function MapColor(Inbyte : byte) : byte;

begin
  Case InByte of
    18   : MapColor := Black;
    19   : MapColor := Blue;
    20   : MapColor := Red;
    21   : MapColor := Green;
    22   : MapColor := Cyan;
    23   : MapColor := Yellow;
    24   : MapColor := Magenta;
    25   : MapColor := White;
    26   : MapColor := Black+Reverse;
    27   : MapColor := Blue+Reverse;
    28   : MapColor := Red+Reverse;
    29   : MapColor := Green+Reverse;
    30   : MapColor := Cyan+Reverse;
    31   : MapColor := Yellow+Reverse;
    32   : MapColor := Magenta+Reverse;
    33   : MapColor := White+Reverse;
    else   MapColor := White;
  end;{case}
end;

{---------------------------------------------------------------------------}

procedure Read_Help(HelpNum : word);

Var
  Pos1  : longint;
  Bytes : word;

begin
  {$I-}
  Seek(InFile,0);
  Seek(InFile,sizeof(Header)+((HelpNum-1)*sizeof(Pos1)));
  blockread(InFile,Pos1,sizeof(Pos1),Bytes);
  Seek(InFile,Pos1);
  blockread(InFile,HelpItemBuff,sizeof(HelpItemBuff),Bytes);
  getmem(TextBuffer,HelpItemBuff.TextLen+10);
  FillChar(TextBuffer^,HelpItemBuff.TextLen+10,#0);
  blockread(InFile,TextBuffer^,HelpItemBuff.TextLen,Bytes);
  HelpItemBuff.TextLen := Bytes;
  {$I-}
end;

{---------------------------------------------------------------------------}

function CountRefsEP(Sel,Page : word) : word;

Var
  Loop,PCnt,SCnt : word;

begin
  PCnt := 1;
  SCnt := 0;
  Loop := 1;
  while PCnt <= Page do
    begin
      if TextBuffer^[Loop] = char(NEWPAGEVAL) then
        inc(PCnt);
      if TextBuffer^[Loop] = char(HBEGIN) then
        inc(SCnt);
      inc(Loop);
    end;
  CountRefsEP := SCnt;
end;

{---------------------------------------------------------------------------}

function PageCountEP : word;

Var
  Loop, Pcnt : word;

begin
  Loop := 1;
  PCnt := 1;
  while Loop < HelpItemBuff.TextLen do
    begin
      if TextBuffer^[Loop] = char(NEWPAGEVAL) then
        inc(PCnt);
      inc(Loop);
    end;
  PageCountEP := PCnt;
end;

{---------------------------------------------------------------------------}

function CountRefsFP(Sel,Page : word) : word;

Var
  Loop,PCnt,SCnt : word;

begin
  PCnt := 1;
  SCnt := 0;
  Loop := 1;
  while PCnt <= Page do
    begin
      if TextBuffer^[Loop] = char(NEWPAGEVAL) then
        inc(PCnt);
      if (TextBuffer^[Loop] = char(HBEGIN)) and (PCnt = Page) then
        begin
          inc(SCnt);
          CountRefsFP := SCnt;
          Exit;
        end;
      inc(Loop);
    end;
  CountRefsFP := SCnt;
end;

{---------------------------------------------------------------------------}

procedure Display_Prompt(Sel,Page : word);

Var
  Loop : word;
  PCnt : word;
  SCnt : word;
  High : boolean;

begin
  PCnt := 1;
  SCnt := 0;
  Loop := 1;
  High := FALSE;
  while PCnt < Page do
    begin
      if TextBuffer^[Loop] = char(NEWPAGEVAL) then
        inc(PCnt);
      if TextBuffer^[Loop] = char(HBEGIN) then
        inc(SCnt);
      inc(Loop);
    end;
  GotoXY(1,1);
  while (TextBuffer^[Loop] <> char(NEWPAGEVAL)) and (Loop <= HelpItemBuff.TextLen) do
    begin
      if TextBuffer^[Loop] = char(HBEGIN) then
        begin
          High := TRUE;
          inc(SCnt);
          if (Scnt = Sel) then
            TextColor(MapColor(Header.HighCol))
          else
            TextColor(MapColor(Header.TitleCol));
        end;

      if TextBuffer^[Loop] = char(HEND) then
        begin
          TextColor(White);
          TextReverse(NoReverse);
          TextColor(MapColor(Header.TextCol));
          High := FALSE;
        end;

      if TextBuffer^[Loop] in [#10,#13,#32..#255] then
        begin
          if (Textbuffer^[Loop] >= #32) and not(HIGH) then
            DosPutch(TextBuffer^[Loop])
          else
            write(TextBuffer^[Loop]);
        end
      else
        write(' ');
      inc(Loop);
    end;
end;

{---------------------------------------------------------------------------}

function Display_Help(HelpNum : word) : word;

Var
  Inch : char;

begin
  TextColor(MapColor(Header.TextCol));
  ClrScr;
  Read_Help(HelpNum);
  Page     := 1;
  Select   := 1;
  Inch := #0;
  while Inch <> #27 do
    begin
      Display_Prompt(Select,Page);
      repeat until KeyPressed;
      Inch := ReadKey;
      case Inch of
        #13   : begin
                  Display_Help := HelpItemBuff.Refs[Select];
                  Exit;
                end;
        #12   : begin
                  if Select < CountRefsEP(Select,Page) then
                    inc(Select);
                end;
        #8    : begin
                  if Select > CountRefsFP(Select,Page) then
                    dec(Select);
                end;
        #11   : begin
                  if Page > 1 then
                    dec(Page);
                  ClrScr;
                end;
        #10   : begin
                  if Page < PageCountEP then
                    inc(Page);
                  ClrScr;
                end;
      end;{case}
    end;
  Display_Help := 0;
end;

{---------------------------------------------------------------------------}

procedure STI_HelpSys(FileName : string; Start : word);

Var
  SaveWin : WindowSave;
  Dummy   : word;

begin
  if Open_HelpFile(FileName) then
    begin
      HiddenCursor;
      blockread(InFile,Header,sizeof(Header));
      MakeWindow(SaveWin,
                 Header.X1,Header.Y1,
                 Header.X2,Header.Y2,
                 MapColor(Header.TextCol),
                 MapColor(Header.FrameCol),
                 MapColor(Header.TitleCol),
                 MapBorder(Header.FrameType),
                 ' Help ');
      Window(Header.X1+1,Header.Y1+1,Header.X2-1,Header.Y2-1);
      while Start <> 0 do
        Start := Display_Help(Start);
      Window(1,1,80,25);
      DisposeWindow(SaveWin);
    end;
  Close(InFile);
end;

{---------------------------------------------------------------------------}

begin
end.