source: trunk/Components/RichTextView.PAS@ 418

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

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