source: trunk/Components/RichTextView.PAS@ 423

Last change on this file since 423 was 421, checked in by ataylor, 7 years ago

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