whlpview.pas 42 KB

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