source: trunk/Components/RichTextLayoutUnit.pas@ 330

Last change on this file since 330 was 214, checked in by RBRi, 18 years ago

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