source: trunk/Components/RichTextView.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: 66.9 KB
RevLine 
[15]1Unit RichTextView;
2
3Interface
4
5Uses
6 Os2Def,
7 Classes, Forms, Messages, Graphics,
8 RichTextStyleUnit,
9 RichTextLayoutUnit,
10 RichTextDocumentUnit,
11 CanvasFontManager; // menus for SPCC 2.5+
12
13{
14Remaining keyboard support
15- cursor down to go to end of line (this is tricky)
16 I don't understand what I mean here!
17- If scrolllock is on, then scroll the screen, not move cursor.
18 Really? So few things obey it...
19}
20
21const
22 // for dragtext support, primarily.
23 RT_QUERYTEXT = WM_USER + 500;
24 // Param1: pointer to buffer (may be nil)
25 // Param2: buffer size (-1 to ignore)
26 // Returns: number of bytes copied
27
28 RT_QUERYSELTEXT = WM_USER + 501;
29 // Param1: pointer to buffer (may be nil)
30 // Param2: buffer size (-1 to ignore)
31 // Returns: number of bytes copied
32
33Type
34 TFindOrigin = ( foFromStart, foFromCurrent );
35
36 TScrollingDirection = ( sdUp, sdDown );
37
38Type
39
40 TRichTextView = class;
41
42 TLinkEvent = procedure( Sender: TRichTextView; Link: string ) of object;
43
44 TRichTextView = Class( TControl )
45 Protected
46 FFontManager: TCanvasFontManager;
47
48 FRichTextSettings: TRichTextSettings;
49
50 // Properties
51 FBorderStyle:TBorderStyle;
52 FScrollbarWidth: longint;
53 FSmoothScroll: boolean;
54 FUseDefaultMenu: boolean;
55 FDebug: boolean;
56
57 FOnOverLink: TLinkEvent;
58 FOnNotOverLink: TLinkEvent;
59 FOnClickLink: TLinkEvent;
60
61 FDefaultMenu: TPopupMenu;
62 FSelectAllMI: TMenuItem;
63 FCopyMI: TMenuItem;
64
65 FRefreshMI: TMenuItem;
66
67 FWordWrapMI: TMenuItem;
68 FSmoothScrollMI: TMenuItem;
69 FDebugMI: TMenuItem;
70
71 // Internal layout data
72 FNeedVScroll, FNeedHScroll: boolean;
73
74 FLayoutRequired: boolean;
75 FLayout: TRichTextLayout;
76
77 // Child controls
78 FHScrollbar: TScrollbar;
79 FVScrollbar: TScrollbar;
80
81 // Text
82 FText: PChar;
83
84 FTopCharIndex: longint; // only applies until following flag set.
85 FVerticalPositionInitialised: boolean;
86
87 FCursorRow: longint;
88 FCursorOffset: longint;
89
90 FSelectionStart: longint;
91 FSelectionEnd: longint;
92
93 // The text cursor
94 FCaret: TCaret;
95
96 FImages: TImageList;
97
98 // Selection scrolling
99 FScrollTimer: TTimer;
100 FOldMousePoint: TPoint;
101 FScrollingDirection: TScrollingDirection;
102
103 // Scroll information
104 // we use these rather than the scrollbar positions direct,
105 // since those are not updated during tracking
106 FXScroll: longint;
107 FYScroll: longint;
108
109 FLastXScroll: longint;
110 FLastYScroll: longint;
111
112 // Link
113 FLastLinkOver: string;
114 FClickedLink: string;
115
116 FLinkCursor: TCursor;
117
118 // PM Events
119 Procedure CreateWnd; override;
120 Procedure DisposeWnd; override;
121 Procedure Resize; override;
122 Procedure SetupComponent; Override;
123
124 Procedure Redraw( const rec: TRect ); Override;
125
126 procedure ScanEvent( Var KeyCode: TKeyCode;
127 RepeatCount: Byte ); override;
128
129 Procedure MouseDown( Button: TMouseButton;
130 ShiftState: TShiftState;
131 X, Y: Longint ); override;
132 Procedure MouseUp( Button: TMouseButton;
133 ShiftState: TShiftState;
134 X, Y: Longint ); override;
135
136 Procedure MouseDblClick( Button: TMouseButton;
137 ShiftState: TShiftState;
138 X, Y: Longint ); override;
139
140 Procedure MouseMove( ShiftState: TShiftState;
141 X, Y: Longint ); override;
142
143 Procedure Scroll( Sender: TScrollbar;
144 ScrollCode: TScrollCode;
145 Var ScrollPos: Longint ); override;
146
147 Procedure KillFocus; override;
148 Procedure SetFocus; override;
149
150 // Messages for DragText
151 Procedure RTQueryText( Var Msg: TMessage ); message RT_QUERYTEXT;
152 Procedure RTQuerySelText( Var Msg: TMessage ); message RT_QUERYSELTEXT;
153
154 procedure Layout;
155
156 function FindPoint( XToFind: longint;
157 YToFind: longint;
158 Var LineIndex: longint;
159 Var Offset: longint;
160 Var Link: string ): TTextPosition;
161
162 // Scroll functions
163
164 // Scroll display to given positions (does NOT
165 // update scrollbars as this may be called during
166 // scrolling)
167 Procedure DoVerticalScroll( NewY: longint );
168 Procedure DoHorizontalScroll( NewX: longint );
169
170 // Set scrollbar position, and update display
171 Procedure SetVerticalPosition( NewY: longint );
172 Procedure SetHorizontalPosition( NewX: longint );
173
174 procedure OnScrollTimer( Sender: TObject );
175
176 Function GetLineDownPosition: longint;
177 Function GetLineUpPosition: longint;
178
179 Function GetSmallDownScrollPosition: longint;
180 Function GetSmallUpScrollPosition: longint;
181
182 Function GetSmallRightScrollPosition: longint;
183 Function GetSmallLeftScrollPosition: longint;
184
185 // Calculates line down position given the last line and displayed pixels
186 Function GetLineDownPositionFrom( LastLine: longint;
187 PixelsDisplayed: longint ): longint;
188 Function GetLineUpPositionFrom( FirstVisibleLine: longint;
189 Offset: longint ): longint;
190
191 // Drawing functions
192
193 Procedure DrawBorder;
194 Procedure Draw( StartLine, EndLine: longint );
195
196 Function GetDrawRect: TRect;
197 Function GetTextAreaRect: TRect;
198 Function GetTextAreaHeight: longint;
199 Function GetTextAreaWidth: longint;
200
201 // Queries
202
203 procedure GetFirstVisibleLine( Var LineIndex: longint;
204 Var Offset: longint );
205 procedure GetBottomLine( Var LineIndex: longint;
206 Var PixelsDisplayed: longint );
207
208 // Layout functions
209
210 Procedure SetupScrollbars;
211
212 Procedure SetupCursor;
213 procedure RemoveCursor;
214
215 function GetTextEnd: longint;
216
217 // property handlers
218 procedure SetBorder( BorderStyle: TBorderStyle );
219 Procedure SetDebug( Debug: boolean );
220 Procedure SetScrollBarWidth( NewValue: longint );
221
222 Procedure OnRichTextSettingsChanged( Sender: TObject );
223
224 function GetCursorIndex: longint;
225
226 Function GetTopCharIndex: longint;
227 Procedure SetTopCharIndex( NewValue: longint );
228 Function GetTopCharIndexPosition( NewValue: longint ): longint;
229
230 // Update the cursor row/column for the selction start/end
231 procedure RefreshCursorPosition;
232
233 procedure SetCursorIndex( Index: longint;
234 PreserveSelection: boolean );
235 procedure SetCursorPosition( Offset: longint;
236 Row: longint;
237 PreserveSelection: boolean );
238
239 procedure MakeRowVisible( Row: longint );
240 procedure MakeRowAndColumnVisible( Row: longint;
241 Column: longint );
242
243 // These two methods set selection start and end,
244 // and redraw the screen, but do not set up cursor.
245 Procedure SetSelectionStartInternal( SelectionStart: longint );
246 Procedure SetSelectionEndInternal( SelectionEnd: longint );
247
248 // Property handlers. These are for programmatic access
249 // where a complete setup of selection is needed
250 Procedure SetSelectionStart( SelectionStart: longint );
251 Procedure SetSelectionEnd( SelectionEnd: longint );
252
253 Procedure SetImages( Images: TImageList );
254 Procedure Notification( AComponent: TComponent;
255 Operation: TOperation ); override;
256
257 // Default Menu
258 Procedure CreateDefaultMenu;
259 Procedure SelectAllMIClick( Sender: TObject );
260 Procedure CopyMIClick( Sender: TObject );
261 Procedure RefreshMIClick( Sender: TObject );
262 Procedure WordWrapMIClick( Sender: TObject );
263 Procedure SmoothScrollMIClick( Sender: TObject );
264 Procedure DebugMIClick( Sender: TObject );
265 Procedure DefaultMenuPopup( Sender: TObject );
266
267 Public
268 // Runtime methods
269 Procedure CreateWindow;
270
271 Procedure AddText( Text: PChar );
272 Procedure AddParagraph( Text: PChar );
273 Procedure AddSelectedParagraph( Text: PChar );
274 Procedure Clear;
275
276 // Insert at current point
277 Procedure InsertText( CharIndexToInsertAt: longword;
278 TextToInsert: PChar );
279
280 Destructor Destroy; Override;
281
282 property Text: PChar read FText;
283 property TextEnd: longint read GetTextEnd;
284
285 // Selection operations
286 property SelectionStart: longint read FSelectionStart write SetSelectionStart;
287 property SelectionEnd: longint read FSelectionEnd write SetSelectionEnd;
288
289 property CursorIndex: longint read GetCursorIndex;
290
291 // Copy all text to buffer
292 // Buffer can be nil to simply get size.
293 // If BufferLength is negative, it is ignored
294 Function CopyTextToBuffer( Buffer: PChar;
295 BufferLength: longint ): longint;
296
297 // Clipboard
298 Procedure CopySelectionToClipboard;
299
300 // returns number of chars (that would be) copied.
301 // Buffer can be nil to simply get size.
302 // If BufferLength is negative, it is ignored
303 Function CopySelectionToBuffer( Buffer: PChar;
304 BufferLength: longint ): longint;
305
306 Function GetSelectionAsString: string; // returns up to 255 chars obviously
307
308 // Selection queries
309 Function SelectionLength: longint; // Note: includes formatting
310 Function SelectionSet: boolean; // returns true if there is a selection
311
312 // Selection actions
313 Procedure ClearSelection;
314 Procedure SelectAll;
315
316 property CursorRow: longint read FCursorRow;
317
318 // Navigation
319 procedure GoToTop;
320 procedure GotoBottom;
321 Procedure UpLine;
322 Procedure DownLine;
323 Procedure UpPage;
324 Procedure DownPage;
325
326 Procedure SmallScrollUp;
327 Procedure SmallScrollDown;
328 Procedure SmallScrollLeft;
329 Procedure SmallScrollRight;
330
331 Procedure MakeCharVisible( CharIndex: longint );
332 Property TopCharIndex: longint read GetTopCharIndex write SetTopCharIndex;
333
334 Procedure CursorLeft( PreserveSelection: boolean );
335 Procedure CursorRight( PreserveSelection: boolean );
336 Procedure CursorDown( PreserveSelection: boolean );
337 Procedure CursorUp( PreserveSelection: boolean );
338 Procedure CursorPageDown( PreserveSelection: boolean );
339 Procedure CursorPageUp( PreserveSelection: boolean );
340
341 Procedure CursorToLineStart( PreserveSelection: boolean );
342 Procedure CursorToLineEnd( PreserveSelection: boolean );
343
344 Procedure CursorWordLeft( PreserveSelection: boolean );
345 Procedure CursorWordRight( PreserveSelection: boolean );
346
347 function HighlightNextLink: boolean;
348 function HighlightPreviousLink: boolean;
349
350 // Search for the given text
351 // if found, returns true, MatchIndex is set to the first match,
352 // and MatchLength returns the length of the match
353 // (which may be greater than the length of Text due to
354 // to skipping tags)
355 // if not found, returns false, pMatch is set to -1
356 function FindString( Origin: TFindOrigin;
357 const Text: string;
358 var MatchIndex: longint;
359 var MatchLength: longint ): boolean;
360
361 // Searches for text and selects it found
362 // returns true if found, false if not
363 function Find( Origin: TFindOrigin;
364 const Text: string ): boolean;
365
366 function LinkFromIndex( const CharIndexToFind: longint): string;
367
368 Published
369 property Align;
370 property Color;
371 property ParentColor;
372 property ParentFont;
373 property ParentPenColor;
374 property ParentShowHint;
375 property PenColor;
376 property PopupMenu;
377 property ShowHint;
378 Property TabOrder;
379 Property TabStop;
380 property Visible;
381 property ZOrder;
382
383 property RichTextSettings: TRichTextSettings read FRichTextSettings;
384
385 property ScrollBarWidth: longint read FScrollBarWidth write SetScrollBarWidth;
386
387 property BorderStyle: TBorderStyle read FBorderStyle write SetBorder;
388
389 property SmoothScroll: boolean read FSmoothScroll write FSmoothScroll;
390 property UseDefaultMenu: boolean read FUseDefaultMenu write FUseDefaultMenu;
391 property Debug: boolean read FDebug write SetDebug;
392
393 property Images: TImageList read FImages write SetImages;
394
395 // ------- EVENTS ----------
396
397 // Called with the name of the link when the mouse first moves over it
398 property OnOverLink: TLinkEvent read FOnOverLink write FOnOverLink;
399
400 // Called with the name of the link when the mouse leaves it
401 property OnNotOverLink: TLinkEvent read FOnNotOverLink write FOnNotOverLink;
402
403 // Called when the link is clicked.
404 property OnClickLink: TLinkEvent read FOnClickLink write FOnClickLink;
405
406 Property OnClick;
407 Property OnDblClick;
408 property OnDragOver;
409 property OnDragDrop;
410 property OnEndDrag;
411 Property OnEnter;
412 Property OnExit;
413 Property OnFontChange;
414 Property OnMouseClick;
415 Property OnMouseDblClick;
416 Property OnSetupShow;
417
418 Property OnScan;
419 Protected
420 Property Font;
421
422 End;
423
424Exports
425 TRichTextView,'User','RichTextView.bmp';
426
427Implementation
428
429Uses
[395]430 SysUtils,
431 PMWin,
432 BseDos,
433 Dos,
434 ClipBrd,
435 Printers,
436 ACLString,
437 ControlScrolling,
438 ControlsUtility,
439 RichTextDocumentUnit,
440 RichTextDisplayUnit,
[15]441
[395]442 CharUtilsUnit;
443
[15]444Procedure TRichTextView.SetSelectionStart( SelectionStart: longint );
445begin
446 RemoveCursor;
447 SetSelectionStartInternal( SelectionStart );
448 RefreshCursorPosition;
449 SetupCursor;
450end;
451
452Procedure TRichTextView.SetSelectionEnd( SelectionEnd: longint );
453begin
454 RemoveCursor;
455 SetSelectionEndInternal( SelectionEnd );
456 RefreshCursorPosition;
457 SetupCursor;
458end;
459
460Procedure TRichTextView.SetSelectionStartInternal( SelectionStart: longint );
[418]461var
462 Offset: longint; // ALT
[15]463begin
464 if SelectionStart = FSelectionStart then
465 exit;
466
467 if SelectionSet then
468 if SelectionStart = -1 then
469 // small side effect here - also sets selectionend to -1
470 ClearSelection;
471
[418]472 // ALT
473 Offset := FCursorOffset;
[420]474 MoveToCharacterBoundary( FText, SelectionStart, FCursorOffset, Offset, FLayout.Codepage, false );
[418]475
[15]476 FSelectionStart := SelectionStart;
477 if FSelectionEnd = -1 then
478 // still no selection
479 exit;
480 Refresh;
481end;
482
483Procedure TRichTextView.SetSelectionEndInternal( SelectionEnd: longint );
484var
485 StartRedrawLine: longint;
486 EndRedrawLine: longint;
[418]487 Offset: longint; // ALT
[15]488 OldClip: TRect;
489begin
490 if SelectionEnd = FSelectionEnd then
491 exit;
492
[418]493 // ALT
494 Offset := FCursorOffset;
[420]495 MoveToCharacterBoundary( FText, SelectionEnd, FCursorOffset, Offset, FLayout.Codepage, false );
[418]496
[15]497 if FSelectionStart = -1 then
498 begin
499 FSelectionEnd := SelectionEnd;
500 // still not a valid selection, no need to redraw
501 exit;
502 end;
503
504 if SelectionEnd = FSelectionStart then
505 SelectionEnd := -1;
506
507 if ( FSelectionEnd = -1 ) then
508 begin
509 // there is currently no selection,
510 // and we are setting one: need to draw it all
511 StartRedrawLine := FLayout.GetLineFromCharIndex( FSelectionStart );
512 EndRedrawLine := FLayout.GetLineFromCharIndex( SelectionEnd );
513 end
514 else
515 begin
516 // there is already a selection
517 if SelectionEnd = -1 then
518 begin
519 // and we're clearing it
520 StartRedrawLine := FLayout.GetLineFromCharIndex( FSelectionStart );
521 EndRedrawLine := FLayout.GetLineFromCharIndex( FSelectionEnd );
522 end
523 else
524 begin
525 // and we're setting a new one, so draw from the old end to the new
526 StartRedrawLine := FLayout.GetLineFromCharIndex( FSelectionEnd );
527 EndRedrawLine := FLayout.GetLineFromCharIndex( SelectionEnd );
528 end;
529 end;
530
531 FSelectionEnd := SelectionEnd;
532
533 OldClip := Canvas.ClipRect;
534 Canvas.ClipRect := GetTextAreaRect;
535
536 // (re)draw selection
537 Draw( StartRedrawLine, EndRedrawLine );
538 Canvas.ClipRect := OldClip;
539end;
540
541Procedure TRichTextView.ClearSelection;
542var
543 OldClip: TRect;
544 StartLine: longint;
545 EndLine: longint;
546begin
547
548 if SelectionSet then
549 begin
550 OldClip := Canvas.ClipRect;
551 Canvas.ClipRect := GetTextAreaRect;
552
553 StartLine := FLayout.GetLineFromCharIndex( FSelectionStart );
554 EndLine := FLayout.GetLineFromCharIndex( FSelectionEnd );
555
556 FSelectionEnd := -1;
557 FSelectionStart := -1;
558
559 // clear display of selection
560 Draw( StartLine,
561 EndLine );
562
563 Canvas.ClipRect := OldClip;
564 end;
565
566 FSelectionEnd := -1;
567 FSelectionStart := -1;
568end;
569
570Function TRichTextView.GetTextEnd: longint;
571begin
572 Result := StrLen( FText );
573end;
574
575Procedure TRichTextView.CreateDefaultMenu;
576var
577 SeparatorMI: TMenuItem;
578begin
579 FDefaultMenu := TPopupMenu.Create( self );
580 FDefaultMenu.OnPopup:= DefaultMenuPopup;
581
582 FSelectAllMI := TMenuItem.Create( self );
583 FSelectAllMI.Caption := 'Select &All';
584 FSelectAllMI.OnClick := SelectAllMIClick;
585 FDefaultMenu.Items.Add( FSelectAllMI );
586
587 FCopyMI := TMenuItem.Create( self );
588 FCopyMI.Caption := '&Copy';
589 FCopyMI.OnClick := CopyMIClick;
590 FDefaultMenu.Items.Add( FCopyMI );
591
592 SeparatorMI := TMenuItem.Create( self );
593 SeparatorMI.Caption := '-';
594 FDefaultMenu.Items.Add( SeparatorMI );
595
596 FRefreshMI := TMenuItem.Create( self );
597 FRefreshMI.Caption := '&Refresh';
598 FRefreshMI.OnClick := RefreshMIClick;
599 FDefaultMenu.Items.Add( FRefreshMI );
600
601 SeparatorMI := TMenuItem.Create( self );
602 SeparatorMI.Caption := '-';
603 FDefaultMenu.Items.Add( SeparatorMI );
604
605 FSmoothScrollMI := TMenuItem.Create( self );
606 FSmoothScrollMI.Caption := '&Smooth Scrolling';
607 FSmoothScrollMI.OnClick := SmoothScrollMIClick;
608 FDefaultMenu.Items.Add( FSmoothScrollMI );
609
610 FWordWrapMI := TMenuItem.Create( self );
611 FWordWrapMI.Caption := '&Word Wrap';
612 FWordWrapMI.OnClick := WordWrapMIClick;
613 FDefaultMenu.Items.Add( FWordWrapMI );
614
615 FDebugMI := TMenuItem.Create( self );
616 FDebugMI.Caption := '&Debug';
617 FDebugMI.OnClick := DebugMIClick;
618 FDefaultMenu.Items.Add( FDebugMI );
619end;
620
621Procedure TRichTextView.SelectAllMIClick( Sender: TObject );
622begin
623 SelectAll;
624end;
625
626Procedure TRichTextView.CopyMIClick( Sender: TObject );
627begin
628 CopySelectionToClipBoard;
629end;
630
631Procedure TRichTextView.RefreshMIClick( Sender: TObject );
632begin
633 Refresh;
634end;
635
636Procedure TRichTextView.WordWrapMIClick( Sender: TObject );
637begin
638 FRichTextSettings.DefaultWrap := not FRichTextSettings.DefaultWrap;
639end;
640
641Procedure TRichTextView.SmoothScrollMIClick( Sender: TObject );
642begin
643 SmoothScroll := not SmoothScroll;
644end;
645
646Procedure TRichTextView.DebugMIClick( Sender: TObject );
647begin
648 Debug := not Debug;
649end;
650
651Procedure TRichTextView.DefaultMenuPopup( Sender: TObject );
652begin
653 FWordWrapMI.Checked := FRichTextSettings.DefaultWrap;
654 FSmoothScrollMI.Checked := SmoothScroll;
655 FDebugMI.Checked := Debug;
656end;
657
658Procedure TRichTextView.SetupComponent;
659Begin
660 Inherited SetupComponent;
661
662 Name := 'RichTextView';
663
664 Width := 100;
665 Height := 100;
666
667 FSmoothScroll := true;
668 FBorderStyle := bsSingle;
669 FScrollbarWidth := 15;
670 FUseDefaultMenu := true;
671
672 Color := clEntryField;
673 ParentPenColor := true;
674
675 Cursor := crIBeam;
676
677 FRichTextSettings := TRichTextSettings.Create( self );
678
679 // make sibyl store the settings
680 Include( FRichTextSettings.DesignerState, dsStored );
681
682 FRichTextSettings.Margins := Rect( 5, 5, 5, 5 );
683 Include( FRichTextSettings.ComponentState, csDetail );
684
685 FRichTextSettings.OnChange := OnRichTextSettingsChanged;
686
687 Exclude( ComponentState, csAcceptsControls);
688
689 FImages := nil;
690
691 if not InDesigner then
692 begin
693 FFontManager := nil;
694
695 FCaret := TCaret.Create( self );
696
697 FText := StrAlloc( 100 );
698 FText[ 0 ] := #0;
699
700 FTopCharIndex := 0;
701 FVerticalPositionInitialised := false;
702 end;
703
704 // initial setup
705 OnRichTextSettingsChanged( self );
706End;
707
708Destructor TRichTextView.Destroy;
709Begin
710 if not InDesigner then
711 begin
712 RemoveCursor;
713 StrDispose( FText );
714 end;
715 Inherited Destroy;
716End;
717
718Procedure TRichTextView.KillFocus;
719begin
720 RemoveCursor;
721 inherited KillFocus;
722end;
723
724Procedure TRichTextView.SetFocus;
725begin
726 inherited SetFocus;
727 SetupCursor;
728end;
729
730// Custom window messages for DragText support
731Procedure TRichTextView.RTQueryText( Var Msg: TMessage );
732begin
733 Msg.Handled := true;
734 Msg.Result :=
735 CopyPlainTextToBuffer( FText,
736 FText + strlen( FText ),
737 PChar( Msg.Param1 ),
738 Msg.Param2 );
739end;
740
741Procedure TRichTextView.RTQuerySelText( Var Msg: TMessage );
742begin
743 Msg.Handled := true;
744 Msg.Result :=
745 CopySelectionToBuffer( PChar( Msg.Param1 ),
[39]746 Msg.Param2 );
[15]747end;
748
749Procedure TRichTextView.SetDebug( Debug: boolean );
750begin
751 if Debug = FDebug then
752 exit;
753 FDebug := Debug;
754 Refresh;
755end;
756
757Procedure TRichTextView.SetScrollBarWidth( NewValue: longint );
758begin
759 if ( NewValue < 0 )
760 or ( NewValue = FScrollBarWidth ) then
761 exit;
762 FScrollBarWidth := NewValue;
763 Layout;
764 Refresh;
765end;
766
767Procedure TRichTextView.CreateWnd;
768begin
769 Inherited CreateWnd;
770
771 if InDesigner then
772 exit;
773
774 FFontManager := TCanvasFontManager.Create( Canvas,
775 true // allow bitmap fonts
776 );
777
778 FLastLinkOver := '';
779 FSelectionStart := -1;
780 FSelectionEnd := -1;
781
782 if FUseDefaultMenu then
783 begin
784 CreateDefaultMenu;
785 PopupMenu := FDefaultMenu;
786 end;
787
788 FHScrollbar := TScrollBar.Create( self );
789 FHScrollbar.Hide;
790 InsertControl( FHScrollBar );
791 FHScrollbar.Kind := sbHorizontal;
792 Include( FHScrollBar.ComponentState, csDetail);
793
794 FVScrollbar := TScrollBar.Create( self );
795 FVScrollbar.Hide;
796 InsertControl( FVScrollBar );
797 FVScrollbar.Kind := sbVertical;
798 Include( FVScrollBar.ComponentState, csDetail);
799
800 FScrollTimer := TTimer.Create( self );
801 Include( FScrollTimer.ComponentState, csDetail );
802 FScrollTimer.Interval := 100;
803 FScrollTimer.OnTimer := OnScrollTimer;
804
805 FLinkCursor := GetLinkCursor;
806
807 if FLayoutRequired then
808 // we haven't yet done a layout
809 Layout;
810
[418]811
[15]812end;
813
814Procedure TRichTextView.DisposeWnd;
815begin
816 // destroy the font manager NOW
817 // while the canvas is still valid
818 // (it will be freed in TControl.DisposeWnd)
819 // in order to release logical fonts
820 if FFontManager <> nil then
821 FFontManager.Destroy;
822 if FLayout <> nil then
823 FLayout.Destroy;
824 inherited DisposeWnd;
825end;
826
827Procedure TRichTextView.Resize;
828begin
829 if InDesigner then
830 exit;
831
832 if Handle = 0 then
833 exit;
834
835 RemoveCursor;
836
837 if FVerticalPositionInitialised then
838 begin
839 // Preserve current position
840 if FLayout.FNumLines > 0 then
841 FTopCharIndex := GetTopCharIndex
842 else
843 FTopCharIndex := 0;
844 end;
845
846 Layout;
847
848 // This is the point at which vertical position
849 // is initialised during first window show
850 FVScrollBar.Position := GetTopCharIndexPosition( FTopCharIndex );
851
852 FYScroll := FVScrollBar.Position;
853 FLastYScroll := FYScroll;
854 FVerticalPositionInitialised := true;
855
856 SetupCursor;
857end;
858
859// Main procedure: reads through the whole text currently stored
860// and breaks up into lines - each represented as a TLayoutLine in
861// the array FLines[ 0.. FNumLines ]
862Procedure TRichTextView.Layout;
863Var
864 DrawWidth: longint;
865
866begin
867 FLayoutRequired := true;
868
869 if InDesigner then
870 exit;
871 if Handle = 0 then
872 exit;
873
874 FSelectionEnd := -1;
875 FSelectionStart := -1;
876 RemoveCursor;
877
878 DrawWidth := Width;
879 if FBorderStyle = bsSingle then
880 dec( DrawWidth, 4 ); // left+right border
881 dec( DrawWidth, FScrollBarWidth ); // vert scroll bar always present
882
883 if FLayout <> nil then
884 FLayout.Destroy;
885
886 FLayout := TRichTextLayout.Create( FText,
887 FImages,
888 FRichTextSettings,
889 FFontManager,
890 DrawWidth );
891
892 SetupScrollBars;
893 RefreshCursorPosition;
894
895 FLayoutRequired := false;
896End;
897
898procedure TRichTextView.GetFirstVisibleLine( Var LineIndex: longint;
899 Var Offset: longint );
900begin
901 FLayout.GetLineFromPosition( FYScroll,
902 LineIndex,
903 Offset );
904end;
905
906procedure TRichTextView.GetBottomLine( Var LineIndex: longint;
907 Var PixelsDisplayed: longint );
908begin
909 FLayout.GetLineFromPosition( FYScroll + GetTextAreaHeight,
910 LineIndex,
911 PixelsDisplayed );
912end;
913
914function TRichTextView.FindPoint( XToFind: longint;
915 YToFind: longint;
916 Var LineIndex: longint;
917 Var Offset: longint;
918 Var Link: string ): TTextPosition;
919var
920 TextHeight: longint;
921begin
922 LineIndex := 0;
923 Offset := 0;
924 Link := '';
925
926 TextHeight := GetTextAreaHeight;
927
928 YToFind := Height - YToFind;
929
930 if FBorderStyle = bsSingle then
931 begin
932 dec( YToFind, 2 );
933 dec( XToFind, 2 );
934 end;
935
936 if YToFind < 0 then
937 begin
938 // above the top
939 Result := tpAboveTextArea;
940 exit;
941 end;
942
943 if YToFind >= TextHeight then
944 begin
945 // below the bottom
946 Result := tpBelowTextArea;
947 LineIndex := FLayout.FNumLines;
948 Offset := FLayout.FLines[ FLayout.FNumLines - 1 ].Length - 1;
949 exit;
950 end;
951
952 Result := FLayout.FindPoint( XToFind + FXScroll,
953 YToFind + FYScroll,
954 LineIndex,
955 Offset,
956 Link );
957end;
958
959Procedure TRichTextView.DrawBorder;
960var
961 Rect: TRect;
962begin
963 Rect := GetDrawRect;
964 DrawSystemBorder( Self, Rect, FBorderStyle );
965end;
966
967Procedure TRichTextView.Draw( StartLine, EndLine: longint );
968Var
969 DrawRect: TRect;
970
971 X: longint;
972 Y: longint;
973
974 SelectionStartP: PChar;
975 SelectionEndP: PChar;
976
977 Temp: longint;
978begin
979 DrawRect := GetTextAreaRect;
980
981 if StartLine > EndLine then
982 begin
983 // swap
984 Temp := EndLine;
985 EndLine := StartLine;
986 StartLine := Temp;
987 end;
988
989 // calculate selection ptrs
990 if SelectionSet then
991 begin
992 SelectionStartP := FText + FSelectionStart;
993 SelectionEndP := FText + FSelectionEnd;
994 end
995 else
996 begin
997 SelectionStartP := nil;
998 SelectionEndP := nil;
999 end;
1000
1001 // calculate destination point
1002 Y := DrawRect.Top
1003 + FYScroll;
1004 X := DrawRect.Left
1005 - FXScroll;
1006
1007 DrawRichTextLayout( FFontManager,
1008 FLayout,
1009 SelectionStartP,
1010 SelectionEndP,
1011 StartLine,
1012 EndLine,
1013 Point( X,
1014 Y ) );
1015
1016 Canvas.Pen.Mode := pmCopy;
1017
1018End;
1019
1020// This gets the area of the control that we can draw on
1021// (not taken up by vertical scroll bar)
1022Function TRichTextView.GetDrawRect: TRect;
1023begin
1024 Result := ClientRect;
1025 if InDesigner then
1026 exit;
1027
1028 if FNeedHScroll then
1029 inc( Result.Bottom, FScrollbarWidth );
1030 // always have vscrollbar
1031 dec( Result.Right, FScrollbarWidth );
1032end;
1033
1034// Gets the area that we are drawing text on, which is the
1035// draw rect minus borders
1036Function TRichTextView.GetTextAreaRect: TRect;
1037begin
1038 Result := GetDrawRect;
1039 if FBorderStyle = bsSingle then
1040 begin
1041 // top and left borders
1042 inc( Result.Left, 2 );
1043 dec( Result.Top, 2 );
1044
1045 // bottom border
1046 inc( Result.Bottom, 2 );
1047
1048 // right border
1049 dec( Result.Right, 2 );
1050 end;
1051end;
1052
1053Function TRichTextView.GetTextAreaHeight: longint;
1054var
1055 TextArea: TRect;
1056begin
1057 TextArea := GetTextAreaRect;
1058 Result := TextArea.Top - TextArea.Bottom + 1;
1059end;
1060
1061Function TRichTextView.GetTextAreaWidth: longint;
1062begin
1063 Result := Width;
1064 if FBorderStyle <> bsNone then
1065 dec( Result, 4 );
1066 dec( Result, FScrollBarWidth ); // always allow space for vscrollbar
1067end;
1068
1069Procedure TRichTextView.Redraw( const rec: TRect );
1070Var
1071 CornerRect: TRect;
1072 OldClip: TRect;
1073 DrawRect: TRect;
1074 TextRect: TRect;
1075 ClipRect: TRect;
1076begin
1077 DrawRect := GetDrawRect;
1078// OldClip := Canvas.ClipRect;
1079 ClipRect := IntersectRect( rec, DrawRect );
1080 Canvas.ClipRect := ClipRect;
1081
1082 TextRect := GetTextAreaRect;
1083
1084 DrawBorder;
1085
1086 Canvas.FillRect( TextRect, Color );
1087
1088 if InDesigner then
1089 begin
1090 Canvas.TextOut( TextRect.Left,
1091 TextRect.Top - Canvas.TextHeight( 'H' ),
1092 'Rich text will appear here.' );
1093 Canvas.DeleteClipRegion;
1094 exit;
1095 end;
1096
1097 ClipRect := IntersectRect( rec, TextRect );
1098 Canvas.ClipRect := ClipRect;
1099
1100 Draw( 0, FLayout.FNumLines );
1101
1102 Canvas.DeleteClipRegion;
1103
1104 if FNeedHScroll then
1105 begin
1106 // blank out corner between scrollbars
1107 CornerRect.Left := Width - FScrollBarWidth;
1108 CornerRect.Bottom := 0;
1109 CornerRect.Right := Width;
1110 CornerRect.Top := FScrollBarWidth;
1111 Canvas.FillRect( CornerRect, clBtnFace );
1112 end;
1113
1114// Canvas.ClipRect := OldClip;
1115// not needed?
1116End;
1117
1118Procedure TRichTextView.SetupScrollbars;
1119var
1120 AvailableWidth: longint;
1121 MaxDisplayWidth: longint;
1122 AvailableHeight: longint;
1123Begin
1124
1125 // Calculate used and available width
1126 AvailableWidth := GetTextAreaWidth;
1127
1128 MaxDisplayWidth := FLayout.Width div FontWidthPrecisionFactor;
1129
1130 // Defaults
1131 FNeedVScroll := false;
1132 FNeedHScroll := false;
1133
1134 // Horizontal scroll setup
1135 if MaxDisplayWidth
1136 > AvailableWidth then
1137 FNeedHScroll := true;
1138
1139 FHScrollbar.SliderSize := AvailableWidth;
1140 FHScrollbar.Min := 0;
1141
1142 if FNeedHScroll then
1143 begin
1144 FHScrollbar.Max := MaxDisplayWidth;
1145 end
1146 else
1147 begin
1148 FHScrollBar.Position := 0;
1149 FHScrollbar.Max := 0;
1150 end;
1151
1152 // Calculate available height.
1153 // Note: this depends on whether a h scroll bar is needed.
1154
1155 AvailableHeight := Height;
1156 if FBorderStyle <> bsNone then
1157 dec( AvailableHeight, 4 );
1158 if FNeedHScroll then
1159 dec( AvailableHeight, FScrollBarWidth );
1160
1161 // Vertical scroll setup
1162
1163 if FLayout.Height > AvailableHeight then
1164 FNeedVScroll := true;
1165
1166 FVScrollBar.SliderSize := AvailableHeight;
1167 FVScrollBar.Min := 0;
1168
1169 if FNeedVScroll then
1170 begin
1171 FVScrollBar.Max := FLayout.Height - 1;
1172 end
1173 else
1174 begin
1175 FVScrollBar.Position := 0;
1176 FVScrollBar.Max := 0;
1177 end;
1178
1179 FHScrollBar.SmallChange := 15; // pixels
1180 FHScrollBar.LargeChange := AvailableWidth div 2;
1181 FVScrollBar.SmallChange := 1; // not used (line up/down calculated explicitly)
1182 FVScrollBar.LargeChange := GetTextAreaHeight div 2;
1183
1184 // Physical horizontal scroll setup
1185
1186 FHScrollbar.Visible := FNeedHScroll;
1187
1188 FHScrollbar.Left := 0;
1189 FHScrollbar.Bottom := 0;
1190 FHScrollbar.Height := FScrollbarWidth;
1191 FHScrollbar.Width := Width - FScrollBarWidth;
1192
1193 // Physical vertical scroll setup
1194
1195 FVScrollbar.Visible := true;
1196 FVScrollbar.Enabled := FNeedVScroll;
1197
1198 FVScrollbar.Left := Width - FScrollbarWidth;
1199 FVScrollbar.Width := FScrollbarWidth;
1200
1201 if FNeedHScroll then
1202 begin
1203 FVScrollbar.Bottom := FScrollbarWidth;
1204 FVScrollbar.Height := Height - FScrollbarWidth
1205 end
1206 else
1207 begin
1208 FVScrollbar.Bottom := 0;
1209 FVScrollbar.Height := Height;
1210 end;
1211
1212 // Initialise scroll
1213
1214 FYScroll := FVScrollBar.Position;
1215 FLastYScroll := FYScroll;
1216 FXScroll := FHScrollBar.Position;
1217 FLastXScroll := FXScroll;
1218End;
1219
1220Procedure TRichTextView.SetupCursor;
1221var
1222 Line: TLayoutLine;
1223 X, Y: longint;
1224 TextRect: TRect;
1225 DrawHeight: longint;
1226 DrawWidth: longint;
1227 CursorHeight: longint;
1228 TextHeight: longint;
1229 LineHeight: longint;
1230 Descender: longint;
1231 MaxDescender: longint;
[420]1232 Index: longint; // ALT
1233 RowStart: longint; // ALT
[15]1234begin
1235 RemoveCursor;
1236 if FSelectionStart = -1 then
1237 exit;
1238
1239 TextRect := GetTextAreaRect;
1240 DrawHeight := TextRect.Top - TextRect.Bottom;
1241 DrawWidth := TextRect.Right - TextRect.Left;
1242
1243 Line := FLayout.FLines[ CursorRow ];
1244 LineHeight := Line.Height;
1245
1246 Y := DrawHeight
1247 - ( FLayout.GetLinePosition( CursorRow )
1248 - FVScrollbar.Position );
1249 // Now Y is the top of the line
1250 if Y < 0 then
1251 // off bottom
1252 exit;
1253 if ( Y - LineHeight ) > DrawHeight then
1254 // off top
1255 exit;
1256
[420]1257 // ALT - move to nearest character boundary
1258 Index := FLayout.GetCharIndex( Line.Text ) + FCursorOffset;
1259 RowStart := FLayout.GetCharIndex( Line.Text );
1260 MoveToCharacterBoundary( FText, Index, FCursorOffset, RowStart, FLayout.Codepage, false );
1261
[15]1262 FLayout.GetXFromOffset( FCursorOffset, CursorRow, X );
1263
1264 X := X - FHScrollBar.Position;
1265
1266 if X < 0 then
1267 // offscreen to left
1268 exit;
1269
1270 if X > DrawWidth then
1271 // offscreen to right
1272 exit;
1273
1274 FCaret := TCaret.Create( self );
1275
1276 TextHeight := FFontManager.CharHeight;
1277 Descender := FFontManager.CharDescender;
1278 MaxDescender := FLayout.FLines[ CursorRow ].MaxDescender;
1279 CursorHeight := TextHeight;
1280
1281 dec( Y, LineHeight - 1 );
1282 // now Y is the BOTTOM of the line
1283
1284 // move Y up to the bottom of the cursor;
1285 // since the current text may be smaller than the highest in the line
1286 inc( Y, MaxDescender - Descender );
1287
1288 if Y < 0 then
1289 begin
1290 // bottom of line will be below bottom of display.
1291 dec( CursorHeight, 1 - Y );
1292 Y := 0;
1293 end;
1294
1295 if Y + CursorHeight - 1 > DrawHeight then
1296 begin
1297 // top of cursor will be above top of display
1298 CursorHeight := DrawHeight - Y + 1;
1299 end;
1300
1301 FCaret.SetSize( 0, CursorHeight );
1302 FCaret.SetPos( TextRect.Left + X,
1303 TextRect.Bottom + Y ) ;
1304 FCaret.Show;
1305end;
1306
1307procedure TRichTextView.RemoveCursor;
1308begin
1309 if FCaret <> nil then
1310 begin
1311 FCaret.Hide;
1312 FCaret.Destroy;
1313 FCaret := nil;
1314 end;
1315end;
1316
1317Function TRichTextView.GetLineDownPosition: longint;
1318var
1319 LastLine: longint;
1320 PixelsDisplayed: longint;
1321begin
1322 GetBottomLine( LastLine,
1323 PixelsDisplayed );
1324
1325 Result := GetLineDownPositionFrom( LastLine, PixelsDisplayed );
1326end;
1327
1328Function TRichTextView.GetLineDownPositionFrom( LastLine: longint;
1329 PixelsDisplayed: longint ): longint;
1330var
1331 LineHeight: longint;
1332begin
1333 if LastLine = -1 then
1334 exit;
1335
1336 LineHeight := FLayout.FLines[ LastLine ].Height;
1337
1338 if LastLine = FLayout.FNumLines - 1 then
1339 begin
1340 // last line
1341 if PixelsDisplayed >= LineHeight then
1342 begin
1343 // and it's fully displayed, so scroll to show margin
1344 Result := FLayout.Height
1345 - GetTextAreaHeight;
1346 exit;
1347 end;
1348 end;
1349
1350 // Scroll to make last line fully visible...
1351 Result := FVScrollBar.Position
1352 + LineHeight
1353 - PixelsDisplayed;
1354 if PixelsDisplayed > LineHeight div 2 then
1355 // more than half line already displayed so
1356 if LastLine < FLayout.FNumLines - 1 then
1357 // AND to make next line fully visible
1358 inc( Result, FLayout.FLines[ LastLine + 1 ].Height );
1359end;
1360
1361Function TRichTextView.GetSmallDownScrollPosition: longint;
1362var
1363 LastLine: longint;
1364 PixelsDisplayed: longint;
1365 LineTextHeight: longint;
1366 Diff: longint;
1367begin
1368 GetBottomLine( LastLine,
1369 PixelsDisplayed );
1370
1371 Result := GetLineDownPositionFrom( LastLine, PixelsDisplayed );
1372
1373 // Now limit the scrolling to max text height for the bottom line
1374 Diff := Result - FVScrollBar.Position;
1375
1376 LineTextHeight := FLayout.FLines[ LastLine ].MaxTextHeight;
1377 if Diff > LineTextHeight then
1378 Diff := LineTextHeight;
1379 Result := FVScrollBar.Position + Diff;
1380end;
1381
1382Function TRichTextView.GetSmallUpScrollPosition: longint;
1383var
1384 FirstVisibleLine: longint;
1385 Offset: longint;
1386 LineTextHeight: longint;
1387 Diff: longint;
1388begin
1389 GetFirstVisibleLine( FirstVisibleLine,
1390 Offset );
1391 Result := GetLineUpPositionFrom( FirstVisibleLine,
1392 Offset );
1393 // Now limit the scrolling to max text height for the bottom line
1394 Diff := FVScrollBar.Position - Result;
1395
1396 LineTextHeight := FLayout.FLines[ FirstVisibleLine ].MaxTextHeight;
1397 if Diff > LineTextHeight then
1398 Diff := LineTextHeight;
1399 Result := FVScrollBar.Position - Diff;
1400end;
1401
1402Function TRichTextView.GetSmallRightScrollPosition: longint;
1403begin
1404 Result := FHScrollBar.Position + FHScrollBar.SmallChange;
1405 if Result > FHScrollBar.Max then
1406 Result := FHScrollBar.Max;
1407end;
1408
1409Function TRichTextView.GetSmallLeftScrollPosition: longint;
1410begin
1411 Result := FHScrollBar.Position - FHScrollBar.SmallChange;
1412 if Result < 0 then
1413 Result := 0;
1414end;
1415
1416Function TRichTextView.GetLineUpPosition: longint;
1417var
1418 FirstVisibleLine: longint;
1419 Offset: longint;
1420begin
1421 GetFirstVisibleLine( FirstVisibleLine,
1422 Offset );
1423 Result := GetLineUpPositionFrom( FirstVisibleLine,
1424 Offset );
1425end;
1426
1427Function TRichTextView.GetLineUpPositionFrom( FirstVisibleLine: longint;
1428 Offset: longint ): longint;
1429begin
1430 // we should never have scrolled all lines off the top!!
1431 assert( FirstVisibleLine <> -1 );
1432
1433 if FirstVisibleLine = 0 then
1434 begin
1435 // first line
1436 if Offset = 0 then
1437 begin
1438 // and it's already fully visible, so scroll to show margin
1439 Result := 0;
1440 exit;
1441 end;
1442 end;
1443
1444 // scroll so that top line is fully visible...
1445 Result := FVScrollBar.Position
1446 - Offset;
1447
1448 if Offset < FLayout.FLines[ FirstVisibleLine ].Height div 2 then
1449 // more than half the line was already displayed so
1450 if FirstVisibleLine > 0 then
1451 // AND to make next line up visible
1452 dec( Result, FLayout.FLines[ FirstVisibleLine - 1 ].Height );
1453
1454end;
1455
1456Function Sign( arg: longint ): longint;
1457begin
1458 if arg>0 then
1459 Result := 1
1460 else if arg<0 then
1461 Result := -1
1462 else
1463 Result := 0;
1464end;
1465
1466Function FSign( arg: double ): double;
1467begin
1468 if arg>0 then
1469 Result := 1
1470 else if arg<0 then
1471 Result := -1
1472 else
1473 Result := 0;
1474end;
1475
1476Procedure ExactDelay( MS: longint );
1477var
1478 LastTime: ULONG;
1479begin
1480 LastTime := WinGetCurrentTime( AppHandle );
1481
1482 while WinGetCurrentTime( AppHandle ) - LastTime < MS do
1483 ;
1484end;
1485
1486Procedure TRichTextView.Scroll( Sender: TScrollbar;
1487 ScrollCode: TScrollCode;
1488 Var ScrollPos: Longint );
1489
1490begin
1491 case ScrollCode of
1492// scVertEndScroll,
1493// scVertPosition,
1494 scPageUp,
1495 scPageDown,
1496 scVertTrack:
1497 DoVerticalScroll( ScrollPos );
1498
1499 // Line up and down positions are calculated for each case
1500 scLineDown:
1501 begin
1502 ScrollPos := GetSmallDownScrollPosition;
1503 DoVerticalScroll( ScrollPos );
1504 end;
1505
1506 scLineUp:
1507 begin
1508 ScrollPos := GetSmallUpScrollPosition;
1509 DoVerticalScroll( ScrollPos );
1510 end;
1511
1512 scHorzPosition,
1513 scPageRight,
1514 scPageLeft,
1515 scHorzTrack,
1516 scColumnRight,
1517 scColumnLeft:
1518 begin
1519 DoHorizontalScroll( ScrollPos );
1520 end;
1521 end;
1522end;
1523
1524Procedure TRichTextView.DoVerticalScroll( NewY: longint );
1525
1526var
1527 ScrollDistance: longint;
1528begin
1529 FYScroll := NewY;
1530
1531 if not Visible then
1532 begin
1533 FLastYScroll := FYScroll;
1534 exit;
1535 end;
1536
1537 ScrollDistance := FYScroll - FLastYScroll;
1538
1539 ScrollControlRect( Self,
1540 GetTextAreaRect,
1541 0,
1542 ScrollDistance,
1543 Color,
1544 FSmoothScroll );
1545
1546 FLastYScroll := FYScroll;
1547 Update;
1548 SetupCursor;
1549end;
1550
1551Procedure TRichTextView.DoHorizontalScroll( NewX: longint );
1552var
1553 ScrollDistance: longint;
1554begin
1555 FXScroll := NewX;
1556
1557 if not Visible then
1558 begin
1559 FLastXScroll := FXScroll;
1560 exit;
1561 end;
1562
1563 ScrollDistance := FXScroll - FLastXScroll;
1564
1565 ScrollControlRect( Self,
1566 GetTextAreaRect,
1567 - ScrollDistance,
1568 0,
1569 Color,
1570 FSmoothScroll );
1571
1572 FLastXScroll := FXScroll;
1573 Update;
1574 SetupCursor;
1575end;
1576
1577Procedure TRichTextView.SetVerticalPosition( NewY: longint );
1578begin
1579 FVScrollbar.Position := NewY;
1580 DoVerticalScroll( FVScrollbar.Position );
1581end;
1582
1583Procedure TRichTextView.SetHorizontalPosition( NewX: longint );
1584begin
1585 FHScrollbar.Position := NewX;
1586 DoHorizontalScroll( FHScrollbar.Position );
1587end;
1588
1589Procedure TRichTextView.AddParagraph( Text: PChar );
1590begin
1591 if GetTextEnd > 0 then
1592 begin
1593 AddText( #13 );
1594 AddText( #10 );
1595 end;
1596 AddText( Text );
1597 Layout;
1598end;
1599
1600Procedure TRichTextView.AddSelectedParagraph( Text: PChar );
1601begin
1602 if GetTextEnd > 0 then
1603 begin
1604 AddText( #13 );
1605 AddText( #10 );
1606 end;
1607 SelectionStart := GetTextEnd;
1608 AddText( Text );
1609 Layout;
1610 Refresh;
1611 SelectionEnd := GetTextEnd;
1612 MakeCharVisible( SelectionStart );
1613end;
1614
1615Procedure TRichTextView.AddText( Text: PChar );
1616begin
1617 AddAndResize( FText, Text );
1618 Layout;
1619 Refresh;
1620end;
1621
1622// Insert at current point
1623Procedure TRichTextView.InsertText( CharIndexToInsertAt: longword;
1624 TextToInsert: PChar );
1625var
1626 NewText: PChar;
1627begin
1628 if CharIndexToInsertAt < 0 then
1629 exit;
1630
1631 NewText := StrAlloc( StrLen( FText ) + StrLen( TextToInsert ) + 1 );
1632 StrLCopy( NewText, FText, CharIndexToInsertAt );
1633 StrCat( NewText, TextToInsert );
1634 StrCat( NewText, FText + CharIndexToInsertAt );
1635
1636 Clear;
1637 AddText( NewText );
1638 StrDispose( NewText );
1639end;
1640
1641Procedure TRichTextView.Clear;
1642begin
1643 ClearSelection;
1644 FText[ 0 ] := #0;
1645 FTopCharIndex := 0;
1646 Layout;
1647 Refresh;
1648end;
1649
1650procedure TRichTextView.SetBorder( BorderStyle: TBorderStyle );
1651begin
1652 FBorderStyle := BorderStyle;
1653 Refresh;
1654end;
1655
1656Procedure TRichTextView.SetImages( Images: TImageList );
1657begin
1658 if Images = FImages then
1659 exit; // no change
1660
1661 if FImages <> nil then
1662 // Tell the old imagelist not to inform us any more
1663 FImages.Notification( Self, opRemove );
1664
1665 FImages := Images;
1666 if FImages <> nil then
1667 // request notification when other is freed
1668 FImages.FreeNotification( Self );
1669
1670 if GetTextEnd = 0 then
1671 // no text - can't be any image references - no need to layout
1672 exit;
1673
1674 Layout;
1675 Refresh;
1676end;
1677
1678Procedure TRichTextView.OnRichTextSettingsChanged( Sender: TObject );
1679begin
1680 if not InDesigner then
1681 begin
1682 Layout;
1683 Refresh;
1684 end;
1685end;
1686
1687Procedure TRichTextView.Notification( AComponent: TComponent;
1688 Operation: TOperation );
1689begin
1690 inherited Notification( AComponent, Operation );
1691 if AComponent = FImages then
1692 if Operation = opRemove then
1693 FImages := nil;
1694end;
1695
1696Procedure TRichTextView.MouseDown( Button: TMouseButton;
1697 ShiftState: TShiftState;
1698 X, Y: Longint );
1699var
1700 Line: longint;
1701 Offset: longint;
1702 Link: string;
1703 Position: TTextPosition;
1704 Shift: boolean;
1705begin
1706 Focus;
1707
1708 inherited MouseDown( Button, ShiftState, X, Y );
1709
1710 if Button <> mbLeft then
1711 begin
1712 if Button = mbRight then
1713 begin
1714 if MouseCapture then
1715 begin
1716 // this is a shortcut - left mouse drag to select, right mouse to copy
1717 CopySelectionToClipboard;
1718 end;
1719 end;
1720 exit;
1721 end;
1722
1723// if FText[ 0 ] = #0 then
1724// exit;
1725
1726 Position := FindPoint( X, Y, Line, Offset, Link );
1727 FClickedLink := Link;
1728
1729 if Position in [ tpAboveTextArea,
1730 tpBelowTextArea ] then
1731 // not on the control (this probably won't happen)
1732 exit;
1733
1734 // if shift is pressed then keep the same selection start.
1735
1736 Shift := ssShift in ShiftState;
1737 RemoveCursor;
1738
1739 if not Shift then
1740 ClearSelection;
1741
1742 SetCursorPosition( Offset, Line, Shift );
1743 MouseCapture := true;
1744
1745end;
1746
1747Procedure TRichTextView.MouseUp( Button: TMouseButton;
1748 ShiftState: TShiftState;
1749 X, Y: Longint );
1750begin
1751 if Button = mbRight then
1752 if MouseCapture then
1753 // don't popup menu for shortcut - left mouse drag to select, right mouse to copy
1754 exit;
1755
1756 inherited MouseUp( Button, ShiftState, X, Y );
1757
1758 if Button <> mbLeft then
1759 exit;
1760
1761 if not MouseCapture then
1762 // not a mouse up from a link click
1763 exit;
1764
1765 if FScrollTimer.Running then
1766 FScrollTimer.Stop;
1767
1768 MouseCapture := false;
1769
1770 SetupCursor;
1771
1772 if FClickedLink <> '' then
1773 if Assigned( FOnClickLink ) then
1774 FOnClickLink( Self, FClickedLink );
1775
1776end;
1777
1778Procedure TRichTextView.MouseDblClick( Button: TMouseButton;
1779 ShiftState: TShiftState;
1780 X, Y: Longint );
1781var
1782 Row: longint;
1783 Offset: longint;
1784 Link: string;
1785 Position: TTextPosition;
1786 P: PChar;
1787 pWordStart: PChar;
1788 WordLength: longint;
1789begin
1790 inherited MouseDblClick( Button, ShiftState, X, Y );
1791
1792 if Button <> mbLeft then
1793 exit;
1794
1795// if FText[ 0 ] = #0 then
1796// exit;
1797
1798 Position := FindPoint( X, Y, Row, Offset, Link );
1799
1800 if Position in [ tpAboveTextArea,
1801 tpBelowTextArea ] then
1802 // not on the control (this probably won't happen)
1803 exit;
1804
1805 Assert( Row >= 0 );
1806 Assert( Row < FLayout.FNumLines );
1807
1808 P := FLayout.FLines[ Row ].Text + Offset;
1809
1810 RemoveCursor;
1811
1812 if not RichTextWordAt( FText,
1813 P,
1814 pWordStart,
1815 WordLength ) then
1816 begin
1817 // not in a word
1818 SetCursorPosition( Offset, Row, false );
1819 SetupCursor;
1820 exit;
1821 end;
1822
1823 SetSelectionStartInternal( FLayout.GetCharIndex( pWordStart ) );
1824 SetSelectionEndInternal( FLayout.GetCharIndex( pWordStart )
1825 + WordLength );
1826 RefreshCursorPosition;
1827 SetupCursor;
1828end;
1829
1830Procedure TRichTextView.MouseMove( ShiftState: TShiftState;
1831 X, Y: Longint );
1832var
1833 Line: longint;
1834 Offset: longint;
1835 Link: string;
1836 Position: TTextPosition;
1837begin
1838 inherited MouseMove( ShiftState, X, Y );
1839
1840 Position := FindPoint( X, Y, Line, Offset, Link );
1841
1842 if not MouseCapture then
1843 begin
1844 if Link <> FLastLinkOver then
1845 begin
1846 if Link <> '' then
1847 begin
1848 if Assigned( FOnOverLink ) then
1849 FOnOverLink( Self, Link )
1850 end
1851 else
1852 begin
1853 if Assigned( FOnNotOverLink ) then
1854 FOnNotOverLink( Self, FLastLinkOver );
1855 end;
1856
1857 FLastLinkOver := Link;
1858 end;
1859
1860 if Link <> '' then
1861 Cursor := FLinkCursor
1862 else
1863 Cursor := crIBeam;
1864 exit;
1865 end;
1866
1867 // We are holding mouse down and dragging to set a selection:
1868
1869 if Position in [ tpAboveTextArea,
1870 tpBelowTextArea ] then
1871 begin
1872 // above top or below bottom of control
1873 FOldMousePoint := Point( X, Y );
1874
1875 if Position = tpAboveTextArea then
1876 FScrollingDirection := sdUp
1877 else
1878 FScrollingDirection := sdDown;
1879
1880 if not FScrollTimer.Running then
1881 begin
1882 FScrollTimer.Start;
1883 OnScrollTimer( self );
1884 end;
1885 exit;
1886 end;
1887
1888 // Normal selection, cursor within text rect
1889 if FScrollTimer.Running then
1890 FScrollTimer.Stop;
1891
1892 SetCursorPosition( Offset,
1893 Line,
1894 true );
1895
1896 if SelectionSet then
1897 begin
1898 FClickedLink := ''; // if they move while on a link we don't want to follow it.
1899 Cursor := crIBeam;
1900 end;
1901
1902end;
1903
1904procedure TRichTextView.OnScrollTimer( Sender: TObject );
1905var
1906 Line, Offset: longint;
1907 MousePoint: TPoint;
1908 TextRect: TRect;
1909begin
1910 MousePoint := Screen.MousePos;
1911 MousePoint := ScreenToClient( MousePoint );
1912 TextRect := GetTextAreaRect;
1913
1914 if FScrollingDirection = sdDown then
1915 // scrolling down
1916 if FVScrollbar.Position = FVScrollbar.Max then
1917 exit
1918 else
1919 begin
1920 if ( TextRect.Bottom - MousePoint.Y ) < 20 then
1921 DownLine
1922 else
1923 DownPage;
1924
1925 GetBottomLine( Line, Offset );
1926 SetSelectionEndInternal( FLayout.GetCharIndex( FLayout.Flines[ Line ].Text )
1927 + FLayout.FLines[ Line ].Length );
1928 end
1929 else
1930 // scrolling up
1931 if FVScrollbar.Position = FVScrollbar.Min then
1932 exit
1933 else
1934 begin
1935 if ( MousePoint.Y - TextRect.Top ) < 20 then
1936 UpLine
1937 else
1938 UpPage;
1939 GetFirstVisibleLine( Line, Offset );
1940 SetSelectionEndInternal( FLayout.GetCharIndex( FLayout.FLines[ Line ].Text ) );
1941 end;
1942
1943end;
1944
1945Procedure TRichTextView.UpLine;
1946begin
1947 SetVerticalPosition( GetLineUpPosition );
1948end;
1949
1950Procedure TRichTextView.DownLine;
1951begin
1952 SetVerticalPosition( GetLineDownPosition );
1953end;
1954
1955Procedure TRichTextView.UpPage;
1956begin
1957 SetVerticalPosition( FVScrollbar.Position - FVScrollbar.LargeChange );
1958end;
1959
1960Procedure TRichTextView.DownPage;
1961begin
1962 SetVerticalPosition( FVScrollbar.Position + FVScrollbar.LargeChange );
1963end;
1964
1965Procedure TRichTextView.SmallScrollUp;
1966begin
1967 SetVerticalPosition( GetSmallUpScrollPosition );
1968end;
1969
1970Procedure TRichTextView.SmallScrollDown;
1971begin
1972 SetVerticalPosition( GetSmallDownScrollPosition );
1973end;
1974
1975Procedure TRichTextView.SmallScrollRight;
1976begin
1977 SetHorizontalPosition( GetSmallRightScrollPosition );
1978end;
1979
1980Procedure TRichTextView.SmallScrollLeft;
1981begin
1982 SetHorizontalPosition( GetSmallLeftScrollPosition );
1983end;
1984
1985function TRichTextView.GetCursorIndex: longint;
1986begin
1987 if FCursorRow = -1 then
1988 begin
1989 Result := -1;
1990 exit;
1991 end;
1992 Result := FLayout.GetCharIndex( FLayout.FLines[ FCursorRow ].Text ) + FCursorOffset;
1993end;
1994
1995procedure TRichTextView.RefreshCursorPosition;
1996var
1997 Index: longint;
1998 Row: longint;
1999begin
2000 if SelectionSet then
2001 begin
2002 Index := FSelectionEnd
2003 end
2004 else
2005 begin
2006 Index := FSelectionStart;
2007 end;
2008
2009 if Index = -1 then
2010 begin
2011 FCursorRow := -1;
2012 FCursorOffset := 0;
2013 RemoveCursor;
2014 exit;
2015 end;
2016
2017 Row := FLayout.GetLineFromCharIndex( Index );
2018 SetCursorPosition( Index - FLayout.GetCharIndex( FLayout.FLines[ Row ].Text ),
2019 Row,
2020 true );
2021end;
2022
2023procedure TRichTextView.SetCursorIndex( Index: longint;
2024 PreserveSelection: boolean );
2025var
2026 Row: longint;
2027begin
2028 Row := FLayout.GetLineFromCharIndex( Index );
2029 SetCursorPosition( Index - FLayout.GetCharIndex( FLayout.FLines[ Row ].Text ),
2030 Row,
2031 PreserveSelection );
2032 SetupCursor;
2033end;
2034
2035procedure TRichTextView.SetCursorPosition( Offset: longint;
2036 Row: longint;
2037 PreserveSelection: boolean );
2038var
[418]2039// P: PChar; // ALT
2040// NextP: PChar; // ALT
2041// Element: TTextElement; // ALT
2042// InsideDBC: boolean; // ALT
2043 RowStart: longint; // ALT
[420]2044 MoveRight: boolean; // ALT
[15]2045 Index: longint;
2046begin
2047 RemoveCursor;
[418]2048
2049 Index := FLayout.GetCharIndex( FLayout.FLines[ Row ].Text ) + Offset;
2050
2051// ALT
2052{
2053 if ( Offset > 0 ) and
2054 ( FLayout.Codepage in [ 932, 936, 942, 943, 949, 950, 1381, 1386 ]) then
2055 begin
2056 RowStart := FLayout.GetCharIndex( FLayout.FLines[ Row ].Text );
2057 P := FText + RowStart;
2058 InsideDBC := false;
2059 while RowStart < Index do
2060 begin
2061 Element := ExtractNextTextElement( P, NextP );
2062 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, FLayout.Codepage );
2063 P := NextP;
2064 inc( RowStart );
2065 end;
2066 Element := ExtractNextTextElement( P, NextP );
2067 CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, FLayout.Codepage );
2068 if InsideDBC then
2069 begin
2070 dec( Index );
2071 dec( Offset );
2072 end;
2073 end;
2074}
2075
2076 RowStart := FLayout.GetCharIndex( FLayout.FLines[ Row ].Text );
2077
[420]2078 // ALT
2079 if Offset = ( FCursorOffset + 1 ) then
2080 MoveRight := true
2081 else
2082 MoveRight := false;
2083 MoveToCharacterBoundary( FText, Index, Offset, RowStart, FLayout.Codepage, MoveRight );
2084
[15]2085 FCursorOffset := Offset;
2086 FCursorRow := Row;
[418]2087
[15]2088 if PreserveSelection then
2089 begin
2090 SetSelectionEndInternal( Index )
2091 end
2092 else
2093 begin
2094 SetSelectionEndInternal( -1 );
2095 SetSelectionStartInternal( Index );
2096 end;
2097 MakeRowAndColumnVisible( FCursorRow, Offset );
2098end;
2099
2100Procedure TRichTextView.CursorRight( PreserveSelection: boolean );
2101Var
2102 P: PChar;
2103 NextP: PChar;
2104 Element: TTextElement;
2105 NewOffset: longint;
2106 Line: TLayoutLine;
2107begin
2108 P := FText + CursorIndex;
2109
2110 Element := ExtractNextTextElement( P, NextP );
[418]2111
[15]2112 P := NextP;
2113 while Element.ElementType = teStyle do
2114 begin
2115 Element := ExtractNextTextElement( P, NextP );
2116 P := NextP;
2117 end;
2118
2119// if Element.ElementType = teTextEnd then
2120// exit;
2121
2122// SetCursorIndex( GetCharIndex( P ), PreserveSelection );
2123 Line := FLayout.FLines[ CursorRow ];
[395]2124 NewOffset := PCharPointerDiff( P, Line.Text );
[15]2125 if NewOffset < Line.Length then
2126 begin
2127 SetCursorPosition( NewOffset, FCursorRow, PreserveSelection )
2128 end
2129 else if ( NewOffset = Line.Length )
2130 and not Line.Wrapped then
2131 begin
2132 SetCursorPosition( NewOffset, FCursorRow, PreserveSelection )
2133 end
2134 else
2135 begin
2136 if FCursorRow >= FLayout.FNumLines - 1 then
2137 exit;
2138 SetCursorPosition( 0, FCursorRow + 1, PreserveSelection );
2139 end;
2140 SetupCursor;
2141end;
2142
2143Procedure TRichTextView.CursorLeft( PreserveSelection: boolean );
2144Var
2145 P: PChar;
2146 NextP: PChar;
2147 Element: TTextElement;
2148 Line: TLayoutLine;
2149 NewOffset: longint;
2150begin
2151 P := FText + CursorIndex;
2152
2153 Element := ExtractPreviousTextElement( FText, P, NextP );
2154 P := NextP;
2155 while Element.ElementType = teStyle do
2156 begin
2157 Element := ExtractPreviousTextElement( FText, P, NextP );
2158 P := NextP;
2159 end;
2160
2161// if Element.ElementType = teTextEnd then
2162// exit;
2163 Line := FLayout.FLines[ CursorRow ];
[395]2164 NewOffset := PCharPointerDiff( P, Line.Text );
[15]2165 if NewOffset >= 0 then
2166 begin
2167 SetCursorPosition( NewOffset, FCursorRow, PreserveSelection )
2168 end
2169 else
2170 begin
2171 if FCursorRow <= 0 then
2172 exit;
2173 Line := FLayout.FLines[ CursorRow - 1 ];
2174 if Line.Wrapped then
2175 SetCursorPosition( Line.Length - 1, FCursorRow - 1, PreserveSelection )
2176 else
2177 SetCursorPosition( Line.Length, FCursorRow - 1, PreserveSelection )
2178 end;
2179 SetupCursor;
2180
2181end;
2182
2183Procedure TRichTextView.CursorWordLeft( PreserveSelection: boolean );
2184Var
2185 P: PChar;
2186begin
2187 P := FText + CursorIndex;
2188
2189 P := RichTextWordLeft( FText, P );
2190
2191 SetCursorIndex( FLayout.GetCharIndex( P ),
2192 PreserveSelection );
2193end;
2194
2195Procedure TRichTextView.CursorWordRight( PreserveSelection: boolean );
2196Var
2197 P: PChar;
2198begin
2199 P := FText + CursorIndex;
2200
2201 P := RichTextWordRight( P );
2202
2203 SetCursorIndex( FLayout.GetCharIndex( P ),
2204 PreserveSelection );
2205end;
2206
2207Procedure TRichTextView.CursorToLineStart( PreserveSelection: boolean );
2208Var
2209 Line: TLayoutLine;
2210begin
2211 Line := FLayout.FLines[ FCursorRow ];
2212 SetCursorPosition( 0, FCursorRow, PreserveSelection );
2213 SetupCursor;
2214end;
2215
2216Procedure TRichTextView.CursorToLineEnd( PreserveSelection: boolean );
2217Var
2218 Line: TLayoutLine;
2219begin
2220 Line := FLayout.FLines[ FCursorRow ];
2221 SetCursorPosition( Line.Length, FCursorRow, PreserveSelection );
2222 SetupCursor;
2223end;
2224
2225Procedure TRichTextView.CursorDown( PreserveSelection: boolean );
2226var
2227 X: longint;
2228 Link: string;
2229 Offset: longint;
2230begin
2231 if CursorRow >= FLayout.FNumLines - 1 then
2232 exit;
2233
2234 FLayout.GetXFromOffset( FCursorOffset, FCursorRow, X );
2235 FLayout.GetOffsetFromX( X,
2236 FCursorRow + 1,
2237 Offset,
2238 Link );
2239
2240 SetCursorPosition( Offset, FCursorRow + 1, PreserveSelection );
2241 SetupCursor;
2242end;
2243
2244Procedure TRichTextView.CursorUp( PreserveSelection: boolean );
2245var
2246 X: longint;
2247 Link: string;
2248 Offset: longint;
2249begin
2250 if CursorRow <= 0 then
2251 exit;
2252
2253 FLayout.GetXFromOffset( FCursorOffset,
2254 FCursorRow,
2255 X );
2256 FLayout.GetOffsetFromX( X,
2257 FCursorRow - 1,
2258 Offset,
2259 Link );
2260
2261 SetCursorPosition( Offset, FCursorRow - 1, PreserveSelection );
2262 SetupCursor;
2263
2264end;
2265
2266Procedure TRichTextView.CursorPageDown( PreserveSelection: boolean );
2267var
2268 X: longint;
2269 Link: string;
2270 Offset: longint;
2271 Distance: longint;
2272 NewRow: longint;
2273begin
2274 NewRow := CursorRow;
2275 Distance := 0;
2276 while ( Distance < GetTextAreaHeight ) do
2277 begin
2278 if NewRow >= FLayout.FNumLines - 1 then
2279 break;
2280
2281 Distance := Distance + FLayout.FLines[ NewRow ].Height;
2282 inc( NewRow );
2283 end;
2284
2285 FLayout.GetXFromOffset( FCursorOffset, FCursorRow, X );
2286 FLayout.GetOffsetFromX( X,
2287 NewRow,
2288 Offset,
2289 Link );
2290 SetCursorPosition( Offset, NewRow, PreserveSelection );
2291 SetupCursor;
2292end;
2293
2294Procedure TRichTextView.CursorPageUp( PreserveSelection: boolean );
2295var
2296 X: longint;
2297 Link: string;
2298 Offset: longint;
2299 Distance: longint;
2300 NewRow: longint;
2301begin
2302 NewRow := CursorRow;
2303 Distance := 0;
2304 while ( Distance < GetTextAreaHeight ) do
2305 begin
2306 if NewRow <= 0 then
2307 break;
2308 dec( NewRow );
2309 Distance := Distance + FLayout.FLines[ NewRow ].Height;
2310 end;
2311
2312 FLayout.GetXFromOffset( FCursorOffset, FCursorRow, X );
2313 FLayout.GetOffsetFromX( X,
2314 NewRow,
2315 Offset,
2316 Link );
2317 SetCursorPosition( Offset, NewRow, PreserveSelection );
2318 SetupCursor;
2319end;
2320
2321Function TRichTextView.GetSelectionAsString: string; // returns up to 255 chars obviously
2322var
2323 Buffer: array[ 0..255 ] of char;
2324 Length: longint;
2325begin
2326 Length := CopySelectionToBuffer( Addr( Buffer ),
2327 255 );
2328
[395]2329 Result := StrPasWithLength( Buffer, Length );
[15]2330end;
2331
2332Procedure TRichTextView.CopySelectionToClipboard;
2333var
2334 SelLength: Longint;
2335 Buffer: PChar;
2336begin
2337 SelLength := SelectionLength;
2338 if SelectionLength = 0 then
2339 exit;
2340
2341 Buffer := StrAlloc( SelLength + 1 );
2342
2343 CopySelectionToBuffer( Buffer, SelLength + 1 );
2344
2345 if Clipboard.Open( Self.Handle ) then
2346 begin
2347 Clipboard.Empty;
2348 Clipboard.SetTextBuf( Buffer );
2349 Clipboard.Close;
2350 end;
2351
2352 StrDispose( Buffer );
2353end;
2354
2355function TRichTextView.CopySelectionToBuffer( Buffer: PChar;
2356 BufferLength: longint ): longint;
2357var
2358 P, EndP: PChar;
2359begin
2360 Result := 0;
2361 if ( FSelectionStart = -1 )
2362 or ( FSelectionEnd = -1 ) then
2363 exit;
2364
2365 if FSelectionStart < FSelectionEnd then
2366 begin
2367 P := FText + FSelectionStart;
2368 EndP := FText + FSelectionEnd;
2369 end
2370 else
2371 begin
2372 P := FText + FSelectionEnd;
2373 EndP := FText + FSelectionStart;
2374 end;
2375
2376 Result := CopyPlainTextToBuffer( P,
2377 EndP,
2378 Buffer,
2379 BufferLength );
2380end;
2381
2382function TRichTextView.CopyTextToBuffer( Buffer: PChar;
2383 BufferLength: longint ): longint;
2384begin
2385 Result := CopyPlainTextToBuffer( FText,
2386 FText + strlen( FText ),
2387 Buffer,
2388 BufferLength );
2389end;
2390
2391Function TRichTextView.SelectionLength: longint;
2392begin
2393 Result := 0;
2394 if ( FSelectionStart = -1 )
2395 or ( FSelectionEnd = -1 ) then
2396 exit;
2397
2398 Result := FSelectionEnd - FSelectionStart;
2399 if Result < 0 then
2400 Result := FSelectionStart - FSelectionEnd;
2401end;
2402
2403Function TRichTextView.SelectionSet: boolean;
2404begin
2405 Result := ( FSelectionStart <> -1 )
2406 and ( FSelectionEnd <> - 1 )
2407 and ( FSelectionStart <> FSelectionEnd );
2408end;
2409
2410Procedure TRichTextView.SelectAll;
2411begin
2412 ClearSelection;
2413 SelectionStart := FLayout.GetCharIndex( FText );
2414 SelectionEnd := FLayout.GetTextEnd;
2415end;
2416
2417procedure TRichTextView.ScanEvent( Var KeyCode: TKeyCode;
2418 RepeatCount: Byte );
2419var
2420 CursorVisible: boolean;
2421 Shift: boolean;
2422 Key: TKeyCode;
2423begin
2424 CursorVisible := FSelectionStart <> -1;
2425
2426 Case KeyCode of
2427 kbTab:
2428 begin
2429 if HighlightNextLink then
2430 begin
2431 KeyCode := kbNull;
2432 exit;
2433 end;
2434 end;
2435
2436 kbShiftTab:
2437 begin
2438 if HighlightPreviousLink then
2439 begin
2440 KeyCode := kbNull;
2441 exit;
2442 end;
2443 end;
2444
2445 kbEnter:
2446 begin
2447
2448 end;
2449 end;
2450
2451 Shift := KeyCode and kb_Shift > 0 ;
2452 Key := KeyCode and ( not kb_Shift );
2453
2454 // Keys which work the same regardless of whether
2455 // cursor is present or not
2456 case Key of
2457 kbCtrlC, kbCtrlIns:
2458 CopySelectionToClipboard;
2459 kbCtrlA:
2460 SelectAll;
2461
2462 kbAltCUp:
2463 SmallScrollUp;
2464 kbAltCDown:
2465 SmallScrollDown;
2466 kbAltCLeft:
2467 SmallScrollLeft;
2468 kbAltCRight:
2469 SmallScrollRight;
2470 end;
2471
2472 // Keys which change behaviour if cursor is present
2473 if CursorVisible then
2474 begin
2475 case Key of
2476 kbCUp:
2477 CursorUp( Shift );
2478 kbCDown:
2479 CursorDown( Shift );
2480
2481 // these next two are not exactly orthogonal or required,
2482 // but better match other text editors.
2483 kbCtrlCUp:
2484 if Shift then
2485 CursorUp( Shift )
2486 else
2487 SmallScrollUp;
2488 kbCtrlCDown:
2489 if Shift then
2490 CursorDown( Shift )
2491 else
2492 SmallScrollDown;
2493
2494 kbCRight:
2495 CursorRight( Shift );
2496 kbCLeft:
2497 CursorLeft( Shift );
2498
2499 kbCtrlCLeft:
2500 CursorWordLeft( Shift );
2501 kbCtrlCRight:
2502 CursorWordRight( Shift );
2503
2504 kbCtrlHome, kbCtrlPageUp:
2505 SetCursorIndex( 0, Shift );
2506 kbCtrlEnd, kbCtrlPageDown:
2507 SetCursorIndex( GetTextEnd, Shift );
2508
2509 kbPageUp:
2510 CursorPageUp( Shift );
2511 kbPageDown:
2512 CursorPageDown( Shift );
2513
2514 kbHome:
2515 CursorToLineStart( Shift );
2516 kbEnd:
2517 CursorToLineEnd( Shift );
2518 end
2519 end
2520 else // no cursor visible
2521 begin
2522 case Key of
2523 kbCUp, kbCtrlCUp:
2524 SmallScrollUp;
2525 kbCDown, kbCtrlCDown:
2526 SmallScrollDown;
2527
2528 kbCLeft, kbCtrlCLeft:
2529 SmallScrollLeft;
2530 kbCRight, kbCtrlCRight:
2531 SmallScrollRight;
2532
2533 kbPageUp:
2534 UpPage;
2535 kbPageDown:
2536 DownPage;
2537
2538 kbHome, kbCtrlHome, kbCtrlPageUp:
2539 GotoTop;
2540 kbEnd, kbCtrlEnd, kbCtrlPageDown:
2541 GotoBottom;
2542 end;
2543 end;
2544
2545 inherited ScanEvent( KeyCode, RepeatCount );
2546
2547end;
2548
2549function TRichTextView.HighlightNextLink: boolean;
2550Var
2551 P: PChar;
2552 NextP: PChar;
2553 T: TTextElement;
2554 StartP: PChar;
2555begin
2556 if CursorIndex = -1 then
2557 P := FText // no cursor yet
2558 else
2559 P := FText + CursorIndex;
2560
2561 result := false;
2562
2563 // if we're sitting on a begin-link, skip it...
2564 T := ExtractNextTextElement( P, NextP );
2565 if T.ElementType = teStyle then
2566 if T.Tag.TagType = ttBeginLink then
2567 P := NextP;
2568
2569 while true do
2570 begin
2571 T := ExtractNextTextElement( P, NextP );
2572 if T.ElementType = teTextEnd then
2573 // no link found
2574 exit;
2575
2576 if T.ElementType = teStyle then
2577 if T.Tag.TagType = ttBeginLink then
2578 break;
2579
2580 p := NextP;
2581
2582 end;
2583
2584 StartP := P;
2585 p := NextP; // skip begin link
2586
2587 while true do
2588 begin
2589 T := ExtractNextTextElement( P, NextP );
2590 if T.ElementType = teTextEnd then
2591 break; // no explicit link end...
2592
2593 if T.ElementType = teStyle then
2594 if T.Tag.TagType = ttEndLink then
2595 break;
2596
2597 p := NextP;
2598 end;
2599
2600 SetSelectionStart( FLayout.GetCharIndex( StartP ) );
2601 SetSelectionEnd( FLayout.GetCharIndex( NextP ) );
2602
2603 result := true;
2604end;
2605
2606function TRichTextView.HighlightPreviousLink: boolean;
2607Var
2608 P: PChar;
2609 PreviousP: PChar;
2610 T: TTextElement;
2611 EndP: PChar;
2612begin
2613 result := false;
2614 if CursorIndex = -1 then
2615 exit; // no cursor yet
2616
2617 P := FText + CursorIndex;
2618
2619 // if we're sitting on an end-of-link, skip it...
2620 T := ExtractPreviousTextElement( FText, P, PreviousP );
2621 if T.ElementType = teStyle then
2622 if T.Tag.TagType = ttEndLink then
2623 P := PreviousP;
2624
2625 while true do
2626 begin
2627 T := ExtractPreviousTextElement( FText, P, PreviousP );
2628 if T.ElementType = teTextEnd then
2629 // no link found
2630 exit;
2631
2632 if T.ElementType = teStyle then
2633 if T.Tag.TagType = ttEndLink then
2634 break;
2635
2636 p := PreviousP;
2637
2638 end;
2639
2640 EndP := P;
2641 p := PreviousP; // skip end link
2642
2643 while true do
2644 begin
2645 T := ExtractPreviousTextElement( FText, P, PreviousP );
2646 if T.ElementType = teTextEnd then
2647 break; // no explicit link end...
2648
2649 if T.ElementType = teStyle then
2650 if T.Tag.TagType = ttBeginLink then
2651 break;
2652
2653 p := PreviousP;
2654 end;
2655
2656 SetSelectionStart( FLayout.GetCharIndex( EndP ) );
2657 SetSelectionEnd( FLayout.GetCharIndex( PreviousP ) );
2658
2659 result := true;
2660end;
2661
2662procedure TRichTextView.GoToTop;
2663begin
2664 SetVerticalPosition( 0 );
2665end;
2666
2667procedure TRichTextView.GotoBottom;
2668begin
2669 SetVerticalPosition( FVScrollBar.Max );
2670end;
2671
2672Function TRichTextView.GetTopCharIndex: longint;
2673var
2674 LineIndex: longint;
2675 Y: longint;
2676begin
2677 if not FVerticalPositionInitialised then
2678 begin
2679 Result := FTopCharIndex;
2680 exit;
2681 end;
2682 GetFirstVisibleLine( LineIndex,
2683 Y );
2684 if LineIndex >= 0 then
2685 Result := FLayout.GetCharIndex( FLayout.FLines[ LineIndex ].Text )
2686 else
2687 Result := 0;
2688end;
2689
2690Function TRichTextView.GetTopCharIndexPosition( NewTopCharIndex: longint ): longint;
2691var
2692 Line: longint;
2693 Height: longint;
2694begin
2695 if NewValue > GetTextEnd then
2696 begin
2697 Result := FVScrollBar.Max;
2698 exit;
2699 end;
2700 Line := FLayout.GetLineFromCharIndex( NewValue );
2701 if Line = 0 then
2702 begin
2703 Result := 0; // include top margin
2704 exit;
2705 end;
2706
2707 if Line < 0 then
2708 begin
2709 Result := FVScrollBar.Position;
2710 exit;
2711 end;
2712 Height := FLayout.GetLinePosition( Line );
2713 Result := Height;
2714end;
2715
2716Procedure TRichTextView.SetTopCharIndex( NewValue: longint );
2717var
2718 NewPosition: longint;
2719begin
2720 if not FVerticalPositionInitialised then
2721 begin
2722 if ( NewValue >= 0 )
2723 and ( NewValue < GetTextEnd ) then
2724 begin
2725 FTopCharIndex := NewValue;
2726 end;
2727 exit;
2728 end;
2729 NewPosition := GetTopCharIndexPosition( NewValue );
2730 SetVerticalPosition( NewPosition );
2731end;
2732
2733procedure TRichTextView.MakeCharVisible( CharIndex: longint );
2734var
2735 Line: longint;
2736begin
2737 Line := FLayout.GetLineFromCharIndex( CharIndex );
2738
2739 MakeRowAndColumnVisible( Line,
2740 FLayout.GetOffsetFromCharIndex( CharIndex, Line ) );
2741end;
2742
2743procedure TRichTextView.MakeRowVisible( Row: longint );
2744var
2745 TopLine: longint;
2746 BottomLine: longint;
2747 Offset: longint;
2748 NewPosition: longint;
2749begin
2750 GetFirstVisibleLine( TopLine, Offset );
2751 GetBottomLine( BottomLine, Offset );
2752
2753 if ( Row > TopLine )
2754 and ( Row < BottomLine ) then
2755 // already visible
2756 exit;
2757
2758 if ( Row = BottomLine )
2759 and ( Offset >= FLayout.FLines[ BottomLine ].Height - 1 ) then
2760 // bottom row already entirely visible
2761 exit;
2762
2763 if Row <= TopLine then
2764 begin
2765 // need to scroll up, desird row above top line
2766 if Row = 0 then
2767 NewPosition := 0 // include margins
2768 else
2769 NewPosition := FLayout.GetLinePosition( Row );
2770
2771 if NewPosition > FVScrollbar.Position then
2772 // no need to scroll
2773 exit;
2774 SetVerticalPosition( NewPosition );
2775 end
2776 else
2777 begin
2778 // need to scroll down, desired row below bottom line
2779 if ( BottomLine <> -1 )
2780 and ( Row >= BottomLine ) then
2781 SetVerticalPosition( FLayout.GetLinePosition( Row )
2782 + FLayout.FLines[ Row ].Height
2783 - GetTextAreaHeight );
2784 end;
2785end;
2786
2787procedure TRichTextView.MakeRowAndColumnVisible( Row: longint;
2788 Column: longint );
2789var
2790 X: Longint;
2791begin
2792 MakeRowVisible( Row );
2793 FLayout.GetXFromOffset( Column, Row, X );
2794
2795 if X > FXScroll + GetTextAreaWidth then
2796 // off the right
2797 SetHorizontalPosition( X - GetTextAreaWidth + 5 )
2798 else if X < FXScroll then
2799 // off to left
2800 SetHorizontalPosition( X );
2801
2802end;
2803
2804function TRichTextView.LinkFromIndex( const CharIndexToFind: longint): string;
2805begin
2806 Result := FLayout.LinkFromIndex( CharIndexToFind );
2807end;
2808
2809function TRichTextView.FindString( Origin: TFindOrigin;
2810 const Text: string;
2811 var MatchIndex: longint;
2812 var MatchLength: longint ): boolean;
2813var
2814 P: PChar;
2815 pMatch: pchar;
2816begin
2817 if ( Origin = foFromCurrent )
2818 and ( FSelectionStart <> -1 ) then
2819 begin
2820 // start at current cursor position
2821 P := FText + GetCursorIndex;
2822 end
2823 else
2824 begin
2825 P := FText;
2826 end;
2827
2828 Result := RichTextFindString( P, Text, pMatch, MatchLength );
2829
2830 if Result then
2831 // found
2832 MatchIndex := FLayout.GetCharIndex( pMatch )
2833 else
2834 MatchIndex := -1;
2835
2836end;
2837
2838function TRichTextView.Find( Origin: TFindOrigin;
2839 const Text: string ): boolean;
2840var
2841 MatchIndex: longint;
2842 MatchLength: longint;
2843begin
2844 Result := FindString( Origin,
2845 Text,
2846 MatchIndex,
2847 MatchLength );
2848 if Result then
2849 begin
2850 MakeCharVisible( MatchIndex );
2851 FSelectionStart := MatchIndex;
2852 SelectionEnd := MatchIndex + MatchLength;
2853 end;
2854end;
2855
2856Procedure TRichTextView.CreateWindow;
2857begin
2858 CreateWnd;
2859end;
2860
2861Initialization
2862 {Register classes}
2863 RegisterClasses( [ TRichTextView ] );
2864
2865finalization
2866
2867End.
2868
Note: See TracBrowser for help on using the repository browser.