whlpview.pas 44 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549
  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);
  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. repeat
  406. P:=Pos(#255,Line);
  407. if P>0 then
  408. if InImage then
  409. Delete(Line,p,1)
  410. else
  411. Line[P]:=#32;
  412. until P=0;
  413. while copy(Line,length(Line),1)=' ' do 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. nbNormal :
  504. begin
  505. case C of
  506. hscLineBreak :
  507. {if ZeroLevel=0 then ZeroLevel:=1 else
  508. begin FlushLine; FlushLine; ZeroLevel:=0; end;}
  509. if InLink then CurWord:=CurWord+' ' else
  510. begin
  511. NextLineStart:=0;
  512. FlushLine;
  513. LineStart:=0;
  514. LineAlign:=laLeft;
  515. end;
  516. #1 : {Break};
  517. hscLink :
  518. begin
  519. CheckZeroLevel;
  520. if InLink=false then
  521. begin LinkStart:=CurPos; InLink:=true; end else
  522. begin
  523. if CurWord<>'' then AddWord(CurWord); CurWord:='';
  524. LinkEnd:=CurPos; Dec(LinkEnd.X);
  525. if Topic^.Links<>nil then
  526. begin
  527. Inc(LastLink);
  528. if LinkNo<Topic^.LinkCount then
  529. Links^.Insert(NewLink(Topic^.Links^[LinkNo].FileID,
  530. Topic^.Links^[LinkNo].Context,LinkStart,LinkEnd));
  531. Inc(LinkNo);
  532. end;
  533. InLink:=false;
  534. end;
  535. end;
  536. hscLineStart :
  537. begin
  538. NextLineStart:=length(Line)+length(CurWord);
  539. { LineStart:=LineStart+(NextLineStart-LineStart);}
  540. end;
  541. hscCode :
  542. begin
  543. if InCodeArea=false then
  544. CodeAreaStart:=CurPos else
  545. begin
  546. if CurWord<>'' then AddWord(CurWord); CurWord:='';
  547. CodeAreaEnd:=CurPos; Dec(CodeAreaEnd.X);
  548. ColorAreas^.Insert(NewColorArea(CommentColor,$f0,CodeAreaStart,CodeAreaEnd));
  549. end;
  550. InCodeArea:=not InCodeArea;
  551. end;
  552. hscCenter :
  553. LineAlign:=laCenter;
  554. hscRight :
  555. LineAlign:=laRight{was laCenter, typo error ? PM };
  556. hscNamedMark :
  557. begin
  558. if NamedMarkNo<Topic^.NamedMarks^.Count then
  559. NamedMarks^.Add(GetStr(Topic^.NamedMarks^.At(NamedMarkNo)),CurPos);
  560. Inc(NamedMarkNo);
  561. end;
  562. hscTextAttr,hscTextColor :
  563. begin
  564. if InColorArea then
  565. EndColorArea;
  566. if C=hscTextAttr then
  567. ColorAreaType:=atFull
  568. else
  569. ColorAreaType:=atText;
  570. NextByte:=nbAreaColor;
  571. ColorAreaStart:=CurPos;
  572. InColorArea:=true;
  573. end;
  574. hscInImage :
  575. begin
  576. InImage := not InImage;
  577. end;
  578. hscNormText :
  579. begin
  580. if InColorArea then
  581. EndColorArea;
  582. end;
  583. #32: if InLink then CurWord:=CurWord+C else
  584. begin CheckZeroLevel; AddWord(CurWord+C); CurWord:=''; end;
  585. else begin CheckZeroLevel; CurWord:=CurWord+C; end;
  586. end;
  587. end;
  588. end;
  589. CurPos.X:=Margin+length(Line)+length(CurWord);
  590. Inc(TextPos);
  591. end;
  592. if (Line<>'') or (CurWord<>'') then FlushLine;
  593. end;
  594. end;
  595. function THelpTopic.GetLineCount: sw_integer;
  596. begin
  597. GetLineCount:=Lines^.Count;
  598. end;
  599. function THelpTopic.GetLineText(Line: sw_integer): string;
  600. var S: string;
  601. begin
  602. if Line<GetLineCount then S:=PString(Lines^.At(Line))^ else S:='';
  603. GetLineText:=S;
  604. end;
  605. function THelpTopic.GetLinkCount: sw_integer;
  606. begin
  607. GetLinkCount:=Links^.Count;
  608. end;
  609. procedure THelpTopic.GetLinkBounds(Index: sw_integer; var R: TRect);
  610. var P: PHelpLink;
  611. begin
  612. P:=Links^.At(Index);
  613. R:=P^.Bounds;
  614. end;
  615. function THelpTopic.GetLinkFileID(Index: sw_integer): word;
  616. var P: PHelpLink;
  617. begin
  618. P:=Links^.At(Index);
  619. GetLinkFileID:=P^.FileID;
  620. end;
  621. function THelpTopic.GetLinkContext(Index: sw_integer): THelpCtx;
  622. var P: PHelpLink;
  623. begin
  624. P:=Links^.At(Index);
  625. GetLinkContext:=P^.Context;
  626. end;
  627. function THelpTopic.GetColorAreaCount: sw_integer;
  628. begin
  629. GetColorAreaCount:=ColorAreas^.Count;
  630. end;
  631. procedure THelpTopic.GetColorAreaBounds(Index: sw_integer; var R: TRect);
  632. var P: PHelpColorArea;
  633. begin
  634. P:=ColorAreas^.At(Index);
  635. R:=P^.Bounds;
  636. end;
  637. function THelpTopic.GetColorAreaColor(Index: sw_integer): word;
  638. var P: PHelpColorArea;
  639. begin
  640. P:=ColorAreas^.At(Index);
  641. GetColorAreaColor:=P^.Color;
  642. end;
  643. function THelpTopic.GetColorAreaMask(Index: sw_integer): word;
  644. var P: PHelpColorArea;
  645. begin
  646. P:=ColorAreas^.At(Index);
  647. GetColorAreaMask:=P^.AttrMask;
  648. end;
  649. destructor THelpTopic.Done;
  650. begin
  651. inherited Done;
  652. Dispose(Lines, Done);
  653. Dispose(LinesPos, Done);
  654. Dispose(Links, Done);
  655. Dispose(ColorAreas, Done);
  656. Dispose(NamedMarks, Done);
  657. if (Topic<>nil) then DisposeTopic(Topic);
  658. end;
  659. constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  660. begin
  661. inherited Init(Bounds, AHScrollBar, AVScrollBar, nil, nil);
  662. Flags:=efInsertMode; ReadOnly:=true;
  663. New(WordList, Init(50,50));
  664. Margin:=1; CurLink:=-1;
  665. end;
  666. procedure THelpViewer.ChangeBounds(var Bounds: TRect);
  667. var
  668. LinePos,NewLineIndex,I : longint;
  669. ymin, ymax : sw_integer;
  670. prop : real;
  671. begin
  672. if Owner<>nil then Owner^.Lock;
  673. ymin:=Delta.Y;
  674. ymax:=ymin+Size.Y;
  675. if ymax>ymin then
  676. prop:=(CurPos.Y-ymin)/(ymax-ymin)
  677. else
  678. prop:=0;
  679. inherited ChangeBounds(Bounds);
  680. if (HelpTopic<>nil) and (HelpTopic^.Topic<>nil) and
  681. (HelpTopic^.Topic^.FileID<>0) then
  682. Begin
  683. LinePos:=HelpTopic^.LinesPos^.At(CurPos.Y)+CurPos.X;
  684. RenderTopic;
  685. NewLineIndex:=-1;
  686. For i:=0 to HelpTopic^.LinesPos^.Count-1 do
  687. if LinePos<HelpTopic^.LinesPos^.At(i) then
  688. begin
  689. NewLineIndex:=i-1;
  690. break;
  691. end;
  692. if NewLineIndex>=0 then
  693. Begin
  694. ymin:=NewLineIndex - trunc(prop * Size.Y);
  695. if ymin<0 then
  696. ymin:=0;
  697. ScrollTo(0,ymin);
  698. SetCurPtr(LinePos-HelpTopic^.LinesPos^.At(NewLineIndex),NewLineIndex);
  699. End;
  700. End;
  701. if Owner<>nil then Owner^.UnLock;
  702. end;
  703. procedure THelpViewer.RenderTopic;
  704. begin
  705. if HelpTopic<>nil then
  706. HelpTopic^.SetParams(Margin,Size.X);
  707. {$ifndef EDITORS}
  708. SetLimit(255,GetLineCount);
  709. {$endif}
  710. DrawView;
  711. end;
  712. function THelpViewer.LinkContainsPoint(var R: TRect; var P: TPoint): boolean;
  713. var OK: boolean;
  714. begin
  715. if (R.A.Y=R.B.Y) then
  716. OK:= (P.Y=R.A.Y) and (R.A.X<=P.X) and (P.X<=R.B.X) else
  717. OK:=
  718. ( (R.A.Y=P.Y) and (R.A.X<=P.X) ) or
  719. ( (R.A.Y<P.Y) and (P.Y<R.B.Y) ) or
  720. ( (R.B.Y=P.Y) and (P.X<=R.B.X) );
  721. LinkContainsPoint:=OK;
  722. end;
  723. procedure THelpViewer.SetCurPtr(X,Y: sw_integer);
  724. var OldCurLink,I: sw_integer;
  725. OldPos,P: TPoint;
  726. R: TRect;
  727. begin
  728. OldPos:=CurPos;
  729. OldCurLink:=CurLink;
  730. inherited SetCurPtr(X,Y);
  731. CurLink:=-1;
  732. P:=CurPos;
  733. for I:=0 to GetLinkCount-1 do
  734. begin
  735. GetLinkBounds(I,R);
  736. if LinkContainsPoint(R,P) then
  737. begin CurLink:=I; Break; end;
  738. end;
  739. if OldCurLink<>CurLink then DrawView;
  740. if ((OldPos.X<>CurPos.X) or (OldPos.Y<>CurPos.Y)) and (InLookup=false) then
  741. Lookup('');
  742. end;
  743. function THelpViewer.GetLineCount: sw_integer;
  744. var Count: sw_integer;
  745. begin
  746. if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLineCount;
  747. GetLineCount:=Count;
  748. end;
  749. function THelpViewer.GetLine(LineNo: sw_integer): PCustomLine;
  750. begin
  751. {Abstract; used in wcedit unit ! }
  752. GetLine:=nil;
  753. end;
  754. function THelpViewer.GetDisplayText(I: sw_integer): string;
  755. begin
  756. GetDisplayText:=ExtractTabs(GetLineText(I),DefaultTabSize);
  757. end;
  758. function THelpViewer.GetLineText(Line: sw_integer): string;
  759. var S: string;
  760. begin
  761. if HelpTopic=nil then S:='' else S:=HelpTopic^.GetLineText(Line);
  762. GetLineText:=S;
  763. end;
  764. function THelpViewer.GetLinkCount: sw_integer;
  765. var Count: sw_integer;
  766. begin
  767. if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetLinkCount;
  768. GetLinkCount:=Count;
  769. end;
  770. procedure THelpViewer.GetLinkBounds(Index: sw_integer; var R: TRect);
  771. begin
  772. HelpTopic^.GetLinkBounds(Index,R);
  773. end;
  774. function THelpViewer.GetLinkFileID(Index: sw_integer): word;
  775. begin
  776. GetLinkFileID:=HelpTopic^.GetLinkFileID(Index);
  777. end;
  778. function THelpViewer.GetLinkContext(Index: sw_integer): THelpCtx;
  779. begin
  780. GetLinkContext:=HelpTopic^.GetLinkContext(Index);
  781. end;
  782. function THelpViewer.GetLinkText(Index: sw_integer): string;
  783. var S: string;
  784. R: TRect;
  785. Y,StartX,EndX: sw_integer;
  786. begin
  787. S:=''; GetLinkBounds(Index,R);
  788. Y:=R.A.Y;
  789. while (Y<=R.B.Y) do
  790. begin
  791. if Y=R.A.Y then StartX:=R.A.X else StartX:=Margin;
  792. if Y=R.B.Y then EndX:=R.B.X else EndX:=High(S);
  793. S:=S+copy(GetLineText(Y),StartX+1,EndX-StartX+1);
  794. Inc(Y);
  795. end;
  796. GetLinkText:=S;
  797. end;
  798. function THelpViewer.GetColorAreaCount: sw_integer;
  799. var Count: sw_integer;
  800. begin
  801. if HelpTopic=nil then Count:=0 else Count:=HelpTopic^.GetColorAreaCount;
  802. GetColorAreaCount:=Count;
  803. end;
  804. procedure THelpViewer.GetColorAreaBounds(Index: sw_integer; var R: TRect);
  805. begin
  806. HelpTopic^.GetColorAreaBounds(Index,R);
  807. end;
  808. function THelpViewer.GetColorAreaColor(Index: sw_integer): word;
  809. begin
  810. GetColorAreaColor:=HelpTopic^.GetColorAreaColor(Index);
  811. end;
  812. function THelpViewer.GetColorAreaMask(Index: sw_integer): word;
  813. begin
  814. GetColorAreaMask:=HelpTopic^.GetColorAreaMask(Index);
  815. end;
  816. procedure THelpViewer.SelectNextLink(ANext: boolean);
  817. var I,Link: sw_integer;
  818. R: TRect;
  819. begin
  820. if HelpTopic=nil then Exit;
  821. Link:=CurLink;
  822. if Link<>-1 then
  823. begin
  824. if ANext then
  825. begin Inc(Link); if Link>=GetLinkCount then Link:=0; end else
  826. begin Dec(Link); if Link=-1 then Link:=GetLinkCount-1; end;
  827. end else
  828. for I:=0 to GetLinkCount-1 do
  829. begin
  830. GetLinkBounds(I,R);
  831. if (R.A.Y>CurPos.Y) or
  832. (R.A.Y=CurPos.Y) and (R.A.X>CurPos.X) then
  833. begin Link:=I; Break; end;
  834. end;
  835. if (Link=-1) and (GetLinkCount>0) then
  836. if ANext then Link:=0
  837. else Link:=GetLinkCount-1;
  838. SetCurLink(Link);
  839. end;
  840. procedure THelpViewer.SetCurLink(Link: sw_integer);
  841. var R: TRect;
  842. begin
  843. if Link<>-1 then
  844. begin
  845. GetLinkBounds(Link,R);
  846. SetCurPtr(R.A.X,R.A.Y);
  847. TrackCursor(true);
  848. end;
  849. end;
  850. procedure THelpViewer.SwitchToIndex;
  851. begin
  852. if IndexTopic=nil then
  853. IndexTopic:=HelpFacility^.BuildIndexTopic;
  854. ISwitchToTopicPtr(IndexTopic,true);
  855. end;
  856. procedure THelpViewer.SwitchToTopic(SourceFileID: word; Context: THelpCtx);
  857. begin
  858. ISwitchToTopic(SourceFileID,Context,true);
  859. end;
  860. procedure THelpViewer.ISwitchToTopic(SourceFileID: word; Context: THelpCtx; RecordInHistory: boolean);
  861. var P: PTopic;
  862. begin
  863. if HelpFacility=nil then P:=nil else
  864. if (SourceFileID=0) and (Context=0) and (HelpTopic<>nil) then
  865. P:=IndexTopic else
  866. P:=HelpFacility^.LoadTopic(SourceFileID, Context);
  867. ISwitchToTopicPtr(P,RecordInHistory);
  868. end;
  869. procedure THelpViewer.ISwitchToTopicPtr(P: PTopic; RecordInHistory: boolean);
  870. var HistoryFull: boolean;
  871. begin
  872. if (P<>nil) and RecordInHistory and (HelpTopic<>nil) then
  873. begin
  874. HistoryFull:=HistoryPtr>=HistorySize;
  875. if HistoryFull then
  876. Move(History[1],History[0],SizeOf(History)-SizeOf(History[0]));
  877. with History[HistoryPtr] do
  878. begin
  879. {SourceTopic_:=SourceTopic; }Context_:=HelpTopic^.Topic^.HelpCtx;
  880. FileID_:=HelpTopic^.Topic^.FileID;
  881. Delta_:=Delta; CurPos_:=CurPos; CurLink_:=CurLink;
  882. end;
  883. if HistoryFull=false then Inc(HistoryPtr);
  884. end;
  885. if Owner<>nil then Owner^.Lock;
  886. SetTopic(P);
  887. DrawView;
  888. if Owner<>nil then Owner^.UnLock;
  889. end;
  890. procedure THelpViewer.PrevTopic;
  891. begin
  892. if HistoryPtr>0 then
  893. begin
  894. if Owner<>nil then Owner^.Lock;
  895. Dec(HistoryPtr);
  896. with History[HistoryPtr] do
  897. begin
  898. ISwitchToTopic(FileID_,Context_,false);
  899. ScrollTo(Delta_.X,Delta_.Y);
  900. SetCurPtr(CurPos_.X,CurPos_.Y);
  901. TrackCursor(false);
  902. if CurLink<>CurLink_ then SetCurLink(CurLink_);
  903. end;
  904. DrawView;
  905. if Owner<>nil then Owner^.UnLock;
  906. end;
  907. end;
  908. procedure THelpViewer.SetTopic(Topic: PTopic);
  909. var Bookmark: string;
  910. P: TPoint;
  911. begin
  912. CurLink:=-1;
  913. if (HelpTopic=nil) or (Topic<>HelpTopic^.Topic) then
  914. begin
  915. if (HelpTopic<>nil) and (HelpTopic<>IndexHelpTopic) then
  916. Dispose(HelpTopic, Done);
  917. HelpTopic:=nil;
  918. if Topic<>nil then
  919. begin
  920. if (Topic=IndexTopic) and (IndexHelpTopic<>nil) then
  921. HelpTopic:=IndexHelpTopic else
  922. New(HelpTopic, Init(Topic));
  923. if Topic=IndexTopic then
  924. IndexHelpTopic:=HelpTopic;
  925. end;
  926. end;
  927. if Owner<>nil then Owner^.Lock;
  928. SetCurPtr(0,0); TrackCursor(false);
  929. RenderTopic;
  930. BuildTopicWordList;
  931. Lookup('');
  932. if Assigned(Topic) then
  933. if Topic^.StartNamedMark>0 then
  934. if Topic^.NamedMarks^.Count>=Topic^.StartNamedMark then
  935. begin
  936. Bookmark:=GetStr(Topic^.NamedMarks^.At(Topic^.StartNamedMark-1));
  937. if HelpTopic^.NamedMarks^.GetMarkPos(Bookmark,P) then
  938. begin
  939. SetCurPtr(P.X,P.Y);
  940. ScrollTo(0,Max(0,P.Y-1));
  941. end;
  942. end;
  943. SetSelection(CurPos,CurPos);
  944. DrawView;
  945. if Owner<>nil then Owner^.UnLock;
  946. end;
  947. procedure THelpViewer.BuildTopicWordList;
  948. var I: sw_integer;
  949. begin
  950. WordList^.FreeAll;
  951. for I:=0 to GetLinkCount-1 do
  952. WordList^.Insert(NewKeyword(I,Trim(GetLinkText(I))));
  953. end;
  954. procedure THelpViewer.Lookup(S: string);
  955. var Index, I: Sw_integer;
  956. W: string;
  957. OldLookup: string;
  958. R: TRect;
  959. P: PHelpKeyword;
  960. begin
  961. InLookup:=true;
  962. OldLookup:=LookupWord;
  963. S:=UpcaseStr(S);
  964. Index:=-1;
  965. I:=0; {J:=0;
  966. while (J<GetLinkCount) do
  967. begin
  968. GetLinkBounds(J,R);
  969. if (R.A.Y<CurPos.Y) or ((R.A.Y=CurPos.Y) and (R.B.X<CurPos.X))
  970. then Inc(J) else
  971. begin I:=J; Break; end;
  972. end;}
  973. if S='' then LookupWord:='' else
  974. begin
  975. while (Index=-1) and (I<WordList^.Count) do
  976. begin
  977. P:=WordList^.At(I);
  978. if P^.KWord<>nil then
  979. begin
  980. W:=UpcaseStr(Trim(P^.KWord^));
  981. if copy(W,1,length(S))=S then Index:=I;
  982. end;
  983. { if W>S then Break else}
  984. Inc(I);
  985. end;
  986. if Index<>-1 then
  987. begin
  988. W:=Trim(WordList^.At(Index)^.KWord^);
  989. LookupWord:=copy(W,1,length(S));
  990. end;
  991. end;
  992. if LookupWord<>OldLookup then
  993. begin
  994. if Index=-1 then SetCurLink(CurLink) else
  995. begin
  996. if Owner<>nil then Owner^.Lock;
  997. P:=WordList^.At(Index);
  998. S:=GetLinkText(P^.Index);
  999. I:=Pos(LookupWord,S); if I=0 then I:=1;
  1000. GetLinkBounds(P^.Index,R);
  1001. SetCurPtr(R.A.X+(I-1)+length(Lookupword),R.A.Y);
  1002. CurLink:=P^.Index; DrawView;
  1003. TrackCursor(true);
  1004. if Owner<>nil then Owner^.UnLock;
  1005. end;
  1006. end;
  1007. InLookup:=false;
  1008. end;
  1009. procedure THelpViewer.SelectLink(Index: sw_integer);
  1010. var ID: word;
  1011. Ctx: THelpCtx;
  1012. begin
  1013. if Index=-1 then Exit;
  1014. if HelpTopic=nil then begin ID:=0; Ctx:=0; end else
  1015. begin
  1016. ID:=GetLinkFileID(Index);
  1017. Ctx:=GetLinkContext(Index);
  1018. end;
  1019. SwitchToTopic(ID,Ctx);
  1020. end;
  1021. procedure THelpViewer.HandleEvent(var Event: TEvent);
  1022. var DontClear: boolean;
  1023. procedure GetMousePos(var P: TPoint);
  1024. begin
  1025. MakeLocal(Event.Where,P);
  1026. Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
  1027. end;
  1028. begin
  1029. case Event.What of
  1030. evMouseDown :
  1031. if MouseInView(Event.Where) then
  1032. if (Event.Buttons=mbLeftButton) and (Event.Double) then
  1033. begin
  1034. inherited HandleEvent(Event);
  1035. if CurLink<>-1 then
  1036. SelectLink(CurLink);
  1037. end;
  1038. evBroadcast :
  1039. case Event.Command of
  1040. cmHelpFilesChanged :
  1041. begin
  1042. if HelpTopic=IndexHelpTopic then HelpTopic:=nil;
  1043. IndexTopic:=nil;
  1044. if IndexHelpTopic<>nil then Dispose(IndexHelpTopic, Done);
  1045. IndexHelpTopic:=nil;
  1046. end;
  1047. end;
  1048. evCommand :
  1049. begin
  1050. DontClear:=false;
  1051. case Event.Command of
  1052. cmPrevTopic :
  1053. PrevTopic;
  1054. else DontClear:=true;
  1055. end;
  1056. if DontClear=false then ClearEvent(Event);
  1057. end;
  1058. evKeyDown :
  1059. begin
  1060. DontClear:=false;
  1061. case Event.KeyCode of
  1062. kbTab :
  1063. SelectNextLink(true);
  1064. kbShiftTab :
  1065. begin NoSelect:=true; SelectNextLink(false); NoSelect:=false; end;
  1066. kbEnter :
  1067. if CurLink<>-1 then
  1068. SelectLink(CurLink);
  1069. kbBack,kbDel :
  1070. if Length(LookupWord)>0 then
  1071. Lookup(Copy(LookupWord,1,Length(LookupWord)-1));
  1072. else
  1073. case Event.CharCode of
  1074. #32..#255 :
  1075. begin NoSelect:=true; Lookup(LookupWord+Event.CharCode); NoSelect:=false; end;
  1076. else DontClear:=true;
  1077. end;
  1078. end;
  1079. TrackCursor(false);
  1080. if DontClear=false then ClearEvent(Event);
  1081. end;
  1082. end;
  1083. inherited HandleEvent(Event);
  1084. end;
  1085. procedure THelpViewer.Draw;
  1086. var NormalColor, LinkColor,
  1087. SelectColor, SelectionColor: word;
  1088. B: TDrawBuffer;
  1089. DX,DY,X,Y,I,MinX,MaxX,ScreenX: sw_integer;
  1090. LastLinkDrawn,LastColorAreaDrawn: sw_integer;
  1091. S: string;
  1092. R: TRect;
  1093. {$ifndef EDITORS}
  1094. SelR : TRect;
  1095. {$endif}
  1096. C,Mask: word;
  1097. CurP: TPoint;
  1098. ANDSB,ORSB: word;
  1099. begin
  1100. if ELockFlag>0 then
  1101. begin
  1102. DrawCalled:=true;
  1103. Exit;
  1104. end;
  1105. DrawCalled:=false;
  1106. NormalColor:=GetColor(1); LinkColor:=GetColor(2);
  1107. SelectColor:=GetColor(3); SelectionColor:=GetColor(4);
  1108. {$ifndef EDITORS}
  1109. SelR.A:=SelStart; SelR.B:=SelEnd;
  1110. {$endif}
  1111. LastLinkDrawn:=0; LastColorAreaDrawn:=0;
  1112. for DY:=0 to Size.Y-1 do
  1113. begin
  1114. Y:=Delta.Y+DY;
  1115. MoveChar(B,' ',NormalColor,Size.X);
  1116. if Y<GetLineCount then
  1117. begin
  1118. S:=copy(GetLineText(Y),Delta.X+1,High(S));
  1119. S:=copy(S,1,MaxViewWidth);
  1120. MoveStr(B,S,NormalColor);
  1121. for I:=LastColorAreaDrawn to GetColorAreaCount-1 do
  1122. begin
  1123. GetColorAreaBounds(I,R);
  1124. if R.A.Y>Y then Break;
  1125. LastColorAreaDrawn:=I;
  1126. if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)+Delta.X-1);
  1127. if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
  1128. if (R.A.Y<=Y) and (Y<=R.B.Y) then
  1129. begin
  1130. C:=GetColorAreaColor(I);
  1131. Mask:=GetColorAreaMask(I);
  1132. for DX:=MinX to MaxX do
  1133. begin
  1134. X:=DX;
  1135. ScreenX:=X-(Delta.X);
  1136. if (ScreenX>=0) and (ScreenX<=High(B)) then
  1137. begin
  1138. { CurP.X:=X; CurP.Y:=Y;
  1139. if LinkAreaContainsPoint(R,CurP) then}
  1140. (* B[ScreenX]:=(B[ScreenX] and $f0ff) or (C shl 8);*)
  1141. ANDSB:=(Mask shl 8)+$ff;
  1142. ORSB:=(C shl 8);
  1143. B[ScreenX]:=(B[ScreenX] and ANDSB) or ORSB;
  1144. end;
  1145. end;
  1146. end;
  1147. end;
  1148. for I:=LastLinkDrawn to GetLinkCount-1 do
  1149. begin
  1150. GetLinkBounds(I,R);
  1151. if R.A.Y>Y then Break;
  1152. LastLinkDrawn:=I;
  1153. if Y=R.B.Y then MaxX:=R.B.X else MaxX:=(length(S)-1);
  1154. if Y=R.A.Y then MinX:=R.A.X else MinX:=0;
  1155. if (R.A.Y<=Y) and (Y<=R.B.Y) then
  1156. for DX:=MinX to MaxX do
  1157. begin
  1158. X:=DX;
  1159. ScreenX:=X-(Delta.X);
  1160. if (ScreenX>=0) and (ScreenX<=High(B)) then
  1161. begin
  1162. CurP.X:=X; CurP.Y:=Y;
  1163. if LinkContainsPoint(R,CurP) then
  1164. if I=CurLink then C:=SelectColor else C:=LinkColor;
  1165. B[ScreenX]:=(B[ScreenX] and $ff) or (C shl 8);
  1166. end;
  1167. end;
  1168. end;
  1169. {$ifndef EDITORS}
  1170. 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
  1171. begin
  1172. if Y=SelR.A.Y then MinX:=SelR.A.X else MinX:=0;
  1173. if Y=SelR.B.Y then MaxX:=SelR.B.X-1 else MaxX:=High(string);
  1174. for DX:=MinX to MaxX do
  1175. begin
  1176. X:=DX;
  1177. ScreenX:=X-(Delta.X);
  1178. if (ScreenX>=0) and (ScreenX<High(B)) then
  1179. B[ScreenX]:=(B[ScreenX] and $0fff) or ((SelectionColor and $f0) shl 8);
  1180. end;
  1181. end;
  1182. {$endif}
  1183. end;
  1184. WriteLine(0,DY,Size.X,1,B);
  1185. end;
  1186. DrawCursor;
  1187. end;
  1188. function THelpViewer.GetPalette: PPalette;
  1189. const P: string[length(CHelpViewer)] = CHelpViewer;
  1190. begin
  1191. GetPalette:=@P;
  1192. end;
  1193. constructor THelpViewer.Load(var S: TStream);
  1194. begin
  1195. inherited Load(S);
  1196. end;
  1197. procedure THelpViewer.Store(var S: TStream);
  1198. begin
  1199. inherited Store(S);
  1200. end;
  1201. destructor THelpViewer.Done;
  1202. begin
  1203. if (HelpTopic<>nil) and (HelpTopic<>IndexHelpTopic) then
  1204. Dispose(HelpTopic, Done);
  1205. HelpTopic:=nil;
  1206. if IndexHelpTopic<>nil then
  1207. Dispose(IndexHelpTopic, Done);
  1208. IndexHelpTopic:=nil;
  1209. inherited Done;
  1210. if assigned(WordList) then
  1211. Dispose(WordList, Done);
  1212. end;
  1213. function THelpFrame.GetPalette: PPalette;
  1214. const P: string[length(CHelpFrame)] = CHelpFrame;
  1215. begin
  1216. GetPalette:=@P;
  1217. end;
  1218. constructor THelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
  1219. begin
  1220. inherited Init(Bounds, ATitle, ANumber);
  1221. InitScrollBars;
  1222. if Assigned(HSB) then Insert(HSB);
  1223. if Assigned(VSB) then Insert(VSB);
  1224. InitHelpView;
  1225. if Assigned(HelpView) then
  1226. begin
  1227. if (ASourceFileID<>0) or (AContext<>0) then
  1228. ShowTopic(ASourceFileID, AContext);
  1229. Insert(HelpView);
  1230. end;
  1231. end;
  1232. procedure THelpWindow.InitScrollBars;
  1233. var R: TRect;
  1234. begin
  1235. GetExtent(R); R.Grow(0,-1); R.A.X:=R.B.X-1;
  1236. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1237. GetExtent(R); R.Grow(-1,0); R.A.Y:=R.B.Y-1;
  1238. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
  1239. end;
  1240. procedure THelpWindow.InitHelpView;
  1241. var R: TRect;
  1242. begin
  1243. GetExtent(R); R.Grow(-1,-1);
  1244. New(HelpView, Init(R, HSB, VSB));
  1245. HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1246. end;
  1247. procedure THelpWindow.InitFrame;
  1248. var R: TRect;
  1249. begin
  1250. GetExtent(R);
  1251. Frame:=New(PHelpFrame, Init(R));
  1252. end;
  1253. procedure THelpWindow.ShowIndex;
  1254. begin
  1255. HelpView^.SwitchToIndex;
  1256. end;
  1257. procedure THelpWindow.ShowTopic(SourceFileID: word; Context: THelpCtx);
  1258. begin
  1259. HelpView^.SwitchToTopic(SourceFileID, Context);
  1260. end;
  1261. procedure THelpWindow.HandleEvent(var Event: TEvent);
  1262. begin
  1263. case Event.What of
  1264. evKeyDown :
  1265. case Event.KeyCode of
  1266. kbEsc :
  1267. begin
  1268. Event.What:=evCommand; Event.Command:=cmClose;
  1269. end;
  1270. end;
  1271. end;
  1272. inherited HandleEvent(Event);
  1273. end;
  1274. procedure THelpWindow.Close;
  1275. begin
  1276. if HideOnClose then Hide else inherited Close;
  1277. end;
  1278. function THelpWindow.GetPalette: PPalette;
  1279. begin
  1280. GetPalette:=nil;
  1281. end;
  1282. END.
  1283. {
  1284. $Log$
  1285. Revision 1.5 2001-09-30 22:18:57 pierre
  1286. * try to fix problem when unzooming help
  1287. Revision 1.4 2001/09/26 22:46:04 pierre
  1288. * remove break for #1 in THelpTopic.Rebuild
  1289. Revision 1.3 2001/09/24 23:54:46 pierre
  1290. * save text position to allow correct cursor placement when zooming
  1291. Revision 1.2 2001/08/05 02:01:49 peter
  1292. * FVISION define to compile with fvision units
  1293. Revision 1.1 2001/08/04 11:30:25 peter
  1294. * ide works now with both compiler versions
  1295. Revision 1.1.2.5 2001/03/20 00:20:44 pierre
  1296. * fix some memory leaks + several small enhancements
  1297. Revision 1.1.2.4 2001/03/06 22:04:54 pierre
  1298. * Avoid cursor updates when editor window is locked
  1299. Revision 1.1.2.3 2000/12/18 21:59:25 pierre
  1300. * fix for bug1216
  1301. Revision 1.1.2.2 2000/11/16 23:13:06 pierre
  1302. + support for ANSI substitutes to HTML images in HTML viewer
  1303. Revision 1.1.2.1 2000/11/14 23:41:33 pierre
  1304. * fix for bug 1234
  1305. Revision 1.1 2000/07/13 09:48:37 michael
  1306. + Initial import
  1307. Revision 1.18 2000/06/22 09:07:14 pierre
  1308. * Gabor changes: see fixes.txt
  1309. Revision 1.17 2000/06/16 08:50:45 pierre
  1310. + new bunch of Gabor's changes
  1311. Revision 1.16 2000/05/30 07:18:33 pierre
  1312. + colors for HTML help by Gabor
  1313. Revision 1.15 2000/05/29 10:45:00 pierre
  1314. + New bunch of Gabor's changes: see fixes.txt
  1315. Revision 1.14 2000/04/25 08:42:35 pierre
  1316. * New Gabor changes : see fixes.txt
  1317. Revision 1.13 2000/04/18 11:42:39 pierre
  1318. lot of Gabor changes : see fixes.txt
  1319. Revision 1.12 2000/03/21 23:21:38 pierre
  1320. adapted to wcedit addition
  1321. Revision 1.11 2000/02/07 08:29:13 michael
  1322. [*] the fake (!) TOKENS.PAS still contained the typo bug
  1323. FSplit(,n,d,e) (correctly FSplit(,d,n,e))
  1324. [*] CodeComplete had a very ugly bug - coordinates were document-relative
  1325. (instead of being screen-relative)
  1326. [*] TResourceStream didn't count the size of the resource names when
  1327. determining the file size and this could lead to the last resources not
  1328. loaded correctly
  1329. [+] Ctrl-Enter in editor now tries to open the file at cursor
  1330. [+] CodeComplete option added to Options|Environment|Editor
  1331. [+] user interface for managing CodeComplete implemented
  1332. [+] user interface for CodeTemplates implemented
  1333. [+] CodeComplete wordlist and CodeTemplates stored in desktop file
  1334. [+] help topic size no longer limited to 64KB when compiled with FPC
  1335. Revision 1.10 1999/08/16 18:25:31 peter
  1336. * Adjusting the selection when the editor didn't contain any line.
  1337. * Reserved word recognition redesigned, but this didn't affect the overall
  1338. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  1339. The syntax scanner loop is a bit slow but the main problem is the
  1340. recognition of special symbols. Switching off symbol processing boosts
  1341. the performance up to ca. 200%...
  1342. * The editor didn't allow copying (for ex to clipboard) of a single character
  1343. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  1344. * Compiler Messages window (actually the whole desktop) did not act on any
  1345. keypress when compilation failed and thus the window remained visible
  1346. + Message windows are now closed upon pressing Esc
  1347. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  1348. only when neccessary
  1349. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  1350. + LineSelect (Ctrl+K+L) implemented
  1351. * The IDE had problems closing help windows before saving the desktop
  1352. Revision 1.9 1999/06/28 19:32:35 peter
  1353. * fixes from gabor
  1354. Revision 1.8 1999/04/07 21:56:02 peter
  1355. + object support for browser
  1356. * html help fixes
  1357. * more desktop saving things
  1358. * NODEBUG directive to exclude debugger
  1359. Revision 1.7 1999/03/08 14:58:20 peter
  1360. + prompt with dialogs for tools
  1361. Revision 1.6 1999/03/01 15:42:13 peter
  1362. + Added dummy entries for functions not yet implemented
  1363. * MenuBar didn't update itself automatically on command-set changes
  1364. * Fixed Debugging/Profiling options dialog
  1365. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
  1366. * efBackSpaceUnindents works correctly
  1367. + 'Messages' window implemented
  1368. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  1369. + Added TP message-filter support (for ex. you can call GREP thru
  1370. GREP2MSG and view the result in the messages window - just like in TP)
  1371. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  1372. so topic search didn't work...
  1373. * In FPHELP.PAS there were still context-variables defined as word instead
  1374. of THelpCtx
  1375. * StdStatusKeys() was missing from the statusdef for help windows
  1376. + Topic-title for index-table can be specified when adding a HTML-files
  1377. Revision 1.5 1999/02/18 13:44:38 peter
  1378. * search fixed
  1379. + backward search
  1380. * help fixes
  1381. * browser updates
  1382. Revision 1.4 1999/02/08 10:37:47 peter
  1383. + html helpviewer
  1384. Revision 1.3 1999/01/21 11:54:32 peter
  1385. + tools menu
  1386. + speedsearch in symbolbrowser
  1387. * working run command
  1388. Revision 1.2 1998/12/28 15:47:57 peter
  1389. + Added user screen support, display & window
  1390. + Implemented Editor,Mouse Options dialog
  1391. + Added location of .INI and .CFG file
  1392. + Option (INI) file managment implemented (see bottom of Options Menu)
  1393. + Switches updated
  1394. + Run program
  1395. Revision 1.31 1998/12/27 12:07:30 gabor
  1396. * changed THelpViewer.Init to reflect changes in WEDITOR
  1397. Revision 1.3 1998/12/22 10:39:56 peter
  1398. + options are now written/read
  1399. + find and replace routines
  1400. }