source: trunk/Components/RichTextLayoutUnit.pas@ 454

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

NewView 2.19.6 versioning updates & minor wrap width tweak.
  • 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 - FontWidthPrecisionFactor // ALT
392 - Style.LeftMargin * FontWidthPrecisionFactor // ALT
393 - FRichTextSettings.Margins.Right * FontWidthPrecisionFactor;
394
395 LineWordsCompleted := 0;
396
397 WordStarted := false;
398 DisplayedCharsSinceFontChange := false;
399 InsideDBC := false;
400
401 repeat
402 CurrentElement := ExtractNextTextElement( P, NextP );
403 assert( NextP > P );
404 CheckSpecialElementType( CurrentElement.Character, CurrentElement.ElementType, InsideDBC, Codepage ); // ALT
405
406 OnBreak := false;
407
408 case CurrentElement.ElementType of
409 teWordBreak:
410 begin
411 CurrentCharWidth := FFontManager.CharWidth( ' ' );
412 OnBreak := true;
413 InsideDBC := false;
414 end;
415
416 teLineBreak:
417 begin
418 DoLine( P, NextP, WordStartX + WordX );
419
420 // remember start of line
421 WordStart := NextP;
422 WordX := 0;
423 InsideDBC := false;
424
425 P := NextP;
426
427 continue;
428 end;
429
430 teTextEnd:
431 begin
432 DoLine( P, NextP, WordStartX + WordX );
433 InsideDBC := false;
434
435 // end of text, done
436 break;
437 end;
438
439 teImage:
440 begin
441 BitmapHeight := 0;
442 try
443 BitmapIndex := StrToInt( CurrentElement.Tag.Arguments );
444 except
445 BitmapIndex := -1;
446 end;
447 Bitmap := nil;
448 if IsValidBitmapIndex( BitmapIndex ) then
449 begin
450 Bitmap := FImages.GetBitmapReference( BitmapIndex );
451
452 CurrentCharWidth := Bitmap.Width
453 * FontWidthPrecisionFactor
454 * FHorizontalImageScale;
455
456 WordStarted := true;
457 BitmapHeight := Bitmap.Height * FVerticalImageScale;
458 end;
459
460 end;
461
462 teText:
463 begin
464 // Normal (non-leading-space) character
465 CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
466 WordStarted := true;
467 InsideDBC := false;
468 end;
469
470 // ALT begins
471 //
472 teWrapChar:
473 begin
474 // This is a legal break character, but not a space (so we still display it).
475 CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
476
477 // Treat as the start of a new word (for the sake of wrapping).
478 WordStarted := true;
479 inc( WordStartX, WordX + CurrentCharWidth );
480 WordX := 0;
481 WordStart := NextP;
482 end;
483
484 teLeadByte:
485 begin
486 // Leading byte of a double-byte character.
487 // Get the complete character width for our wrapping calculations.
488 if ( NextP > P ) then
489 CurrentCharWidth := FFontManager.CJKTextWidth( 2, P )
490 else
491 CurrentCharWidth := FFontManager.CJKCharWidth;
492 WordStarted := true;
493 end;
494
495 teSecondByte:
496 begin
497 // Secondary byte of a double-byte character.
498 // The full character width was already assigned to the leading byte.
499 CurrentCharWidth := 0;
500
501 // We treat each double-byte character as a complete word for the sake
502 // of the wrapping algorithm.
503 inc( LineWordsCompleted );
504 WordStarted := true;
505 inc( WordStartX, WordX + CurrentCharWidth );
506 WordX := 0;
507 WordStart := NextP;
508 end;
509 //
510 // ALT ends
511
512 teStyle:
513 begin
514 InsideDBC := false;
515 case CurrentElement.Tag.TagType of
516 ttBeginLink:
517 begin
518 CurrentLinkIndex := FLinks.Add( CurrentElement.Tag.Arguments );
519 P := NextP;
520 continue;
521 end;
522
523 ttEndLink:
524 begin
525 CurrentLinkIndex := -1;
526 P := NextP;
527 continue;
528 end;
529
530 ttSetLeftMargin: // SPECIAL CASE... could affect display immediately
531 begin
532 PerformStyleTag( CurrentElement.Tag,
533 Style,
534 WordstartX + WordX );
535 if Style.LeftMargin * FontWidthPrecisionFactor < WordStartX then
536 begin
537 // we're already past the margin being set
538
539 if pos( 'breakifpast', CurrentElement.Tag.Arguments ) > 0 then
540 begin
541 // this argument means, do a line break
542 // if the margin is already past
543 // Seems unusual for most purposes, but needed for IPF rendering.
544 DoLine( P, NextP, WordStartX + WordX );
545
546 // remember start of line
547 WordStart := NextP;
548 WordX := 0;
549
550 P := NextP;
551
552 continue;
553 end;
554
555 // so ignore it for now.
556 P := NextP;
557 continue;
558 end;
559
560 // skip across to the new margin
561 CurrentCharWidth := Style.LeftMargin * FontWidthPrecisionFactor
562 - WordStartX
563 - WordX;
564 // BUT! Don't treat it as a space, because you would not
565 // expect wrapping to take place in a margin change...
566 // at least not for IPF (NewView) :)
567
568 end;
569
570 else
571 begin
572 // before processing the tag see if font height needs updating
573 if DisplayedCharsSinceFontChange then
574 CheckFontHeights( CurrentLine );
575
576 if ( CurrentElement.Tag.TagType = ttItalicOff )
577 and ( faItalic in Style.Font.Attributes ) then
578 if not FFontManager.IsFixed then
579 // end of italic; add a space
580 inc( WordX, FFontManager.CharWidth( ' ' ) );
581
582 PerformStyleTag( CurrentElement.Tag,
583 Style,
584 WordX );
585
586 DisplayedCharsSinceFontChange := false;
587 P := NextP;
588 continue; // continue loop
589 end;
590 end;
591
592 end
593
594 end;
595
596 if OnBreak then
597 begin
598 // we just processed a space
599 if WordStarted then
600 begin
601 DisplayedCharsSinceFontChange := true;
602 // remember that we have now completed a word on this line
603 inc( LineWordsCompleted );
604 WordStarted := false;
605
606 // Add the word width, and the space width,
607 // to get the start of the next word
608 inc( WordStartX, WordX + CurrentCharWidth );
609 WordX := 0;
610
611 // remember the start of the next word
612 WordStart := NextP;
613
614 P := NextP;
615
616 continue;
617 end;
618 // else - starting spaces - fall through like normal char
619 end;
620
621 // if we're still going here we have a normal char
622 // (or leading spaces)
623
624 if not Style.Wrap then
625 begin
626 // No alignment
627 // We don't care about how wide it gets
628 inc( WordX, CurrentCharWidth );
629 DisplayedCharsSinceFontChange := true;
630
631 if CurrentElement.ElementType = teImage then
632 if Bitmap <> nil then
633 if BitmapHeight > CurrentLine.Height then
634 CurrentLine.Height := BitmapHeight;
635
636 P := NextP;
637 continue;
638 end;
639
640 DoWrap := false;
641
642 // Calculate position of end of character
643 // see if char would exceed width
644 if WordStartX
645 + WordX
646 + CurrentCharWidth
647 >= WrapX then
648 begin
649 // reached right hand side before finding end of word
650 if LineWordsCompleted > 0 then
651 // always wrap after at least one word displayed
652 DoWrap := true
653
654 else if ( CurrentElement.ElementType = teWrapChar ) or
655 ( CurrentElement.ElementType = teLeadByte ) then
656 DoWrap := true // ALT
657
658 else if ( not FRichTextSettings.AtLeastOneWordBeforeWrap ) then
659 // only wrap during the first word, if the "at least 1 word" flag is not set.
660 DoWrap := true;
661
662 end;
663
664 if DoWrap then
665 begin
666 if LineWordsCompleted = 0 then
667 begin
668 // the first word did not fit on the line. so draw
669 // as much as will fit
670 if WordX = 0 then
671 begin
672 // even the first char doesn't fit,
673 // but draw it anyway (otherwise, infinite loop)
674
675 NextElement := ExtractNextTextElement( NextP, NextP2 );
676
677 // ALT
678 if InsideDBC then
679 begin
680 // we're in the middle of a double-byte character, so keep the next byte too
681 InsideDBC := false;
682 NextP := NextP2;
683 NextElement := ExtractNextTextElement( NextP2, NextP3 );
684 NextP2 := NextP3;
685 end;
686 // /ALT
687
688 if NextElement.ElementType <> teLineBreak then
689 // there is still more on the line...
690 CurrentLine.Wrapped := true
691 else
692 // the line ends after this one char or image, we can skip the line end
693 NextP := NextP2;
694
695 if CurrentElement.ElementType = teImage then
696 begin
697 // the only thing on the line is the image. so check height
698 if Bitmap <> nil then
699 if BitmapHeight > CurrentLine.Height then
700 CurrentLine.Height := BitmapHeight;
701 end;
702
703 DoLine( NextP,
704 NextP,
705 WordStartX + WordX + CurrentCharWidth );
706 WordStart := NextP;
707
708 WordX := 0;
709 end
710 else
711 begin
712 CurrentLine.Wrapped := true;
713 // at least 1 char fits
714 // so draw up to, but not including this char
715 DoLine( P,
716 P,
717 WordStartX + WordX );
718 WordStart := P;
719 WordX := CurrentCharWidth;
720 end;
721 end
722 else
723 begin
724 // Normal wrap; at least one word fitted on the line
725 CurrentLine.Wrapped := true;
726
727
728 if ( CurrentElement.ElementType = teLeadByte ) or
729 ( CurrentElement.ElementType = teWrapChar ) then // ALT
730 begin
731 // draw up to but not including this 'word' (ALT)
732 DoLine( WordStart,
733 WordStart,
734 WordStartX );
735 end
736 else
737 begin // ALT
738 // take the width of the last space of the
739 // previous word off the line width
740 DoLine( WordStart, // current line ends at start of this word
741 WordStart, // next line starts at start of this word
742 WordStartX - FFontManager.CharWidth( ' ' ) );
743 if CurrentElement.ElementType = teImage then
744 if Bitmap <> nil then
745 if BitmapHeight > CurrentLine.Height then
746 CurrentLine.Height := BitmapHeight;
747 end; // ALT
748
749 // do NOT reset WordX to zero; as we are continuing
750 // from partway thru the word on the next line.
751 inc( WordX, CurrentCharWidth );
752 end;
753 WordStarted := true; // by definition, for wrapping
754 end
755 else
756 begin
757 // Character fits.
758 inc( WordX, CurrentCharWidth );
759
760 DisplayedCharsSinceFontChange := true;
761
762 if CurrentElement.ElementType = teImage then
763 if Bitmap <> nil then
764 if BitmapHeight > CurrentLine.Height then
765 CurrentLine.Height := BitmapHeight;
766 end;
767
768 P := NextP;
769
770 until false; // loop is exited by finding end of text
771
772 inc( FHeight, FRichTextSettings.Margins.Bottom );
773End;
774
775Function TRichTextLayout.GetStartX( Style: TTextDrawStyle;
776 Line: TLayoutLine ): longint;
777var
778 SpaceOnLine: longint;
779begin
780 case Style.Alignment of
781 taLeft:
782 Result := Style.LeftMargin * FontWidthPrecisionFactor;
783
784 taRight:
785 Result := Style.LeftMargin * FontWidthPrecisionFactor
786 + FLayoutWidth
787 - Style.RightMargin * FontWidthPrecisionFactor
788 - Line.Width;
789
790 taCenter:
791 begin
792 // |<------layout width------------------>|
793 // | |
794 // |<-lm->[aaaaaaaaaaaaaaa]<-space-><-rm->|
795 // |<-----line width------> |
796 // space = layoutw-rm-linew
797 SpaceOnLine := FLayoutWidth
798 - Style.RightMargin * FontWidthPrecisionFactor
799 - Line.Width; // Note: line width includes left margin
800 Result := Style.LeftMargin * FontWidthPrecisionFactor
801 + SpaceOnLine div 2;
802 end;
803 end;
804end;
805
806Procedure TRichTextLayout.GetOffsetFromX( const XToFind: longint;
807 const LineIndex: longint;
808 Var Offset: longint;
809 Var Link: string );
810Var
811 X: longint;
812 P: PChar;
813 NextP: PChar;
814 EndP: PChar;
815 Element: TTextElement;
816 CurrentLink: string;
817 Line: TLayoutLine;
818 Style: TTextDrawStyle;
819 NewMarginX: longint;
820 StartedDrawing: boolean;
821 InsideDBC: boolean; // ALT
822begin
823 Line := FLines[ LineIndex ];
824 P := Line.Text;
825 EndP := Line.Text + Line.Length;
826
827 Style := Line.Style;
828 FFontManager.SetFont( Style.Font );
829
830 StartedDrawing := false;
831 InsideDBC := false; // ALT
832
833 Link := '';
834 if Line.LinkIndex <> -1 then
835 CurrentLink := FLinks[ Line.LinkIndex ]
836 else
837 CurrentLink := '';
838
839 while P < EndP do
840 begin
841 Element := ExtractNextTextElement( P, NextP );
842
843 // ALT - handle double-byte characters
844 if InsideDBC and ( P < EndP ) then
845 begin
846 P := NextP;
847 Element := ExtractNextTextElement( P, NextP );
848 InsideDBC := false;
849 end;
850 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
851 // ALT done
852
853 case Element.ElementType of
854 teWordBreak,
855 teText,
856 teLeadByte, // ALT
857 teWrapChar, // ALT
858 teImage:
859 begin
860 if not StartedDrawing then
861 begin
862 // we haven't yet started drawing:
863 // so work out alignment
864 X := GetStartX( Style, Line );
865
866 if X div FontWidthPrecisionFactor
867 > XToFind then
868 begin
869 // found before the start of the line
870 // don't set link
871 Offset := 0;
872 exit;
873 end;
874
875 StartedDrawing := true;
876
877 end;
878
879 // Now find out how wide the thing is
880 if (( Element.ElementType = teLeadByte ) And ( EndP > P )) then // ALT
881 inc( X, FFontManager.CJKTextWidth( 2, P ))
882 else
883 inc( X, GetElementWidth( Element ) );
884
885 if X div FontWidthPrecisionFactor
886 > XToFind then
887 begin
888 // found
889 Offset := PCharPointerDiff( P, Line.Text );
890 Link := CurrentLink;
891 exit;
892 end;
893
894 end;
895
896 teStyle:
897 case Element.Tag.TagType of
898 ttBeginLink:
899 CurrentLink := Element.Tag.Arguments;
900 ttEndLink:
901 CurrentLink := '';
902 else
903 begin
904 if ( Element.Tag.TagType = ttItalicOff )
905 and ( faItalic in Style.Font.Attributes )
906 and ( not FFontManager.IsFixed ) then
907 // end of italic; add a space
908 inc( X, FFontManager.CharWidth( ' ' ) );
909
910 PerformStyleTag( Element.Tag,
911 Style,
912 X );
913 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
914 if NewMarginX > X then
915 begin
916 //skip across...
917 X := NewMarginX;
918 end;
919 end;
920 end;
921 end;
922
923 P := NextP;
924 end;
925 Offset := Line.Length;
926end;
927
928Procedure TRichTextLayout.GetXFromOffset( const Offset: longint;
929 const LineIndex: longint;
930 Var X: longint );
931Var
932 P: PChar;
933 NextP: PChar;
934 EndP: PChar;
935 Element: TTextElement;
936 StartedDrawing: boolean;
937 Line: TLayoutLine;
938 Style: TTextDrawStyle;
939 NewMarginX: longint;
940 InsideDBC: Boolean; // ALT
941begin
942 Line := FLines[ LineIndex ];
943 P := Line.Text;
944 EndP := Line.Text + Line.Length;
945
946 Style := Line.Style;
947 FFontManager.SetFont( Style.Font );
948
949 StartedDrawing := false;
950 InsideDBC := false; // ALT
951
952 while P < EndP do
953 begin
954 Element := ExtractNextTextElement( P, NextP );
955 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage ); // ALT
956
957 case Element.ElementType of
958 teWordBreak,
959 teText,
960 teWrapChar, // ALT
961 teLeadByte, // ALT
962 teImage:
963 begin
964 if not StartedDrawing then
965 begin
966 // we haven't yet started drawing:
967 // so work out alignment
968 X := GetStartX( Style, Line );
969 StartedDrawing := true;
970 end;
971
972 if GetCharIndex( P ) - GetCharIndex( Line.Text ) >= Offset then
973 begin
974 X := X div FontWidthPrecisionFactor;
975 // found
976 exit;
977 end;
978
979 // Now find out how wide the thing is
980 if (( Element.ElementType = teLeadByte ) And ( EndP > P )) then // ALT
981 inc( X, FFontManager.CJKTextWidth( 2, P ))
982 else
983 inc( X, GetElementWidth( Element ) );
984
985 end;
986
987 // teSecondByte: do nothing and continue to next byte (ALT)
988
989 teStyle:
990 begin
991 if ( Element.Tag.TagType = ttItalicOff )
992 and ( faItalic in Style.Font.Attributes )
993 and ( not FFontManager.IsFixed ) then
994 // end of italic; add a space
995 inc( X, FFontManager.CharWidth( ' ' ) );
996
997 PerformStyleTag( Element.Tag,
998 Style,
999 X );
1000
1001 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
1002 if NewMarginX > X then
1003 begin
1004 //skip across...
1005 X := NewMarginX;
1006 end;
1007 end;
1008 end;
1009
1010 P := NextP;
1011 end;
1012 // went thru the whole line without finding the point,
1013 if not StartedDrawing then
1014 X := GetStartX( Style, Line );
1015
1016 X := X div FontWidthPrecisionFactor;
1017end;
1018
1019function TRichTextLayout.GetLineFromPosition( YToFind: longint;
1020 Var LineIndex: longint;
1021 Var Remainder: longint ): TTextPosition;
1022var
1023 Y: longint;
1024 LineHeight: longint;
1025begin
1026 LineIndex := 0;
1027 Remainder := 0;
1028
1029 Y := FRichTextSettings.Margins.Top;
1030
1031 if YToFind < Y then
1032 begin
1033 Result := tpAboveText;
1034 exit;
1035 end;
1036
1037 while LineIndex < FNumLines do
1038 begin
1039 LineHeight := FLines[ LineIndex ].Height;
1040 if ( YToFind >= Y )
1041 and ( YToFind < Y + LineHeight ) then
1042 begin
1043 // YToFind is within the line
1044 Result := tpWithinText;
1045 Remainder := YToFind - Y;
1046 exit;
1047 end;
1048
1049 inc( Y, FLines[ LineIndex ].Height );
1050 inc( LineIndex );
1051 end;
1052
1053 LineIndex := FNumLines - 1;
1054 Remainder := FLines[ LineIndex ].Height;
1055
1056 Result := tpBelowText;
1057end;
1058
1059function TRichTextLayout.FindPoint( XToFind, YToFind: longint;
1060 Var LineIndex: longint;
1061 Var Offset: longint;
1062 Var Link: string ): TTextPosition;
1063var
1064 Remainder: longint;
1065begin
1066 Link := '';
1067 Result := GetLineFromPosition( YToFind,
1068 LineIndex,
1069 Remainder );
1070 case Result of
1071 tpAboveText:
1072 begin
1073 Offset := 0;
1074 exit;
1075 end;
1076
1077 tpBelowText:
1078 begin
1079 Offset := FLines[ LineIndex ].Length;
1080 exit;
1081 end;
1082 end;
1083
1084 // found the line
1085 GetOffsetFromX( XToFind,
1086 LineIndex,
1087 Offset,
1088 Link );
1089end;
1090
1091function TRichTextLayout.GetLineFromCharIndex( Index: longint ): longint;
1092var
1093 LineCharIndex: longint;
1094 LineLength: longint;
1095begin
1096 Result := 0;
1097 if Index <= 0 then
1098 exit;
1099
1100 while Result < FNumLines do
1101 begin
1102 LineCharIndex := GetCharIndex( FLines[ Result ].Text );
1103 LineLength := FLines[ Result ].Length;
1104 if LineCharIndex + LineLength
1105 > Index then
1106 begin
1107 // found
1108 exit;
1109 end;
1110 inc( Result );
1111 end;
1112 Result := FNumLines - 1;
1113end;
1114
1115function TRichTextLayout.GetOffsetFromCharIndex( Index: longint;
1116 Line: longint ): longint;
1117begin
1118 Result := Index - GetCharIndex( TLayoutLine( FLines[ Line ] ).Text );
1119end;
1120
1121function TRichTextLayout.GetElementWidth( Element: TTextElement ): longint;
1122var
1123 Bitmap: TBItmap;
1124 BitmapIndex: longint;
1125begin
1126 // Now find out how wide the thing is
1127 case Element.ElementType of
1128 teImage:
1129 begin
1130 try
1131 BitmapIndex := StrToInt( Element.Tag.Arguments );
1132 except
1133 BitmapIndex := -1;
1134 end;
1135 if IsValidBitmapIndex( BitmapIndex ) then
1136 begin
1137 Bitmap := FImages.GetBitmapReference( BitmapIndex );
1138 Result := Bitmap.Width
1139 * FontWidthPrecisionFactor
1140 * FHorizontalImageScale;
1141 end;
1142 end;
1143
1144 teText, teWordBreak, teWrapChar: // ALT
1145 Result := FFontManager.CharWidth( Element.Character );
1146
1147 teLeadByte: // ALT - should not be reached
1148 Result := FFontManager.CJKCharWidth;
1149
1150 teSecondByte: // ALT
1151 Result := 0;
1152
1153 else
1154 Assert( False ); // should never be trying to find the width of a style, etc
1155
1156 end;
1157end;
1158
1159Function TRichTextLayout.GetCharIndex( P: PChar ): longint;
1160begin
1161 Result := PCharPointerDiff( P, FText );
1162end;
1163
1164function TRichTextLayout.GetLinePosition( Line: longint ): longint;
1165begin
1166 Result := FRichTextSettings.Margins.Top;
1167 dec( line );
1168 while line >= 0 do
1169 begin
1170 inc( Result,
1171 Flines[ Line ].Height );
1172 dec( line );
1173 end;
1174end;
1175
1176function TRichTextLayout.LinkFromIndex( const CharIndexToFind: longint): string;
1177Var
1178 P: PChar;
1179 NextP: PChar;
1180 EndP: PChar;
1181 Element: TTextElement;
1182 LineIndex: longint;
1183 Line: TLayoutLine;
1184begin
1185 if FNumLines = 0 then
1186 begin
1187 Result := '';
1188 exit;
1189 end;
1190
1191 LineIndex := GetLineFromCharIndex( CharIndexToFind );
1192
1193 Line := FLines[ LineIndex ];
1194 P := Line.Text;
1195 EndP := Line.Text + Line.Length;
1196
1197 if Line.LinkIndex <> -1 then
1198 Result := FLinks[ Line.LinkIndex ]
1199 else
1200 Result := '';
1201
1202 while P < EndP do
1203 begin
1204 if GetCharIndex( P ) >= CharIndexToFind then
1205 exit;
1206
1207 Element := ExtractNextTextElement( P, NextP );
1208
1209 case Element.ElementType of
1210 teStyle:
1211 case Element.Tag.TagType of
1212 ttBeginLink:
1213 Result := Element.Tag.Arguments;
1214 ttEndLink:
1215 Result := '';
1216 end;
1217 end;
1218
1219 P := NextP;
1220 end;
1221end;
1222
1223// ALT begins
1224//
1225// Given a text position, check if it's in the middle of a double-byte
1226// character; if so, shift the position one byte forwards or backwards.
1227//
1228function TRichTextLayout.FindCharacterBoundary( TextPointer: PChar; // pointer to text
1229 var Index: LongInt; // position (byte index) within text
1230 Advance: Boolean; // whether to adjust position forward
1231 ): LongInt; // returns new offset within line
1232var
1233 P: PChar; // pointer to current character in string
1234 NextP: PChar; // pointer to the following character, if any
1235 Element: TTextElement; // element data about the current character
1236 CurrentPos: LongInt; // index of first character of line
1237 Line: LongInt; // current line number
1238 Offset: LongInt; // offset position within current line
1239 InsideDBC: boolean;
1240begin
1241 Offset := 0;
1242
1243 if ( Codepage in [ 932, 936, 942, 943, 949, 950, 1381, 1386 ]) then
1244 begin
1245 // Because parsing of byte types is state based, we must verify every
1246 // byte's type from the beginning of the line until we reach the target.
1247 //
1248 Line := GetLineFromCharIndex( Index );
1249 CurrentPos := GetCharIndex( FLines[ Line ].Text );
1250 P := TextPointer + CurrentPos;
1251 InsideDBC := false;
1252
1253 while CurrentPos < Index do
1254 begin
1255 Element := ExtractNextTextElement( P, NextP );
1256 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
1257 CurrentPos := CurrentPos + PCharPointerDiff( NextP, P );
1258 Offset := Offset + PCharPointerDiff( NextP, P );
1259 P := NextP;
1260 end;
1261
1262 // We've reached the target position, and the current parsing state should
1263 // be correctly set. So now we can safely determine the target byte's type.
1264 //
1265 Element := ExtractNextTextElement( P, NextP );
1266 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
1267
1268 if Element.ElementType = teSecondByte then
1269 begin
1270 // If we are inside a a double byte character, shift position by one.
1271 if Advance Then
1272 Begin
1273 inc( Index );
1274 inc( Offset );
1275 End
1276 Else
1277 Begin
1278 dec( Index );
1279 dec( Offset );
1280 End
1281 end;
1282
1283 end;
1284
1285 Result := Offset;
1286end;
1287//
1288// ALT ends
1289
1290Initialization
1291End.
1292
Note: See TracBrowser for help on using the repository browser.