source: trunk/Components/RichTextLayoutUnit.pas@ 418

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

Experimental new logic to try and fix DBCS text wrapping.
  • Property svn:eol-style set to native
File size: 31.2 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 );
[418]836 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage ); // ALT
[15]837
838 case Element.ElementType of
839 teWordBreak,
840 teText,
[418]841 teLeadByte, // ALT
842 teWrapChar, // ALT
[15]843 teImage:
844 begin
845 if not StartedDrawing then
846 begin
847 // we haven't yet started drawing:
848 // so work out alignment
849 X := GetStartX( Style, Line );
850
851 if X div FontWidthPrecisionFactor
852 > XToFind then
853 begin
854 // found before the start of the line
855 // don't set link
856 Offset := 0;
857 exit;
858 end;
859
860 StartedDrawing := true;
861
862 end;
863
864 // Now find out how wide the thing is
[418]865 if (( Element.ElementType = teLeadByte ) And ( EndP > P )) then // ALT
866 inc( X, FFontManager.CJKTextWidth( 2, P ))
867 else
868 inc( X, GetElementWidth( Element ) );
[15]869
870 if X div FontWidthPrecisionFactor
871 > XToFind then
872 begin
873 // found
[395]874 Offset := PCharPointerDiff( P, Line.Text );
[15]875 Link := CurrentLink;
876 exit;
877 end;
878
879 end;
880
881 teStyle:
882 case Element.Tag.TagType of
883 ttBeginLink:
884 CurrentLink := Element.Tag.Arguments;
885 ttEndLink:
886 CurrentLink := '';
887 else
888 begin
889 if ( Element.Tag.TagType = ttItalicOff )
890 and ( faItalic in Style.Font.Attributes )
891 and ( not FFontManager.IsFixed ) then
892 // end of italic; add a space
893 inc( X, FFontManager.CharWidth( ' ' ) );
894
895 PerformStyleTag( Element.Tag,
896 Style,
897 X );
898 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
899 if NewMarginX > X then
900 begin
901 //skip across...
902 X := NewMarginX;
903 end;
904 end;
905 end;
906 end;
907
908 P := NextP;
909 end;
910 Offset := Line.Length;
911end;
912
913Procedure TRichTextLayout.GetXFromOffset( const Offset: longint;
914 const LineIndex: longint;
915 Var X: longint );
916Var
917 P: PChar;
918 NextP: PChar;
919 EndP: PChar;
920 Element: TTextElement;
921 StartedDrawing: boolean;
922 Line: TLayoutLine;
923 Style: TTextDrawStyle;
924 NewMarginX: longint;
925begin
926 Line := FLines[ LineIndex ];
927 P := Line.Text;
928 EndP := Line.Text + Line.Length;
929
930 Style := Line.Style;
931 FFontManager.SetFont( Style.Font );
932
933 StartedDrawing := false;
934
935 while P < EndP do
936 begin
937 Element := ExtractNextTextElement( P, NextP );
938
939 case Element.ElementType of
940 teWordBreak,
941 teText,
942 teImage:
943 begin
944 if not StartedDrawing then
945 begin
946 // we haven't yet started drawing:
947 // so work out alignment
948 X := GetStartX( Style, Line );
949 StartedDrawing := true;
950 end;
951
952 if GetCharIndex( P ) - GetCharIndex( Line.Text ) >= Offset then
953 begin
954 X := X div FontWidthPrecisionFactor;
955 // found
956 exit;
957 end;
958
959 // Now find out how wide the thing is
960 inc( X, GetElementWidth( Element ) );
961
962 end;
963
964 teStyle:
965 begin
966 if ( Element.Tag.TagType = ttItalicOff )
967 and ( faItalic in Style.Font.Attributes )
968 and ( not FFontManager.IsFixed ) then
969 // end of italic; add a space
970 inc( X, FFontManager.CharWidth( ' ' ) );
971
972 PerformStyleTag( Element.Tag,
973 Style,
974 X );
975
976 NewMarginX := Style.LeftMargin * FontWidthPrecisionFactor;
977 if NewMarginX > X then
978 begin
979 //skip across...
980 X := NewMarginX;
981 end;
982 end;
983 end;
984
985 P := NextP;
986 end;
987 // went thru the whole line without finding the point,
988 if not StartedDrawing then
989 X := GetStartX( Style, Line );
990
991 X := X div FontWidthPrecisionFactor;
992end;
993
994function TRichTextLayout.GetLineFromPosition( YToFind: longint;
995 Var LineIndex: longint;
996 Var Remainder: longint ): TTextPosition;
997var
998 Y: longint;
999 LineHeight: longint;
1000begin
1001 LineIndex := 0;
1002 Remainder := 0;
1003
1004 Y := FRichTextSettings.Margins.Top;
1005
1006 if YToFind < Y then
1007 begin
1008 Result := tpAboveText;
1009 exit;
1010 end;
1011
1012 while LineIndex < FNumLines do
1013 begin
1014 LineHeight := FLines[ LineIndex ].Height;
1015 if ( YToFind >= Y )
1016 and ( YToFind < Y + LineHeight ) then
1017 begin
1018 // YToFind is within the line
1019 Result := tpWithinText;
1020 Remainder := YToFind - Y;
1021 exit;
1022 end;
1023
1024 inc( Y, FLines[ LineIndex ].Height );
1025 inc( LineIndex );
1026 end;
1027
1028 LineIndex := FNumLines - 1;
1029 Remainder := FLines[ LineIndex ].Height;
1030
1031 Result := tpBelowText;
1032end;
1033
1034function TRichTextLayout.FindPoint( XToFind, YToFind: longint;
1035 Var LineIndex: longint;
1036 Var Offset: longint;
1037 Var Link: string ): TTextPosition;
1038var
1039 Remainder: longint;
1040begin
1041 Link := '';
1042 Result := GetLineFromPosition( YToFind,
1043 LineIndex,
1044 Remainder );
1045 case Result of
1046 tpAboveText:
1047 begin
1048 Offset := 0;
1049 exit;
1050 end;
1051
1052 tpBelowText:
1053 begin
1054 Offset := FLines[ LineIndex ].Length;
1055 exit;
1056 end;
1057 end;
1058
1059 // found the line
1060 GetOffsetFromX( XToFind,
1061 LineIndex,
1062 Offset,
1063 Link );
1064end;
1065
1066function TRichTextLayout.GetLineFromCharIndex( Index: longint ): longint;
1067var
1068 LineCharIndex: longint;
1069 LineLength: longint;
1070begin
1071 Result := 0;
1072 if Index <= 0 then
1073 exit;
1074
1075 while Result < FNumLines do
1076 begin
1077 LineCharIndex := GetCharIndex( FLines[ Result ].Text );
1078 LineLength := FLines[ Result ].Length;
1079 if LineCharIndex + LineLength
1080 > Index then
1081 begin
1082 // found
1083 exit;
1084 end;
1085 inc( Result );
1086 end;
1087 Result := FNumLines - 1;
1088end;
1089
1090function TRichTextLayout.GetOffsetFromCharIndex( Index: longint;
1091 Line: longint ): longint;
1092begin
1093 Result := Index - GetCharIndex( TLayoutLine( FLines[ Line ] ).Text );
1094end;
1095
1096function TRichTextLayout.GetElementWidth( Element: TTextElement ): longint;
1097var
1098 Bitmap: TBItmap;
1099 BitmapIndex: longint;
1100begin
1101 // Now find out how wide the thing is
1102 case Element.ElementType of
1103 teImage:
1104 begin
1105 try
1106 BitmapIndex := StrToInt( Element.Tag.Arguments );
1107 except
1108 BitmapIndex := -1;
1109 end;
1110 if IsValidBitmapIndex( BitmapIndex ) then
1111 begin
1112 Bitmap := FImages.GetBitmapReference( BitmapIndex );
1113 Result := Bitmap.Width
1114 * FontWidthPrecisionFactor
1115 * FHorizontalImageScale;
1116 end;
1117 end;
1118
[418]1119 teText, teWordBreak, teWrapChar: // ALT
[15]1120 Result := FFontManager.CharWidth( Element.Character );
1121
[418]1122 teLeadByte: // ALT - should not be reached
1123 Result := FFontManager.CJKCharWidth;
1124
1125 teSecondByte: // ALT
1126 Result := 0;
1127
[15]1128 else
1129 Assert( False ); // should never be trying to find the width of a style, etc
1130
1131 end;
1132end;
1133
1134Function TRichTextLayout.GetCharIndex( P: PChar ): longint;
1135begin
[395]1136 Result := PCharPointerDiff( P, FText );
[15]1137end;
1138
1139function TRichTextLayout.GetLinePosition( Line: longint ): longint;
1140begin
1141 Result := FRichTextSettings.Margins.Top;
1142 dec( line );
1143 while line >= 0 do
1144 begin
1145 inc( Result,
1146 Flines[ Line ].Height );
1147 dec( line );
1148 end;
1149end;
1150
1151function TRichTextLayout.LinkFromIndex( const CharIndexToFind: longint): string;
1152Var
1153 P: PChar;
1154 NextP: PChar;
1155 EndP: PChar;
1156 Element: TTextElement;
1157 LineIndex: longint;
1158 Line: TLayoutLine;
1159begin
1160 if FNumLines = 0 then
1161 begin
1162 Result := '';
1163 exit;
1164 end;
1165
1166 LineIndex := GetLineFromCharIndex( CharIndexToFind );
1167
1168 Line := FLines[ LineIndex ];
1169 P := Line.Text;
1170 EndP := Line.Text + Line.Length;
1171
1172 if Line.LinkIndex <> -1 then
1173 Result := FLinks[ Line.LinkIndex ]
1174 else
1175 Result := '';
1176
1177 while P < EndP do
1178 begin
1179 if GetCharIndex( P ) >= CharIndexToFind then
1180 exit;
1181
1182 Element := ExtractNextTextElement( P, NextP );
1183
1184 case Element.ElementType of
1185 teStyle:
1186 case Element.Tag.TagType of
1187 ttBeginLink:
1188 Result := Element.Tag.Arguments;
1189 ttEndLink:
1190 Result := '';
1191 end;
1192 end;
1193
1194 P := NextP;
1195 end;
1196end;
1197
1198Initialization
1199End.
1200
Note: See TracBrowser for help on using the repository browser.