source: trunk/Components/RichTextLayoutUnit.pas@ 428

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

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