source: trunk/Components/RichTextLayoutUnit.pas@ 201

Last change on this file since 201 was 15, checked in by RBRi, 19 years ago

+ components stuff
  • Property svn:eol-style set to native
File size: 27.8 KB
Line 
1Unit RichTextLayoutUnit;
2
3// Dynamically created layout class.
4// Represents a laid out rich text document
5
6Interface
7
8Uses
9 Os2Def,
10 Classes, Forms, Messages, Graphics,
11 CanvasFontManager,
12 RichTextDocumentUnit, RichTextStyleUnit;
13
14Type
15 TLayoutLine = record
16 Text: PChar;
17 Length: longint;
18
19 Height: longint;
20 Width: longint;
21
22 MaxDescender: longint;
23 MaxTextHeight: longint; // maximum height of text, doesn't include images
24
25 LinkIndex: longint; // link index at start of line, if any
26
27 Style: TTextDrawStyle;
28
29 Wrapped: boolean;
30 end;
31
32 TLinesArray = array[ 0..0 ] of TLayoutLine;
33
34Type
35 TTextPosition =
36 (
37 tpAboveTextArea,
38 tpAboveText,
39 tpWithinText,
40 tpBelowText,
41 tpBelowTextArea
42 );
43
44
45 TRichTextLayout = class;
46
47 TLinkEvent = procedure( Sender: TRichTextLayout; Link: string ) of object;
48
49 TRichTextLayout = class
50 Protected
51 FFontManager: TCanvasFontManager;
52
53 // Text
54 FText: PChar;
55 FImages: TImageList;
56
57 FAllocatedNumLines: Longint;
58
59 FLayoutWidth: longint; // The target width for the layout. Used for centreing/right align
60 FWidth: longint; // The actual width of the text. May be wider due to unaligned
61 // parts or bitmaps or width so small individual characters don't fit.
62 FHeight: longint;
63
64 FLinks: TStringList;
65
66 FHorizontalImageScale: double;
67 FVerticalImageScale: double;
68
69 public
70 // Internal layout data
71 FLines: ^TLinesArray;
72 FNumLines: longint;
73
74 FRichTextSettings: TRichTextSettings;
75
76 // Drawing functions
77
78 Procedure PerformStyleTag( Const Tag: TTag;
79 Var Style: TTextDrawStyle;
80 const X: longint );
81
82 function GetElementWidth( Element: TTextElement ): longint;
83
84 // Queries
85
86 Function GetStartX( Style: TTextDrawStyle;
87 Line: TLayoutLine ): longint;
88
89 Procedure GetXFromOffset( const Offset: longint;
90 const LineIndex: longint;
91 Var X: longint );
92 Procedure GetOffsetFromX( const XToFind: longint;
93 const LineIndex: longint;
94 Var Offset: longint;
95 Var Link: string );
96 function FindPoint( XToFind, YToFind: longint;
97 Var LineIndex: longint;
98 Var Offset: longint;
99 Var Link: string ): TTextPosition;
100 function GetLineFromCharIndex( Index: longint ): longint;
101 function GetOffsetFromCharIndex( Index: longint;
102 Line: longint ): longint;
103 function GetLinePosition( Line: longint ): longint;
104 function GetLineFromPosition( YToFind: longint;
105 Var LineIndex: longint;
106 Var Remainder: longint ): TTextPosition;
107
108 // Layout functions
109
110 Procedure AddLineStart( Const Line: TLayoutLine );
111 Procedure CheckFontHeights( Var Line: TLayoutLine );
112 Procedure Layout;
113
114 function IsValidBitmapIndex( Index: longint ): boolean;
115
116 // property handlers
117
118 Function GetCharIndex( P: PChar ): longint;
119 Function GetTextEnd: longint;
120
121 Public
122 constructor Create( Text: PChar;
123 Images: TImageList;
124 RichTextSettings: TRichTextSettings;
125 FontManager: TCanvasFontManager;
126 Width: longint );
127
128 Destructor Destroy; Override;
129
130 property TextEnd: longint read GetTextEnd;
131
132 function LinkFromIndex( const CharIndexToFind: longint): string;
133
134 property Images: TImageList read FImages;
135
136 property Width: longint read FWidth;
137 property Height: longint read FHeight;
138
139 property HorizontalImageScale: double read FHorizontalImageScale;
140 property VerticalImageScale: double read FVerticalImageScale;
141
142 End;
143
144Implementation
145
146Uses
147 SysUtils, PMWin, BseDos, Dos, ClipBrd, Printers,
148 ACLUtility, ACLStringUtility, ACLString,
149 ControlScrolling;
150
151Function TRichTextLayout.GetTextEnd: longint;
152begin
153 Result := StrLen( FText );
154end;
155
156// Create a layout of the specified rich text.
157constructor TRichTextLayout.Create( Text: PChar;
158 Images: TImageList;
159 RichTextSettings: TRichTextSettings;
160 FontManager: TCanvasFontManager;
161 Width: longint );
162var
163 DefaultFontSpec: TFontSpec;
164Begin
165 Inherited Create;
166
167 FRichTextSettings := RichTextSettings;
168
169 FImages := Images;
170
171 FText := Text;
172
173 FAllocatedNumLines := 10;
174 GetMem( FLines, FAllocatedNumLines * sizeof( TLayoutLine ) );
175 FNumLines := 0;
176
177 FLinks := TStringList.Create;
178 FLinks.Duplicates := dupIgnore;
179
180 FFontManager := FontManager;
181
182 FLayoutWidth := Width
183 * FontWidthPrecisionFactor;
184
185 FHorizontalImageScale := FFontManager.Canvas.HorizontalResolution
186 / Screen.Canvas.HorizontalResolution;
187 FVerticalImageScale := FFontManager.Canvas.VerticalResolution
188 / Screen.Canvas.VerticalResolution;
189
190 // use normal font for default font when specified fonts can't be found
191 SibylFontToFontSpec( RichTextSettings.NormalFont,
192 DefaultFontSpec );
193 FFontManager.DefaultFontSpec := DefaultFontSpec;
194
195 Layout;
196End;
197
198Destructor TRichTextLayout.Destroy;
199Begin
200 FreeMem( Flines, FAllocatedNumLines * sizeof( TLayoutLine ) );
201 FLinks.Destroy;
202
203 Inherited Destroy;
204End;
205
206Procedure TRichTextLayout.AddLineStart( Const Line: TLayoutLine );
207var
208 NewAllocation: longint;
209begin
210 if FNumLines >= FAllocatedNumLines then
211 begin
212 // reallocate the array twice the size
213 NewAllocation := FAllocatedNumLines * 2;
214 FLines := ReAllocMem( FLines,
215 FAllocatedNumLines * sizeof( TLayoutLine ),
216 NewAllocation * sizeof( TLayoutLine ) );
217 FAllocatedNumLines := NewAllocation;
218 end;
219 FLines^[ FNumLines ] := Line;
220 inc( FNumLines );
221end;
222
223Procedure TRichTextLayout.PerformStyleTag( Const Tag: TTag;
224 Var Style: TTextDrawStyle;
225 const X: longint );
226begin
227 ApplyStyleTag( Tag,
228 Style,
229 FFontManager,
230 FRichTextSettings,
231 X );
232end;
233
234// Check the current font specifications and see if the
235// give line needs updating for max height/descender
236Procedure TRichTextLayout.CheckFontHeights( Var Line: TLayoutLine );
237var
238 FontHeight: longint;
239 Descender: longint;
240begin
241 FontHeight := FFontManager.CharHeight;
242 Descender := FFontManager.CharDescender;
243
244 if FontHeight > Line.Height then
245 Line.Height := FontHeight;
246
247 if FontHeight > Line.MaxTextHeight then
248 Line.MaxTextHeight := FontHeight;
249
250 if Descender > Line.MaxDescender then
251 Line.MaxDescender := Descender;
252end;
253
254function TRichTextLayout.IsValidBitmapIndex( Index: longint ): boolean;
255begin
256 if FImages = nil then
257 Result := false
258 else if FImages.Count = 0 then
259 Result := false
260 else
261 Result := Between( Index, 0, FImages.Count - 1 );
262end;
263
264// Main procedure: reads through the whole text currently stored
265// and breaks up into lines - each represented as a TLayoutLine in
266// the array FLines[ 0.. FNumLines ]
267Procedure TRichTextLayout.Layout;
268Var
269 CurrentLine: TLayoutLine;
270
271 CurrentLinkIndex: longint;
272
273 WrapX: longint; // X to wrap at
274
275 WordX: longint; // width of word so far
276 P: PChar;
277 NextP: PChar;
278 NextP2: PChar;
279
280 WordStart: PChar;
281 WordStarted: boolean; // if false, just skipping spaces..
282 WordStartX: longint; // X position of word start
283
284 LineWordsCompleted: longint; // how many words draw so far this line
285
286 CurrentElement: TTextElement;
287 NextElement: TTextElement;
288
289 CurrentCharWidth: longint;
290
291 Style: TTextDrawStyle;
292
293 DisplayedCharsSinceFontChange: boolean;
294
295 BitmapIndex: longint;
296 Bitmap: TBitmap;
297 BitmapHeight: longint;
298
299 OnBreak: boolean;
300
301 DoWrap: boolean;
302
303 // Nested procedure
304
305 Procedure DoLine( EndPoint: PChar;
306 NextLine: PChar;
307 EndX: longint );
308 begin
309 // check if the max font
310 // height needs updating for the last string of the line
311 CheckFontHeights( CurrentLine );
312
313 inc( FHeight, CurrentLine.Height );
314
315 CurrentLine.Length := PCharDiff( EndPoint, CurrentLine.Text );
316
317 CurrentLine.Width := EndX;
318
319 if CurrentLine.Width > FWidth then
320 FWidth := CurrentLine.Width;
321
322 assert( CurrentLine.Height > 0 ); // we must have set the line height!
323
324 AddLineStart( CurrentLine );
325 CurrentLine.Text := NextLine;
326 CurrentLine.Style := Style;
327 CurrentLine.Height := 0;
328 CurrentLine.MaxDescender := 0;
329 CurrentLine.MaxTextHeight := 0;
330 CurrentLine.Width := 0;
331 CurrentLine.LinkIndex := CurrentLinkIndex;
332 CurrentLine.Wrapped := false;
333
334 assert( CurrentLinkIndex >= -1 );
335 assert( CurrentLinkIndex < FLinks.Count );
336
337 WordStartX := Style.LeftMargin * FontWidthPrecisionFactor;
338 // next line
339
340 // reset words completed count
341 LineWordsCompleted := 0;
342
343 WordStarted := false;
344 end;
345
346begin
347 FNumLines := 0;
348 FWidth := 0;
349 FHeight := FRichTextSettings.Margins.Top;
350
351 Style := GetDefaultStyle( FRichTextSettings );
352
353 ApplyStyle( Style, FFontManager );
354
355 CurrentLinkIndex := -1;
356
357 P := FText; // P is the current search position
358 CurrentLine.Text := P;
359 CurrentLine.Style := Style;
360 CurrentLine.Height := 0;
361 CurrentLine.MaxDescender := 0;
362 CurrentLine.MaxTextHeight := 0;
363 CurrentLine.Width := 0;
364 CurrentLine.LinkIndex := -1;
365 CurrentLine.Wrapped := false;
366
367 WordStartX := Style.LeftMargin * FontWidthPrecisionFactor;
368 WordX := 0;
369
370 WrapX := FLayoutWidth
371 - FRichTextSettings.Margins.Right
372 * FontWidthPrecisionFactor;
373
374 LineWordsCompleted := 0;
375
376 WordStarted := false;
377 DisplayedCharsSinceFontChange := false;
378
379 repeat
380 CurrentElement := ExtractNextTextElement( P, NextP );
381 assert( NextP > P );
382
383 OnBreak := false;
384
385 case CurrentElement.ElementType of
386 teWordBreak:
387 begin
388 CurrentCharWidth := FFontManager.CharWidth( ' ' );
389 OnBreak := true;
390 end;
391
392 teLineBreak:
393 begin
394 DoLine( P, NextP, WordStartX + WordX );
395
396 // remember start of line
397 WordStart := NextP;
398 WordX := 0;
399
400 P := NextP;
401
402 continue;
403 end;
404
405 teTextEnd:
406 begin
407 DoLine( P, NextP, WordStartX + WordX );
408
409 // end of text, done
410 break;
411 end;
412
413 teImage:
414 begin
415 BitmapHeight := 0;
416 try
417 BitmapIndex := StrToInt( CurrentElement.Tag.Arguments );
418 except
419 BitmapIndex := -1;
420 end;
421 Bitmap := nil;
422 if IsValidBitmapIndex( BitmapIndex ) then
423 begin
424 Bitmap := FImages.GetBitmapReference( BitmapIndex );
425
426 CurrentCharWidth := Bitmap.Width
427 * FontWidthPrecisionFactor
428 * FHorizontalImageScale;
429
430 WordStarted := true;
431 BitmapHeight := Bitmap.Height * FVerticalImageScale;
432 end;
433
434 end;
435
436 teText:
437 begin
438 // Normal (non-leading-space) character
439 CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
440 WordStarted := true;
441 end;
442
443 teStyle:
444 begin
445 case CurrentElement.Tag.TagType of
446 ttBeginLink:
447 begin
448 CurrentLinkIndex := FLinks.Add( CurrentElement.Tag.Arguments );
449 P := NextP;
450 continue;
451 end;
452
453 ttEndLink:
454 begin
455 CurrentLinkIndex := -1;
456 P := NextP;
457 continue;
458 end;
459
460 ttSetLeftMargin: // SPECIAL CASE... could affect display immediately
461 begin
462 PerformStyleTag( CurrentElement.Tag,
463 Style,
464 WordstartX + WordX );
465 if Style.LeftMargin * FontWidthPrecisionFactor < WordStartX then
466 begin
467 // we're already past the margin being set
468
469 if pos( 'breakifpast', CurrentElement.Tag.Arguments ) > 0 then
470 begin
471 // this argument means, do a line break
472 // if the margin is already past
473 // Seems unusual for most purposes, but needed for IPF rendering.
474 DoLine( P, NextP, WordStartX + WordX );
475
476 // remember start of line
477 WordStart := NextP;
478 WordX := 0;
479
480 P := NextP;
481
482 continue;
483 end;
484
485 // so ignore it for now.
486 P := NextP;
487 continue;
488 end;
489
490 // skip across to the new margin
491 CurrentCharWidth := Style.LeftMargin * FontWidthPrecisionFactor
492 - WordStartX
493 - WordX;
494 // BUT! Don't treat it as a space, because you would not
495 // expect wrapping to take place in a margin change...
496 // at least not for IPF (NewView) :)
497
498 end;
499
500 else
501 begin
502 // before processing the tag see if font height needs updating
503 if DisplayedCharsSinceFontChange then
504 CheckFontHeights( CurrentLine );
505
506 if ( CurrentElement.Tag.TagType = ttItalicOff )
507 and ( faItalic in Style.Font.Attributes ) then
508 if not FFontManager.IsFixed then
509 // end of italic; add a space
510 inc( WordX, FFontManager.CharWidth( ' ' ) );
511
512 PerformStyleTag( CurrentElement.Tag,
513 Style,
514 WordX );
515
516 DisplayedCharsSinceFontChange := false;
517 P := NextP;
518 continue; // continue loop
519 end;
520 end;
521
522 end
523
524 end;
525
526 if OnBreak then
527 begin
528 // we just processed a space
529 if WordStarted then
530 begin
531 DisplayedCharsSinceFontChange := true;
532 // remember that we have now completed a word on this line
533 inc( LineWordsCompleted );
534 WordStarted := false;
535
536 // Add the word width, and the space width,
537 // to get the start of the next word
538 inc( WordStartX, WordX + CurrentCharWidth );
539 WordX := 0;
540
541 // remember the start of the next word
542 WordStart := NextP;
543
544 P := NextP;
545
546 continue;
547 end;
548 // else - starting spaces - fall through like normal char
549 end;
550
551 // if we're still going here we have a normal char
552 // (or leading spaces)
553
554 if not Style.Wrap then
555 begin
556 // No alignment
557 // We don't care about how wide it gets
558 inc( WordX, CurrentCharWidth );
559 DisplayedCharsSinceFontChange := true;
560
561 if CurrentElement.ElementType = teImage then
562 if Bitmap <> nil then
563 if BitmapHeight > CurrentLine.Height then
564 CurrentLine.Height := BitmapHeight;
565
566 P := NextP;
567 continue;
568 end;
569
570 DoWrap := false;
571
572 // Calculate position of end of character
573 // see if char would exceed width
574 if WordStartX
575 + WordX
576 + CurrentCharWidth
577 >= WrapX then
578 begin
579 // reached right hand side before finding end of word
580 if LineWordsCompleted > 0 then
581 // always wrap after at least one word displayed
582 DoWrap := true
583 else if not FRichTextSettings.AtLeastOneWordBeforeWrap then
584 // only wrap during the first word, if the "at least 1 word" flag is not set.
585 DoWrap := true;
586
587 end;
588
589 if DoWrap then
590 begin
591 if LineWordsCompleted = 0 then
592 begin
593 // the first word did not fit on the line. so draw
594 // as much as will fit
595 if WordX = 0 then
596 begin
597 // even the first char doesn't fit,
598 // but draw it anyway (otherwise, infinite loop)
599
600 NextElement := ExtractNextTextElement( NextP, NextP2 );
601 if NextElement.ElementType <> teLineBreak then
602 // there is still more on the line...
603 CurrentLine.Wrapped := true
604 else
605 // the line ends after this one char or image, we can skip the line end
606 NextP := NextP2;
607
608 if CurrentElement.ElementType = teImage then
609 begin
610 // the only thing on the line is the image. so check height
611 if Bitmap <> nil then
612 if BitmapHeight > CurrentLine.Height then
613 CurrentLine.Height := BitmapHeight;
614 end;
615
616 DoLine( NextP,
617 NextP,
618 WordStartX + WordX + CurrentCharWidth );
619 WordStart := NextP;
620
621 WordX := 0;
622 end
623 else
624 begin
625 CurrentLine.Wrapped := true;
626 // at least 1 char fits
627 // so draw up to, but not including this char
628 DoLine( P,
629 P,
630 WordStartX + WordX );
631 WordStart := P;
632 WordX := CurrentCharWidth;
633 end;
634 end
635 else
636 begin
637 // Normal wrap; at least one word fitted on the line
638 CurrentLine.Wrapped := true;
639
640 // take the width of the last space of the
641 // previous word off the line width
642 DoLine( WordStart, // current line ends at start of this word
643 WordStart, // next line starts at start of this word
644 WordStartX - FFontManager.CharWidth( ' ' ) );
645 if CurrentElement.ElementType = teImage then
646 if Bitmap <> nil then
647 if BitmapHeight > CurrentLine.Height then
648 CurrentLine.Height := BitmapHeight;
649
650 // do NOT reset WordX to zero; as we are continuing
651 // from partway thru the word on the next line.
652 inc( WordX, CurrentCharWidth );
653 end;
654 WordStarted := true; // by definition, for wrapping
655 end
656 else
657 begin
658 // Character fits.
659 inc( WordX, CurrentCharWidth );
660
661 DisplayedCharsSinceFontChange := true;
662
663 if CurrentElement.ElementType = teImage then
664 if Bitmap <> nil then
665 if BitmapHeight > CurrentLine.Height then
666 CurrentLine.Height := BitmapHeight;
667 end;
668
669 P := NextP;
670
671 until false; // loop is exited by finding end of text
672
673 inc( FHeight, FRichTextSettings.Margins.Bottom );
674End;
675
676Function TRichTextLayout.GetStartX( Style: TTextDrawStyle;
677 Line: TLayoutLine ): longint;
678var
679 SpaceOnLine: longint;
680begin
681 case Style.Alignment of
682 taLeft:
683 Result := Style.LeftMargin * FontWidthPrecisionFactor;
684
685 taRight:
686 Result := Style.LeftMargin * FontWidthPrecisionFactor
687 + FLayoutWidth
688 - Style.RightMargin * FontWidthPrecisionFactor
689 - Line.Width;
690
691 taCenter:
692 begin
693 // |<------layout width------------------>|
694 // | |
695 // |<-lm->[aaaaaaaaaaaaaaa]<-space-><-rm->|
696 // |<-----line width------> |
697 // space = layoutw-rm-linew
698 SpaceOnLine := FLayoutWidth
699 - Style.RightMargin * FontWidthPrecisionFactor
700 - Line.Width; // Note: line width includes left margin
701 Result := Style.LeftMargin * FontWidthPrecisionFactor
702 + SpaceOnLine div 2;
703 end;
704 end;
705end;
706
707Procedure TRichTextLayout.GetOffsetFromX( const XToFind: longint;
708 const LineIndex: longint;
709 Var Offset: longint;
710 Var Link: string );
711Var
712 X: longint;
713 P: PChar;
714 NextP: PChar;
715 EndP: PChar;
716 Element: TTextElement;
717 CurrentLink: string;
718 Line: TLayoutLine;
719 Style: TTextDrawStyle;
720 NewMarginX: longint;
721 StartedDrawing: boolean;
722begin
723 Line := FLines[ LineIndex ];
724 P := Line.Text;
725 EndP := Line.Text + Line.Length;
726
727 Style := Line.Style;
728 FFontManager.SetFont( Style.Font );
729
730 StartedDrawing := false;
731
732 Link := '';
733 if Line.LinkIndex <> -1 then
734 CurrentLink := FLinks[ Line.LinkIndex ]
735 else
736 CurrentLink := '';
737
738 while P < EndP do
739 begin
740 Element := ExtractNextTextElement( P, NextP );
741
742 case Element.ElementType of
743 teWordBreak,
744 teText,
745 teImage:
746 begin
747 if not StartedDrawing then
748 begin
749 // we haven't yet started drawing:
750 // so work out alignment
751 X := GetStartX( Style, Line );
752
753 if X div FontWidthPrecisionFactor
754 > XToFind then
755 begin
756 // found before the start of the line
757 // don't set link
758 Offset := 0;
759 exit;
760 end;
761
762 StartedDrawing := true;
763
764 end;
765
766 // Now find out how wide the thing is
767 inc( X, GetElementWidth( Element ) );
768
769 if X div FontWidthPrecisionFactor
770 > XToFind then
771 begin
772 // found
773 Offset := PCharDiff( P, Line.Text );
774 Link := CurrentLink;
775 exit;
776 end;
777
778 end;
779
780 teStyle:
781 case Element.Tag.TagType of
782 ttBeginLink:
783 CurrentLink := Element.Tag.Arguments;
784 ttEndLink:
785 CurrentLink := '';
786 else
787 begin
788 if ( Element.Tag.TagType = ttItalicOff )
789 and ( faItalic in Style.Font.Attributes )
790 and ( not FFontManager.IsFixed ) then
791 // end of italic; add a space
792 inc( X, FFontManager.CharWidth( ' ' ) );
793
794 PerformStyleTag( Element.Tag,
795 Style,
796 X );
797 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
798 if NewMarginX > X then
799 begin
800 //skip across...
801 X := NewMarginX;
802 end;
803 end;
804 end;
805 end;
806
807 P := NextP;
808 end;
809 Offset := Line.Length;
810end;
811
812Procedure TRichTextLayout.GetXFromOffset( const Offset: longint;
813 const LineIndex: longint;
814 Var X: longint );
815Var
816 P: PChar;
817 NextP: PChar;
818 EndP: PChar;
819 Element: TTextElement;
820 StartedDrawing: boolean;
821 Line: TLayoutLine;
822 Style: TTextDrawStyle;
823 NewMarginX: longint;
824begin
825 Line := FLines[ LineIndex ];
826 P := Line.Text;
827 EndP := Line.Text + Line.Length;
828
829 Style := Line.Style;
830 FFontManager.SetFont( Style.Font );
831
832 StartedDrawing := false;
833
834 while P < EndP do
835 begin
836 Element := ExtractNextTextElement( P, NextP );
837
838 case Element.ElementType of
839 teWordBreak,
840 teText,
841 teImage:
842 begin
843 if not StartedDrawing then
844 begin
845 // we haven't yet started drawing:
846 // so work out alignment
847 X := GetStartX( Style, Line );
848 StartedDrawing := true;
849 end;
850
851 if GetCharIndex( P ) - GetCharIndex( Line.Text ) >= Offset then
852 begin
853 X := X div FontWidthPrecisionFactor;
854 // found
855 exit;
856 end;
857
858 // Now find out how wide the thing is
859 inc( X, GetElementWidth( Element ) );
860
861 end;
862
863 teStyle:
864 begin
865 if ( Element.Tag.TagType = ttItalicOff )
866 and ( faItalic in Style.Font.Attributes )
867 and ( not FFontManager.IsFixed ) then
868 // end of italic; add a space
869 inc( X, FFontManager.CharWidth( ' ' ) );
870
871 PerformStyleTag( Element.Tag,
872 Style,
873 X );
874
875 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
876 if NewMarginX > X then
877 begin
878 //skip across...
879 X := NewMarginX;
880 end;
881 end;
882 end;
883
884 P := NextP;
885 end;
886 // went thru the whole line without finding the point,
887 if not StartedDrawing then
888 X := GetStartX( Style, Line );
889
890 X := X div FontWidthPrecisionFactor;
891end;
892
893function TRichTextLayout.GetLineFromPosition( YToFind: longint;
894 Var LineIndex: longint;
895 Var Remainder: longint ): TTextPosition;
896var
897 Y: longint;
898 LineHeight: longint;
899begin
900 LineIndex := 0;
901 Remainder := 0;
902
903 Y := FRichTextSettings.Margins.Top;
904
905 if YToFind < Y then
906 begin
907 Result := tpAboveText;
908 exit;
909 end;
910
911 while LineIndex < FNumLines do
912 begin
913 LineHeight := FLines[ LineIndex ].Height;
914 if ( YToFind >= Y )
915 and ( YToFind < Y + LineHeight ) then
916 begin
917 // YToFind is within the line
918 Result := tpWithinText;
919 Remainder := YToFind - Y;
920 exit;
921 end;
922
923 inc( Y, FLines[ LineIndex ].Height );
924 inc( LineIndex );
925 end;
926
927 LineIndex := FNumLines - 1;
928 Remainder := FLines[ LineIndex ].Height;
929
930 Result := tpBelowText;
931end;
932
933function TRichTextLayout.FindPoint( XToFind, YToFind: longint;
934 Var LineIndex: longint;
935 Var Offset: longint;
936 Var Link: string ): TTextPosition;
937var
938 Remainder: longint;
939begin
940 Link := '';
941 Result := GetLineFromPosition( YToFind,
942 LineIndex,
943 Remainder );
944 case Result of
945 tpAboveText:
946 begin
947 Offset := 0;
948 exit;
949 end;
950
951 tpBelowText:
952 begin
953 Offset := FLines[ LineIndex ].Length;
954 exit;
955 end;
956 end;
957
958 // found the line
959 GetOffsetFromX( XToFind,
960 LineIndex,
961 Offset,
962 Link );
963end;
964
965function TRichTextLayout.GetLineFromCharIndex( Index: longint ): longint;
966var
967 LineCharIndex: longint;
968 LineLength: longint;
969begin
970 Result := 0;
971 if Index <= 0 then
972 exit;
973
974 while Result < FNumLines do
975 begin
976 LineCharIndex := GetCharIndex( FLines[ Result ].Text );
977 LineLength := FLines[ Result ].Length;
978 if LineCharIndex + LineLength
979 > Index then
980 begin
981 // found
982 exit;
983 end;
984 inc( Result );
985 end;
986 Result := FNumLines - 1;
987end;
988
989function TRichTextLayout.GetOffsetFromCharIndex( Index: longint;
990 Line: longint ): longint;
991begin
992 Result := Index - GetCharIndex( TLayoutLine( FLines[ Line ] ).Text );
993end;
994
995function TRichTextLayout.GetElementWidth( Element: TTextElement ): longint;
996var
997 Bitmap: TBItmap;
998 BitmapIndex: longint;
999begin
1000 // Now find out how wide the thing is
1001 case Element.ElementType of
1002 teImage:
1003 begin
1004 try
1005 BitmapIndex := StrToInt( Element.Tag.Arguments );
1006 except
1007 BitmapIndex := -1;
1008 end;
1009 if IsValidBitmapIndex( BitmapIndex ) then
1010 begin
1011 Bitmap := FImages.GetBitmapReference( BitmapIndex );
1012 Result := Bitmap.Width
1013 * FontWidthPrecisionFactor
1014 * FHorizontalImageScale;
1015 end;
1016 end;
1017
1018 teText, teWordBreak:
1019 Result := FFontManager.CharWidth( Element.Character );
1020
1021 else
1022 Assert( False ); // should never be trying to find the width of a style, etc
1023
1024 end;
1025end;
1026
1027Function TRichTextLayout.GetCharIndex( P: PChar ): longint;
1028begin
1029 Result := PCharDiff( P, FText );
1030end;
1031
1032function TRichTextLayout.GetLinePosition( Line: longint ): longint;
1033begin
1034 Result := FRichTextSettings.Margins.Top;
1035 dec( line );
1036 while line >= 0 do
1037 begin
1038 inc( Result,
1039 Flines[ Line ].Height );
1040 dec( line );
1041 end;
1042end;
1043
1044function TRichTextLayout.LinkFromIndex( const CharIndexToFind: longint): string;
1045Var
1046 P: PChar;
1047 NextP: PChar;
1048 EndP: PChar;
1049 Element: TTextElement;
1050 LineIndex: longint;
1051 Line: TLayoutLine;
1052begin
1053 if FNumLines = 0 then
1054 begin
1055 Result := '';
1056 exit;
1057 end;
1058
1059 LineIndex := GetLineFromCharIndex( CharIndexToFind );
1060
1061 Line := FLines[ LineIndex ];
1062 P := Line.Text;
1063 EndP := Line.Text + Line.Length;
1064
1065 if Line.LinkIndex <> -1 then
1066 Result := FLinks[ Line.LinkIndex ]
1067 else
1068 Result := '';
1069
1070 while P < EndP do
1071 begin
1072 if GetCharIndex( P ) >= CharIndexToFind then
1073 exit;
1074
1075 Element := ExtractNextTextElement( P, NextP );
1076
1077 case Element.ElementType of
1078 teStyle:
1079 case Element.Tag.TagType of
1080 ttBeginLink:
1081 Result := Element.Tag.Arguments;
1082 ttEndLink:
1083 Result := '';
1084 end;
1085 end;
1086
1087 P := NextP;
1088 end;
1089end;
1090
1091Initialization
1092End.
1093
Note: See TracBrowser for help on using the repository browser.