whlpview.pas 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Help display objects
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit WHlpView;
  13. interface
  14. uses
  15. Objects,Drivers,Views,
  16. {$ifdef FVISION}
  17. FVConsts,
  18. {$else}
  19. Commands,
  20. {$endif}
  21. WEditor,WCEdit,
  22. WUtils,WHelp;
  23. {$IFNDEF EDITORS}
  24. type
  25. TEditor = TCodeEditor; PEditor = PCodeEditor;
  26. {$ENDIF}
  27. const
  28. cmPrevTopic = 90;
  29. HistorySize = 30;
  30. CHelpViewer = #33#34#35#36;
  31. CHelpFrame = #37#37#38#38#39;
  32. cmHelpFilesChanged = 57340;
  33. type
  34. PHelpLink = ^THelpLink;
  35. THelpLink = record
  36. Bounds : TRect;
  37. FileID : longint;
  38. Context : THelpCtx;
  39. end;
  40. PHelpColorArea = ^THelpColorArea;
  41. THelpColorArea = record
  42. Color : byte;
  43. Bounds : TRect;
  44. AttrMask : byte;
  45. end;
  46. PHelpKeyword = ^THelpKeyword;
  47. THelpKeyword = record
  48. KWord : PString;
  49. Index : sw_integer;
  50. end;
  51. PLinkCollection = ^TLinkCollection;
  52. TLinkCollection = object(TCollection)
  53. procedure FreeItem(Item: Pointer); virtual;
  54. end;
  55. PColorAreaCollection = ^TColorAreaCollection;
  56. TColorAreaCollection = object(TCollection)
  57. procedure FreeItem(Item: Pointer); virtual;
  58. end;
  59. PKeywordCollection = ^TKeywordCollection;
  60. TKeywordCollection = object({TSorted}TCollection)
  61. function At(Index: sw_Integer): PHelpKeyword;
  62. procedure FreeItem(Item: Pointer); virtual;
  63. function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
  64. end;
  65. { TSearchRelation = (srEqual,srGreater,srLess,srGreatEqu,srLessEqu);
  66. PAdvancedStringCollection = ^TAdvancedStringCollection;
  67. TAdvancedStringCollection = object(TStringCollection)
  68. function SearchItem(Key: pointer; Rel: TSearchRelation; var Index: integer): boolean; virtual;
  69. end;}
  70. PNamedMark = ^TNamedMark;
  71. TNamedMark = object(TObject)
  72. constructor Init(const AName: string; AX, AY: integer);
  73. function GetName: string;
  74. destructor Done; virtual;
  75. private
  76. Name: PString;
  77. Pos: TPoint;
  78. end;
  79. PNamedMarkCollection = ^TNamedMarkCollection;
  80. TNamedMarkCollection = object(TSortedCollection)
  81. function At(Index: sw_Integer): PNamedMark;
  82. function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
  83. function SearchMark(const Name: string): PNamedMark;
  84. function GetMarkPos(const Name: string; var P: TPoint): boolean;
  85. procedure Add(const Name: string; P: TPoint);
  86. end;
  87. PLinePosCollection = ^TLinePosCollection;
  88. TLinePosCollection = object(TNoDisposeCollection)
  89. function At(Index: sw_Integer): sw_integer;
  90. procedure Insert (Item: longint);virtual;
  91. end;
  92. PHelpTopic = ^THelpTopic;
  93. THelpTopic = object(TObject)
  94. Topic: PTopic;
  95. Lines: PUnsortedStringCollection;
  96. LinesPos: PLinePosCollection;
  97. Links: PLinkCollection;
  98. NamedMarks: PNamedMarkCollection;
  99. ColorAreas: PColorAreaCollection;
  100. public
  101. constructor Init(ATopic: PTopic);
  102. procedure SetParams(AMargin, AWidth: sw_integer); virtual;
  103. function GetLineCount: sw_integer; virtual;
  104. function GetLineText(Line: sw_integer): string; virtual;
  105. function GetLinkCount: sw_integer; virtual;
  106. procedure GetLinkBounds(Index: sw_integer; var R: TRect); virtual;
  107. function GetLinkFileID(Index: sw_integer): word; virtual;
  108. function GetLinkContext(Index: sw_integer): THelpCtx; virtual;
  109. function GetColorAreaCount: sw_integer; virtual;
  110. procedure GetColorAreaBounds(Index: sw_integer; var R: TRect); virtual;
  111. function GetColorAreaColor(Index: sw_integer): word; virtual;
  112. function GetColorAreaMask(Index: sw_integer): word; virtual;
  113. destructor Done; virtual;
  114. private
  115. Width,Margin: sw_integer;
  116. { StockItem: boolean;}
  117. procedure ReBuild;
  118. end;
  119. THelpHistoryEntry = record
  120. Context_ : THelpCtx;
  121. Delta_ : TPoint;
  122. CurPos_ : TPoint;
  123. CurLink_ : sw_integer;
  124. FileID_ : word;
  125. end;
  126. PHelpViewer = ^THelpViewer;
  127. THelpViewer = object(TEditor)
  128. Margin: sw_integer;
  129. HelpTopic: PHelpTopic;
  130. CurLink: sw_integer;
  131. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  132. procedure ChangeBounds(var Bounds: TRect); virtual;
  133. procedure Draw; virtual;
  134. procedure HandleEvent(var Event: TEvent); virtual;
  135. procedure SetCurPtr(X,Y: sw_integer); virtual;
  136. function GetLineCount: sw_integer; virtual;
  137. function GetLine(LineNo: sw_integer): PCustomLine; virtual;
  138. function GetLineText(Line: sw_integer): string; virtual;
  139. function GetDisplayText(I: sw_integer): string; virtual;
  140. function GetLinkCount: sw_integer; virtual;
  141. procedure GetLinkBounds(Index: sw_integer; var R: TRect); virtual;
  142. function GetLinkFileID(Index: sw_integer): word; virtual;
  143. function GetLinkContext(Index: sw_integer): THelpCtx; virtual;
  144. function GetLinkTarget(Index: sw_integer): string; virtual;
  145. function GetLinkText(Index: sw_integer): string; virtual;
  146. function GetColorAreaCount: sw_integer; virtual;
  147. procedure GetColorAreaBounds(Index: sw_integer; var R: TRect); virtual;
  148. function GetColorAreaColor(Index: sw_integer): word; virtual;
  149. function GetColorAreaMask(Index: sw_integer): word; virtual;
  150. procedure SelectNextLink(ANext: boolean); virtual;
  151. procedure SwitchToIndex; virtual;
  152. procedure SwitchToTopic(SourceFileID: word; Context: THelpCtx); virtual;
  153. procedure SetTopic(Topic: PTopic); virtual;
  154. procedure SetCurLink(Link: sw_integer); virtual;
  155. procedure SelectLink(Index: sw_integer); virtual;
  156. procedure PrevTopic; virtual;
  157. procedure RenderTopic; virtual;
  158. procedure Lookup(S: string); virtual;
  159. function GetPalette: PPalette; virtual;
  160. constructor Load(var S: TStream);
  161. procedure Store(var S: TStream);
  162. destructor Done; virtual;
  163. private
  164. History : array[0..HistorySize] of THelpHistoryEntry;
  165. HistoryPtr : integer;
  166. WordList : PKeywordCollection;
  167. Lookupword : string;
  168. InLookUp : boolean;
  169. IndexTopic : PTopic;
  170. IndexHelpTopic: PHelpTopic;
  171. function LinkContainsPoint(var R: TRect; var P: TPoint): boolean;
  172. procedure ISwitchToTopic(SourceFileID: word; Context: THelpCtx; RecordInHistory: boolean);
  173. procedure ISwitchToTopicPtr(P: PTopic; RecordInHistory: boolean);
  174. procedure BuildTopicWordList;
  175. end;
  176. PHelpFrame = ^THelpFrame;
  177. THelpFrame = object(TFrame)
  178. function GetPalette: PPalette; virtual;
  179. end;
  180. PHelpWindow = ^THelpWindow;
  181. THelpWindow = object(TWindow)
  182. HSB,VSB : PScrollBar;
  183. HelpView: PHelpViewer;
  184. HideOnClose: boolean;
  185. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
  186. procedure InitFrame; virtual;
  187. procedure InitScrollBars; virtual;
  188. procedure InitHelpView; virtual;
  189. procedure ShowIndex; virtual;
  190. procedure ShowTopic(SourceFileID: word; Context: THelpCtx); virtual;
  191. procedure HandleEvent(var Event: TEvent); virtual;
  192. procedure Close; virtual;
  193. function GetPalette: PPalette; virtual; { needs to be overriden }
  194. end;
  195. implementation
  196. uses
  197. Video,
  198. WConsts;
  199. const CommentColor = Blue;
  200. function NewLink(FileID: longint; Topic: THelpCtx; StartP, EndP: TPoint): PHelpLink;
  201. var P: PHelpLink;
  202. begin
  203. New(P); FillChar(P^, SizeOf(P^), 0);
  204. P^.FileID:=FileID;
  205. P^.Context:=Topic; P^.Bounds.A:=StartP; P^.Bounds.B:=EndP;
  206. NewLink:=P;
  207. end;
  208. procedure DisposeLink(P: PHelpLink);
  209. begin
  210. if P<>nil then Dispose(P);
  211. end;
  212. function NewColorArea(Color, AttrMask: byte; StartP, EndP: TPoint): PHelpColorArea;
  213. var P: PHelpColorArea;
  214. begin
  215. New(P); FillChar(P^, SizeOf(P^), 0);
  216. P^.Color:=Color; P^.AttrMask:=AttrMask;
  217. P^.Bounds.A:=StartP; P^.Bounds.B:=EndP;
  218. NewColorArea:=P;
  219. end;
  220. procedure DisposeColorArea(P: PHelpColorArea);
  221. begin
  222. if P<>nil then Dispose(P);
  223. end;
  224. function NewKeyword(Index: sw_integer; KWord: string): PHelpKeyword;
  225. var P: PHelpKeyword;
  226. begin
  227. New(P); FillChar(P^, SizeOf(P^), 0);
  228. P^.Index:=Index; P^.KWord:=NewStr(KWord);
  229. NewKeyword:=P;
  230. end;
  231. procedure DisposeKeyword(P: PHelpKeyword);
  232. begin
  233. if P<>nil then
  234. begin
  235. if P^.KWord<>nil then DisposeStr(P^.KWord);
  236. Dispose(P);
  237. end;
  238. end;
  239. procedure TLinkCollection.FreeItem(Item: Pointer);
  240. begin
  241. if Item<>nil then DisposeLink(Item);
  242. end;
  243. procedure TColorAreaCollection.FreeItem(Item: Pointer);
  244. begin
  245. if Item<>nil then DisposeColorArea(Item);
  246. end;
  247. function TKeywordCollection.At(Index: sw_Integer): PHelpKeyword;
  248. begin
  249. At:=inherited At(Index);
  250. end;
  251. procedure TKeywordCollection.FreeItem(Item: Pointer);
  252. begin
  253. if Item<>nil then DisposeKeyword(Item);
  254. end;
  255. function TKeywordCollection.Compare(Key1, Key2: Pointer): sw_Integer;
  256. var R: sw_integer;
  257. K1: PHelpKeyword absolute Key1;
  258. K2: PHelpKeyword absolute Key2;
  259. S1,S2: string;
  260. begin
  261. S1:=UpcaseStr(K1^.KWord^); S2:=UpcaseStr(K2^.KWord^);
  262. if S1<S2 then R:=-1 else
  263. if S1>S2 then R:=1 else
  264. R:=0;
  265. Compare:=R;
  266. end;
  267. {function TAdvancedStringCollection.SearchItem(Key: pointer; Rel: TSearchRelation; var Index: sw_integer): boolean;
  268. var
  269. L, H, I, C: sw_Integer;
  270. const resSmaller = -1; resEqual = 0; resGreater = 1;
  271. begin
  272. Index:=-1;
  273. case Rel of
  274. srEqual :
  275. while (L <= H) and (Index=-1) do
  276. begin
  277. I := (L + H) shr 1;
  278. C := Compare(KeyOf(Items^[I]), Key);
  279. if C = resSmaller then L := I + 1 else
  280. begin
  281. H := I - 1;
  282. if C = resEqual then
  283. begin
  284. if not Duplicates then L := I;
  285. Index := L;
  286. end;
  287. end;
  288. end;
  289. srGreater :
  290. begin
  291. end;
  292. srLess :
  293. ;
  294. srGreatEqu :
  295. ;
  296. srLessEqu :
  297. ;
  298. else Exit;
  299. end;
  300. Search:=Index<>-1;
  301. end;}
  302. constructor TNamedMark.Init(const AName: string; AX, AY: integer);
  303. begin
  304. inherited Init;
  305. Name:=NewStr(AName);
  306. Pos.X:=AX; Pos.Y:=AY;
  307. end;
  308. function TNamedMark.GetName: string;
  309. begin
  310. GetName:=GetStr(Name);
  311. end;
  312. destructor TNamedMark.Done;
  313. begin
  314. if Assigned(Name) then DisposeStr(Name); Name:=nil;
  315. inherited Done;
  316. end;
  317. function TNamedMarkCollection.At(Index: sw_Integer): PNamedMark;
  318. begin
  319. At:=inherited At(Index);
  320. end;
  321. function TNamedMarkCollection.Compare(Key1, Key2: Pointer): sw_Integer;
  322. var K1: PNamedMark absolute Key1;
  323. K2: PNamedMark absolute Key2;
  324. R: integer;
  325. N1,N2: string;
  326. begin
  327. N1:=UpcaseStr(K1^.GetName); N2:=UpcaseStr(K2^.GetName);
  328. if N1<N2 then R:=-1 else
  329. if N1>N2 then R:= 1 else
  330. R:=0;
  331. Compare:=R;
  332. end;
  333. function TNamedMarkCollection.SearchMark(const Name: string): PNamedMark;
  334. var M,P: PNamedMark;
  335. I: sw_integer;
  336. begin
  337. New(M, Init(Name,0,0));
  338. if Search(M,I)=false then P:=nil else
  339. P:=At(I);
  340. Dispose(M, Done);
  341. SearchMark:=P;
  342. end;
  343. function TNamedMarkCollection.GetMarkPos(const Name: string; var P: TPoint): boolean;
  344. var M: PNamedMark;
  345. begin
  346. M:=SearchMark(Name);
  347. if Assigned(M) then
  348. P:=M^.Pos;
  349. GetMarkPos:=Assigned(M);
  350. end;
  351. procedure TNamedMarkCollection.Add(const Name: string; P: TPoint);
  352. begin
  353. Insert(New(PNamedMark, Init(Name, P.X, P.Y)));
  354. end;
  355. function TLinePosCollection.At(Index: sw_Integer): sw_integer;
  356. begin
  357. at := longint (inherited at(Index));
  358. end;
  359. procedure TLinePosCollection.Insert (Item: longint);
  360. begin
  361. Inherited Insert(pointer(Item));
  362. end;
  363. constructor THelpTopic.Init(ATopic: PTopic);
  364. begin
  365. inherited Init;
  366. Topic:=ATopic;
  367. New(Lines, Init(100,100));
  368. New(LinesPos, Init(100,100));
  369. New(Links, Init(50,50));
  370. New(ColorAreas, Init(50,50));
  371. New(NamedMarks, Init(10,10));
  372. end;
  373. procedure THelpTopic.SetParams(AMargin, AWidth: sw_integer);
  374. begin
  375. if Width<>AWidth then
  376. begin
  377. Width:=AWidth; Margin:=AMargin;
  378. ReBuild;
  379. end;
  380. end;
  381. procedure THelpTopic.ReBuild;
  382. var TextPos,LinePos,LinkNo,NamedMarkNo: sw_word;
  383. Line,CurWord: string;
  384. C: char;
  385. InLink,InCodeArea,InColorArea,InImage: boolean;
  386. LinkStart,LinkEnd,CodeAreaStart,CodeAreaEnd: TPoint;
  387. ColorAreaStart,ColorAreaEnd: TPoint;
  388. ColorAreaType: (atText,atFull);
  389. CurPos: TPoint;
  390. ZeroLevel: sw_integer;
  391. LineStart,NextLineStart: sw_integer;
  392. LineAlign : (laLeft,laCenter,laRight);
  393. FirstLink,LastLink: sw_integer;
  394. AreaColor: word;
  395. NextByte: (nbNormal,nbAreaColor,nbDirect);
  396. procedure ClearLine;
  397. begin
  398. Line:='';
  399. end;
  400. procedure AddWord(TheWord: string); forward;
  401. procedure NextLine;
  402. var P: sw_integer;
  403. I,Delta: sw_integer;
  404. begin
  405. Line:=CharStr(' ',Margin)+Line;
  406. if not InImage then
  407. repeat
  408. P:=Pos(#255,Line);
  409. if P>0 then
  410. Line[P]:=#32;
  411. until P=0;
  412. if Not InImage then
  413. while copy(Line,length(Line),1)=' ' do
  414. Delete(Line,length(Line),1);
  415. Delta:=0;
  416. if Line<>'' then
  417. case LineAlign of
  418. laLeft : ;
  419. laCenter : if Margin+length(Line)+Margin<Width then
  420. begin
  421. Delta:=(Width-(Margin+length(Line)+Margin)) div 2;
  422. Line:=CharStr(' ',Delta)+Line;
  423. end;
  424. laRight : if Margin+length(Line)+Margin<Width then
  425. begin
  426. Delta:=Width-(Margin+length(Line)+Margin);
  427. Line:=CharStr(' ',Delta)+Line;
  428. end;
  429. end;
  430. if (Delta>0) and (FirstLink<>LastLink) then
  431. for I:=FirstLink to LastLink-1 do
  432. with PHelpLink(Links^.At(I))^ do
  433. Bounds.Move(Delta,0);
  434. if Line='' then Line:=' ';
  435. Lines^.Insert(NewStr(Line));
  436. LinesPos^.Insert(LinePos);
  437. ClearLine;
  438. LineStart:=NextLineStart;
  439. CurPos.X:=Margin+LineStart; Line:=CharStr(#255,LineStart); Inc(CurPos.Y);
  440. if InLink then LinkStart:=CurPos;
  441. FirstLink:=LastLink;
  442. LinePos:=TextPos;
  443. end;
  444. procedure FlushLine;
  445. var W: string;
  446. begin
  447. if CurWord<>'' then begin W:=CurWord; CurWord:=''; AddWord(W); end;
  448. NextLine;
  449. end;
  450. procedure AddWord(TheWord: string);
  451. var W: string;
  452. begin
  453. W:=TheWord;
  454. while (length(W)>0) and (W[length(W)] in [' ',#255]) do
  455. Delete(W,length(W),1);
  456. if (copy(Line+TheWord,1,1)<>' ') then
  457. if (Line<>'') and (Margin+length(Line)+length(W)+Margin>Width) and
  458. not InImage then
  459. NextLine;
  460. Line:=Line+TheWord;
  461. CurPos.X:=Margin+length(Line);
  462. end;
  463. procedure CheckZeroLevel;
  464. begin
  465. if ZeroLevel<>0 then
  466. begin
  467. if CurWord<>'' then AddWord(CurWord+' ');
  468. CurWord:='';
  469. ZeroLevel:=0;
  470. end;
  471. end;
  472. procedure EndColorArea;
  473. var Mask: word;
  474. begin
  475. if ColorAreaType=atText then Mask:=$f0 else Mask:=$00;
  476. if CurWord<>'' then AddWord(CurWord); CurWord:='';
  477. ColorAreaEnd:=CurPos; Dec(ColorAreaEnd.X);
  478. ColorAreas^.Insert(NewColorArea(AreaColor,Mask,ColorAreaStart,ColorAreaEnd));
  479. InColorArea:=false; AreaColor:=0;
  480. end;
  481. begin
  482. Lines^.FreeAll; LinesPos^.FreeAll;
  483. Links^.FreeAll; NamedMarks^.FreeAll; ColorAreas^.FreeAll;
  484. if Topic=nil then Lines^.Insert(NewStr(msg_nohelpavailabelforthistopic)) else
  485. begin
  486. LineStart:=0; NextLineStart:=0;
  487. TextPos:=0; ClearLine; CurWord:=''; Line:='';
  488. CurPos.X:=Margin+LineStart; CurPos.Y:=0; LinkNo:=0;
  489. NamedMarkNo:=0; LinePos:=0;
  490. InLink:=false; InCodeArea:=false; InColorArea:=false;
  491. InImage:=false;
  492. ZeroLevel:=0;
  493. LineAlign:=laLeft;
  494. FirstLink:=0; LastLink:=0; NextByte:=nbNormal;
  495. while (TextPos<Topic^.TextSize) or InImage do
  496. begin
  497. C:=chr(PByteArray(Topic^.Text)^[TextPos]);
  498. case NextByte of
  499. nbAreaColor :
  500. begin
  501. AreaColor:=ord(C);
  502. NextByte:=nbNormal;
  503. end;
  504. nbDirect :
  505. begin
  506. NextByte:=nbNormal;
  507. CurWord:=CurWord+C;
  508. end;
  509. nbNormal :
  510. begin
  511. case C of
  512. hscLineBreak :
  513. {if ZeroLevel=0 then ZeroLevel:=1 else
  514. begin FlushLine; FlushLine; ZeroLevel:=0; end;}
  515. if InLink then CurWord:=CurWord+' ' else
  516. begin
  517. NextLineStart:=0;
  518. FlushLine;
  519. LineStart:=0;
  520. LineAlign:=laLeft;
  521. end;
  522. #1 : {Break};
  523. hscLink :
  524. begin
  525. CheckZeroLevel;
  526. if InLink=false then
  527. begin LinkStart:=CurPos; InLink:=true; end else
  528. begin
  529. if CurWord<>'' then AddWord(CurWord); CurWord:='';
  530. LinkEnd:=CurPos; Dec(LinkEnd.X);
  531. if Topic^.Links<>nil then
  532. begin
  533. if LinkNo<Topic^.LinkCount then
  534. begin
  535. Inc(LastLink);
  536. Links^.Insert(NewLink(Topic^.Links^[LinkNo].FileID,
  537. Topic^.Links^[LinkNo].Context,LinkStart,LinkEnd));
  538. end;
  539. Inc(LinkNo);
  540. end;
  541. InLink:=false;
  542. end;
  543. end;
  544. hscLineStart :
  545. begin
  546. NextLineStart:=length(Line)+length(CurWord);
  547. { LineStart:=LineStart+(NextLineStart-LineStart);}
  548. end;
  549. hscCode :
  550. begin
  551. if InCodeArea=false then
  552. CodeAreaStart:=CurPos else
  553. begin
  554. if CurWord<>'' then AddWord(CurWord); CurWord:='';
  555. CodeAreaEnd:=CurPos; Dec(CodeAreaEnd.X);
  556. ColorAreas^.Insert(NewColorArea(CommentColor,$f0,CodeAreaStart,CodeAreaEnd));
  557. end;
  558. InCodeArea:=not InCodeArea;
  559. end;
  560. hscCenter :
  561. LineAlign:=laCenter;
  562. hscRight :
  563. LineAlign:=laRight{was laCenter, typo error ? PM };
  564. hscNamedMark :
  565. begin
  566. if NamedMarkNo<Topic^.NamedMarks^.Count then
  567. NamedMarks^.Add(GetStr(Topic^.NamedMarks^.At(NamedMarkNo)),CurPos);
  568. Inc(NamedMarkNo);
  569. end;
  570. hscTextAttr,hscTextColor :
  571. begin
  572. if InColorArea then
  573. EndColorArea;
  574. if C=hscTextAttr then
  575. ColorAreaType:=atFull
  576. else
  577. ColorAreaType:=atText;
  578. NextByte:=nbAreaColor;
  579. ColorAreaStart:=CurPos;
  580. InColorArea:=true;
  581. end;
  582. hscDirect :
  583. NextByte:=nbDirect;
  584. hscInImage :
  585. begin
  586. InImage := not InImage;
  587. end;
  588. hscNormText :
  589. begin
  590. if InColorArea then
  591. EndColorArea;
  592. end;
  593. #32: if InLink then CurWord:=CurWord+C else
  594. begin CheckZeroLevel; AddWord(CurWord+C); CurWord:=''; end;
  595. else begin CheckZeroLevel; CurWord:=CurWord+C; end;
  596. end;
  597. end;
  598. end;
  599. CurPos.X:=Margin+length(Line)+length(CurWord);
  600. Inc(TextPos);
  601. end;
  602. if (Line<>'') or (CurWord<>'') then FlushLine;
  603. end;
  604. end;
  605. function THelpTopic.GetLineCount: sw_integer;
  606. begin
  607. GetLineCount:=Lines^.Count;
  608. end;
  609. function THelpTopic.GetLineText(Line: sw_integer): string;
  610. var S: string;
  611. begin
  612. if Line<GetLineCount then S:=PString(Lines^.At(Line))^ else S:='';
  613. GetLineText:=S;
  614. end;
  615. function THelpTopic.GetLinkCount: sw_integer;
  616. begin
  617. GetLinkCount:=Links^.Count;
  618. end;
  619. procedure THelpTopic.GetLinkBounds(Index: sw_integer; var R: TRect);
  620. var P: PHelpLink;
  621. begin
  622. P:=Links^.At(Index);
  623. R:=P^.Bounds;
  624. end;
  625. function THelpTopic.GetLinkFileID(Index: sw_integer): word;
  626. var P: PHelpLink;
  627. begin
  628. P:=Links^.At(Index);
  629. GetLinkFileID:=P^.FileID;
  630. end;
  631. function THelpTopic.GetLinkContext(Index: sw_integer): THelpCtx;
  632. var P: PHelpLink;
  633. begin
  634. P:=Links^.At(Index);
  635. GetLinkContext:=P^.Context;
  636. end;
  637. function THelpTopic.GetColorAreaCount: sw_integer;
  638. begin
  639. GetColorAreaCount:=ColorAreas^.Count;
  640. end;
  641. procedure THelpTopic.GetColorAreaBounds(Index: sw_integer; var R: TRect);
  642. var P: PHelpColorArea;
  643. begin
  644. P:=ColorAreas^.At(Index);
  645. R:=P^.Bounds;
  646. end;
  647. function THelpTopic.GetColorAreaColor(Index: sw_integer): word;
  648. var P: PHelpColorArea;
  649. begin
  650. P:=ColorAreas^.At(Index);
  651. GetColorAreaColor:=P^.Color;
  652. end;
  653. function THelpTopic.GetColorAreaMask(Index: sw_integer): word;
  654. var P: PHelpColorArea;
  655. begin
  656. P:=ColorAreas^.At(Index);
  657. GetColorAreaMask:=P^.AttrMask;
  658. end;
  659. destructor THelpTopic.Done;
  660. begin
  661. inherited Done;
  662. Dispose(Lines, Done);
  663. Dispose(LinesPos, Done);
  664. Dispose(Links, Done);
  665. Dispose(ColorAreas, Done);
  666. Dispose(NamedMarks, Done);
  667. if (Topic<>nil) then DisposeTopic(Topic);
  668. end;
  669. constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  670. begin
  671. inherited Init(Bounds, AHScrollBar, AVScrollBar, nil, nil);
  672. Flags:=efInsertMode or efPersistentBlocks;
  673. ReadOnly:=true;
  674. New(WordList, Init(50,50));
  675. Margin:=1; CurLink:=-1;
  676. end;
  677. procedure THelpViewer.ChangeBounds(var Bounds: TRect);
  678. var
  679. LinePos,NewLineIndex,I : longint;
  680. ymin, ymax : sw_integer;
  681. prop : real;
  682. begin
  683. if Owner<>nil then Owner^.Lock;
  684. ymin:=Delta.Y;
  685. ymax:=ymin+Size.Y;
  686. if ymax>ymin then
  687. prop:=(CurPos.Y-ymin)/(ymax-ymin)
  688. else
  689. prop:=0;
  690. inherited ChangeBounds(Bounds);
  691. if (HelpTopic<>nil) and (HelpTopic^.Topic<>nil) and
  692. (HelpTopic^.Topic^.FileID<>0) then
  693. Begin
  694. LinePos:=HelpTopic^.LinesPos^.At(CurPos.Y)+CurPos.X;
  695. RenderTopic;
  696. NewLineIndex:=-1;
  697. For i:=0 to HelpTopic^.LinesPos^.Count-1 do
  698. if LinePos<HelpTopic^.LinesPos^.At(i) then
  699. begin
  700. NewLineIndex:=i-1;
  701. break;
  702. end;
  703. if NewLineIndex>=0 then
  704. Begin
  705. ymin:=NewLineIndex - trunc(prop * Size.Y);
  706. if ymin<0 then
  707. ymin:=0;
  708. ScrollTo(0,ymin);
  709. SetCurPtr(LinePos-HelpTopic^.LinesPos^.At(NewLineIndex),NewLineIndex);
  710. End;
  711. End;
  712. if Owner<>nil then Owner^.UnLock;
  713. end;
  714. procedure THelpViewer.RenderTopic;
  715. begin
  716. if HelpTopic<>nil then
  717. HelpTopic^.SetParams(Margin,Size.X);
  718. {$ifndef EDITORS}
  719. SetLimit(255,GetLineCount);
  720. {$endif}
  721. DrawView;
  722. end;
  723. function THelpViewer.LinkContainsPoint(var R: TRect; var P: TPoint): boolean;
  724. var OK: boolean;
  725. begin
  726. if (R.A.Y=R.B.Y) then
  727. OK:= (P.Y=R.A.Y) and (R.A.X<=P.X) and (P.X<=R.B.X) else
  728. OK:=
  729. ( (R.A.Y=P.Y) and (R.A.X<=P.X) ) or
  730. ( (R.A.Y<P.Y) and (P.Y<R.B.Y) ) or
  731. ( (R.B.Y=P.Y) and (P.X<=R.B.X) );
  732. LinkContainsPoint:=OK;
  733. end;
  734. procedure THelpViewer.SetCurPtr(X,Y: sw_integer);
  735. var OldCurLink,I: sw_integer;
  736. OldPos,P: TPoint;
  737. R: TRect;
  738. begin
  739. OldPos:=CurPos;
  740. OldCurLink:=CurLink;
  741. inherited SetCurPtr(X,Y);
  742. CurLink:=-1;
  743. P:=CurPos;
  744. for I:=0 to GetLinkCount-1 do
  745. begin
  746. GetLinkBounds(I,R);
  747. if LinkContainsPoint(R,P) then
  748. begin CurLink:=I; Break; end;
  749. end;
  750. if OldCurLink<>CurLink then DrawView;
  751. if ((OldPos.X<>CurPos.X) or (OldPos.Y<>CurPos.Y)) and (InLookup=false) then
  752. Lookup('');
  753. end;
  754. function THelpViewer.GetLineCount: sw_integer;
  755. var Count: sw_integer;
  756. begin
  757. if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLineCount;
  758. GetLineCount:=Count;
  759. end;
  760. function THelpViewer.GetLine(LineNo: sw_integer): PCustomLine;
  761. begin
  762. {Abstract; used in wcedit unit ! }
  763. GetLine:=nil;
  764. end;
  765. function THelpViewer.GetDisplayText(I: sw_integer): string;
  766. begin
  767. GetDisplayText:=ExtractTabs(GetLineText(I),DefaultTabSize);
  768. end;
  769. function THelpViewer.GetLineText(Line: sw_integer): string;
  770. var S: string;
  771. begin
  772. if HelpTopic=nil then S:='' else S:=HelpTopic^.GetLineText(Line);
  773. GetLineText:=S;
  774. end;
  775. function THelpViewer.GetLinkCount: sw_integer;
  776. var Count: sw_integer;
  777. begin
  778. if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLinkCount;
  779. GetLinkCount:=Count;
  780. end;
  781. procedure THelpViewer.GetLinkBounds(Index: sw_integer; var R: TRect);
  782. begin
  783. HelpTopic^.GetLinkBounds(Index,R);
  784. end;
  785. function THelpViewer.GetLinkFileID(Index: sw_integer): word;
  786. begin
  787. GetLinkFileID:=HelpTopic^.GetLinkFileID(Index);
  788. end;
  789. function THelpViewer.GetLinkContext(Index: sw_integer): THelpCtx;
  790. begin
  791. GetLinkContext:=HelpTopic^.GetLinkContext(Index);
  792. end;
  793. function THelpViewer.GetLinkTarget(Index: sw_integer): string;
  794. begin
  795. GetLinkTarget:='';
  796. end;
  797. function THelpViewer.GetLinkText(Index: sw_integer): string;
  798. var S: string;
  799. R: TRect;
  800. Y,StartX,EndX: sw_integer;
  801. begin
  802. S:=''; GetLinkBounds(Index,R);
  803. Y:=R.A.Y;
  804. while (Y<=R.B.Y) do
  805. begin
  806. if Y=R.A.Y then StartX:=R.A.X else StartX:=Margin;
  807. if Y=R.B.Y then EndX:=R.B.X else EndX:=High(S);
  808. S:=S+copy(GetLineText(Y),StartX+1,EndX-StartX+1);
  809. Inc(Y);
  810. end;
  811. GetLinkText:=S;
  812. end;
  813. function THelpViewer.GetColorAreaCount: sw_integer;
  814. var Count: sw_integer;
  815. begin
  816. if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetColorAreaCount;
  817. GetColorAreaCount:=Count;
  818. end;
  819. procedure THelpViewer.GetColorAreaBounds(Index: sw_integer; var R: TRect);
  820. begin
  821. HelpTopic^.GetColorAreaBounds(Index,R);
  822. end;
  823. function THelpViewer.GetColorAreaColor(Index: sw_integer): word;
  824. begin
  825. GetColorAreaColor:=HelpTopic^.GetColorAreaColor(Index);
  826. end;
  827. function THelpViewer.GetColorAreaMask(Index: sw_integer): word;
  828. begin
  829. GetColorAreaMask:=HelpTopic^.GetColorAreaMask(Index);
  830. end;
  831. procedure THelpViewer.SelectNextLink(ANext: boolean);
  832. var I,Link: sw_integer;
  833. R: TRect;
  834. begin
  835. if HelpTopic=nil then Exit;
  836. Link:=CurLink;
  837. if Link<>-1 then
  838. begin
  839. if ANext then
  840. begin Inc(Link); if Link>=GetLinkCount then Link:=0; end else
  841. begin Dec(Link); if Link=-1 then Link:=GetLinkCount-1; end;
  842. end else
  843. for I:=0 to GetLinkCount-1 do
  844. begin
  845. GetLinkBounds(I,R);
  846. if (R.A.Y>CurPos.Y) or
  847. (R.A.Y=CurPos.Y) and (R.A.X>CurPos.X) then
  848. begin Link:=I; Break; end;
  849. end;
  850. if (Link=-1) and (GetLinkCount>0) then
  851. if ANext then Link:=0
  852. else Link:=GetLinkCount-1;
  853. SetCurLink(Link);
  854. end;
  855. procedure THelpViewer.SetCurLink(Link: sw_integer);
  856. var R: TRect;
  857. begin
  858. if Link<>-1 then
  859. begin
  860. GetLinkBounds(Link,R);
  861. SetCurPtr(R.A.X,R.A.Y);
  862. TrackCursor(true);
  863. {St:=GetLinkTarget(Link);
  864. If St<>'' then
  865. SetTitle('Help '+St);}
  866. end;
  867. end;
  868. procedure THelpViewer.SwitchToIndex;
  869. begin
  870. if IndexTopic=nil then
  871. IndexTopic:=HelpFacility^.BuildIndexTopic;
  872. ISwitchToTopicPtr(IndexTopic,true);
  873. end;
  874. procedure THelpViewer.SwitchToTopic(SourceFileID: word; Context: THelpCtx);
  875. begin
  876. ISwitchToTopic(SourceFileID,Context,true);
  877. end;
  878. procedure THelpViewer.ISwitchToTopic(SourceFileID: word; Context: THelpCtx; RecordInHistory: boolean);
  879. var P: PTopic;
  880. begin
  881. if HelpFacility=nil then P:=nil else
  882. if (SourceFileID=0) and (Context=0) and (HelpTopic<>nil) then
  883. P:=IndexTopic else
  884. P:=HelpFacility^.LoadTopic(SourceFileID, Context);
  885. ISwitchToTopicPtr(P,RecordInHistory);
  886. end;
  887. procedure THelpViewer.ISwitchToTopicPtr(P: PTopic; RecordInHistory: boolean);
  888. var HistoryFull: boolean;
  889. begin
  890. if (P<>nil) and RecordInHistory and (HelpTopic<>nil) then
  891. begin
  892. HistoryFull:=HistoryPtr>=HistorySize;
  893. if HistoryFull then
  894. Move(History[1],History[0],SizeOf(History)-SizeOf(History[0]));
  895. with History[HistoryPtr] do
  896. begin
  897. {SourceTopic_:=SourceTopic; }Context_:=HelpTopic^.Topic^.HelpCtx;
  898. FileID_:=HelpTopic^.Topic^.FileID;
  899. Delta_:=Delta; CurPos_:=CurPos; CurLink_:=CurLink;
  900. end;
  901. if HistoryFull=false then Inc(HistoryPtr);
  902. end;
  903. if Owner<>nil then Owner^.Lock;
  904. SetTopic(P);
  905. DrawView;
  906. if Owner<>nil then Owner^.UnLock;
  907. end;
  908. procedure THelpViewer.PrevTopic;
  909. begin
  910. if HistoryPtr>0 then
  911. begin
  912. if Owner<>nil then Owner^.Lock;
  913. Dec(HistoryPtr);
  914. with History[HistoryPtr] do
  915. begin
  916. ISwitchToTopic(FileID_,Context_,false);
  917. ScrollTo(Delta_.X,Delta_.Y);
  918. SetCurPtr(CurPos_.X,CurPos_.Y);
  919. TrackCursor(false);
  920. if CurLink<>CurLink_ then SetCurLink(CurLink_);
  921. end;
  922. DrawView;
  923. if Owner<>nil then Owner^.UnLock;
  924. end;
  925. end;
  926. procedure THelpViewer.SetTopic(Topic: PTopic);
  927. var Bookmark: string;
  928. P: TPoint;
  929. begin
  930. CurLink:=-1;
  931. if (HelpTopic=nil) or (Topic<>HelpTopic^.Topic) then
  932. begin
  933. if (HelpTopic<>nil) and (HelpTopic<>IndexHelpTopic) then
  934. Dispose(HelpTopic, Done);
  935. HelpTopic:=nil;
  936. if Topic<>nil then
  937. begin
  938. if (Topic=IndexTopic) and (IndexHelpTopic<>nil) then
  939. HelpTopic:=IndexHelpTopic else
  940. New(HelpTopic, Init(Topic));
  941. if Topic=IndexTopic then
  942. IndexHelpTopic:=HelpTopic;
  943. end;
  944. end;
  945. if Owner<>nil then Owner^.Lock;
  946. SetCurPtr(0,0); TrackCursor(false);
  947. RenderTopic;
  948. BuildTopicWordList;
  949. Lookup('');
  950. if Assigned(Topic) then
  951. if Topic^.StartNamedMark>0 then
  952. if Topic^.NamedMarks^.Count>=Topic^.StartNamedMark then
  953. begin
  954. Bookmark:=GetStr(Topic^.NamedMarks^.At(Topic^.StartNamedMark-1));
  955. if HelpTopic^.NamedMarks^.GetMarkPos(Bookmark,P) then
  956. begin
  957. SetCurPtr(P.X,P.Y);
  958. ScrollTo(0,Max(0,P.Y-1));
  959. end;
  960. end;
  961. SetSelection(CurPos,CurPos);
  962. DrawView;
  963. if Owner<>nil then Owner^.UnLock;
  964. end;
  965. procedure THelpViewer.BuildTopicWordList;
  966. var I: sw_integer;
  967. begin
  968. WordList^.FreeAll;
  969. for I:=0 to GetLinkCount-1 do
  970. WordList^.Insert(NewKeyword(I,Trim(GetLinkText(I))));
  971. end;
  972. procedure THelpViewer.Lookup(S: string);
  973. var Index, I: Sw_integer;
  974. W: string;
  975. OldLookup: string;
  976. R: TRect;
  977. P: PHelpKeyword;
  978. begin
  979. InLookup:=true;
  980. OldLookup:=LookupWord;
  981. S:=UpcaseStr(S);
  982. Index:=-1;
  983. I:=0; {J:=0;
  984. while (J<GetLinkCount) do
  985. begin
  986. GetLinkBounds(J,R);
  987. if (R.A.Y<CurPos.Y) or ((R.A.Y=CurPos.Y) and (R.B.X<CurPos.X))
  988. then Inc(J) else
  989. begin I:=J; Break; end;
  990. end;}
  991. if S='' then LookupWord:='' else
  992. begin
  993. while (Index=-1) and (I<WordList^.Count) do
  994. begin
  995. P:=WordList^.At(I);
  996. if P^.KWord<>nil then
  997. begin
  998. W:=UpcaseStr(Trim(P^.KWord^));
  999. if copy(W,1,length(S))=S then Index:=I;
  1000. end;
  1001. { if W>S then Break else}
  1002. Inc(I);
  1003. end;
  1004. if Index<>-1 then
  1005. begin
  1006. W:=Trim(WordList^.At(Index)^.KWord^);
  1007. LookupWord:=copy(W,1,length(S));
  1008. end;
  1009. end;
  1010. if LookupWord<>OldLookup then
  1011. begin
  1012. if Index=-1 then SetCurLink(CurLink) else
  1013. begin
  1014. if Owner<>nil then Owner^.Lock;
  1015. P:=WordList^.At(Index);
  1016. S:=GetLinkText(P^.Index);
  1017. I:=Pos(LookupWord,S); if I=0 then I:=1;
  1018. GetLinkBounds(P^.Index,R);
  1019. SetCurPtr(R.A.X+(I-1)+length(Lookupword),R.A.Y);
  1020. CurLink:=P^.Index; DrawView;
  1021. TrackCursor(true);
  1022. if Owner<>nil then Owner^.UnLock;
  1023. end;
  1024. end;
  1025. InLookup:=false;
  1026. end;
  1027. procedure THelpViewer.SelectLink(Index: sw_integer);
  1028. var ID: word;
  1029. Ctx: THelpCtx;
  1030. begin
  1031. if Index=-1 then Exit;
  1032. if HelpTopic=nil then begin ID:=0; Ctx:=0; end else
  1033. begin
  1034. ID:=GetLinkFileID(Index);
  1035. Ctx:=GetLinkContext(Index);
  1036. end;
  1037. SwitchToTopic(ID,Ctx);
  1038. end;
  1039. procedure THelpViewer.HandleEvent(var Event: TEvent);
  1040. var DontClear: boolean;
  1041. procedure GetMousePos(var P: TPoint);
  1042. begin
  1043. MakeLocal(Event.Where,P);
  1044. Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
  1045. end;
  1046. begin
  1047. case Event.What of
  1048. evMouseDown :
  1049. if MouseInView(Event.Where) then
  1050. if (Event.Buttons=mbLeftButton) and (Event.Double) then
  1051. begin
  1052. inherited HandleEvent(Event);
  1053. if CurLink<>-1 then
  1054. SelectLink(CurLink);
  1055. end;
  1056. evBroadcast :
  1057. case Event.Command of
  1058. cmHelpFilesChanged :
  1059. begin
  1060. if HelpTopic=IndexHelpTopic then HelpTopic:=nil;
  1061. IndexTopic:=nil;
  1062. if IndexHelpTopic<>nil then Dispose(IndexHelpTopic, Done);
  1063. IndexHelpTopic:=nil;
  1064. end;
  1065. end;
  1066. evCommand :
  1067. begin
  1068. DontClear:=false;
  1069. case Event.Command of
  1070. cmPrevTopic :
  1071. PrevTopic;
  1072. else DontClear:=true;
  1073. end;
  1074. if DontClear=false then ClearEvent(Event);
  1075. end;
  1076. evKeyDown :
  1077. begin
  1078. DontClear:=false;
  1079. case Event.KeyCode of
  1080. kbTab :
  1081. SelectNextLink(true);
  1082. kbShiftTab :
  1083. begin NoSelect:=true; SelectNextLink(false); NoSelect:=false; end;
  1084. kbEnter :
  1085. if CurLink<>-1 then
  1086. SelectLink(CurLink);
  1087. kbBack,kbDel :
  1088. if Length(LookupWord)>0 then
  1089. Lookup(Copy(LookupWord,1,Length(LookupWord)-1));
  1090. else
  1091. case Event.CharCode of
  1092. #32..#255 :
  1093. begin NoSelect:=true; Lookup(LookupWord+Event.CharCode); NoSelect:=false; end;
  1094. else DontClear:=true;
  1095. end;
  1096. end;
  1097. TrackCursor(false);
  1098. if DontClear=false then ClearEvent(Event);
  1099. end;
  1100. end;
  1101. inherited HandleEvent(Event);
  1102. end;
  1103. procedure THelpViewer.Draw;
  1104. var NormalColor, LinkColor,
  1105. SelectColor, SelectionColor: word;
  1106. B: TDrawBuffer;
  1107. DX,DY,X,Y,I,MinX,MaxX,ScreenX: sw_integer;
  1108. LastLinkDrawn,LastColorAreaDrawn: sw_integer;
  1109. S: string;
  1110. R: TRect;
  1111. {$ifndef EDITORS}
  1112. SelR : TRect;
  1113. {$endif}
  1114. C,Mask: word;
  1115. CurP: TPoint;
  1116. ANDSB,ORSB: word;
  1117. begin
  1118. if ELockFlag>0 then
  1119. begin
  1120. DrawCalled:=true;
  1121. Exit;
  1122. end;
  1123. DrawCalled:=false;
  1124. NormalColor:=GetColor(1); LinkColor:=GetColor(2);
  1125. SelectColor:=GetColor(3); SelectionColor:=GetColor(4);
  1126. {$ifndef EDITORS}
  1127. SelR.A:=SelStart; SelR.B:=SelEnd;
  1128. {$endif}
  1129. LastLinkDrawn:=0; LastColorAreaDrawn:=0;
  1130. for DY:=0 to Size.Y-1 do
  1131. begin
  1132. Y:=Delta.Y+DY;
  1133. MoveChar(B,' ',NormalColor,Size.X);
  1134. if Y<GetLineCount then
  1135. begin
  1136. S:=copy(GetLineText(Y),Delta.X+1,High(S));
  1137. S:=copy(S,1,MaxViewWidth);
  1138. MoveStr(B,S,NormalColor);
  1139. for I:=LastColorAreaDrawn to GetColorAreaCount-1 do
  1140. begin
  1141. GetColorAreaBounds(I,R);
  1142. if R.A.Y>Y then Break;
  1143. LastColorAreaDrawn:=I;
  1144. if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)+Delta.X-1);
  1145. if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
  1146. if (R.A.Y<=Y) and (Y<=R.B.Y) then
  1147. begin
  1148. C:=GetColorAreaColor(I);
  1149. Mask:=GetColorAreaMask(I);
  1150. for DX:=MinX to MaxX do
  1151. begin
  1152. X:=DX;
  1153. ScreenX:=X-(Delta.X);
  1154. if (ScreenX>=0) and (ScreenX<=High(B)) then
  1155. begin
  1156. { CurP.X:=X; CurP.Y:=Y;
  1157. if LinkAreaContainsPoint(R,CurP) then}
  1158. (* B[ScreenX]:=(B[ScreenX] and $f0ff) or (C shl 8);*)
  1159. ANDSB:=(Mask shl 8)+$ff;
  1160. ORSB:=(C shl 8);
  1161. B[ScreenX]:=(B[ScreenX] and ANDSB) or ORSB;
  1162. end;
  1163. end;
  1164. end;
  1165. end;
  1166. for I:=LastLinkDrawn to GetLinkCount-1 do
  1167. begin
  1168. GetLinkBounds(I,R);
  1169. if R.A.Y>Y then Break;
  1170. LastLinkDrawn:=I;
  1171. if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)-1);
  1172. if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
  1173. if (R.A.Y<=Y) and (Y<=R.B.Y) then
  1174. for DX:=MinX to MaxX do
  1175. begin
  1176. X:=DX;
  1177. ScreenX:=X-(Delta.X);
  1178. if (ScreenX>=0) and (ScreenX<=High(B)) then
  1179. begin
  1180. CurP.X:=X; CurP.Y:=Y;
  1181. if LinkContainsPoint(R,CurP) then
  1182. if I=CurLink then C:=SelectColor else C:=LinkColor;
  1183. B[ScreenX]:=(B[ScreenX] and $ff) or (C shl 8);
  1184. end;
  1185. end;
  1186. end;
  1187. {$ifndef EDITORS}
  1188. if ((SelR.A.X<>SelR.B.X) or (SelR.A.Y<>SelR.B.Y)) and (SelR.A.Y<=Y) and (Y<=SelR.B.Y) then
  1189. begin
  1190. if Y=SelR.A.Y then MinX:=SelR.A.X else MinX:=0;
  1191. if Y=SelR.B.Y then MaxX:=SelR.B.X-1 else MaxX:=High(string);
  1192. for DX:=MinX to MaxX do
  1193. begin
  1194. X:=DX;
  1195. ScreenX:=X-(Delta.X);
  1196. if (ScreenX>=0) and (ScreenX<High(B)) then
  1197. B[ScreenX]:=(B[ScreenX] and $0fff) or ((SelectionColor and $f0) shl 8);
  1198. end;
  1199. end;
  1200. {$endif}
  1201. end;
  1202. WriteLine(0,DY,Size.X,1,B);
  1203. end;
  1204. DrawCursor;
  1205. end;
  1206. function THelpViewer.GetPalette: PPalette;
  1207. const P: string[length(CHelpViewer)] = CHelpViewer;
  1208. begin
  1209. GetPalette:=@P;
  1210. end;
  1211. constructor THelpViewer.Load(var S: TStream);
  1212. begin
  1213. inherited Load(S);
  1214. end;
  1215. procedure THelpViewer.Store(var S: TStream);
  1216. begin
  1217. inherited Store(S);
  1218. end;
  1219. destructor THelpViewer.Done;
  1220. begin
  1221. if (HelpTopic<>nil) and (HelpTopic<>IndexHelpTopic) then
  1222. Dispose(HelpTopic, Done);
  1223. HelpTopic:=nil;
  1224. if IndexHelpTopic<>nil then
  1225. Dispose(IndexHelpTopic, Done);
  1226. IndexHelpTopic:=nil;
  1227. inherited Done;
  1228. if assigned(WordList) then
  1229. Dispose(WordList, Done);
  1230. end;
  1231. function THelpFrame.GetPalette: PPalette;
  1232. const P: string[length(CHelpFrame)] = CHelpFrame;
  1233. begin
  1234. GetPalette:=@P;
  1235. end;
  1236. constructor THelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
  1237. begin
  1238. inherited Init(Bounds, ATitle, ANumber);
  1239. InitScrollBars;
  1240. if Assigned(HSB) then Insert(HSB);
  1241. if Assigned(VSB) then Insert(VSB);
  1242. InitHelpView;
  1243. if Assigned(HelpView) then
  1244. begin
  1245. if (ASourceFileID<>0) or (AContext<>0) then
  1246. ShowTopic(ASourceFileID, AContext);
  1247. Insert(HelpView);
  1248. end;
  1249. end;
  1250. procedure THelpWindow.InitScrollBars;
  1251. var R: TRect;
  1252. begin
  1253. GetExtent(R); R.Grow(0,-1); R.A.X:=R.B.X-1;
  1254. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1255. GetExtent(R); R.Grow(-1,0); R.A.Y:=R.B.Y-1;
  1256. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
  1257. end;
  1258. procedure THelpWindow.InitHelpView;
  1259. var R: TRect;
  1260. begin
  1261. GetExtent(R); R.Grow(-1,-1);
  1262. New(HelpView, Init(R, HSB, VSB));
  1263. HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1264. end;
  1265. procedure THelpWindow.InitFrame;
  1266. var R: TRect;
  1267. begin
  1268. GetExtent(R);
  1269. Frame:=New(PHelpFrame, Init(R));
  1270. end;
  1271. procedure THelpWindow.ShowIndex;
  1272. begin
  1273. HelpView^.SwitchToIndex;
  1274. end;
  1275. procedure THelpWindow.ShowTopic(SourceFileID: word; Context: THelpCtx);
  1276. begin
  1277. HelpView^.SwitchToTopic(SourceFileID, Context);
  1278. end;
  1279. procedure THelpWindow.HandleEvent(var Event: TEvent);
  1280. begin
  1281. case Event.What of
  1282. evKeyDown :
  1283. case Event.KeyCode of
  1284. kbEsc :
  1285. begin
  1286. Event.What:=evCommand; Event.Command:=cmClose;
  1287. end;
  1288. end;
  1289. end;
  1290. inherited HandleEvent(Event);
  1291. end;
  1292. procedure THelpWindow.Close;
  1293. begin
  1294. if HideOnClose then Hide else inherited Close;
  1295. end;
  1296. function THelpWindow.GetPalette: PPalette;
  1297. begin
  1298. GetPalette:=nil;
  1299. end;
  1300. END.
  1301. {
  1302. $Log$
  1303. Revision 1.10 2003-01-18 01:36:23 pierre
  1304. * fix web bug 1649
  1305. Revision 1.9 2002/09/07 15:40:49 peter
  1306. * old logs removed and tabs fixed
  1307. Revision 1.8 2002/03/25 14:37:45 pierre
  1308. +handle hscDirect
  1309. Revision 1.7 2002/03/20 17:10:04 pierre
  1310. * avoid to cut a part of an image
  1311. Revision 1.6 2002/03/20 11:15:51 pierre
  1312. * possible fix for the IDE prerelease crash
  1313. }