www.pudn.com > tp60src.zip > HELP.PAS
unit Help;
{$O+,F+,S-,X+,V-}
interface
uses Objects, Drivers, Views, Dialogs, TVars, HelpUtil, HelpScrn, HelpHist;
const
HelpCommands = [cmCopy, cmCopyExample, cmCrossRef];
CHelpView = #6#7#8#9#10#11#12#13;
CHelpViewInDialog = #33#34#35#36#37#38#39#40;
type
TColorArray = array[0..Length(CHelpView)-1] of Byte;
PHelpView = ^THelpView;
THelpView = object(TView)
InDialog: Boolean;
HScrollBar: PScrollBar;
VScrollBar: PScrollBar;
CurScreen: PHelpScreen;
CurTopic: PHelpScreen;
MainIndex: PHelpScreen;
History: PHelpHistory;
Buffer: PChar;
BufSize: Word;
CurIndex: Word;
CursorPos, ScreenPos: TPos;
CurWidth: Byte;
BlockBeg, BlockEnd: TPos;
BlockPresent: Boolean;
HiliteIndex: Word;
TrackWord: string[38];
constructor Init(var R: TRect; AHScrollBar, AVScrollBar: PScrollBar;
AInDialog: Boolean; ABufSize: Word);
constructor Load(var S: TStream);
destructor Done; virtual;
procedure Store(var S: TStream);
procedure HandleEvent(var Event: TEvent); virtual;
procedure Draw; virtual;
function GetPalette: PPalette; virtual;
procedure SetState(AState: Word; Enable: Boolean); virtual;
function Valid(Command: Word): Boolean; virtual;
procedure SetCurScreen(Index: Word);
function ReadPos(Index: Word; Pos1, Pos2: TPos; Width: Byte): Boolean;
procedure Redraw;
function ShowPos(Index: Word; Pos1, Pos2: TPos; Width: Byte): Boolean;
function ReadScreen(Index: Word): Boolean;
function ShowScreen(Index: Word): Boolean;
procedure PushPos;
function PushReadScreen(Index: Word): Boolean;
function PushShowScreen(Index: Word): Boolean;
procedure PopPos;
function ShowContents: Boolean;
function ShowIndex: Boolean;
function ShowHelpOnHelp: Boolean;
function ValidScreen: Boolean;
function HasLinks: Boolean;
procedure Format(Width: Word; Adjust: Boolean);
procedure Reformat;
procedure UpdateCommands;
function HasSelection: Boolean;
function HasExample: Boolean;
procedure CopyToClip(var BegPos, EndPos: TPos);
procedure Copy;
procedure CopyExample;
function GetRowCount: Word;
function MaxLeftCol: Byte;
procedure AdjustCol;
procedure AdjustRow;
procedure AdjustPos;
procedure AdjustCursor(var Pos: TPos);
procedure UpdateCursor;
procedure ProcessScrollBars;
procedure UpdateScrollBars;
procedure GetColors(var Colors: TColorArray);
procedure DrawRows(BegRow, EndRow: Word);
procedure RedrawRows(BegRow, EndRow: Integer);
function ScrollBy(R, C: Word): Byte;
function ScrollTo(Row, Col: Integer; Len: Word; Center: Boolean): Byte;
function ScrollToCursor: Byte;
function MoveByRaw(R, C: Word; Hilite, Drag: Boolean): Byte;
function MoveBy(R, C: Integer; Drag: Boolean): Byte;
procedure MoveToMouse(R, C: Word; Drag: Boolean);
procedure MoveCode(RCode, CCode: Byte; Drag: Boolean);
procedure ScrollToHilite(MoveCursor: Boolean; Ofs: Integer;
Center: Boolean);
procedure ChangeHilite(Index: Word; Scroll: Boolean; Ofs: Integer;
Center: Boolean);
procedure ChangeHiliteBy(D: Integer);
procedure HiliteCurrent;
function IndexUnderCursor(var Pos: TPos): Word;
procedure WordUnderCursor(var S: string);
function GoNextIndex: Word;
procedure SetBlockAnchor(R, C: Word);
procedure TrackChar(C: Char);
procedure TrackBack;
procedure TrackClear;
function HiliteTrack: Boolean;
procedure GoCrossRef;
procedure SearchCurWord;
procedure SearchString(var S: string);
procedure TrackString(var S: string);
end;
const
RHelpView: TStreamRec = (
ObjType: 10001;
VmtLink: Ofs(TypeOf(THelpView)^);
Load: @THelpView.Load;
Store: @THelpView.Store
);
procedure InitHelp;
function HelpWindow: PWindow;
function HelpDialog: PDialog;
implementation
uses Memory, App, VMemUtil, TWindows, Editor, Utils, Controls, TStdDlg, Context;
type
PHelpWalker = ^THelpWalker;
THelpWalker = object(TObject)
Col: Integer;
CurChar: Char;
Index: Word;
Screen: PHelpScreen;
Text: PChar;
Ofs: Word;
constructor Init(AScreen: PHelpScreen; Row: Word);
function GetRow(Row: Word): Boolean;
procedure SkipControls;
procedure GoForward;
procedure GoBack;
procedure GoCol(ACol: Word);
procedure GoEol;
end;
constructor THelpWalker.Init(AScreen: PHelpScreen; Row: Word);
begin
Screen := AScreen;
GetRow(Row);
end;
function THelpWalker.GetRow(Row: Word): Boolean;
var
Example: Boolean;
begin
if Row >= Screen^.MaxRow then
begin
GetRow := False;
Exit
end;
GetRow := True;
Screen^.GetRow(Row, Text, Index, Example);
Index := Index * 2;
Ofs := 0;
Col := 0;
SkipControls;
end;
procedure THelpWalker.SkipControls;
begin
if Col < 1 then
begin
CurChar := ' ';
Exit
end;
while (Text^ <> #0) and (Text^ < #7) do
begin
Inc(Ofs);
if Text^ = #2 then
Inc(Index);
Inc(PtrRec(Text).Ofs);
end;
CurChar := Text^;
end;
procedure THelpWalker.GoForward;
begin
if Col < 1 then
begin
Inc(Col);
SkipControls;
Exit
end;
if Text^ <> #0 then
begin
Inc(Col);
Inc(PtrRec(Text).Ofs);
Inc(Ofs);
SkipControls;
end;
end;
procedure THelpWalker.GoBack;
begin
if Col > 0 then
begin
if Ofs > 0 then
repeat
Dec(PtrRec(Text).Ofs);
Dec(Ofs);
if Text^ = #2 then
Dec(Index);
until (Ofs = 0) or (Text^ >= #7);
Dec(Col);
SkipControls;
end;
end;
procedure THelpWalker.GoCol(ACol: Word);
begin
if Col < ACol then
while (CurChar <> #0) and (Col < ACol) do
GoForward
else
while Col > ACol do
GoBack;
end;
procedure THelpWalker.GoEol;
begin
while CurChar <> #0 do
GoForward;
if Col > 0 then
repeat
GoBack
until (Col = 0) or (CurChar <> ' ');
if CurChar <> ' ' then
GoForward;
end;
var
HelpHistory: THelpHistory;
constructor THelpView.Init(var R: TRect; AHScrollBar, AVScrollBar: PScrollBar;
AInDialog: Boolean; ABufSize: Word);
begin
TView.Init(R);
GrowMode := gfGrowHiX + gfGrowHiY;
Options := Options or ofSelectable;
EventMask := EventMask or (evBroadcast + evDebugger + evRightClick);
InDialog := AInDialog;
HScrollBar := AHScrollBar;
VScrollBar := AVScrollBar;
BufSize := ABufSize;
end;
constructor THelpView.Load(var S: TStream);
begin
TView.Load(S);
S.Read(InDialog, SizeOf(InDialog));
History := @HelpHistory;
GetPeerViewPtr(S, HScrollBar);
GetPeerViewPtr(S, VScrollBar);
S.Read(BufSize, SizeOf(BufSize));
Buffer := MemAlloc(BufSize);
CurScreen := nil;
CurTopic := New(PHelpTopic, Init(Buffer, BufSize));
MainIndex := New(PHelpIndex, Init(Buffer, BufSize));
CurIndex := $FFFF;
end;
destructor THelpView.Done;
begin
PushPos;
if CurTopic <> nil then
Dispose(CurTopic, Done);
if MainIndex <> nil then
Dispose(MainIndex, Done);
if Buffer <> nil then
FreeMem(Buffer, BufSize);
TView.Done;
end;
procedure THelpView.Store(var S: TStream);
begin
TView.Store(S);
S.Write(InDialog, SizeOf(InDialog));
PutPeerViewPtr(S, HScrollBar);
PutPeerViewPtr(S, VScrollBar);
S.Write(BufSize, SizeOf(BufSize));
end;
procedure THelpView.SetCurScreen(Index: Word);
begin
if Index = 1 then
CurScreen := MainIndex
else
CurScreen := CurTopic;
end;
function THelpView.ReadPos(Index: Word; Pos1, Pos2: TPos; Width: Byte):
Boolean;
begin
ReadPos := True;
if Index = 0 then
Index := 3;
CurIndex := Index;
if CurIndex = $FFFF then
Exit;
SetCurScreen(Index);
if not CurScreen^.Read(Index) then
begin
CurIndex := $FFFF;
ReadPos := False;
Exit
end;
CursorPos := Pos1;
ScreenPos := Pos2;
BlockBeg.Clear;
BlockEnd.Clear;
BlockPresent := False;
HiliteIndex := $FFFE;
TrackClear;
Format(Width, False);
end;
procedure THelpView.Redraw;
begin
if ValidScreen then
begin
DrawView;
HiliteCurrent
end;
end;
function THelpView.ShowPos(Index: Word; Pos1, Pos2: TPos; Width: Byte):
Boolean;
var
B: Boolean;
begin
B := ReadPos(Index, Pos1, Pos2, Width);
if B then
Redraw;
ShowPos := B;
end;
function THelpView.ReadScreen(Index: Word): Boolean;
var
s1, s2: TPos;
function Read(Index: Word): Boolean;
begin
Read := ReadPos(Index, s1, s2, Size.X - 1);
end;
begin
ReadScreen := True;
s1.Clear;
s2.Clear;
if not Read(Index) then
begin
ReadScreen := False;
Read($FFFF)
end;
end;
function THelpView.ShowScreen(Index: Word): Boolean;
var
B: Boolean;
begin
B := ReadScreen(Index);
if B then
Redraw;
ShowScreen := B;
end;
procedure THelpView.PushPos;
begin
if (History <> nil) and (CurIndex <> $FFFF) then
History^.Push(CurIndex, CursorPos, ScreenPos, CurWidth);
end;
function THelpView.PushReadScreen(Index: Word): Boolean;
begin
PushPos;
PushReadScreen := ReadScreen(Index);
end;
function THelpView.PushShowScreen(Index: Word): Boolean;
var
B: Boolean;
begin
B := PushReadScreen(Index);
if B then
Redraw;
PushShowScreen := B;
end;
procedure THelpView.PopPos;
var
Index: Word;
s1, s2: TPos;
Width: Word;
begin
if (History <> nil) and not History^.Empty then
begin
History^.Pop(Index, s1, s2, Width);
if not ShowPos(Index, s1, s2, Width) then
ShowScreen(3);
end else
ShowScreen(3);
end;
function THelpView.ShowContents: Boolean;
begin
ShowContents := PushShowScreen(hcContents);
end;
function THelpView.ShowIndex: Boolean;
begin
ShowIndex := PushShowScreen(hcIndex);
end;
function THelpView.ShowHelpOnHelp: Boolean;
begin
ShowHelpOnHelp := PushShowScreen(hcHelpOnHelp);
end;
function THelpView.ValidScreen: Boolean;
begin
ValidScreen := CurIndex <> $FFFF;
end;
function THelpView.HasLinks: Boolean;
begin
HasLinks := ValidScreen and (CurScreen^.MaxIndex > 0);
end;
procedure THelpView.Format(Width: Word; Adjust: Boolean);
var
P: array[0..3] of PPos;
N: Word;
C: Byte;
begin
C := ScreenPos.Col;
N := 0;
if Adjust then
begin
P[0] := @CursorPos;
P[1] := @ScreenPos;
P[2] := @BlockBeg;
P[3] := @BlockEnd;
N := 4;
end;
CurScreen^.Format(Width, P, N);
ScreenPos.Col := C;
CurWidth := Width;
end;
procedure THelpView.Reformat;
var
Width: Word;
begin
Width := Size.X - 1;
if CurWidth <> Width then
Format(Width, True);
end;
procedure THelpView.UpdateCommands;
var
T: TCommandSet;
begin
GetCommands(T);
ChangeSet(T, cmCopy, HasSelection);
ChangeSet(T, cmCrossRef, HasLinks);
ChangeSet(T, cmCopyExample, HasExample);
SetCommands(T);
end;
function THelpView.HasSelection: Boolean;
begin
HasSelection := ValidScreen and not InDialog and
(BlockBeg.Compare(BlockEnd) <> 0);
end;
function THelpView.HasExample: Boolean;
begin
HasExample := ValidScreen and not InDialog and (CurScreen <> nil) and
CurScreen^.HasExample;
end;
procedure THelpView.CopyToClip(var BegPos, EndPos: TPos);
var
Row: Word;
Text: PChar;
TrailingSpaces: Boolean;
MinLeadingSpaces, EatSpaces, RowLength, LeadingSpaces: Integer;
Index: Word;
Example: Boolean;
NewText: string[80];
procedure Help2Text(Src: PChar; Dest: string); assembler;
asm
PUSH DS
CLD
LDS SI,Src
LES DI,Dest
MOV BX,DI
INC DI
MOV CX,1
MOV AL,' '
REP STOSB
MOV CX,77
JMP @@2
@@1: AND AL,AL
JZ @@3
@@2: LODSB
CMP AL,7
JB @@1
STOSB
LOOP @@2
@@3: SUB CL,78
NEG CL
JCXZ @@4
DEC DI
STD
MOV AL,' '
REPE SCASB
JE @@4
INC CX
@@4: MOV ES:[BX],CL
CLD
POP DS
end;
procedure Row2Text(Row: Word);
begin
CurScreen^.GetRow(Row, Text, Index, Example);
Help2Text(Text, NewText);
end;
function GetLeadingSpaces(S: string): Word; assembler;
asm
CLD
LES DI,S
MOV BX,DI
MOV CL,ES:[DI]
SUB CH,CH
JCXZ @@1
INC DI
MOV AL,' '
REPE SCASB
JE @@1
SUB DI,BX
XCHG AX,DI
DEC AX
DEC AX
JMP @@2
@@1: MOV AX,78
@@2:
end;
function RowLeadingSpaces(Row: Word): Word;
begin
Row2Text(Row);
RowLeadingSpaces := GetLeadingSpaces(NewText);
end;
function Inside(Row: Word): Boolean;
begin
Inside := ((Row <> BegPos.Row) and (Row <> EndPos.Row)) or
((Row = BegPos.Row) and (Row < EndPos.Row) and (BegPos.Col = 0)) or
((Row = EndPos.Row) and (Row > BegPos.Row) and TrailingSpaces);
end;
begin
MinLeadingSpaces := 78;
TrailingSpaces := EndPos.Col >= RowLeadingSpaces(EndPos.Row);
for Row := BegPos.Row to EndPos.Row do
if Inside(Row) then
begin
LeadingSpaces := RowLeadingSpaces(Row);
if LeadingSpaces < MinLeadingSpaces then
MinLeadingSpaces := LeadingSpaces;
end;
if MinLeadingSpaces = 78 then
MinLeadingSpaces := 0;
for Row := BegPos.Row to EndPos.Row do
begin
if Inside(Row) then
EatSpaces := MinLeadingSpaces
else
EatSpaces := 0;
if (Row = BegPos.Row) and (BegPos.Col > EatSpaces) then
EatSpaces := BegPos.Col;
RowLength := 78;
if Row = EndPos.Row then
begin
RowLength := EndPos.Col - EatSpaces;
if RowLength < 0 then
RowLength := 0;
end;
Row2Text(Row);
if Length(NewText) <= EatSpaces then
RowLength := 0
else if EatSpaces + RowLength > Length(NewText) then
RowLength := Length(NewText) - EatSpaces;
if Row <> EndPos.Row then
begin
NewText[EatSpaces+RowLength+1] := ^M;
NewText[EatSpaces+RowLength+2] := ^J;
RowLength := RowLength + 2;
end;
PutToVMem(NewText[EatSpaces+1], RowLength);
end;
Clipboard^.CopyToClip;
end;
procedure THelpView.Copy;
begin
if HasSelection then CopyToClip(BlockBeg,BlockEnd);
end;
procedure THelpView.CopyExample;
var
BegPos, EndPos: TPos;
procedure Adjust(var Pos: TPos);
begin
with Pos do
if Col = 1 then
Col := 0;
end;
begin
if HasExample then
begin
CurScreen^.GetExample(BegPos, EndPos);
Adjust(BegPos);
Adjust(EndPos);
CopyToClip(BegPos, EndPos);
end;
end;
function THelpView.GetRowCount: Word;
var
Row: Word;
begin
Row := CurScreen^.MaxRow;
if Row > 0 then
Dec(Row);
GetRowCount := Row;
end;
function THelpView.MaxLeftCol: Byte;
begin
MaxLeftCol := 78 - Size.X;
end;
procedure THelpView.AdjustCol;
var
Col: Byte;
begin
Col := MaxLeftCol;
if ScreenPos.Col > Col then
ScreenPos.Col := Col;
end;
procedure THelpView.AdjustRow;
var
Row: Word;
begin
Row := GetRowCount;
if ScreenPos.Row > Row then
ScreenPos.Row := Row;
end;
procedure THelpView.AdjustPos;
begin
AdjustRow;
AdjustCol;
end;
procedure THelpView.AdjustCursor(var Pos: TPos);
begin
if Pos.Col >= 78 then
Pos.Col := 77;
if Pos.Row > GetRowCount then
Pos.Row := GetRowCount;
end;
procedure THelpView.UpdateCursor;
begin
if (CursorPos.Col >= ScreenPos.Col) and
(CursorPos.Col < ScreenPos.Col + Size.X) and
(CursorPos.Row >= ScreenPos.Row) and
(CursorPos.Row < ScreenPos.Row + Size.Y) then
begin
SetCursor(CursorPos.Col - ScreenPos.Col, CursorPos.Row - ScreenPos.Row);
ShowCursor;
end else
HideCursor;
end;
procedure THelpView.ProcessScrollBars;
begin
ScreenPos.Row := VScrollBar^.Value;
ScreenPos.Col := HScrollBar^.Value;
DrawView;
end;
procedure THelpView.UpdateScrollBars;
begin
VScrollBar^.Value := ScreenPos.Row;
VScrollBar^.SetParams(ScreenPos.Row, 0, GetRowCount, Size.Y, 1);
VScrollBar^.DrawView;
HScrollBar^.Value := ScreenPos.Col;
HScrollBar^.SetParams(ScreenPos.Col, 0, MaxLeftCol, Size.X, 1);
HScrollBar^.DrawView;
end;
procedure THelpView.GetColors(var Colors: TColorArray);
var
StartRow: Integer;
begin
for StartRow := 0 to 7 do
Colors[StartRow] := GetColor(StartRow + 1);
end;
procedure THelpView.DrawRows(BegRow, EndRow: Word);
var
Colors: TColorArray;
Row: Word;
B: array[0..77] of Word;
Text: PChar;
Index: Word;
Example: Boolean;
I, BlockBegRow, BlockBegCol, BlockEndRow, BlockEndCol: Word;
begin
GetColors(Colors);
BlockBegRow := BlockBeg.Row;
BlockBegCol := BlockBeg.Col;
BlockEndRow := BlockEnd.Row;
BlockEndCol := BlockEnd.Col;
I := HiliteIndex shl 1 + 1;
for Row := BegRow + ScreenPos.Row to EndRow + ScreenPos.Row do
begin
CurScreen^.GetRow(Row, Text, Index, Example);
Index := Index shl 1;
asm
PUSH DS
MOV AX,Row
SUB BX,BX
CMP AX,BlockBegRow
JB @@3
JNZ @@1
MOV BX,BlockBegCol
@@1: MOV DX,78
CMP AX,BlockEndRow
JA @@3
JNZ @@2
MOV DX,BlockEndCol
@@2: SUB DX,BX
JGE @@4
@@3: SUB BX,BX
SUB DX,DX
@@4: PUSH SS
POP ES
LEA DI,B
CLD
MOV CX,BX
MOV AX,' '
REP STOSW
MOV CX,DX
MOV AH,4
REP STOSW
MOV CX,78
SUB CX,BX
SUB CX,DX
MOV AH,0
REP STOSW
LEA DI,B[2]
MOV CX,78
LDS SI,Text
MOV DH,0
TEST Example,1
JZ @@5
MOV DH,1
@@5: JMP @@10
@@6: CMP AL,2
JNE @@8
INC Index
MOV BX,Index
TEST BX,1
JNZ @@7
MOV DH,DL
JMP @@9
@@7: MOV DL,DH
MOV DH,2
CMP BX,I
JNE @@9
MOV DH,3
JMP @@9
@@8: OR AL,AL
JZ @@11
CMP AL,5
JNE @@9
XOR Example,1
MOV DH,0
JZ @@9
MOV DH,1
@@9: LODSB
CMP AL,7
JB @@6
MOV AH,DH
ADD AH,ES:[DI+1]
STOSW
@@10: LOOP @@9
@@11: POP DS
LEA BX,Colors
LEA DI,B[1]
MOV CX,78
@@12: MOV AL,ES:[DI]
XLAT
STOSB
INC DI
LOOP @@12
end;
WriteLine(0, Row - ScreenPos.Row, Size.X, 1, B[ScreenPos.Col]);
end;
end;
procedure THelpView.Draw;
begin
if ValidScreen then
begin
Reformat;
AdjustPos;
UpdateCursor;
UpdateScrollBars;
DrawRows(0, Size.Y - 1);
end;
end;
procedure THelpView.RedrawRows(BegRow, EndRow: Integer);
var
I: Integer;
begin
BegRow := BegRow - ScreenPos.Row;
EndRow := EndRow - ScreenPos.Row;
if BegRow > EndRow then
begin
I := BegRow;
BegRow := EndRow;
EndRow := I
end;
if BegRow < 0 then
BegRow := 0;
if EndRow >= Size.Y then
EndRow := Size.Y - 1;
if BegRow <= EndRow then
begin
UpdateCursor;
UpdateScrollBars;
DrawRows(BegRow, EndRow);
end;
end;
function THelpView.ScrollBy(R, C: Word): Byte;
var
Row, Col: Integer;
Flag: Byte;
begin
Row := ScreenPos.Row + R;
Col := ScreenPos.Col + C;
if Row < 0 then
Row := 0
else if Row > GetRowCount then
Row := GetRowCount;
if Col < 0 then
Col := 0
else if Col > MaxLeftCol then
Col := MaxLeftCol;
Flag := Integer(Row <> ScreenPos.Row) shl 1 or Integer(Col <> ScreenPos.Col);
if Flag <> 0 then
begin
ScreenPos.Row := Row;
ScreenPos.Col := Col;
Draw;
Flag := Flag or 4;
end;
ScrollBy := Flag;
end;
function THelpView.ScrollTo(Row, Col: Integer; Len: Word; Center: Boolean):
Byte;
var
R, C, Half: Integer;
begin
Col := Col - ScreenPos.Col;
C := Col;
if C > 0 then
begin
C := C + Len - Size.X;
if C < 0 then
C := 0
else if Col < C then
C := Col;
end;
Row := Row - ScreenPos.Row;
R := Row;
if R > 0 then
begin
R := Row - Size.Y + 1;
if R < 0 then
R := 0;
end;
if Center and (R <> 0) then
begin
Half := Size.Y shr 1;
if R < 0 then
R := R - Half
else
R := R + Half;
end;
if R or C <> 0 then
ScrollTo := ScrollBy(R, C)
else
ScrollTo := 0;
end;
function THelpView.ScrollToCursor: Byte;
var
Flag: Byte;
begin
Flag := ScrollTo(CursorPos.Row, CursorPos.Col, 1, False);
if Flag = 0 then
UpdateCursor;
ScrollToCursor := Flag;
end;
function THelpView.MoveByRaw(R, C: Word; Hilite, Drag: Boolean): Byte;
var
Flag: Byte;
NeedRedraw, Changed: Boolean;
Row, Col, OldRow: Integer;
begin
Row := CursorPos.Row + R;
Col := CursorPos.Col + C;
OldRow := CursorPos.Row;
if Row < 0 then
Row := 0
else if Row >= GetRowCount then
Row := GetRowCount;
if Col < 0 then
Col := 0
else if Col >= 78 then
Col := 77;
Changed := (Row <> CursorPos.Row) or (Col <> CursorPos.Col);
if Changed then
begin
CursorPos.Row := Row;
CursorPos.Col := Col
end;
NeedRedraw := False;
if not InDialog and Drag then
begin
NeedRedraw := Changed;
if BlockPresent then
if CursorPos.Compare(BlockEnd) >= 0 then
begin
BlockBeg := BlockEnd;
BlockEnd := CursorPos;
BlockPresent := False;
end else
BlockBeg := CursorPos
else if CursorPos.Compare(BlockBeg) < 0 then
begin
BlockEnd := BlockBeg;
BlockBeg := CursorPos;
BlockPresent := True;
end else
BlockEnd := CursorPos;
end else
begin
NeedRedraw := BlockBeg.Compare(BlockEnd) <> 0;
BlockPresent := False;
BlockBeg := CursorPos;
BlockEnd := BlockBeg;
end;
Flag := ScrollToCursor;
if Hilite then
HiliteCurrent;
if (Flag and 4 = 0) and NeedRedraw then
if Drag and (Abs(OldRow - Row) < Size.Y shr 1) then
RedrawRows(OldRow, Row)
else
Draw;
MoveByRaw := Flag;
end;
function THelpView.MoveBy(R, C: Integer; Drag: Boolean): Byte;
begin
TrackClear;
MoveBy := MoveByRaw(R, C, True, Drag);
end;
procedure THelpView.MoveToMouse(R, C: Word; Drag: Boolean);
begin
MoveBy(ScreenPos.Row + R - CursorPos.Row,
ScreenPos.Col + C - CursorPos.Col, Drag);
end;
procedure THelpView.MoveCode(RCode, CCode: Byte; Drag: Boolean);
var
R, C, RR, I, J: Integer;
W: THelpWalker;
label
A, B;
begin
R := 0;
C := 0;
RR := 0;
case RCode of
0:
;
1:
begin
if (CursorPos.Row >= ScreenPos.Row) and
(CursorPos.Row < ScreenPos.Row + Size.Y) then
RR := -Size.Y;
R := -Size.Y;
end;
2:
begin
J := CursorPos.Row + Size.Y;
if J > GetRowCount then
J := GetRowCount;
if (J < ScreenPos.Row) or (J >= ScreenPos.Row + Size.Y) then
RR := Size.Y;
R := J - CursorPos.Row;
end;
7:
R := -CursorPos.Row;
8:
R := GetRowCount - CursorPos.Row;
9:
R := ScreenPos.Row - CursorPos.Row;
10:
R := ScreenPos.Row + Size.Y - 1 - CursorPos.Row;
end;
case CCode of
0:
;
5:
C := -CursorPos.Col;
6:
begin
ScrollBy(RR, 0);
MoveBy(R, 0, Drag);
RR := 0;
R := 0;
W.Init(CurScreen, CursorPos.Row);
W.GoEol;
C := W.Col - CursorPos.Col;
end;
4:
begin
W.Init(CurScreen, CursorPos.Row);
W.GoCol(CursorPos.Col);
while W.CurChar in HelpWordChars do
W.GoForward;
while not (W.CurChar in HelpWordChars) do
if W.CurChar = #0 then
begin
Inc(R);
if not W.GetRow(CursorPos.Row + R) then
begin
Dec(R);
W.GetRow(CursorPos.Row + R);
W.GoEol;
goto A;
end
end else
W.GoForward;
A: C := W.Col - CursorPos.Col;
end;
3:
begin
W.Init(CurScreen, CursorPos.Row);
W.GoCol(CursorPos.Col);
W.GoBack;
while not (W.CurChar in HelpWordChars) do
if W.Col = 0 then
if CursorPos.Row + R = 0 then
goto B
else
begin
Dec(R);
W.GetRow(CursorPos.Row + R);
W.GoEol;
end else
W.GoBack;
while (W.Col > 0) and (W.CurChar in HelpWordChars) do
W.GoBack;
if not (W.CurChar in HelpWordChars) then
W.GoForward;
B: C := W.Col - CursorPos.Col;
end;
end;
ScrollBy(RR, 0);
MoveBy(R, C, Drag);
end;
procedure THelpView.ScrollToHilite(MoveCursor: Boolean; Ofs: Integer;
Center: Boolean);
var
R, C: Integer;
Len: Word;
begin
CurScreen^.GetPos(HiliteIndex, R, C, Len);
ScrollTo(R, C, Len, Center);
if MoveCursor then
begin
R := R - CursorPos.Row;
C := C - CursorPos.Col;
if Ofs > 0 then
MoveByRaw(R, C + Ofs, False, False)
else
MoveBy(R, C, False);
end;
end;
procedure THelpView.ChangeHilite(Index: Word; Scroll: Boolean; Ofs: Integer;
Center: Boolean);
var
OldHilite: Word;
Row, Col: Integer;
Len: Word;
begin
if CurScreen^.MaxIndex > 0 then
begin
OldHilite := HiliteIndex;
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.