source: trunk/Components/RichTextLayoutUnit.pas@ 429

Last change on this file since 429 was 429, checked in by ataylor, 6 years ago

Fixed unintialized variable causing rare glitch in cursor positioning on click.
Text wrap width calculation now takes both left and right margins into account.
  • Property svn:eol-style set to native
File size: 34.6 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 Codepage: ULong; // ALT
77
78 // Drawing functions
79
80 Procedure PerformStyleTag( Const Tag: TTag;
81 Var Style: TTextDrawStyle;
82 const X: longint );
83
84 function GetElementWidth( Element: TTextElement ): longint;
85
86 // Queries
87
88 Function GetStartX( Style: TTextDrawStyle;
89 Line: TLayoutLine ): longint;
90
91 Procedure GetXFromOffset( const Offset: longint;
92 const LineIndex: longint;
93 Var X: longint );
94 Procedure GetOffsetFromX( const XToFind: longint;
95 const LineIndex: longint;
96 Var Offset: longint;
97 Var Link: string );
98 function FindPoint( XToFind, YToFind: longint;
99 Var LineIndex: longint;
100 Var Offset: longint;
101 Var Link: string ): TTextPosition;
102 function GetLineFromCharIndex( Index: longint ): longint;
103 function GetOffsetFromCharIndex( Index: longint;
104 Line: longint ): longint;
105 function GetLinePosition( Line: longint ): longint;
106 function GetLineFromPosition( YToFind: longint;
107 Var LineIndex: longint;
108 Var Remainder: longint ): TTextPosition;
109
110 // Layout functions
111
112 Procedure AddLineStart( Const Line: TLayoutLine );
113 Procedure CheckFontHeights( Var Line: TLayoutLine );
114 Procedure Layout;
115
116 function IsValidBitmapIndex( Index: longint ): boolean;
117
118 // property handlers
119
120 Function GetCharIndex( P: PChar ): longint;
121 Function GetTextEnd: longint;
122
123 // ALT
124 Function FindCharacterBoundary( TextPointer: PChar;
125 var Index: LongInt;
126 Advance: Boolean; ): LongInt;
127
128 Public
129 constructor Create( Text: PChar;
130 Images: TImageList;
131 RichTextSettings: TRichTextSettings;
132 FontManager: TCanvasFontManager;
133 Width: longint );
134
135 Destructor Destroy; Override;
136
137 property TextEnd: longint read GetTextEnd;
138
139 function LinkFromIndex( const CharIndexToFind: longint): string;
140
141 property Images: TImageList read FImages;
142
143 property Width: longint read FWidth;
144 property Height: longint read FHeight;
145
146 property HorizontalImageScale: double read FHorizontalImageScale;
147 property VerticalImageScale: double read FVerticalImageScale;
148
149 End;
150
151Implementation
152
153Uses
154 SysUtils,
155 PMWin,
156 BseDos,
157 Dos,
158 ClipBrd,
159 Printers,
160 ACLUtility,
161 ACLString,
162 ControlScrolling,
163 CharUtilsUnit;
164
165Function TRichTextLayout.GetTextEnd: longint;
166begin
167 Result := StrLen( FText );
168end;
169
170// Create a layout of the specified rich text.
171constructor TRichTextLayout.Create( Text: PChar;
172 Images: TImageList;
173 RichTextSettings: TRichTextSettings;
174 FontManager: TCanvasFontManager;
175 Width: longint );
176var
177 DefaultFontSpec: TFontSpec;
178 CpSize: ULong; // ALT
179Begin
180 Inherited Create;
181
182 FRichTextSettings := RichTextSettings;
183
184 FImages := Images;
185
186 FText := Text;
187
188 FAllocatedNumLines := 10;
189 GetMem( FLines, FAllocatedNumLines * sizeof( TLayoutLine ) );
190 FNumLines := 0;
191
192 FLinks := TStringList.Create;
193 FLinks.Duplicates := dupIgnore;
194
195 FFontManager := FontManager;
196
197 FLayoutWidth := Width
198 * FontWidthPrecisionFactor;
199
200 FHorizontalImageScale := FFontManager.Canvas.HorizontalResolution
201 / Screen.Canvas.HorizontalResolution;
202 FVerticalImageScale := FFontManager.Canvas.VerticalResolution
203 / Screen.Canvas.VerticalResolution;
204
205 // use normal font for default font when specified fonts can't be found
206 SibylFontToFontSpec( RichTextSettings.NormalFont,
207 DefaultFontSpec );
208 FFontManager.DefaultFontSpec := DefaultFontSpec;
209
210 DosQueryCp( sizeof( Codepage ), Codepage, CpSize ); // ALT
211
212 Layout;
213End;
214
215Destructor TRichTextLayout.Destroy;
216Begin
217 FreeMem( Flines, FAllocatedNumLines * sizeof( TLayoutLine ) );
218 FLinks.Destroy;
219
220 Inherited Destroy;
221End;
222
223Procedure TRichTextLayout.AddLineStart( Const Line: TLayoutLine );
224var
225 NewAllocation: longint;
226begin
227 if FNumLines >= FAllocatedNumLines then
228 begin
229 // reallocate the array twice the size
230 NewAllocation := FAllocatedNumLines * 2;
231 FLines := ReAllocMem( FLines,
232 FAllocatedNumLines * sizeof( TLayoutLine ),
233 NewAllocation * sizeof( TLayoutLine ) );
234 FAllocatedNumLines := NewAllocation;
235 end;
236 FLines^[ FNumLines ] := Line;
237 inc( FNumLines );
238end;
239
240Procedure TRichTextLayout.PerformStyleTag( Const Tag: TTag;
241 Var Style: TTextDrawStyle;
242 const X: longint );
243begin
244 ApplyStyleTag( Tag,
245 Style,
246 FFontManager,
247 FRichTextSettings,
248 X );
249end;
250
251// Check the current font specifications and see if the
252// give line needs updating for max height/descender
253Procedure TRichTextLayout.CheckFontHeights( Var Line: TLayoutLine );
254var
255 FontHeight: longint;
256 Descender: longint;
257begin
258 FontHeight := FFontManager.CharHeight;
259 Descender := FFontManager.CharDescender;
260
261 if FontHeight > Line.Height then
262 Line.Height := FontHeight;
263
264 if FontHeight > Line.MaxTextHeight then
265 Line.MaxTextHeight := FontHeight;
266
267 if Descender > Line.MaxDescender then
268 Line.MaxDescender := Descender;
269end;
270
271function TRichTextLayout.IsValidBitmapIndex( Index: longint ): boolean;
272begin
273 if FImages = nil then
274 Result := false
275 else if FImages.Count = 0 then
276 Result := false
277 else
278 Result := Between( Index, 0, FImages.Count - 1 );
279end;
280
281// Main procedure: reads through the whole text currently stored
282// and breaks up into lines - each represented as a TLayoutLine in
283// the array FLines[ 0.. FNumLines ]
284Procedure TRichTextLayout.Layout;
285Var
286 CurrentLine: TLayoutLine;
287
288 CurrentLinkIndex: longint;
289
290 WrapX: longint; // X to wrap at
291
292 WordX: longint; // width of word so far
293 P: PChar;
294 NextP: PChar;
295 NextP2: PChar;
296 NextP3: PChar;
297
298 WordStart: PChar;
299 WordStarted: boolean; // if false, just skipping spaces..
300 WordStartX: longint; // X position of word start
301
302 LineWordsCompleted: longint; // how many words draw so far this line
303
304 CurrentElement: TTextElement;
305 NextElement: TTextElement;
306
307 CurrentCharWidth: longint;
308
309 Style: TTextDrawStyle;
310
311 DisplayedCharsSinceFontChange: boolean;
312
313 BitmapIndex: longint;
314 Bitmap: TBitmap;
315 BitmapHeight: longint;
316
317 OnBreak: boolean;
318
319 DoWrap: boolean;
320
321 InsideDBC: Boolean; // ALT
322
323 // Nested procedure
324
325 Procedure DoLine( EndPoint: PChar;
326 NextLine: PChar;
327 EndX: longint );
328 begin
329 // check if the max font
330 // height needs updating for the last string of the line
331 CheckFontHeights( CurrentLine );
332
333 inc( FHeight, CurrentLine.Height );
334
335 CurrentLine.Length := PCharPointerDiff( EndPoint, CurrentLine.Text );
336
337 CurrentLine.Width := EndX;
338
339 if CurrentLine.Width > FWidth then
340 FWidth := CurrentLine.Width;
341
342 assert( CurrentLine.Height > 0 ); // we must have set the line height!
343
344 AddLineStart( CurrentLine );
345 CurrentLine.Text := NextLine;
346 CurrentLine.Style := Style;
347 CurrentLine.Height := 0;
348 CurrentLine.MaxDescender := 0;
349 CurrentLine.MaxTextHeight := 0;
350 CurrentLine.Width := 0;
351 CurrentLine.LinkIndex := CurrentLinkIndex;
352 CurrentLine.Wrapped := false;
353
354 assert( CurrentLinkIndex >= -1 );
355 assert( CurrentLinkIndex < FLinks.Count );
356
357 WordStartX := Style.LeftMargin * FontWidthPrecisionFactor;
358 // next line
359
360 // reset words completed count
361 LineWordsCompleted := 0;
362
363 WordStarted := false;
364 end;
365
366begin
367 FNumLines := 0;
368 FWidth := 0;
369 FHeight := FRichTextSettings.Margins.Top;
370
371 Style := GetDefaultStyle( FRichTextSettings );
372
373 ApplyStyle( Style, FFontManager );
374
375 CurrentLinkIndex := -1;
376
377 P := FText; // P is the current search position
378 CurrentLine.Text := P;
379 CurrentLine.Style := Style;
380 CurrentLine.Height := 0;
381 CurrentLine.MaxDescender := 0;
382 CurrentLine.MaxTextHeight := 0;
383 CurrentLine.Width := 0;
384 CurrentLine.LinkIndex := -1;
385 CurrentLine.Wrapped := false;
386
387 WordStartX := Style.LeftMargin * FontWidthPrecisionFactor;
388 WordX := 0;
389
390 WrapX := FLayoutWidth
391 - Style.LeftMargin // ALT
392 * FontWidthPrecisionFactor
393 - FRichTextSettings.Margins.Right
394 * FontWidthPrecisionFactor;
395
396 LineWordsCompleted := 0;
397
398 WordStarted := false;
399 DisplayedCharsSinceFontChange := false;
400 InsideDBC := false;
401
402 repeat
403 CurrentElement := ExtractNextTextElement( P, NextP );
404 assert( NextP > P );
405 CheckSpecialElementType( CurrentElement.Character, CurrentElement.ElementType, InsideDBC, Codepage ); // ALT
406
407 OnBreak := false;
408
409 case CurrentElement.ElementType of
410 teWordBreak:
411 begin
412 CurrentCharWidth := FFontManager.CharWidth( ' ' );
413 OnBreak := true;
414 InsideDBC := false;
415 end;
416
417 teLineBreak:
418 begin
419 DoLine( P, NextP, WordStartX + WordX );
420
421 // remember start of line
422 WordStart := NextP;
423 WordX := 0;
424 InsideDBC := false;
425
426 P := NextP;
427
428 continue;
429 end;
430
431 teTextEnd:
432 begin
433 DoLine( P, NextP, WordStartX + WordX );
434 InsideDBC := false;
435
436 // end of text, done
437 break;
438 end;
439
440 teImage:
441 begin
442 BitmapHeight := 0;
443 try
444 BitmapIndex := StrToInt( CurrentElement.Tag.Arguments );
445 except
446 BitmapIndex := -1;
447 end;
448 Bitmap := nil;
449 if IsValidBitmapIndex( BitmapIndex ) then
450 begin
451 Bitmap := FImages.GetBitmapReference( BitmapIndex );
452
453 CurrentCharWidth := Bitmap.Width
454 * FontWidthPrecisionFactor
455 * FHorizontalImageScale;
456
457 WordStarted := true;
458 BitmapHeight := Bitmap.Height * FVerticalImageScale;
459 end;
460
461 end;
462
463 teText:
464 begin
465 // Normal (non-leading-space) character
466 CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
467 WordStarted := true;
468 InsideDBC := false;
469 end;
470
471 // ALT begins
472 //
473 teWrapChar:
474 begin
475 // This is a legal break character, but not a space (so we still display it).
476 CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
477
478 // Treat as the start of a new word (for the sake of wrapping).
479 WordStarted := true;
480 inc( WordStartX, WordX + CurrentCharWidth );
481 WordX := 0;
482 WordStart := NextP;
483 end;
484
485 teLeadByte:
486 begin
487 // Leading byte of a double-byte character.
488 // Get the complete character width for our wrapping calculations.
489 if ( NextP > P ) then
490 CurrentCharWidth := FFontManager.CJKTextWidth( 2, P )
491 else
492 CurrentCharWidth := FFontManager.CJKCharWidth;
493 WordStarted := true;
494 end;
495
496 teSecondByte:
497 begin
498 // Secondary byte of a double-byte character.
499 // The full character width was already assigned to the leading byte.
500 CurrentCharWidth := 0;
501
502 // We treat each double-byte character as a complete word for the sake
503 // of the wrapping algorithm.
504 inc( LineWordsCompleted );
505 WordStarted := true;
506 inc( WordStartX, WordX + CurrentCharWidth );
507 WordX := 0;
508 WordStart := NextP;
509 end;
510 //
511 // ALT ends
512
513 teStyle:
514 begin
515 InsideDBC := false;
516 case CurrentElement.Tag.TagType of
517 ttBeginLink:
518 begin
519 CurrentLinkIndex := FLinks.Add( CurrentElement.Tag.Arguments );
520 P := NextP;
521 continue;
522 end;
523
524 ttEndLink:
525 begin
526 CurrentLinkIndex := -1;
527 P := NextP;
528 continue;
529 end;
530
531 ttSetLeftMargin: // SPECIAL CASE... could affect display immediately
532 begin
533 PerformStyleTag( CurrentElement.Tag,
534 Style,
535 WordstartX + WordX );
536 if Style.LeftMargin * FontWidthPrecisionFactor < WordStartX then
537 begin
538 // we're already past the margin being set
539
540 if pos( 'breakifpast', CurrentElement.Tag.Arguments ) > 0 then
541 begin
542 // this argument means, do a line break
543 // if the margin is already past
544 // Seems unusual for most purposes, but needed for IPF rendering.
545 DoLine( P, NextP, WordStartX + WordX );
546
547 // remember start of line
548 WordStart := NextP;
549 WordX := 0;
550
551 P := NextP;
552
553 continue;
554 end;
555
556 // so ignore it for now.
557 P := NextP;
558 continue;
559 end;
560
561 // skip across to the new margin
562 CurrentCharWidth := Style.LeftMargin * FontWidthPrecisionFactor
563 - WordStartX
564 - WordX;
565 // BUT! Don't treat it as a space, because you would not
566 // expect wrapping to take place in a margin change...
567 // at least not for IPF (NewView) :)
568
569 end;
570
571 else
572 begin
573 // before processing the tag see if font height needs updating
574 if DisplayedCharsSinceFontChange then
575 CheckFontHeights( CurrentLine );
576
577 if ( CurrentElement.Tag.TagType = ttItalicOff )
578 and ( faItalic in Style.Font.Attributes ) then
579 if not FFontManager.IsFixed then
580 // end of italic; add a space
581 inc( WordX, FFontManager.CharWidth( ' ' ) );
582
583 PerformStyleTag( CurrentElement.Tag,
584 Style,
585 WordX );
586
587 DisplayedCharsSinceFontChange := false;
588 P := NextP;
589 continue; // continue loop
590 end;
591 end;
592
593 end
594
595 end;
596
597 if OnBreak then
598 begin
599 // we just processed a space
600 if WordStarted then
601 begin
602 DisplayedCharsSinceFontChange := true;
603 // remember that we have now completed a word on this line
604 inc( LineWordsCompleted );
605 WordStarted := false;
606
607 // Add the word width, and the space width,
608 // to get the start of the next word
609 inc( WordStartX, WordX + CurrentCharWidth );
610 WordX := 0;
611
612 // remember the start of the next word
613 WordStart := NextP;
614
615 P := NextP;
616
617 continue;
618 end;
619 // else - starting spaces - fall through like normal char
620 end;
621
622 // if we're still going here we have a normal char
623 // (or leading spaces)
624
625 if not Style.Wrap then
626 begin
627 // No alignment
628 // We don't care about how wide it gets
629 inc( WordX, CurrentCharWidth );
630 DisplayedCharsSinceFontChange := true;
631
632 if CurrentElement.ElementType = teImage then
633 if Bitmap <> nil then
634 if BitmapHeight > CurrentLine.Height then
635 CurrentLine.Height := BitmapHeight;
636
637 P := NextP;
638 continue;
639 end;
640
641 DoWrap := false;
642
643 // Calculate position of end of character
644 // see if char would exceed width
645 if WordStartX
646 + WordX
647 + CurrentCharWidth
648 >= WrapX then
649 begin
650 // reached right hand side before finding end of word
651 if LineWordsCompleted > 0 then
652 // always wrap after at least one word displayed
653 DoWrap := true
654
655 else if ( CurrentElement.ElementType = teWrapChar ) or
656 ( CurrentElement.ElementType = teLeadByte ) then
657 DoWrap := true // ALT
658
659 else if ( not FRichTextSettings.AtLeastOneWordBeforeWrap ) then
660 // only wrap during the first word, if the "at least 1 word" flag is not set.
661 DoWrap := true;
662
663 end;
664
665 if DoWrap then
666 begin
667 if LineWordsCompleted = 0 then
668 begin
669 // the first word did not fit on the line. so draw
670 // as much as will fit
671 if WordX = 0 then
672 begin
673 // even the first char doesn't fit,
674 // but draw it anyway (otherwise, infinite loop)
675
676 NextElement := ExtractNextTextElement( NextP, NextP2 );
677
678 // ALT
679 if InsideDBC then
680 begin
681 // we're in the middle of a double-byte character, so keep the next byte too
682 InsideDBC := false;
683 NextP := NextP2;
684 NextElement := ExtractNextTextElement( NextP2, NextP3 );
685 NextP2 := NextP3;
686 end;
687 // /ALT
688
689 if NextElement.ElementType <> teLineBreak then
690 // there is still more on the line...
691 CurrentLine.Wrapped := true
692 else
693 // the line ends after this one char or image, we can skip the line end
694 NextP := NextP2;
695
696 if CurrentElement.ElementType = teImage then
697 begin
698 // the only thing on the line is the image. so check height
699 if Bitmap <> nil then
700 if BitmapHeight > CurrentLine.Height then
701 CurrentLine.Height := BitmapHeight;
702 end;
703
704 DoLine( NextP,
705 NextP,
706 WordStartX + WordX + CurrentCharWidth );
707 WordStart := NextP;
708
709 WordX := 0;
710 end
711 else
712 begin
713 CurrentLine.Wrapped := true;
714 // at least 1 char fits
715 // so draw up to, but not including this char
716 DoLine( P,
717 P,
718 WordStartX + WordX );
719 WordStart := P;
720 WordX := CurrentCharWidth;
721 end;
722 end
723 else
724 begin
725 // Normal wrap; at least one word fitted on the line
726 CurrentLine.Wrapped := true;
727
728
729 if ( CurrentElement.ElementType = teLeadByte ) or
730 ( CurrentElement.ElementType = teWrapChar ) then // ALT
731 begin
732 // draw up to but not including this 'word' (ALT)
733 DoLine( WordStart,
734 WordStart,
735 WordStartX );
736 end
737 else
738 begin // ALT
739 // take the width of the last space of the
740 // previous word off the line width
741 DoLine( WordStart, // current line ends at start of this word
742 WordStart, // next line starts at start of this word
743 WordStartX - FFontManager.CharWidth( ' ' ) );
744 if CurrentElement.ElementType = teImage then
745 if Bitmap <> nil then
746 if BitmapHeight > CurrentLine.Height then
747 CurrentLine.Height := BitmapHeight;
748 end; // ALT
749
750 // do NOT reset WordX to zero; as we are continuing
751 // from partway thru the word on the next line.
752 inc( WordX, CurrentCharWidth );
753 end;
754 WordStarted := true; // by definition, for wrapping
755 end
756 else
757 begin
758 // Character fits.
759 inc( WordX, CurrentCharWidth );
760
761 DisplayedCharsSinceFontChange := true;
762
763 if CurrentElement.ElementType = teImage then
764 if Bitmap <> nil then
765 if BitmapHeight > CurrentLine.Height then
766 CurrentLine.Height := BitmapHeight;
767 end;
768
769 P := NextP;
770
771 until false; // loop is exited by finding end of text
772
773 inc( FHeight, FRichTextSettings.Margins.Bottom );
774End;
775
776Function TRichTextLayout.GetStartX( Style: TTextDrawStyle;
777 Line: TLayoutLine ): longint;
778var
779 SpaceOnLine: longint;
780begin
781 case Style.Alignment of
782 taLeft:
783 Result := Style.LeftMargin * FontWidthPrecisionFactor;
784
785 taRight:
786 Result := Style.LeftMargin * FontWidthPrecisionFactor
787 + FLayoutWidth
788 - Style.RightMargin * FontWidthPrecisionFactor
789 - Line.Width;
790
791 taCenter:
792 begin
793 // |<------layout width------------------>|
794 // | |
795 // |<-lm->[aaaaaaaaaaaaaaa]<-space-><-rm->|
796 // |<-----line width------> |
797 // space = layoutw-rm-linew
798 SpaceOnLine := FLayoutWidth
799 - Style.RightMargin * FontWidthPrecisionFactor
800 - Line.Width; // Note: line width includes left margin
801 Result := Style.LeftMargin * FontWidthPrecisionFactor
802 + SpaceOnLine div 2;
803 end;
804 end;
805end;
806
807Procedure TRichTextLayout.GetOffsetFromX( const XToFind: longint;
808 const LineIndex: longint;
809 Var Offset: longint;
810 Var Link: string );
811Var
812 X: longint;
813 P: PChar;
814 NextP: PChar;
815 EndP: PChar;
816 Element: TTextElement;
817 CurrentLink: string;
818 Line: TLayoutLine;
819 Style: TTextDrawStyle;
820 NewMarginX: longint;
821 StartedDrawing: boolean;
822 InsideDBC: boolean; // ALT
823begin
824 Line := FLines[ LineIndex ];
825 P := Line.Text;
826 EndP := Line.Text + Line.Length;
827
828 Style := Line.Style;
829 FFontManager.SetFont( Style.Font );
830
831 StartedDrawing := false;
832 InsideDBC := false; // ALT
833
834 Link := '';
835 if Line.LinkIndex <> -1 then
836 CurrentLink := FLinks[ Line.LinkIndex ]
837 else
838 CurrentLink := '';
839
840 while P < EndP do
841 begin
842 Element := ExtractNextTextElement( P, NextP );
843
844 // ALT - handle double-byte characters
845 if InsideDBC and ( P < EndP ) then
846 begin
847 P := NextP;
848 Element := ExtractNextTextElement( P, NextP );
849 InsideDBC := false;
850 end;
851 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
852 // ALT done
853
854 case Element.ElementType of
855 teWordBreak,
856 teText,
857 teLeadByte, // ALT
858 teWrapChar, // ALT
859 teImage:
860 begin
861 if not StartedDrawing then
862 begin
863 // we haven't yet started drawing:
864 // so work out alignment
865 X := GetStartX( Style, Line );
866
867 if X div FontWidthPrecisionFactor
868 > XToFind then
869 begin
870 // found before the start of the line
871 // don't set link
872 Offset := 0;
873 exit;
874 end;
875
876 StartedDrawing := true;
877
878 end;
879
880 // Now find out how wide the thing is
881 if (( Element.ElementType = teLeadByte ) And ( EndP > P )) then // ALT
882 inc( X, FFontManager.CJKTextWidth( 2, P ))
883 else
884 inc( X, GetElementWidth( Element ) );
885
886 if X div FontWidthPrecisionFactor
887 > XToFind then
888 begin
889 // found
890 Offset := PCharPointerDiff( P, Line.Text );
891 Link := CurrentLink;
892 exit;
893 end;
894
895 end;
896
897 teStyle:
898 case Element.Tag.TagType of
899 ttBeginLink:
900 CurrentLink := Element.Tag.Arguments;
901 ttEndLink:
902 CurrentLink := '';
903 else
904 begin
905 if ( Element.Tag.TagType = ttItalicOff )
906 and ( faItalic in Style.Font.Attributes )
907 and ( not FFontManager.IsFixed ) then
908 // end of italic; add a space
909 inc( X, FFontManager.CharWidth( ' ' ) );
910
911 PerformStyleTag( Element.Tag,
912 Style,
913 X );
914 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
915 if NewMarginX > X then
916 begin
917 //skip across...
918 X := NewMarginX;
919 end;
920 end;
921 end;
922 end;
923
924 P := NextP;
925 end;
926 Offset := Line.Length;
927end;
928
929Procedure TRichTextLayout.GetXFromOffset( const Offset: longint;
930 const LineIndex: longint;
931 Var X: longint );
932Var
933 P: PChar;
934 NextP: PChar;
935 EndP: PChar;
936 Element: TTextElement;
937 StartedDrawing: boolean;
938 Line: TLayoutLine;
939 Style: TTextDrawStyle;
940 NewMarginX: longint;
941 InsideDBC: Boolean; // ALT
942begin
943 Line := FLines[ LineIndex ];
944 P := Line.Text;
945 EndP := Line.Text + Line.Length;
946
947 Style := Line.Style;
948 FFontManager.SetFont( Style.Font );
949
950 StartedDrawing := false;
951 InsideDBC := false; // ALT
952
953 while P < EndP do
954 begin
955 Element := ExtractNextTextElement( P, NextP );
956 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage ); // ALT
957
958 case Element.ElementType of
959 teWordBreak,
960 teText,
961 teWrapChar, // ALT
962 teLeadByte, // ALT
963 teImage:
964 begin
965 if not StartedDrawing then
966 begin
967 // we haven't yet started drawing:
968 // so work out alignment
969 X := GetStartX( Style, Line );
970 StartedDrawing := true;
971 end;
972
973 if GetCharIndex( P ) - GetCharIndex( Line.Text ) >= Offset then
974 begin
975 X := X div FontWidthPrecisionFactor;
976 // found
977 exit;
978 end;
979
980 // Now find out how wide the thing is
981 if (( Element.ElementType = teLeadByte ) And ( EndP > P )) then // ALT
982 inc( X, FFontManager.CJKTextWidth( 2, P ))
983 else
984 inc( X, GetElementWidth( Element ) );
985
986 end;
987
988 // teSecondByte: do nothing and continue to next byte (ALT)
989
990 teStyle:
991 begin
992 if ( Element.Tag.TagType = ttItalicOff )
993 and ( faItalic in Style.Font.Attributes )
994 and ( not FFontManager.IsFixed ) then
995 // end of italic; add a space
996 inc( X, FFontManager.CharWidth( ' ' ) );
997
998 PerformStyleTag( Element.Tag,
999 Style,
1000 X );
1001
1002 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
1003 if NewMarginX > X then
1004 begin
1005 //skip across...
1006 X := NewMarginX;
1007 end;
1008 end;
1009 end;
1010
1011 P := NextP;
1012 end;
1013 // went thru the whole line without finding the point,
1014 if not StartedDrawing then
1015 X := GetStartX( Style, Line );
1016
1017 X := X div FontWidthPrecisionFactor;
1018end;
1019
1020function TRichTextLayout.GetLineFromPosition( YToFind: longint;
1021 Var LineIndex: longint;
1022 Var Remainder: longint ): TTextPosition;
1023var
1024 Y: longint;
1025 LineHeight: longint;
1026begin
1027 LineIndex := 0;
1028 Remainder := 0;
1029
1030 Y := FRichTextSettings.Margins.Top;
1031
1032 if YToFind < Y then
1033 begin
1034 Result := tpAboveText;
1035 exit;
1036 end;
1037
1038 while LineIndex < FNumLines do
1039 begin
1040 LineHeight := FLines[ LineIndex ].Height;
1041 if ( YToFind >= Y )
1042 and ( YToFind < Y + LineHeight ) then
1043 begin
1044 // YToFind is within the line
1045 Result := tpWithinText;
1046 Remainder := YToFind - Y;
1047 exit;
1048 end;
1049
1050 inc( Y, FLines[ LineIndex ].Height );
1051 inc( LineIndex );
1052 end;
1053
1054 LineIndex := FNumLines - 1;
1055 Remainder := FLines[ LineIndex ].Height;
1056
1057 Result := tpBelowText;
1058end;
1059
1060function TRichTextLayout.FindPoint( XToFind, YToFind: longint;
1061 Var LineIndex: longint;
1062 Var Offset: longint;
1063 Var Link: string ): TTextPosition;
1064var
1065 Remainder: longint;
1066begin
1067 Link := '';
1068 Result := GetLineFromPosition( YToFind,
1069 LineIndex,
1070 Remainder );
1071 case Result of
1072 tpAboveText:
1073 begin
1074 Offset := 0;
1075 exit;
1076 end;
1077
1078 tpBelowText:
1079 begin
1080 Offset := FLines[ LineIndex ].Length;
1081 exit;
1082 end;
1083 end;
1084
1085 // found the line
1086 GetOffsetFromX( XToFind,
1087 LineIndex,
1088 Offset,
1089 Link );
1090end;
1091
1092function TRichTextLayout.GetLineFromCharIndex( Index: longint ): longint;
1093var
1094 LineCharIndex: longint;
1095 LineLength: longint;
1096begin
1097 Result := 0;
1098 if Index <= 0 then
1099 exit;
1100
1101 while Result < FNumLines do
1102 begin
1103 LineCharIndex := GetCharIndex( FLines[ Result ].Text );
1104 LineLength := FLines[ Result ].Length;
1105 if LineCharIndex + LineLength
1106 > Index then
1107 begin
1108 // found
1109 exit;
1110 end;
1111 inc( Result );
1112 end;
1113 Result := FNumLines - 1;
1114end;
1115
1116function TRichTextLayout.GetOffsetFromCharIndex( Index: longint;
1117 Line: longint ): longint;
1118begin
1119 Result := Index - GetCharIndex( TLayoutLine( FLines[ Line ] ).Text );
1120end;
1121
1122function TRichTextLayout.GetElementWidth( Element: TTextElement ): longint;
1123var
1124 Bitmap: TBItmap;
1125 BitmapIndex: longint;
1126begin
1127 // Now find out how wide the thing is
1128 case Element.ElementType of
1129 teImage:
1130 begin
1131 try
1132 BitmapIndex := StrToInt( Element.Tag.Arguments );
1133 except
1134 BitmapIndex := -1;
1135 end;
1136 if IsValidBitmapIndex( BitmapIndex ) then
1137 begin
1138 Bitmap := FImages.GetBitmapReference( BitmapIndex );
1139 Result := Bitmap.Width
1140 * FontWidthPrecisionFactor
1141 * FHorizontalImageScale;
1142 end;
1143 end;
1144
1145 teText, teWordBreak, teWrapChar: // ALT
1146 Result := FFontManager.CharWidth( Element.Character );
1147
1148 teLeadByte: // ALT - should not be reached
1149 Result := FFontManager.CJKCharWidth;
1150
1151 teSecondByte: // ALT
1152 Result := 0;
1153
1154 else
1155 Assert( False ); // should never be trying to find the width of a style, etc
1156
1157 end;
1158end;
1159
1160Function TRichTextLayout.GetCharIndex( P: PChar ): longint;
1161begin
1162 Result := PCharPointerDiff( P, FText );
1163end;
1164
1165function TRichTextLayout.GetLinePosition( Line: longint ): longint;
1166begin
1167 Result := FRichTextSettings.Margins.Top;
1168 dec( line );
1169 while line >= 0 do
1170 begin
1171 inc( Result,
1172 Flines[ Line ].Height );
1173 dec( line );
1174 end;
1175end;
1176
1177function TRichTextLayout.LinkFromIndex( const CharIndexToFind: longint): string;
1178Var
1179 P: PChar;
1180 NextP: PChar;
1181 EndP: PChar;
1182 Element: TTextElement;
1183 LineIndex: longint;
1184 Line: TLayoutLine;
1185begin
1186 if FNumLines = 0 then
1187 begin
1188 Result := '';
1189 exit;
1190 end;
1191
1192 LineIndex := GetLineFromCharIndex( CharIndexToFind );
1193
1194 Line := FLines[ LineIndex ];
1195 P := Line.Text;
1196 EndP := Line.Text + Line.Length;
1197
1198 if Line.LinkIndex <> -1 then
1199 Result := FLinks[ Line.LinkIndex ]
1200 else
1201 Result := '';
1202
1203 while P < EndP do
1204 begin
1205 if GetCharIndex( P ) >= CharIndexToFind then
1206 exit;
1207
1208 Element := ExtractNextTextElement( P, NextP );
1209
1210 case Element.ElementType of
1211 teStyle:
1212 case Element.Tag.TagType of
1213 ttBeginLink:
1214 Result := Element.Tag.Arguments;
1215 ttEndLink:
1216 Result := '';
1217 end;
1218 end;
1219
1220 P := NextP;
1221 end;
1222end;
1223
1224// ALT begins
1225//
1226// Given a text position, check if it's in the middle of a double-byte
1227// character; if so, shift the position one byte forwards or backwards.
1228//
1229function TRichTextLayout.FindCharacterBoundary( TextPointer: PChar; // pointer to text
1230 var Index: LongInt; // position (byte index) within text
1231 Advance: Boolean; // whether to adjust position forward
1232 ): LongInt; // returns new offset within line
1233var
1234 P: PChar; // pointer to current character in string
1235 NextP: PChar; // pointer to the following character, if any
1236 Element: TTextElement; // element data about the current character
1237 CurrentPos: LongInt; // index of first character of line
1238 Line: LongInt; // current line number
1239 Offset: LongInt; // offset position within current line
1240 InsideDBC: boolean;
1241begin
1242 Offset := 0;
1243
1244 if ( Codepage in [ 932, 936, 942, 943, 949, 950, 1381, 1386 ]) then
1245 begin
1246 // Because parsing of byte types is state based, we must verify every
1247 // byte's type from the beginning of the line until we reach the target.
1248 //
1249 Line := GetLineFromCharIndex( Index );
1250 CurrentPos := GetCharIndex( FLines[ Line ].Text );
1251 P := TextPointer + CurrentPos;
1252 InsideDBC := false;
1253
1254 while CurrentPos < Index do
1255 begin
1256 Element := ExtractNextTextElement( P, NextP );
1257 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
1258 CurrentPos := CurrentPos + PCharPointerDiff( NextP, P );
1259 Offset := Offset + PCharPointerDiff( NextP, P );
1260 P := NextP;
1261 end;
1262
1263 // We've reached the target position, and the current parsing state should
1264 // be correctly set. So now we can safely determine the target byte's type.
1265 //
1266 Element := ExtractNextTextElement( P, NextP );
1267 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
1268
1269 if Element.ElementType = teSecondByte then
1270 begin
1271 // If we are inside a a double byte character, shift position by one.
1272 if Advance Then
1273 Begin
1274 inc( Index );
1275 inc( Offset );
1276 End
1277 Else
1278 Begin
1279 dec( Index );
1280 dec( Offset );
1281 End
1282 end;
1283
1284 end;
1285
1286 Result := Offset;
1287end;
1288//
1289// ALT ends
1290
1291Initialization
1292End.
1293
Note: See TracBrowser for help on using the repository browser.