whlpview.pas 44 KB

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