help.pas

Turbo Pascal 6.0编译器源码

    HiliteIndex := Index;
    if OldHilite <> $FFFE then
    begin
      CurScreen^.GetPos(OldHilite, Row, Col, Len);
      RedrawRows(Row, Row);
    end;
    if Index <> $FFFE then
    begin
      if Scroll then
        ScrollToHilite(True, Ofs, Center);
      CurScreen^.GetPos(Index, Row, Col, Len);
      RedrawRows(Row, Row);
    end;
  end else
    HiliteIndex := $FFFE;
end;

procedure THelpView.ChangeHiliteBy(D: Integer);
var
  Index: Integer;
begin
  if CurScreen^.MaxIndex <= 0 then
    Exit;
  if HiliteIndex = $FFFE then
  begin
    Index := GoNextIndex;
    if D < 0 then
      Dec(Index);
  end else
    Index := HiliteIndex + D;
  if Index >= CurScreen^.MaxIndex then
    Index := 0
  else if Index < 0 then
    Index := CurScreen^.MaxIndex - 1;
  ChangeHilite(Index, True, 0, True);
end;

procedure THelpView.HiliteCurrent;
begin
  ChangeHilite(IndexUnderCursor(CursorPos), False, 0, False);
end;

function THelpView.IndexUnderCursor(var Pos: TPos): Word;
var
  W: THelpWalker;
begin
  W.Init(CurScreen,Pos.Row);
  W.GoCol(Pos.Col);
  if Odd(W.Index) then
    IndexUnderCursor := W.Index shr 1
  else
    IndexUnderCursor := $FFFE;
end;

procedure THelpView.WordUnderCursor(var S: string);
var
  W: THelpWalker;
begin
  S := '';
  W.Init(CurScreen, CursorPos.Row);
  W.GoCol(CursorPos.Col);
  while (W.Col > 0) and (W.CurChar in HelpWordChars) do
    W.GoBack;
  if not (W.CurChar in HelpWordChars) then
    W.GoForward;
  while (W.CurChar in HelpWordChars) do
  begin
    Inc(S[0]);
    S[Length(S)] := W.CurChar;
    W.GoForward;
  end;
end;

function THelpView.GoNextIndex: Word;
var
  W: THelpWalker;
  Row: Word;
begin
  Row := CursorPos.Row;
  W.Init(CurScreen, Row);
  W.GoCol(CursorPos.Col);
  while not Odd(W.Index) do
    if W.CurChar = #0 then
    begin
      Inc(Row);
      if not W.GetRow(Row) then
      begin
        GoNextIndex := 0;
        Exit
      end;
    end else
      W.GoForward;
  GoNextIndex := W.Index shr 1;
end;

procedure THelpView.SetBlockAnchor(R, C: Word);
var
  Pos: TPos;
begin
  Pos.Row := R + ScreenPos.Row;
  Pos.Col := C + ScreenPos.Col;
  AdjustCursor(Pos);
  BlockPresent := Pos.Compare(BlockBeg) < 0;
  if BlockPresent then
    BlockBeg := Pos
  else
    BlockEnd := Pos;
  Draw;
end;

procedure THelpView.TrackChar(C: Char);
begin
  if Length(TrackWord) < 38 then
  begin
    Inc(TrackWord[0]);
    TrackWord[Length(TrackWord)] := UpCase(C);
    if not HiliteTrack then
      TrackBack;
  end;
end;

procedure THelpView.TrackBack;
begin
  if Length(TrackWord) > 0 then
    Dec(TrackWord[0]);
  HiliteTrack;
end;

procedure THelpView.TrackClear;
begin
  TrackWord := '';
end;

function THelpView.HiliteTrack: Boolean;
var
  Index, Len: Word;
begin
  Index := CurScreen^.GetIndex(TrackWord, Len);
  if Index <> $FFFE then
  begin
    HiliteTrack := True;
    ChangeHilite(Index, True, Len, True);
  end else
    HiliteTrack := False;
end;

procedure THelpView.GoCrossRef;
begin
  if HiliteIndex <> $FFFE then
    PushShowScreen(CurScreen^.GetContext(HiliteIndex));
end;

procedure THelpView.SearchCurWord;
var
  Index: Word;
  S: string;
begin
  Index := IndexUnderCursor(CursorPos);
  if Index <> $FFFE then
  begin
    HiliteIndex := Index;
    GoCrossRef
  end else
  begin
    WordUnderCursor(S);
    SearchString(S)
  end;
end;

procedure THelpView.SearchString(var S: string);

procedure TrackAll;
begin
  Redraw;
  TrackString(S);
end;

procedure UpStr(var S: string);
var
  I: Word;
begin
  for I := 1 to Length(S) do
    S[I] := UpCase(S[I]);
end;

var
  Index, Len: Word;
  Row, Col: Integer;
  Len2: Word;
begin
  if PushReadScreen(1) then
  begin
    UpStr(S);
    Index := CurScreen^.GetIndex(S, Len);
    if Index <> $FFFE then
    begin
      CurScreen^.GetPos(Index, Row, Col, Len2);
      if Len2 = Len then
        ShowScreen(CurScreen^.GetContext(Index))
      else
        TrackAll;
    end else
      TrackAll;
  end else
    ShowScreen(3);
end;

procedure THelpView.TrackString(var S: string);
var
  I: Integer;
begin
  TrackClear;
  for I := 1 to Length(S) do
    TrackChar(S[I]);
  TrackClear;
end;

function THelpView.GetPalette: PPalette;
const
  P1: string[Length(CHelpView)] = CHelpView;
  P2: string[Length(CHelpViewInDialog)] = CHelpViewInDialog;
begin
  if InDialog then
    GetPalette := @P2
  else
    GetPalette := @P1;
end;

procedure THelpView.HandleEvent(var Event: TEvent);

function ShiftPressed: Boolean;
var
  ShiftState: Byte absolute $40:$17;
begin
  ShiftPressed := ShiftState and (kbRightShift + kbLeftShift) <> 0;
end;

procedure ProcessMouseDown;
var
  MouseAutosToSkip, C, R: Integer;
  Mouse: TPoint;

function MouseHere: Boolean;
begin
  MakeLocal(Event.Where, Mouse);
  MouseHere := MouseInView(Event.Where);
end;

begin
  if Event.Buttons and mbLeftButton = 0 then
    repeat
    until not MouseEvent(Event, evMouseMove + evMouseAuto)
  else
  begin
    if MouseHere and ShiftPressed then
      SetBlockAnchor(Mouse.Y, Mouse.X)
    else
      MoveToMouse(Mouse.Y, Mouse.X, False);
    MouseAutosToSkip := 0;
    repeat
      if MouseHere then
      begin
        MouseAutosToSkip := 0;
        if Event.Double then
        begin
          SearchCurWord;
          ClearEvent(Event)
        end else
          MoveToMouse(Mouse.Y, Mouse.X, True);
      end else
      begin
        if Event.What = evMouseAuto then
          Dec(MouseAutosToSkip);
        if MouseAutosToSkip < 0 then
        begin
          MouseAutosToSkip := 0;
          if Mouse.X < 0 then
          begin
            C := -1;
            if CursorPos.Col > ScreenPos.Col then
              C := ScreenPos.Col + C - CursorPos.Col;
          end else
          begin
            if Mouse.X >= Size.X then
            begin
              C := 1;
              if CursorPos.Col < ScreenPos.Col + Size.X - 1 then
                C := ScreenPos.Col + C + Size.X - 1 - CursorPos.Col;
            end else
              C := ScreenPos.Col + Mouse.X - CursorPos.Col;
          end;
          if Mouse.Y < 0 then
          begin
            R := -1;
            if CursorPos.Row > ScreenPos.Row then
              R := R + ScreenPos.Row - CursorPos.Row;
          end else
          begin
            if Mouse.Y >= Size.Y then
            begin
              R := 1;
              if CursorPos.Row < ScreenPos.Row + Size.Y - 1 then
                R := R + ScreenPos.Row + Size.Y - 1 - CursorPos.Row;
            end else
              R := Mouse.Y + ScreenPos.Row - CursorPos.Row;
          end;
          MoveBy(R, C, True);
        end;
      end;
    until not MouseEvent(Event, evMouseMove + evMouseAuto);
  end;
  ClearEvent(Event);
end;

procedure ProcessRightClick;
var
  Mouse: TPoint;
begin
  if RBActs[RBAction] = cmTopicSearch then
  begin
    MakeLocal(Event.Where, Mouse);
    MoveToMouse(Mouse.Y, Mouse.X, False);
    SearchCurWord;
    ClearEvent(Event);
  end;
end;

procedure ProcessKeyDown;
var
  Shift: Boolean;
begin
  Shift := ShiftPressed;
  if (Event.ScanCode in Arrows) and Shift then
    Event.CharCode := #0;
  case CtrlToArrow(Event.KeyCode) of
    kbLeft:
      MoveBy(0, -1, Shift);
    kbRight:
      MoveBy(0, 1, Shift);
    kbUp:
      MoveBy(-1, 0, Shift);
    kbDown:
      MoveBy(1, 0, Shift);
    kbPgUp:
      MoveCode(1, 0, Shift);
    kbPgDn:
      MoveCode(2, 0, Shift);
    kbCtrlLeft:
      MoveCode(0, 3, Shift);
    kbCtrlRight:
      MoveCode(0, 4, Shift);
    kbHome:
      if Event.CharCode = ^A then
        MoveCode(0, 3, Shift)
      else
        MoveCode(0, 5, Shift);
    kbEnd:
      if Event.CharCode = ^F then
        MoveCode(0, 4, Shift)
      else
        MoveCode(0, 6, Shift);
    kbCtrlPgUp:
      MoveCode(7, 5, Shift);
    kbCtrlPgDn:
      MoveCode(8, 6, Shift);
    kbCtrlHome:
      MoveCode(9, 0, Shift);
    kbCtrlEnd:
      MoveCode(10, 0, Shift);
    kbTab:
      if InDialog then
        Exit
      else
        ChangeHiliteBy(1);
    kbShiftTab:
      if InDialog then
        Exit
      else
        ChangeHiliteBy(-1);
    kbEnter:
      if InDialog then
        Exit
      else
        GoCrossRef;
    kbBack:
      TrackBack;
    kbAltF1:
      PopPos;
    kbShiftF1:
      ShowIndex;
    kbCtrlF1:
      SearchCurWord;
  else if (Event.CharCode >= ' ') and (Event.CharCode <= '~') then
    TrackChar(Event.CharCode)
  else
    Exit;
  end;
  ClearEvent(Event);
end;

procedure ProcessCommand;
var
  S: string;
begin
  case Event.Command of
    cmScrollBarClicked:
      begin
        Select;
        Exit
      end;
    cmScrollBarChanged:
      begin
        ProcessScrollBars;
        Exit
      end;
    cmFindHelpWindow:
      ;
    cmPreviousTopic:
      PopPos;
    cmHelpIndex:
      ShowIndex;
    cmHelpOnHelp:
      ShowHelpOnHelp;
    cmHelpContents:
      ShowContents;
    cmCrossRef:
      GoCrossRef;
    cmTopicSearch:
      begin
        S := GetEditWord(255, @HelpWordChars);
        SearchString(S)
      end;
    cmCopy:
      Copy;
    cmCopyExample:
      CopyExample;
    cmHelpOnError:
      PushShowScreen(ErrorNumber + ErrorClass);
  else
    Exit;
  end;
  ClearEvent(Event);
end;

begin
  TView.HandleEvent(Event);
  if (Event.What <> evNothing) and ((Event.What = evCommand) or ValidScreen) then
  begin
    case Event.What of
      evMouseDown:
        ProcessMouseDown;
      evRightClick:
        ProcessRightClick;
      evKeyDown:
        ProcessKeyDown;
      evCommand, evBroadcast, evDebugger:
        ProcessCommand;
    end;
    if Event.What = evNothing then
      UpdateCommands;
  end;
end;

procedure THelpView.SetState(AState: Word; Enable: Boolean);

procedure DoShow(P: PView);
begin
  if P <> nil then
    if GetState(sfActive + sfSelected) then
      P^.Show
    else
      P^.Hide;
end;

begin
  TView.SetState(AState, Enable);
  if AState and sfActive <> 0 then
    if Enable then
      UpdateCommands
    else
      DisableCommands(HelpCommands);
  if AState and (sfActive + sfSelected) <> 0 then
  begin
    DoShow(HScrollBar);
    DoShow(VScrollBar);
  end;
end;

function THelpView.Valid(Command: Word): Boolean;
begin
  if Buffer <> nil then
    if Command = cmValid then
      Valid := PushShowScreen(Application^.GetHelpCtx)
    else
      Valid := True
  else
  begin
    OutOfMemory;
    Valid := False
  end;
end;

procedure InitHelp;
begin
  HelpHistory.Init;
end;

function HelpWindow: PWindow;
var
  R: TRect;
  Window: PWindow;
  HScrollBar: PScrollBar;
begin
  R.Assign(0, 0, 50, 18);
  Window := New(PTurboWindow, Init(R, 'Help', wnNoNumber, wpHelpWindow));
  with Window^ do
  begin
    HelpCtx := hcHelpWindow;
    Options := Options or ofCentered;
    Flags := Flags or wfSaveable;
    GetExtent(R);
    R.Grow(-1, -1);
    HScrollBar := StandardScrollBar(sbHorizontal);
    HScrollBar^.SetRange(1, 128);
    Insert(New(PHelpView, Init(R, HScrollBar, StandardScrollBar(sbVertical),
      False, 6144)));
  end;
  HelpWindow := Window;
end;

function HelpDialog: PDialog;
var
  R: TRect;
  Dialog: PHelpDialog;
  HScrollBar, VScrollBar: PScrollBar;
begin
  R.Assign(0, 0, 68, 19);
  Dialog := New(PHelpDialog, Init(R, 'Turbo Help'));
  with Dialog^ do
  begin
    Options := Options or ofCentered;
    R.Assign(2, 17, 50, 18);
    HScrollBar := New(PScrollBar, Init(R));
    Insert(HScrollBar);
    R.Assign(50, 2, 51, 17);
    VScrollBar := New(PScrollBar, Init(R));
    Insert(VScrollBar);
    R.Assign(2, 2, 50, 17);
    HelpView := New(PHelpView, Init(R, HScrollBar, VScrollBar, True, 6144));
    HelpView^.HelpCtx := hcHelpWindow;
    HelpView^.Options := HelpView^.Options or ofFramed;
    Insert(HelpView);
    Insert(NewButton(53, 3, 13, 'Cross ~r~ef', cmCrossRef,
      bfLeftJust + bfdefault, hcHelpCrossRefButton));
    Insert(NewButton(53, 6, 13, '~P~revious', cmPreviousTopic,
      bfLeftJust, hcPreviousTopicItem));
    Insert(NewButton(53, 8, 13, '~C~ontents', cmHelpContents,
      bfLeftJust, hcContentsItem));
    Insert(NewButton(53, 10, 13, '~I~ndex', cmHelpIndex,
      bfLeftJust, hcIndexItem));
    Insert(NewButton(53, 14, 13, 'Cancel', cmCancel,
      bfLeftJust, hcCnlButton));
    SelectNext(False);
  end;
  HelpDialog := Dialog;
end;

end.