source: trunk/Components/RichTextView.PAS@ 294

Last change on this file since 294 was 211, checked in by RBRi, 18 years ago

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