source: trunk/Components/RichTextLayoutUnit.pas@ 420

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

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