whlpview.pas 42 KB

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