source: cprs/branches/GUI-config/BDK32/Source/XWBRich20.PAS@ 1099

Last change on this file since 1099 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility
File size: 47.2 KB
Line 
1{ **************************************************************
2 Package: XWB - Kernel RPCBroker
3 Date Created: Sept 18, 1997 (Version 1.1)
4 Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
5 Developers: Joel Ivey
6 Description: Provides a RichEdit Component with ability
7 to recognize a URL within the RichEdit control.
8 Current Release: Version 1.1 Patch 40 (January 7, 2005))
9*************************************************************** }
10{: Unit XWBRich20
11 Based on the article "Detect URLS in the RichEdit Control" by
12 Elias J. Ongpoy in 'Delphi Developer Newsletter', May 2001
13 which incorporates the functionality of the Microsoft Rich Edit
14 Control 2.0 from RichEd20.DLL which incorporates the ability to
15 recognize a URL within the RichEdit control.
16}
17
18unit XWBRich20;
19interface
20uses Messages, Windows, SysUtils, Classes, Controls, Forms,
21 Menus, Graphics, StdCtrls, RichEdit, ToolWin, ImgList, ExtCtrls, ComCtrls;
22
23type
24 TXWBCustomRichEdit = class;
25
26 TAttributeType = (atSelected, atDefaultText);
27 TConsistentAttribute = (caBold, caColor, caFace, caItalic,
28 caSize, caStrikeOut, caUnderline, caProtected);
29 TConsistentAttributes = set of TConsistentAttribute;
30
31 TXWBTextAttributes = class(TPersistent)
32 private
33 RichEdit: TXWBCustomRichEdit;
34 FType: TAttributeType;
35 procedure GetAttributes(var Format: TCharFormat);
36 function GetCharset: TFontCharset;
37 function GetColor: TColor;
38 function GetConsistentAttributes: TConsistentAttributes;
39 function GetHeight: Integer;
40 function GetName: TFontName;
41 function GetPitch: TFontPitch;
42 function GetProtected: Boolean;
43 function GetSize: Integer;
44 function GetStyle: TFontStyles;
45 procedure SetAttributes(var Format: TCharFormat);
46 procedure SetCharset(Value: TFontCharset);
47 procedure SetColor(Value: TColor);
48 procedure SetHeight(Value: Integer);
49 procedure SetName(Value: TFontName);
50 procedure SetPitch(Value: TFontPitch);
51 procedure SetProtected(Value: Boolean);
52 procedure SetSize(Value: Integer);
53 procedure SetStyle(Value: TFontStyles);
54 protected
55 procedure InitFormat(var Format: TCharFormat);
56 procedure AssignTo(Dest: TPersistent); override;
57 public
58 constructor Create(AOwner: TXWBCustomRichEdit; AttributeType: TAttributeType);
59 procedure Assign(Source: TPersistent); override;
60 property Charset: TFontCharset read GetCharset write SetCharset;
61 property Color: TColor read GetColor write SetColor;
62 property ConsistentAttributes: TConsistentAttributes read GetConsistentAttributes;
63 property Name: TFontName read GetName write SetName;
64 property Pitch: TFontPitch read GetPitch write SetPitch;
65 property Protected: Boolean read GetProtected write SetProtected;
66 property Size: Integer read GetSize write SetSize;
67 property Style: TFontStyles read GetStyle write SetStyle;
68 property Height: Integer read GetHeight write SetHeight;
69 end;
70
71{ TParaAttributes }
72
73 TNumberingStyle = (nsNone, nsBullet);
74
75 TParaAttributes = class(TPersistent)
76 private
77 RichEdit: TXWBCustomRichEdit;
78 procedure GetAttributes(var Paragraph: TParaFormat);
79 function GetAlignment: TAlignment;
80 function GetFirstIndent: Longint;
81 function GetLeftIndent: Longint;
82 function GetRightIndent: Longint;
83 function GetNumbering: TNumberingStyle;
84 function GetTab(Index: Byte): Longint;
85 function GetTabCount: Integer;
86 procedure InitPara(var Paragraph: TParaFormat);
87 procedure SetAlignment(Value: TAlignment);
88 procedure SetAttributes(var Paragraph: TParaFormat);
89 procedure SetFirstIndent(Value: Longint);
90 procedure SetLeftIndent(Value: Longint);
91 procedure SetRightIndent(Value: Longint);
92 procedure SetNumbering(Value: TNumberingStyle);
93 procedure SetTab(Index: Byte; Value: Longint);
94 procedure SetTabCount(Value: Integer);
95 public
96 constructor Create(AOwner: TXWBCustomRichEdit);
97 procedure Assign(Source: TPersistent); override;
98 property Alignment: TAlignment read GetAlignment write SetAlignment;
99 property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
100 property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
101 property Numbering: TNumberingStyle read GetNumbering write SetNumbering;
102 property RightIndent: Longint read GetRightIndent write SetRightIndent;
103 property Tab[Index: Byte]: Longint read GetTab write SetTab;
104 property TabCount: Integer read GetTabCount write SetTabCount;
105 end;
106
107{ TXWBCustomRichEdit }
108
109 TRichEditResizeEvent = procedure(Sender: TObject; Rect: TRect) of object;
110 TRichEditProtectChange = procedure(Sender: TObject;
111 StartPos, EndPos: Integer; var AllowChange: Boolean) of object;
112 TRichEditSaveClipboard = procedure(Sender: TObject;
113 NumObjects, NumChars: Integer; var SaveClipboard: Boolean) of object;
114 TSearchType = (stWholeWord, stMatchCase);
115 TSearchTypes = set of TSearchType;
116
117 TConversion = class(TObject)
118 public
119 function ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; virtual;
120 function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; virtual;
121 end;
122
123 TConversionClass = class of TConversion;
124
125 PConversionFormat = ^TConversionFormat;
126 TConversionFormat = record
127 ConversionClass: TConversionClass;
128 Extension: string;
129 Next: PConversionFormat;
130 end;
131
132 PRichEditStreamInfo = ^TRichEditStreamInfo;
133 TRichEditStreamInfo = record
134 Converter: TConversion;
135 Stream: TStream;
136 end;
137
138 TXWBCustomRichEdit = class(TCustomMemo)
139 private
140 FHideScrollBars: Boolean;
141 FSelAttributes: TXWBTextAttributes;
142 FDefAttributes: TXWBTextAttributes;
143 FParagraph: TParaAttributes;
144 FOldParaAlignment: TAlignment;
145 FScreenLogPixels: Integer;
146 FRichEditStrings: TStrings;
147 FMemStream: TMemoryStream;
148 FOnSelChange: TNotifyEvent;
149
150 FHideSelection: Boolean;
151 FURLDetect: Boolean; // for URL Detect Property
152
153 FModified: Boolean;
154 FDefaultConverter: TConversionClass;
155 FOnResizeRequest: TRichEditResizeEvent;
156 FOnProtectChange: TRichEditProtectChange;
157 FOnSaveClipboard: TRichEditSaveClipboard;
158 FPageRect: TRect;
159
160 procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
161 procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
162 procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
163 procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
164 function GetPlainText: Boolean;
165 function ProtectChange(StartPos, EndPos: Integer): Boolean;
166 function SaveClipboard(NumObj, NumChars: Integer): Boolean;
167 procedure SetHideScrollBars(Value: Boolean);
168 procedure SetHideSelection(Value: Boolean);
169 procedure SetURLDetect(Value: boolean);
170
171 procedure SetPlainText(Value: Boolean);
172 procedure SetRichEditStrings(Value: TStrings);
173 procedure SetDefAttributes(Value: TXWBTextAttributes);
174 procedure SetSelAttributes(Value: TXWBTextAttributes);
175 procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
176 procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
177 procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
178 procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
179 procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
180
181 protected
182 procedure CreateParams(var Params: TCreateParams); override;
183 procedure CreateWnd; override;
184 procedure DestroyWnd; override;
185 procedure RequestSize(const Rect: TRect); virtual;
186 procedure SelectionChange; dynamic;
187 procedure DoSetMaxLength(Value: Integer); override;
188 function GetCaretPos: TPoint; override;
189 function GetSelLength: Integer; override;
190 function GetSelStart: Integer; override;
191 function GetSelText: string; override;
192 procedure SetSelLength(Value: Integer); override;
193 procedure SetSelStart(Value: Integer); override;
194 property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
195
196// New Property - URL Detect
197 property URLDetect : boolean read FURLDetect write SetURLDetect default FALSE;
198
199 property HideScrollBars: Boolean read FHideScrollBars
200 write SetHideScrollBars default True;
201 property Lines: TStrings read FRichEditStrings write SetRichEditStrings;
202 property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard
203 write FOnSaveClipboard;
204 property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
205 property OnProtectChange: TRichEditProtectChange read FOnProtectChange
206 write FOnProtectChange;
207 property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest
208 write FOnResizeRequest;
209 property PlainText: Boolean read GetPlainText write SetPlainText default False;
210
211 public
212 constructor Create(AOwner: TComponent); override;
213 destructor Destroy; override;
214 procedure Clear; override;
215 function FindText(const SearchStr: string;
216 StartPos, Length: Integer; Options: TSearchTypes): Integer;
217 function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; override;
218 procedure Print(const Caption: string); virtual;
219 class procedure RegisterConversionFormat(const AExtension: string;
220 AConversionClass: TConversionClass);
221 property DefaultConverter: TConversionClass
222 read FDefaultConverter write FDefaultConverter;
223 property DefAttributes: TXWBTextAttributes read FDefAttributes write SetDefAttributes;
224 property SelAttributes: TXWBTextAttributes read FSelAttributes write SetSelAttributes;
225 property PageRect: TRect read FPageRect write FPageRect;
226 property Paragraph: TParaAttributes read FParagraph;
227 end;
228
229 TXWBRichEdit = class(TXWBCustomRichEdit)
230 published
231 property Align;
232 property Alignment;
233 property Anchors;
234 property BiDiMode;
235 property BorderStyle;
236 property BorderWidth;
237 property Color;
238 property Ctl3D;
239 property DragCursor;
240 property DragKind;
241 property DragMode;
242 property Enabled;
243 property Font;
244 property HideSelection;
245 property URLDetect; // New URL Detect property
246 property HideScrollBars;
247 property ImeMode;
248 property ImeName;
249 property Constraints;
250 property Lines;
251 property MaxLength;
252 property ParentBiDiMode;
253 property ParentColor;
254 property ParentCtl3D;
255 property ParentFont;
256 property ParentShowHint;
257 property PlainText;
258 property PopupMenu;
259 property ReadOnly;
260 property ScrollBars;
261 property ShowHint;
262 property TabOrder;
263 property TabStop default True;
264
265 property Visible;
266 property WantTabs;
267 property WantReturns;
268 property WordWrap;
269 property OnChange;
270// property OnContextPopup;
271 property OnDragDrop;
272 property OnDragOver;
273 property OnEndDock;
274 property OnEndDrag;
275 property OnEnter;
276 property OnExit;
277 property OnKeyDown;
278 property OnKeyPress;
279 property OnKeyUp;
280 property OnMouseDown;
281 property OnMouseMove;
282 property OnMouseUp;
283 property OnMouseWheel;
284 property OnMouseWheelDown;
285 property OnMouseWheelUp;
286 property OnProtectChange;
287 property OnResizeRequest;
288 property OnSaveClipboard;
289 property OnSelectionChange;
290 property OnStartDock;
291 property OnStartDrag;
292 end;
293
294implementation
295
296uses Printers, Consts, ComStrs, ActnList, StdActns, ShellAPI;
297
298type
299 PFontHandles = ^TFontHandles;
300 TFontHandles = record
301 OurFont,
302 StockFont: Integer;
303 end;
304
305 const
306 SectionSizeArea = 8;
307 RTFConversionFormat: TConversionFormat = (
308 ConversionClass: TConversion;
309 Extension: 'rtf';
310 Next: nil);
311 TextConversionFormat: TConversionFormat = (
312 ConversionClass: TConversion;
313 Extension: 'txt';
314 Next: @RTFConversionFormat);
315
316var
317 ConversionFormatList: PConversionFormat = @TextConversionFormat;
318 FRichEditModule: THandle;
319
320{ TXWBTextAttributes }
321
322constructor TXWBTextAttributes.Create(AOwner: TXWBCustomRichEdit;
323 AttributeType: TAttributeType);
324begin
325 inherited Create;
326 RichEdit := AOwner;
327 FType := AttributeType;
328end;
329
330procedure TXWBTextAttributes.InitFormat(var Format: TCharFormat);
331begin
332 FillChar(Format, SizeOf(TCharFormat), 0);
333 Format.cbSize := SizeOf(TCharFormat);
334end;
335
336function TXWBTextAttributes.GetConsistentAttributes: TConsistentAttributes;
337var
338 Format: TCharFormat;
339begin
340 Result := [];
341 if RichEdit.HandleAllocated and (FType = atSelected) then
342 begin
343 InitFormat(Format);
344 SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
345 WPARAM(FType = atSelected), LPARAM(@Format));
346 with Format do
347 begin
348 if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
349 if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
350 if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
351 if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
352 if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
353 if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
354 if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
355 if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
356 end;
357 end;
358end;
359
360procedure TXWBTextAttributes.GetAttributes(var Format: TCharFormat);
361begin
362 InitFormat(Format);
363 if RichEdit.HandleAllocated then
364 SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
365 WPARAM(FType = atSelected), LPARAM(@Format));
366end;
367
368procedure TXWBTextAttributes.SetAttributes(var Format: TCharFormat);
369var
370 Flag: Longint;
371begin
372 if FType = atSelected then Flag := SCF_SELECTION
373 else Flag := 0;
374 if RichEdit.HandleAllocated then
375 SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, Flag, LPARAM(@Format))
376end;
377
378function TXWBTextAttributes.GetCharset: TFontCharset;
379var
380 Format: TCharFormat;
381begin
382 GetAttributes(Format);
383 Result := Format.bCharset;
384end;
385
386procedure TXWBTextAttributes.SetCharset(Value: TFontCharset);
387var
388 Format: TCharFormat;
389begin
390 InitFormat(Format);
391 with Format do
392 begin
393 dwMask := CFM_CHARSET;
394 bCharSet := Value;
395 end;
396 SetAttributes(Format);
397end;
398
399function TXWBTextAttributes.GetProtected: Boolean;
400var
401 Format: TCharFormat;
402begin
403 GetAttributes(Format);
404 with Format do
405 if (dwEffects and CFE_PROTECTED) <> 0 then
406 Result := True else
407 Result := False;
408end;
409
410procedure TXWBTextAttributes.SetProtected(Value: Boolean);
411var
412 Format: TCharFormat;
413begin
414 InitFormat(Format);
415 with Format do
416 begin
417 dwMask := CFM_PROTECTED;
418 if Value then dwEffects := CFE_PROTECTED;
419 end;
420 SetAttributes(Format);
421end;
422
423function TXWBTextAttributes.GetColor: TColor;
424var
425 Format: TCharFormat;
426begin
427 GetAttributes(Format);
428 with Format do
429 if (dwEffects and CFE_AUTOCOLOR) <> 0 then
430 Result := clWindowText else
431 Result := crTextColor;
432end;
433
434procedure TXWBTextAttributes.SetColor(Value: TColor);
435var
436 Format: TCharFormat;
437begin
438 InitFormat(Format);
439 with Format do
440 begin
441 dwMask := CFM_COLOR;
442 if Value = clWindowText then
443 dwEffects := CFE_AUTOCOLOR else
444 crTextColor := ColorToRGB(Value);
445 end;
446 SetAttributes(Format);
447end;
448
449function TXWBTextAttributes.GetName: TFontName;
450var
451 Format: TCharFormat;
452begin
453 GetAttributes(Format);
454 Result := Format.szFaceName;
455end;
456
457procedure TXWBTextAttributes.SetName(Value: TFontName);
458var
459 Format: TCharFormat;
460begin
461 InitFormat(Format);
462 with Format do
463 begin
464 dwMask := CFM_FACE;
465 StrPLCopy(szFaceName, Value, SizeOf(szFaceName));
466 end;
467 SetAttributes(Format);
468end;
469
470function TXWBTextAttributes.GetStyle: TFontStyles;
471var
472 Format: TCharFormat;
473begin
474 Result := [];
475 GetAttributes(Format);
476 with Format do
477 begin
478 if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold);
479 if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic);
480 if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline);
481 if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut);
482 end;
483end;
484
485procedure TXWBTextAttributes.SetStyle(Value: TFontStyles);
486var
487 Format: TCharFormat;
488begin
489 InitFormat(Format);
490 with Format do
491 begin
492 dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
493 if fsBold in Value then dwEffects := dwEffects or CFE_BOLD;
494 if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC;
495 if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE;
496 if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT;
497 end;
498
499 SetAttributes(Format);
500end;
501
502function TXWBTextAttributes.GetSize: Integer;
503var
504 Format: TCharFormat;
505begin
506 GetAttributes(Format);
507 Result := Format.yHeight div 20;
508end;
509
510procedure TXWBTextAttributes.SetSize(Value: Integer);
511var
512 Format: TCharFormat;
513begin
514 InitFormat(Format);
515 with Format do
516 begin
517 dwMask := Integer(CFM_SIZE);
518 yHeight := Value * 20;
519 end;
520 SetAttributes(Format);
521end;
522
523function TXWBTextAttributes.GetHeight: Integer;
524begin
525 Result := MulDiv(Size, RichEdit.FScreenLogPixels, 72);
526end;
527
528procedure TXWBTextAttributes.SetHeight(Value: Integer);
529begin
530 Size := MulDiv(Value, 72, RichEdit.FScreenLogPixels);
531end;
532
533function TXWBTextAttributes.GetPitch: TFontPitch;
534var
535 Format: TCharFormat;
536begin
537 GetAttributes(Format);
538 case (Format.bPitchAndFamily and $03) of
539 DEFAULT_PITCH: Result := fpDefault;
540 VARIABLE_PITCH: Result := fpVariable;
541 FIXED_PITCH: Result := fpFixed;
542 else
543 Result := fpDefault;
544 end;
545end;
546
547procedure TXWBTextAttributes.SetPitch(Value: TFontPitch);
548var
549 Format: TCharFormat;
550begin
551 InitFormat(Format);
552 with Format do
553 begin
554 case Value of
555 fpVariable: Format.bPitchAndFamily := VARIABLE_PITCH;
556 fpFixed: Format.bPitchAndFamily := FIXED_PITCH;
557 else
558 Format.bPitchAndFamily := DEFAULT_PITCH;
559 end;
560 end;
561 SetAttributes(Format);
562end;
563
564procedure TXWBTextAttributes.Assign(Source: TPersistent);
565begin
566 if Source is TFont then
567 begin
568 Color := TFont(Source).Color;
569 Name := TFont(Source).Name;
570 Charset := TFont(Source).Charset;
571 Style := TFont(Source).Style;
572 Size := TFont(Source).Size;
573 Pitch := TFont(Source).Pitch;
574 end
575 else if Source is TXWBTextAttributes then
576 begin
577 Color := TXWBTextAttributes(Source).Color;
578 Name := TXWBTextAttributes(Source).Name;
579 Charset := TXWBTextAttributes(Source).Charset;
580 Style := TXWBTextAttributes(Source).Style;
581 Pitch := TXWBTextAttributes(Source).Pitch;
582 end
583 else inherited Assign(Source);
584end;
585
586procedure TXWBTextAttributes.AssignTo(Dest: TPersistent);
587begin
588 if Dest is TFont then
589 begin
590 TFont(Dest).Color := Color;
591 TFont(Dest).Name := Name;
592 TFont(Dest).Charset := Charset;
593 TFont(Dest).Style := Style;
594 TFont(Dest).Size := Size;
595 TFont(Dest).Pitch := Pitch;
596 end
597 else if Dest is TXWBTextAttributes then
598 begin
599 TXWBTextAttributes(Dest).Color := Color;
600 TXWBTextAttributes(Dest).Name := Name;
601 TXWBTextAttributes(Dest).Charset := Charset;
602 TXWBTextAttributes(Dest).Style := Style;
603 TXWBTextAttributes(Dest).Pitch := Pitch;
604 end
605 else inherited AssignTo(Dest);
606end;
607
608{ TParaAttributes }
609
610constructor TParaAttributes.Create(AOwner: TXWBCustomRichEdit);
611begin
612 inherited Create;
613 RichEdit := AOwner;
614end;
615
616procedure TParaAttributes.InitPara(var Paragraph: TParaFormat);
617begin
618 FillChar(Paragraph, SizeOf(TParaFormat), 0);
619 Paragraph.cbSize := SizeOf(TParaFormat);
620end;
621
622procedure TParaAttributes.GetAttributes(var Paragraph: TParaFormat);
623begin
624 InitPara(Paragraph);
625 if RichEdit.HandleAllocated then
626 SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph));
627end;
628
629procedure TParaAttributes.SetAttributes(var Paragraph: TParaFormat);
630begin
631 RichEdit.HandleNeeded; { we REALLY need the handle for BiDi }
632 if RichEdit.HandleAllocated then
633 begin
634 if RichEdit.UseRightToLeftAlignment then
635 if Paragraph.wAlignment = PFA_LEFT then
636 Paragraph.wAlignment := PFA_RIGHT
637 else if Paragraph.wAlignment = PFA_RIGHT then
638 Paragraph.wAlignment := PFA_LEFT;
639 SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph));
640 end;
641end;
642
643function TParaAttributes.GetAlignment: TAlignment;
644var
645 Paragraph: TParaFormat;
646begin
647 GetAttributes(Paragraph);
648 Result := TAlignment(Paragraph.wAlignment - 1);
649end;
650
651procedure TParaAttributes.SetAlignment(Value: TAlignment);
652var
653 Paragraph: TParaFormat;
654begin
655 InitPara(Paragraph);
656 with Paragraph do
657 begin
658 dwMask := PFM_ALIGNMENT;
659 wAlignment := Ord(Value) + 1;
660 end;
661 SetAttributes(Paragraph);
662end;
663
664function TParaAttributes.GetNumbering: TNumberingStyle;
665var
666 Paragraph: TParaFormat;
667begin
668 GetAttributes(Paragraph);
669 Result := TNumberingStyle(Paragraph.wNumbering);
670end;
671
672procedure TParaAttributes.SetNumbering(Value: TNumberingStyle);
673var
674 Paragraph: TParaFormat;
675begin
676 case Value of
677 nsBullet: if LeftIndent < 10 then LeftIndent := 10;
678 nsNone: LeftIndent := 0;
679 end;
680 InitPara(Paragraph);
681 with Paragraph do
682 begin
683 dwMask := PFM_NUMBERING;
684 wNumbering := Ord(Value);
685 end;
686 SetAttributes(Paragraph);
687end;
688
689function TParaAttributes.GetFirstIndent: Longint;
690var
691 Paragraph: TParaFormat;
692begin
693 GetAttributes(Paragraph);
694 Result := Paragraph.dxStartIndent div 20
695end;
696
697procedure TParaAttributes.SetFirstIndent(Value: Longint);
698var
699 Paragraph: TParaFormat;
700begin
701 InitPara(Paragraph);
702 with Paragraph do
703 begin
704 dwMask := PFM_STARTINDENT;
705 dxStartIndent := Value * 20;
706 end;
707 SetAttributes(Paragraph);
708end;
709
710function TParaAttributes.GetLeftIndent: Longint;
711var
712 Paragraph: TParaFormat;
713begin
714 GetAttributes(Paragraph);
715 Result := Paragraph.dxOffset div 20;
716end;
717
718procedure TParaAttributes.SetLeftIndent(Value: Longint);
719var
720 Paragraph: TParaFormat;
721begin
722 InitPara(Paragraph);
723 with Paragraph do
724 begin
725 dwMask := PFM_OFFSET;
726 dxOffset := Value * 20;
727 end;
728 SetAttributes(Paragraph);
729end;
730
731function TParaAttributes.GetRightIndent: Longint;
732var
733 Paragraph: TParaFormat;
734begin
735 GetAttributes(Paragraph);
736 Result := Paragraph.dxRightIndent div 20;
737end;
738
739procedure TParaAttributes.SetRightIndent(Value: Longint);
740var
741 Paragraph: TParaFormat;
742begin
743 InitPara(Paragraph);
744 with Paragraph do
745 begin
746 dwMask := PFM_RIGHTINDENT;
747 dxRightIndent := Value * 20;
748 end;
749 SetAttributes(Paragraph);
750end;
751
752function TParaAttributes.GetTab(Index: Byte): Longint;
753var
754 Paragraph: TParaFormat;
755begin
756 GetAttributes(Paragraph);
757 Result := Paragraph.rgxTabs[Index] div 20;
758end;
759
760procedure TParaAttributes.SetTab(Index: Byte; Value: Longint);
761var
762 Paragraph: TParaFormat;
763begin
764 GetAttributes(Paragraph);
765 with Paragraph do
766 begin
767 rgxTabs[Index] := Value * 20;
768 dwMask := PFM_TABSTOPS;
769 if cTabCount < Index then cTabCount := Index;
770 SetAttributes(Paragraph);
771 end;
772end;
773
774function TParaAttributes.GetTabCount: Integer;
775var
776 Paragraph: TParaFormat;
777begin
778 GetAttributes(Paragraph);
779 Result := Paragraph.cTabCount;
780end;
781
782procedure TParaAttributes.SetTabCount(Value: Integer);
783var
784 Paragraph: TParaFormat;
785begin
786 GetAttributes(Paragraph);
787 with Paragraph do
788 begin
789 dwMask := PFM_TABSTOPS;
790 cTabCount := Value;
791 SetAttributes(Paragraph);
792 end;
793end;
794
795procedure TParaAttributes.Assign(Source: TPersistent);
796var
797 I: Integer;
798begin
799 if Source is TParaAttributes then
800 begin
801 Alignment := TParaAttributes(Source).Alignment;
802 FirstIndent := TParaAttributes(Source).FirstIndent;
803 LeftIndent := TParaAttributes(Source).LeftIndent;
804 RightIndent := TParaAttributes(Source).RightIndent;
805 Numbering := TParaAttributes(Source).Numbering;
806 for I := 0 to MAX_TAB_STOPS - 1 do
807 Tab[I] := TParaAttributes(Source).Tab[I];
808 end
809 else inherited Assign(Source);
810end;
811
812{ TConversion }
813
814function TConversion.ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
815begin
816 Result := Stream.Read(Buffer^, BufSize);
817end;
818
819function TConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
820begin
821 Result := Stream.Write(Buffer^, BufSize);
822end;
823
824{ TRichEditStrings }
825
826const
827 ReadError = $0001;
828 WriteError = $0002;
829 NoError = $0000;
830
831type
832 TSelection = record
833 StartPos, EndPos: Integer;
834 end;
835
836 TRichEditStrings = class(TStrings)
837 private
838 RichEdit: TXWBCustomRichEdit;
839 FPlainText: Boolean;
840 FConverter: TConversion;
841 procedure EnableChange(const Value: Boolean);
842 protected
843 function Get(Index: Integer): string; override;
844 function GetCount: Integer; override;
845 procedure Put(Index: Integer; const S: string); override;
846 procedure SetUpdateState(Updating: Boolean); override;
847 procedure SetTextStr(const Value: string); override;
848 public
849 destructor Destroy; override;
850 procedure Clear; override;
851 procedure AddStrings(Strings: TStrings); override;
852 procedure Delete(Index: Integer); override;
853 procedure Insert(Index: Integer; const S: string); override;
854 procedure LoadFromFile(const FileName: string); override;
855 procedure LoadFromStream(Stream: TStream); override;
856 procedure SaveToFile(const FileName: string); override;
857 procedure SaveToStream(Stream: TStream); override;
858 property PlainText: Boolean read FPlainText write FPlainText;
859 end;
860
861destructor TRichEditStrings.Destroy;
862begin
863 FConverter.Free;
864 inherited Destroy;
865end;
866
867procedure TRichEditStrings.AddStrings(Strings: TStrings);
868var
869 SelChange: TNotifyEvent;
870begin
871 SelChange := RichEdit.OnSelectionChange;
872 RichEdit.OnSelectionChange := nil;
873 try
874 inherited AddStrings(Strings);
875 finally
876 RichEdit.OnSelectionChange := SelChange;
877 end;
878end;
879
880function TRichEditStrings.GetCount: Integer;
881begin
882 Result := SendMessage(RichEdit.Handle, EM_GETLINECOUNT, 0, 0);
883 if SendMessage(RichEdit.Handle, EM_LINELENGTH, SendMessage(RichEdit.Handle,
884 EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
885end;
886
887function TRichEditStrings.Get(Index: Integer): string;
888var
889 Text: array[0..4095] of Char;
890 L: Integer;
891begin
892 Word((@Text)^) := SizeOf(Text);
893 L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
894 if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2);
895 SetString(Result, Text, L);
896end;
897
898procedure TRichEditStrings.Put(Index: Integer; const S: string);
899var
900 Selection: TCharRange;
901begin
902 if Index >= 0 then
903 begin
904 Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
905 if Selection.cpMin <> -1 then
906 begin
907 Selection.cpMax := Selection.cpMin +
908 SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
909 SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
910 SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
911 end;
912 end;
913end;
914
915procedure TRichEditStrings.Insert(Index: Integer; const S: string);
916var
917 L: Integer;
918 Selection: TCharRange;
919 Fmt: PChar;
920 Str: string;
921begin
922 if Index >= 0 then
923 begin
924 Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
925 if Selection.cpMin >= 0 then Fmt := '%s'#13#10
926 else begin
927 Selection.cpMin :=
928 SendMessage(RichEdit.Handle, EM_LINEINDEX, Index - 1, 0);
929 if Selection.cpMin < 0 then Exit;
930 L := SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
931 if L = 0 then Exit;
932 Inc(Selection.cpMin, L);
933 Fmt := #13#10'%s';
934 end;
935
936 Selection.cpMax := Selection.cpMin;
937 SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
938
939 Str := Format(Fmt, [S]);
940 SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, LongInt(PChar(Str)));
941{
942 if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then
943 raise EOutOfResources.Create(sRichEditInsertError);
944}
945 end;
946end;
947
948procedure TRichEditStrings.Delete(Index: Integer);
949const
950 Empty: PChar = '';
951var
952 Selection: TCharRange;
953begin
954 if Index < 0 then Exit;
955 Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
956 if Selection.cpMin <> -1 then
957 begin
958 Selection.cpMax := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index + 1, 0);
959 if Selection.cpMax = -1 then
960 Selection.cpMax := Selection.cpMin +
961 SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
962 SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
963 SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
964 end;
965end;
966
967procedure TRichEditStrings.Clear;
968begin
969 RichEdit.Clear;
970end;
971
972procedure TRichEditStrings.SetUpdateState(Updating: Boolean);
973begin
974 if RichEdit.Showing then
975 SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
976 if not Updating then begin
977 RichEdit.Refresh;
978 RichEdit.Perform(CM_TEXTCHANGED, 0, 0);
979 end;
980end;
981
982procedure TRichEditStrings.EnableChange(const Value: Boolean);
983var
984 EventMask: Longint;
985begin
986 with RichEdit do
987 begin
988 if Value then
989 EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) or ENM_CHANGE
990 else
991 EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) and not ENM_CHANGE;
992 SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
993 end;
994end;
995
996procedure TRichEditStrings.SetTextStr(const Value: string);
997begin
998 EnableChange(False);
999 try
1000 inherited SetTextStr(Value);
1001 finally
1002 EnableChange(True);
1003 end;
1004end;
1005
1006function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
1007asm
1008 PUSH ESI
1009 PUSH EDI
1010 MOV EDI,EAX
1011 MOV ESI,EDX
1012 MOV EDX,EAX
1013 CLD
1014@@1: LODSB
1015@@2: OR AL,AL
1016 JE @@4
1017 CMP AL,0AH
1018 JE @@3
1019 STOSB
1020 CMP AL,0DH
1021 JNE @@1
1022 MOV AL,0AH
1023 STOSB
1024 LODSB
1025 CMP AL,0AH
1026 JE @@1
1027 JMP @@2
1028@@3: MOV EAX,0A0DH
1029 STOSW
1030 JMP @@1
1031@@4: STOSB
1032 LEA EAX,[EDI-1]
1033 SUB EAX,EDX
1034 POP EDI
1035 POP ESI
1036end;
1037
1038function StreamSave(dwCookie: Longint; pbBuff: PByte;
1039 cb: Longint; var pcb: Longint): Longint; stdcall;
1040var
1041 StreamInfo: PRichEditStreamInfo;
1042begin
1043 Result := NoError;
1044 StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
1045 try
1046 pcb := 0;
1047 if StreamInfo^.Converter <> nil then
1048 pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb);
1049 except
1050 Result := WriteError;
1051 end;
1052end;
1053
1054function StreamLoad(dwCookie: Longint; pbBuff: PByte;
1055 cb: Longint; var pcb: Longint): Longint; stdcall;
1056var
1057 Buffer, pBuff: PChar;
1058 StreamInfo: PRichEditStreamInfo;
1059begin
1060 Result := NoError;
1061 StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
1062 Buffer := StrAlloc(cb + 1);
1063 try
1064 cb := cb div 2;
1065 pcb := 0;
1066 pBuff := Buffer + cb;
1067 try
1068 if StreamInfo^.Converter <> nil then
1069 pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
1070 if pcb > 0 then
1071 begin
1072 pBuff[pcb] := #0;
1073 if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
1074 pcb := AdjustLineBreaks(Buffer, pBuff);
1075 Move(Buffer^, pbBuff^, pcb);
1076 end;
1077 except
1078 Result := ReadError;
1079 end;
1080 finally
1081 StrDispose(Buffer);
1082 end;
1083end;
1084
1085procedure TRichEditStrings.LoadFromStream(Stream: TStream);
1086var
1087 EditStream: TEditStream;
1088 Position: Longint;
1089 TextType: Longint;
1090 StreamInfo: TRichEditStreamInfo;
1091 Converter: TConversion;
1092begin
1093 StreamInfo.Stream := Stream;
1094 if FConverter <> nil then Converter := FConverter
1095 else Converter := RichEdit.DefaultConverter.Create;
1096 StreamInfo.Converter := Converter;
1097 try
1098 with EditStream do
1099 begin
1100 dwCookie := LongInt(Pointer(@StreamInfo));
1101 pfnCallBack := @StreamLoad;
1102 dwError := 0;
1103 end;
1104 Position := Stream.Position;
1105
1106 if PlainText then TextType := SF_TEXT
1107 else TextType := SF_RTF;
1108 SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
1109
1110 if (TextType = SF_RTF) and (EditStream.dwError <> 0) then
1111 begin
1112 Stream.Position := Position;
1113 if PlainText then TextType := SF_RTF
1114 else TextType := SF_TEXT;
1115 SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
1116 if EditStream.dwError <> 0 then
1117 raise EOutOfResources.Create(sRichEditLoadFail);
1118 end;
1119
1120 finally
1121 if FConverter = nil then Converter.Free;
1122 end;
1123end;
1124
1125procedure TRichEditStrings.SaveToStream(Stream: TStream);
1126var
1127 EditStream: TEditStream;
1128 TextType: Longint;
1129 StreamInfo: TRichEditStreamInfo;
1130 Converter: TConversion;
1131begin
1132 if FConverter <> nil then Converter := FConverter
1133 else Converter := RichEdit.DefaultConverter.Create;
1134 StreamInfo.Stream := Stream;
1135 StreamInfo.Converter := Converter;
1136 try
1137 with EditStream do
1138 begin
1139 dwCookie := LongInt(Pointer(@StreamInfo));
1140 pfnCallBack := @StreamSave;
1141 dwError := 0;
1142 end;
1143 if PlainText then TextType := SF_TEXT
1144 else TextType := SF_RTF;
1145 SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
1146 if EditStream.dwError <> 0 then
1147 raise EOutOfResources.Create(sRichEditSaveFail);
1148 finally
1149 if FConverter = nil then Converter.Free;
1150 end;
1151end;
1152
1153procedure TRichEditStrings.LoadFromFile(const FileName: string);
1154var
1155 Ext: string;
1156 Convert: PConversionFormat;
1157begin
1158 Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
1159 System.Delete(Ext, 1, 1);
1160 Convert := ConversionFormatList;
1161 while Convert <> nil do
1162 with Convert^ do
1163 if Extension <> Ext then Convert := Next
1164 else Break;
1165 if Convert = nil then
1166 Convert := @TextConversionFormat;
1167 if FConverter = nil then FConverter := Convert^.ConversionClass.Create;
1168 try
1169 inherited LoadFromFile(FileName);
1170 except
1171 FConverter.Free;
1172 FConverter := nil;
1173 raise;
1174 end;
1175 RichEdit.DoSetMaxLength($7FFFFFF0);
1176end;
1177
1178procedure TRichEditStrings.SaveToFile(const FileName: string);
1179var
1180 Ext: string;
1181 Convert: PConversionFormat;
1182begin
1183 Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
1184 System.Delete(Ext, 1, 1);
1185 Convert := ConversionFormatList;
1186 while Convert <> nil do
1187 with Convert^ do
1188 if Extension <> Ext then Convert := Next
1189 else Break;
1190 if Convert = nil then
1191 Convert := @TextConversionFormat;
1192 if FConverter = nil then FConverter := Convert^.ConversionClass.Create;
1193 try
1194 inherited SaveToFile(FileName);
1195 except
1196 FConverter.Free;
1197 FConverter := nil;
1198 raise;
1199 end;
1200end;
1201
1202{ TRichEdit }
1203
1204constructor TXWBCustomRichEdit.Create(AOwner: TComponent);
1205var
1206 DC: HDC;
1207begin
1208 inherited Create(AOwner);
1209 FSelAttributes := TXWBTextAttributes.Create(Self, atSelected);
1210 FDefAttributes := TXWBTextAttributes.Create(Self, atDefaultText);
1211 FParagraph := TParaAttributes.Create(Self);
1212 FRichEditStrings := TRichEditStrings.Create;
1213 TRichEditStrings(FRichEditStrings).RichEdit := Self;
1214 TabStop := True;
1215 Width := 185;
1216 Height := 89;
1217 AutoSize := False;
1218 DoubleBuffered := False;
1219 FHideSelection := True;
1220 FURLDetect:= FALSE;
1221 HideScrollBars := True;
1222
1223 DC := GetDC(0);
1224 FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
1225 DefaultConverter := TConversion;
1226 ReleaseDC(0, DC);
1227 FOldParaAlignment := Alignment;
1228 Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
1229end;
1230
1231destructor TXWBCustomRichEdit.Destroy;
1232begin
1233 FSelAttributes.Free;
1234 FDefAttributes.Free;
1235 FParagraph.Free;
1236 FRichEditStrings.Free;
1237 FMemStream.Free;
1238 inherited Destroy;
1239end;
1240
1241procedure TXWBCustomRichEdit.Clear;
1242begin
1243 inherited Clear;
1244 Modified := False;
1245end;
1246
1247procedure TXWBCustomRichEdit.CreateParams(var Params: TCreateParams);
1248const
1249// Use version 2.0 of RichEdit, previously RICHED32.DLL
1250 RichEditModuleName = 'RICHED20.DLL';
1251
1252 HideScrollBar : array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0);
1253 HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
1254
1255begin
1256 if FRichEditModule = 0 then
1257 begin
1258 FRichEditModule := LoadLibrary(RichEditModuleName);
1259 if FRichEditModule <= HINSTANCE_ERROR then FRichEditModule := 0;
1260 end;
1261
1262 inherited CreateParams(Params);
1263
1264// USE RICHEDIT_CLASSA use ANSI version not Unicode
1265 CreateSubClass(Params, RICHEDIT_CLASSA);
1266
1267 with Params do
1268 begin
1269 Style := Style or HideScrollBar[HideScrollBars] or
1270 HideSelections[HideSelection];
1271 WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
1272 end;
1273end;
1274
1275procedure TXWBCustomRichEdit.CreateWnd;
1276var
1277 Plain, DesignMode, WasModified: Boolean;
1278
1279begin
1280 WasModified := inherited Modified;
1281
1282 inherited CreateWnd;
1283 if (SysLocale.FarEast) and not (SysLocale.PriLangID = LANG_JAPANESE) then
1284 Font.Charset := GetDefFontCharSet;
1285 SendMessage(Handle, EM_SETEVENTMASK, 0,
1286 ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or
1287 ENM_PROTECTED or ENM_LINK); // Added the ENM_LINK to receive EN_LINK message
1288
1289 SendMessage(Handle, EM_AUTOURLDETECT, Ord(FURLDetect), 0); // Start the URL Detect
1290
1291 SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color));
1292 if FMemStream <> nil then
1293 begin
1294 Plain := PlainText;
1295 FMemStream.ReadBuffer(DesignMode, sizeof(DesignMode));
1296 PlainText := DesignMode;
1297 try
1298 Lines.LoadFromStream(FMemStream);
1299 FMemStream.Free;
1300 FMemStream := nil;
1301 finally
1302 PlainText := Plain;
1303 end;
1304 end;
1305
1306 Modified := WasModified;
1307end;
1308
1309procedure TXWBCustomRichEdit.DestroyWnd;
1310var
1311 Plain, DesignMode: Boolean;
1312begin
1313 FModified := Modified;
1314 FMemStream := TMemoryStream.Create;
1315 Plain := PlainText;
1316 DesignMode := (csDesigning in ComponentState);
1317 PlainText := DesignMode;
1318 FMemStream.WriteBuffer(DesignMode, sizeof(DesignMode));
1319 try
1320 Lines.SaveToStream(FMemStream);
1321 FMemStream.Position := 0;
1322 finally
1323 PlainText := Plain;
1324 end;
1325
1326 inherited DestroyWnd;
1327end;
1328
1329procedure TXWBCustomRichEdit.WMNCDestroy(var Message: TWMNCDestroy);
1330begin
1331 inherited;
1332end;
1333
1334procedure TXWBCustomRichEdit.WMSetFont(var Message: TWMSetFont);
1335begin
1336 FDefAttributes.Assign(Font);
1337end;
1338
1339procedure TXWBCustomRichEdit.WMRButtonUp(var Message: TWMRButtonUp);
1340begin
1341 // RichEd20 does not pass the WM_RBUTTONUP message to defwndproc,
1342 // so we get no WM_CONTEXTMENU message. Simulate message here.
1343 if Win32MajorVersion < 5 then
1344 Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
1345 ClientToScreen(SmallPointToPoint(Message.Pos)))));
1346 inherited;
1347end;
1348
1349procedure TXWBCustomRichEdit.CMFontChanged(var Message: TMessage);
1350begin
1351 FDefAttributes.Assign(Font);
1352end;
1353
1354procedure TXWBCustomRichEdit.DoSetMaxLength(Value: Integer);
1355begin
1356 SendMessage(Handle, EM_EXLIMITTEXT, 0, Value);
1357end;
1358
1359function TXWBCustomRichEdit.GetCaretPos;
1360var
1361 CharRange: TCharRange;
1362begin
1363 SendMessage(Handle, EM_EXGETSEL, 0, LongInt(@CharRange));
1364 Result.X := CharRange.cpMax;
1365 Result.Y := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, Result.X);
1366 Result.X := Result.X - SendMessage(Handle, EM_LINEINDEX, -1, 0);
1367end;
1368
1369function TXWBCustomRichEdit.GetSelLength: Integer;
1370var
1371 CharRange: TCharRange;
1372begin
1373 SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
1374 Result := CharRange.cpMax - CharRange.cpMin;
1375end;
1376
1377function TXWBCustomRichEdit.GetSelStart: Integer;
1378var
1379 CharRange: TCharRange;
1380begin
1381 SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
1382 Result := CharRange.cpMin;
1383end;
1384
1385function TXWBCustomRichEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
1386var
1387 S: string;
1388begin
1389 S := GetSelText;
1390 Result := Length(S);
1391 if BufSize < Length(S) then Result := BufSize;
1392 StrPLCopy(Buffer, S, Result);
1393end;
1394
1395function TXWBCustomRichEdit.GetSelText: string;
1396var
1397 Length: Integer;
1398begin
1399 SetLength(Result, GetSelLength + 1);
1400 Length := SendMessage(Handle, EM_GETSELTEXT, 0, Longint(PChar(Result)));
1401 SetLength(Result, Length);
1402end;
1403
1404procedure TXWBCustomRichEdit.CMBiDiModeChanged(var Message: TMessage);
1405var
1406 AParagraph: TParaFormat;
1407begin
1408 HandleNeeded; { we REALLY need the handle for BiDi }
1409 inherited;
1410 Paragraph.GetAttributes(AParagraph);
1411 AParagraph.dwMask := PFM_ALIGNMENT;
1412 AParagraph.wAlignment := Ord(Alignment) + 1;
1413 Paragraph.SetAttributes(AParagraph);
1414end;
1415
1416procedure TXWBCustomRichEdit.SetHideScrollBars(Value: Boolean);
1417begin
1418 if HideScrollBars <> Value then
1419 begin
1420 FHideScrollBars := value;
1421 RecreateWnd;
1422 end;
1423end;
1424
1425procedure TXWBCustomRichEdit.SetHideSelection(Value: Boolean);
1426begin
1427 if HideSelection <> Value then
1428 begin
1429 FHideSelection := Value;
1430 SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LongInt(True));
1431 end;
1432end;
1433
1434procedure TXWBCustomRichEdit.SetURLDetect(Value: boolean);
1435begin
1436 if URLDetect <> Value then
1437 begin
1438 FURLDetect:= Value;
1439 RecreateWnd;
1440 end;
1441end;
1442
1443procedure TXWBCustomRichEdit.SetSelAttributes(Value: TXWBTextAttributes);
1444begin
1445 SelAttributes.Assign(Value);
1446end;
1447
1448procedure TXWBCustomRichEdit.SetSelLength(Value: Integer);
1449var
1450 CharRange: TCharRange;
1451begin
1452 SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
1453 CharRange.cpMax := CharRange.cpMin + Value;
1454 SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
1455 SendMessage(Handle, EM_SCROLLCARET, 0, 0);
1456end;
1457
1458procedure TXWBCustomRichEdit.SetDefAttributes(Value: TXWBTextAttributes);
1459begin
1460 DefAttributes.Assign(Value);
1461end;
1462
1463function TXWBCustomRichEdit.GetPlainText: Boolean;
1464begin
1465 Result := TRichEditStrings(Lines).PlainText;
1466end;
1467
1468procedure TXWBCustomRichEdit.SetPlainText(Value: Boolean);
1469begin
1470 TRichEditStrings(Lines).PlainText := Value;
1471end;
1472
1473procedure TXWBCustomRichEdit.CMColorChanged(var Message: TMessage);
1474begin
1475 inherited;
1476 SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color))
1477end;
1478
1479procedure TXWBCustomRichEdit.SetRichEditStrings(Value: TStrings);
1480begin
1481 FRichEditStrings.Assign(Value);
1482end;
1483
1484procedure TXWBCustomRichEdit.SetSelStart(Value: Integer);
1485var
1486 CharRange: TCharRange;
1487begin
1488 CharRange.cpMin := Value;
1489 CharRange.cpMax := Value;
1490 SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
1491end;
1492
1493procedure TXWBCustomRichEdit.Print(const Caption: string);
1494var
1495 Range: TFormatRange;
1496 LastChar, MaxLen, LogX, LogY, OldMap: Integer;
1497 SaveRect: TRect;
1498begin
1499 FillChar(Range, SizeOf(TFormatRange), 0);
1500 with Printer, Range do
1501 begin
1502 Title := Caption;
1503 BeginDoc;
1504 hdc := Handle;
1505 hdcTarget := hdc;
1506 LogX := GetDeviceCaps(Handle, LOGPIXELSX);
1507 LogY := GetDeviceCaps(Handle, LOGPIXELSY);
1508 if IsRectEmpty(PageRect) then
1509 begin
1510 rc.right := PageWidth * 1440 div LogX;
1511 rc.bottom := PageHeight * 1440 div LogY;
1512 end
1513 else begin
1514 rc.left := PageRect.Left * 1440 div LogX;
1515 rc.top := PageRect.Top * 1440 div LogY;
1516 rc.right := PageRect.Right * 1440 div LogX;
1517 rc.bottom := PageRect.Bottom * 1440 div LogY;
1518 end;
1519 rcPage := rc;
1520 SaveRect := rc;
1521 LastChar := 0;
1522 MaxLen := GetTextLen;
1523 chrg.cpMax := -1;
1524 // ensure printer DC is in text map mode
1525 OldMap := SetMapMode(hdc, MM_TEXT);
1526 SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
1527 try
1528 repeat
1529 rc := SaveRect;
1530 chrg.cpMin := LastChar;
1531 LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
1532 if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
1533 until (LastChar >= MaxLen) or (LastChar = -1);
1534 EndDoc;
1535 finally
1536 SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
1537 SetMapMode(hdc, OldMap); // restore previous map mode
1538 end;
1539 end;
1540end;
1541
1542var
1543 Painting: Boolean = False;
1544
1545procedure TXWBCustomRichEdit.WMPaint(var Message: TWMPaint);
1546var
1547 R, R1: TRect;
1548begin
1549 if GetUpdateRect(Handle, R, True) then
1550 begin
1551 with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom);
1552 if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True);
1553 end;
1554 if Painting then
1555 Invalidate
1556 else begin
1557 Painting := True;
1558 try
1559 inherited;
1560 finally
1561 Painting := False;
1562 end;
1563 end;
1564end;
1565
1566procedure TXWBCustomRichEdit.WMSetCursor(var Message: TWMSetCursor);
1567var
1568 P: TPoint;
1569begin
1570 inherited;
1571 if Message.Result = 0 then
1572 begin
1573 Message.Result := 1;
1574 GetCursorPos(P);
1575 with PointToSmallPoint(P) do
1576 case Perform(WM_NCHITTEST, 0, MakeLong(X, Y)) of
1577 HTVSCROLL,
1578 HTHSCROLL:
1579 Windows.SetCursor(Screen.Cursors[crArrow]);
1580 HTCLIENT:
1581 Windows.SetCursor(Screen.Cursors[crIBeam]);
1582 end;
1583 end;
1584end;
1585
1586procedure TXWBCustomRichEdit.CNNotify(var Message: TWMNotify);
1587type
1588 PENLink = ^TENLink;
1589
1590begin
1591 with Message do
1592 case NMHdr^.code of
1593 EN_SELCHANGE: SelectionChange;
1594 EN_REQUESTRESIZE: RequestSize(PReqSize(NMHdr)^.rc);
1595 EN_SAVECLIPBOARD:
1596 with PENSaveClipboard(NMHdr)^ do
1597 if not SaveClipboard(cObjectCount, cch) then Result := 1;
1598 EN_PROTECTED:
1599 with PENProtected(NMHdr)^.chrg do
1600 if not ProtectChange(cpMin, cpMax) then Result := 1;
1601
1602// EN_LINK message being received to respond to it
1603 EN_LINK:
1604 begin
1605 Windows.SetCursor(Screen.Cursors[crHandPoint]);
1606 if PEnLink(NMHdr)^.msg = WM_LBUTTONDOWN then
1607 begin
1608// set the selection
1609 SendMessage(Handle, EM_EXSETSEL, 0, Longint(@PEnLink(NMHdr)^.chrg));
1610// send it to windows to open
1611 ShellExecute(handle, 'open', PChar(GetSelText), nil, nil, SW_SHOWNORMAL);
1612 end;
1613 end;
1614 end;
1615end;
1616
1617function TXWBCustomRichEdit.SaveClipboard(NumObj, NumChars: Integer): Boolean;
1618begin
1619 Result := True;
1620 if Assigned(OnSaveClipboard) then OnSaveClipboard(Self, NumObj, NumChars, Result);
1621end;
1622
1623function TXWBCustomRichEdit.ProtectChange(StartPos, EndPos: Integer): Boolean;
1624begin
1625 Result := False;
1626 if Assigned(OnProtectChange) then OnProtectChange(Self, StartPos, EndPos, Result);
1627end;
1628
1629procedure TXWBCustomRichEdit.SelectionChange;
1630begin
1631 if Assigned(OnSelectionChange) then OnSelectionChange(Self);
1632end;
1633
1634procedure TXWBCustomRichEdit.RequestSize(const Rect: TRect);
1635begin
1636 if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect);
1637end;
1638
1639function TXWBCustomRichEdit.FindText(const SearchStr: string;
1640 StartPos, Length: Integer; Options: TSearchTypes): Integer;
1641var
1642 Find: TFindText;
1643 Flags: Integer;
1644begin
1645 with Find.chrg do
1646 begin
1647 cpMin := StartPos;
1648 cpMax := cpMin + Length;
1649 end;
1650 Flags := 0;
1651 if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD;
1652 if stMatchCase in Options then Flags := Flags or FT_MATCHCASE;
1653 Find.lpstrText := PChar(SearchStr);
1654 Result := SendMessage(Handle, EM_FINDTEXT, Flags, LongInt(@Find));
1655end;
1656
1657procedure AppendConversionFormat(const Ext: string; AClass: TConversionClass);
1658var
1659 NewRec: PConversionFormat;
1660begin
1661 New(NewRec);
1662 with NewRec^ do
1663 begin
1664 Extension := AnsiLowerCaseFileName(Ext);
1665 ConversionClass := AClass;
1666 Next := ConversionFormatList;
1667 end;
1668 ConversionFormatList := NewRec;
1669end;
1670
1671class procedure TXWBCustomRichEdit.RegisterConversionFormat(const AExtension: string;
1672 AConversionClass: TConversionClass);
1673begin
1674 AppendConversionFormat(AExtension, AConversionClass);
1675end;
1676
1677end.
1678
Note: See TracBrowser for help on using the repository browser.