source: branches/2.19_branch/Components/RichTextView.PAS@ 324

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