/
RxRichEd.pas
7363 lines (6643 loc) · 231 KB
/
RxRichEd.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) }
{ }
{ Copyright (c) 1998 Master-Bank }
{ }
{ Revision and enhancements added by JB. }
{*******************************************************}
(* ------------------------------------------------------
+ Changes by Daniel Prado Velasco <dprado.keynote@gmail.com> (Spain) [dpv]
+ Changes by Marek Jedlinski <marek@tranglos.com> (Poland) [mj]
>> Changes to original source code available in KeyNote NF project.
>> Fore more information, please see 'README.md' and 'doc/README_SourceCode.txt'
in https://github.com/dpradov/keynote-nf
--------------------- -----------------------------------*)
unit RxRichEd;
{$I RX.INC}
{.$DEFINE RICHEDIT_VER_10}
{$DEFINE RX_ENH} {last enhancement}
{$DEFINE RX_ENHPRINT} {for better print preview}
{$DEFINE RX_LANGUAGE} // [dpv]
{$DEFINE RX_SELECTDLL} // [dpv] Allow to select another DLL available, for example if we have MS Office installed. See notes at the end of GetDLLProductVersion procedure
{$DEFINE GetSetAttributes_PUBLIC} // [dpv]
{$R-}
interface
uses Windows, {$IFDEF RX_D3} ActiveX, ComObj {$ELSE} Ole2, OleAuto {$ENDIF},
CommCtrl, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls,
{$IFDEF RX_D6}Types, {$ENDIF} {$IFDEF RX_D16}System.UITypes,{$ENDIF}
{$IFDEF RX_D18}System.AnsiStrings,{$ENDIF}
Dialogs, RichEdit, Menus, ComCtrls;
type
{$IFNDEF RX_SELECTDLL}
TRichEditVersion = 1..4;
{$ELSE}
TRichEditVersion = 1..8; // [dpv] See notes at the end of GetDLLProductVersion procedure
{$ENDIF}
{ // [dpv] See comment *5
var
list: TStringList;
st1, st2: TMemoryStream;
}
{$IFNDEF RX_D3}
TCharFormat2A = record
cbSize: UINT;
dwMask: DWORD;
dwEffects: DWORD;
yHeight: Longint;
yOffset: Longint;
crTextColor: TColorRef;
bCharSet: Byte;
bPitchAndFamily: Byte;
szFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
{ new fields in version 2.0 }
wWeight: Word; { Font weight (LOGFONT value) }
sSpacing: Smallint; { Amount to space between letters }
crBackColor: TColorRef; { Background color }
lid: LCID; { Locale ID }
dwReserved: DWORD; { Reserved. Must be 0 }
sStyle: Smallint; { Style handle }
wKerning: Word; { Twip size above which to kern char pair }
bUnderlineType: Byte; { Underline type }
bAnimation: Byte; { Animated text like marching ants }
bRevAuthor: Byte; { Revision author index }
bReserved1: Byte;
end;
TCharFormat2 = TCharFormat2A;
TParaFormat2 = record
cbSize: UINT;
dwMask: DWORD;
wNumbering: Word;
wReserved: Word;
dxStartIndent: Longint;
dxRightIndent: Longint;
dxOffset: Longint;
wAlignment: Word;
cTabCount: Smallint;
rgxTabs: array [0..MAX_TAB_STOPS - 1] of Longint;
{ new fields in version 2.0 }
dySpaceBefore: Longint; { Vertical spacing before paragraph }
dySpaceAfter: Longint; { Vertical spacing after paragraph }
dyLineSpacing: Longint; { Line spacing depending on Rule }
sStyle: Smallint; { Style handle }
bLineSpacingRule: Byte; { Rule for line spacing (see tom.doc) }
bCRC: Byte; { Reserved for CRC for rapid searching }
wShadingWeight: Word; { Shading in hundredths of a per cent }
wShadingStyle: Word; { Nibble 0: style, 1: cfpat, 2: cbpat }
wNumberingStart: Word; { Starting value for numbering }
wNumberingStyle: Word; { Alignment, roman/arabic, (), ), ., etc.}
wNumberingTab: Word; { Space bet 1st indent and 1st-line text }
wBorderSpace: Word; { Space between border and text (twips) }
wBorderWidth: Word; { Border pen width (twips) }
wBorders: Word; { Byte 0: bits specify which borders }
{ Nibble 2: border style, 3: color index }
end;
{$ENDIF RX_D3}
{$IFDEF RX_LANGUAGE}
type
TLanguage = 0..$FFFF; // [dpv]
{$ENDIF}
{$IFDEF RX_D5}
TCharFormat2 = TCharFormat2A;
{$ENDIF}
type
TRxCustomRichEdit = class;
{ TRxTextAttributes }
TRxAttributeType = (atDefaultText, atSelected, atWord); // EM_SETCHARFORMAT -> SCF_DEFAULT, SCF_SELECTION, SCF_WORD, ...
TRxConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize,
caStrikeOut, caUnderline, caProtected, caOffset, caHidden, caLink,
caBackColor, caDisabled, caWeight, caSubscript, caRevAuthor,
caLanguage, caIndexKind, caSpacing, caKerning, caULType, caAnimation,
caSmallCaps, caAllCaps, caOutline, caShadow, caEmboss, caImprint, caURL);
TRxConsistentAttributes = set of TRxConsistentAttribute;
TSubscriptStyle = (ssNone, ssSubscript, ssSuperscript);
TUnderlineType = (utNone, utSolid, utWord, utDouble, utDotted, utWave);
TAnimationType = (aniNone, aniLasVegas, aniBlink, aniSparkle, aniBlackAnts,
aniRedAnts, aniShimmer);
TRxLinkStyle = (lsNone, lsLink, lsMixed); // [dpv]
TRxTextAttributes = class(TPersistent)
private
RichEdit: TRxCustomRichEdit;
FType: TRxAttributeType;
procedure AssignFont(Font: TFont);
{$IFNDEF GetSetAttributes_PUBLIC} // [mj]
procedure GetAttributes(var Format: TCharFormat2);
procedure SetAttributes(var Format: TCharFormat2);
{$ENDIF}
{$IFNDEF VER90}
function GetCharset: TFontCharset;
procedure SetCharset(Value: TFontCharset);
{$ENDIF}
function GetSubscriptStyle: TSubscriptStyle;
procedure SetSubscriptStyle(Value: TSubscriptStyle);
function GetBackColor: TColor;
function GetColor: TColor;
function GetConsistentAttributes: TRxConsistentAttributes;
function GetHeight: Integer;
function GetHidden: Boolean;
{$IFDEF RX_LANGUAGE}
function GetLanguage : TLanguage; // [mj]
procedure SetLanguage(Value: TLanguage); // [mj]
{$ENDIF}
function GetDisabled: Boolean;
function GetLink: Boolean;
function GetLinkStyle: TRxLinkStyle; // [dpv]
function GetName: TFontName;
function GetOffset: Integer;
function GetPitch: TFontPitch;
function GetProtected: Boolean;
function GetRevAuthorIndex: Byte;
function GetSize: Integer;
function GetStyle: TFontStyles;
function GetSpacing: Double;
procedure SetSpacing(Value: Double);
function GetKerning: Double;
procedure SetKerning(Value: Double);
function GetUnderlineType: TUnderlineType;
function GetAnimation: TAnimationType;
procedure SetAnimation(Value: TAnimationType);
procedure SetBackColor(Value: TColor);
procedure SetColor(Value: TColor);
procedure SetDisabled(Value: Boolean);
procedure SetHeight(Value: Integer);
procedure SetHidden(Value: Boolean);
procedure SetLink(Value: Boolean);
procedure SetName(Value: TFontName);
procedure SetOffset(Value: Integer);
procedure SetPitch(Value: TFontPitch);
procedure SetProtected(Value: Boolean);
procedure SetRevAuthorIndex(Value: Byte);
procedure SetSize(Value: Integer);
procedure SetStyle(Value: TFontStyles);
procedure SetUnderlineType(Value: TUnderlineType);
function GetSmallCaps: Boolean;
procedure SetSmallCaps(Value: Boolean);
function GetAllCaps: Boolean;
procedure SetAllCaps(Value: Boolean);
function GetOutline: Boolean;
procedure SetOutline(Value: Boolean);
function GetShadow: Boolean;
procedure SetShadow(Value: Boolean);
function GetEmboss: Boolean;
procedure SetEmboss(Value: Boolean);
function GetImprint: Boolean;
procedure SetImprint(Value: Boolean);
protected
procedure InitFormat(var Format: TCharFormat2);
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create(AOwner: TRxCustomRichEdit; AttributeType: TRxAttributeType);
procedure Assign(Source: TPersistent); override;
{$IFDEF GetSetAttributes_PUBLIC} // [mj] -> Public
procedure GetAttributes(var Format: TCharFormat2);
procedure SetAttributes(var Format: TCharFormat2);
{$ENDIF}
{$IFNDEF VER90}
property Charset: TFontCharset read GetCharset write SetCharset;
{$ENDIF}
property BackColor: TColor read GetBackColor write SetBackColor;
property Color: TColor read GetColor write SetColor;
property ConsistentAttributes: TRxConsistentAttributes read GetConsistentAttributes;
property Disabled: Boolean read GetDisabled write SetDisabled;
property Hidden: Boolean read GetHidden write SetHidden;
{$IFDEF RX_LANGUAGE}
{ Language: Has no effect on the text displayed by a rich edit control, but spelling and grammar checkers can use it to deal with language-dependent problems
https://learn.microsoft.com/en-us/windows/win32/api/richedit/ns-richedit-charformat2a_1 (LCID) }
property Language: TLanguage read GetLanguage write SetLanguage; // [mj]
{$ENDIF}
property Link: Boolean read GetLink write SetLink;
property LinkStyle: TRxLinkStyle read GetLinkStyle; // [dpv]
property Name: TFontName read GetName write SetName;
property Offset: Integer read GetOffset write SetOffset;
property Pitch: TFontPitch read GetPitch write SetPitch;
property Protected: Boolean read GetProtected write SetProtected;
property RevAuthorIndex: Byte read GetRevAuthorIndex write SetRevAuthorIndex;
property SubscriptStyle: TSubscriptStyle read GetSubscriptStyle write SetSubscriptStyle;
property Size: Integer read GetSize write SetSize;
property Style: TFontStyles read GetStyle write SetStyle;
property Height: Integer read GetHeight write SetHeight;
property Spacing: Double read GetSpacing write SetSpacing;
property Kerning: Double read GetKerning write SetKerning;
property UnderlineType: TUnderlineType read GetUnderlineType write SetUnderlineType;
property Animation: TAnimationType read GetAnimation write SetAnimation;
property SmallCaps: Boolean read GetSmallCaps write SetSmallCaps;
property AllCaps: Boolean read GetAllCaps write SetAllCaps;
property Outline: Boolean read GetOutline write SetOutline;
property Shadow: Boolean read GetShadow write SetShadow;
property Emboss: Boolean read GetEmboss write SetEmboss;
property Imprint: Boolean read GetImprint write SetImprint;
procedure SetBold(Value: boolean); // [mj]
procedure SetItalic(Value: boolean); // [mj]
procedure SetUnderline(Value: boolean); // [mj]
procedure SetStrikeOut(Value: boolean); // [mj]
end;
{ TRxParaAttributes }
TRxNumbering = (nsNone, nsBullet, nsArabicNumbers, nsLoCaseLetter,
nsUpCaseLetter, nsLoCaseRoman, nsUpCaseRoman);
//TRxNumberingStyle = (nsParenthesis, nsPeriod, nsEnclosed, nsSimple);
TRxNumberingStyle = (nsParenthesis=$0000, nsEnclosed=$0100, nsPeriod=$0200,
nsSimple=$0300, nsNoNumber=$0400, nsNewNumber=$8000); // [dpv] http://msdn.microsoft.com/en-us/library/bb787942%28VS.85%29.aspx
TParaAlignment = (paLeftJustify, paRightJustify, paCenter, paJustify);
TLineSpacingRule = (lsSingle, lsOneAndHalf, lsDouble, lsSpecifiedOrMore,
lsSpecified, lsMultiple);
THeadingStyle = 0..9;
TParaTableStyle = (tsNone, tsTableRow, tsTableCellEnd, tsTableCell);
TRxParaAttributes = class(TPersistent)
private
RichEdit: TRxCustomRichEdit;
{$IFNDEF GetSetAttributes_PUBLIC} // [mj]
procedure GetAttributes(var Paragraph: TParaFormat2);
procedure SetAttributes(var Paragraph: TParaFormat2);
{$ENDIF}
function GetAlignment: TParaAlignment;
function GetFirstIndent: Longint;
function GetHeadingStyle: THeadingStyle;
function GetLeftIndent: Longint;
function GetRightIndent: Longint;
function GetSpaceAfter: Longint;
function GetSpaceBefore: Longint;
function GetLineSpacing: Longint;
function GetLineSpacingRule: TLineSpacingRule;
function GetNumbering: TRxNumbering;
function GetNumberingStyle: TRxNumberingStyle;
function GetNumberingTab: Word;
function GetTab(Index: Byte): Longint;
function GetTabCount: Integer;
function GetTableStyle: TParaTableStyle;
procedure SetAlignment(Value: TParaAlignment);
procedure SetFirstIndent(Value: Longint);
procedure SetFirstIndentRelative(Value: Longint); // [dpv]
procedure SetHeadingStyle(Value: THeadingStyle);
procedure SetLeftIndent(Value: Longint);
procedure SetRightIndent(Value: Longint);
procedure SetSpaceAfter(Value: Longint);
procedure SetSpaceBefore(Value: Longint);
procedure SetLineSpacing(Value: Longint);
procedure SetLineSpacingRule(Value: TLineSpacingRule);
procedure SetNumbering(Value: TRxNumbering);
function GetNumberingStart : integer; // [dpv]
procedure SetNumberingStart( Value : integer ); // [dpv]
procedure SetNumberingStyle(Value: TRxNumberingStyle);
procedure SetNumberingTab(Value: Word);
procedure SetTab(Index: Byte; Value: Longint);
procedure SetTabCount(Value: Integer);
procedure SetTableStyle(Value: TParaTableStyle);
protected
procedure InitPara(var Paragraph: TParaFormat2);
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create(AOwner: TRxCustomRichEdit);
procedure Assign(Source: TPersistent); override;
{$IFDEF GetSetAttributes_PUBLIC} // [mj] -> public
procedure GetAttributes(var Paragraph: TParaFormat2);
procedure SetAttributes(var Paragraph: TParaFormat2);
{$ENDIF}
property Alignment: TParaAlignment read GetAlignment write SetAlignment;
property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
property FirstIndentRelative: Longint write SetFirstIndentRelative; // [dpv]
property HeadingStyle: THeadingStyle read GetHeadingStyle write SetHeadingStyle;
property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
property LineSpacing: Longint read GetLineSpacing write SetLineSpacing;
property LineSpacingRule: TLineSpacingRule read GetLineSpacingRule write SetLineSpacingRule;
property Numbering: TRxNumbering read GetNumbering write SetNumbering;
property NumberingStart : integer read GetNumberingStart write SetNumberingStart; // [dpv]
property NumberingStyle: TRxNumberingStyle read GetNumberingStyle write SetNumberingStyle;
property NumberingTab: Word read GetNumberingTab write SetNumberingTab;
procedure SetNumberingList(numbering: TRxNumbering;
numberingStyle: TRxNumberingStyle;
numberingStart: integer; LeftIndent: integer); // [mj]
property RightIndent: Longint read GetRightIndent write SetRightIndent;
property SpaceAfter: Longint read GetSpaceAfter write SetSpaceAfter;
property SpaceBefore: Longint read GetSpaceBefore write SetSpaceBefore;
property Tab[Index: Byte]: Longint read GetTab write SetTab;
property TabCount: Integer read GetTabCount write SetTabCount;
property TableStyle: TParaTableStyle read GetTableStyle write SetTableStyle;
end;
{ TOEMConversion }
TOEMConversion = class(TConversion)
public
{$IFDEF RX_D12}
function ConvertReadStream(Stream: TStream; Buffer: TConversionBuffer; BufSize: Integer): Integer; override;
function ConvertWriteStream(Stream: TStream; Buffer: TConversionBuffer; BufSize: Integer): Integer; override;
{$ELSE}
function ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
{$ENDIF}
end;
{ TRxCustomRichEdit }
TUndoName = (unUnknown, unTyping, unDelete, unDragDrop, unCut, unPaste);
TRichSearchType = (stWholeWord, stMatchCase, stBackward, stSetSelection);
TRichSearchTypes = set of TRichSearchType;
TRichSelection = (stText, stObject, stMultiChar, stMultiObject);
TRichSelectionType = set of TRichSelection;
TRichLangOption = (rlAutoKeyboard, rlAutoFont, rlImeCancelComplete,
rlImeAlwaysSendNotify);
TRichLangOptions = set of TRichLangOption;
TRichStreamFormat = (sfDefault, sfRichText, sfPlainText);
TRichStreamMode = (smSelection, smPlainRtf, smNoObjects{$IFNDEF RX_D12}, smUnicode{$ENDIF});
TRichStreamModes = set of TRichStreamMode;
TRichEditURLClickEvent = procedure(Sender: TObject; const URLText: string;
Button: TMouseButton) of object;
TRichEditProtectChangeEx = procedure(Sender: TObject; const Message: TMessage;
StartPos, EndPos: Integer; var AllowChange: Boolean) of object;
TRichEditFindErrorEvent = procedure(Sender: TObject; const FindText: string) of object;
TRichEditFileDroppedEvent = procedure( sender : Tobject; FileList : TStringList ) of object; // [dpv]
{$IFDEF RX_D3}
TRichEditFindCloseEvent = procedure(Sender: TObject; Dialog: TFindDialog) of object;
{$ENDIF}
PRichConversionFormat = ^TRichConversionFormat;
TRichConversionFormat = record
ConversionClass: TConversionClass;
Extension: string;
PlainText: Boolean;
Next: PRichConversionFormat;
end;
{$IFDEF RX_D16}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
TRxCustomRichEdit = class(TCustomMemo)
private
{$IFDEF RX_ENHPRINT}
fdrawendpage : boolean;
{$ENDIF RX_ENHPRINT}
FHideScrollBars: Boolean;
FSelectionBar: Boolean;
FAutoURLDetect: Boolean;
FWordSelection: Boolean;
FPlainText: Boolean;
FSelAttributes: TRxTextAttributes;
FDefAttributes: TRxTextAttributes;
FWordAttributes: TRxTextAttributes;
FParagraph: TRxParaAttributes;
FOldParaAlignment: TParaAlignment;
FScreenLogPixels: Integer;
FUndoLimit: Integer;
FRichEditStrings: TStrings;
FMemStream: TMemoryStream;
FHideSelection: Boolean;
FLangOptions: TRichLangOptions;
FModified: Boolean;
FLinesUpdating: Boolean;
FPageRect: TRect;
FClickRange: TCharRange;
FClickBtn: TMouseButton;
FFindDialog: TFindDialog;
FReplaceDialog: TReplaceDialog;
FLastFind: TFindDialog;
FAllowObjects: Boolean;
FCallback: TObject;
FRichEditOle: IUnknown;
FPopupVerbMenu: TPopupMenu;
FTitle: string;
FAutoVerbMenu: Boolean;
{$IFDEF RX_D3}
FAllowInPlace: Boolean;
{$ENDIF}
FDefaultConverter: TConversionClass;
FOnSelChange: TNotifyEvent;
FOnResizeRequest: TRichEditResizeEvent;
FOnProtectChange: TRichEditProtectChange;
FOnProtectChangeEx: TRichEditProtectChangeEx;
FOnSaveClipboard: TRichEditSaveClipboard;
FOnURLClick: TRichEditURLClickEvent;
FOnFileDropped: TRichEditFileDroppedEvent; // [dpv]
FOnTextNotFound: TRichEditFindErrorEvent;
{$IFDEF RX_D3}
FOnCloseFindDialog: TRichEditFindCloseEvent;
{$ENDIF}
FUpdating: integer; // [dpv] For use with BeginUpdate/EndUpdate
FOldEventMask: integer; // [dpv] ,,
function GetAutoURLDetect: Boolean;
function GetWordSelection: Boolean;
function GetLangOptions: TRichLangOptions;
function GetCanRedo: Boolean;
function GetCanPaste: Boolean;
{$IFNDEF RX_V110}
function GetCanUndo: Boolean;
{$ENDIF}
function GetRedoName: TUndoName;
function GetUndoName: TUndoName;
function GetStreamFormat: TRichStreamFormat;
function GetStreamMode: TRichStreamModes;
function GetSelectionType: TRichSelectionType;
procedure PopupVerbClick(Sender: TObject);
procedure ObjectPropsClick(Sender: TObject);
procedure CloseObjects;
procedure UpdateHostNames;
procedure SetAllowObjects(Value: Boolean);
procedure SetOnFileDropped(Value: TRichEditFileDroppedEvent); // [dpv]
procedure SetStreamFormat(Value: TRichStreamFormat);
procedure SetStreamMode(Value: TRichStreamModes);
procedure SetAutoURLDetect(Value: Boolean);
procedure SetWordSelection(Value: Boolean);
procedure SetHideScrollBars(Value: Boolean);
procedure SetHideSelection(Value: Boolean);
procedure SetTitle(const Value: string);
procedure SetLangOptions(Value: TRichLangOptions);
procedure SetRichEditStrings(Value: TStrings);
procedure SetDefAttributes(Value: TRxTextAttributes);
procedure SetSelAttributes(Value: TRxTextAttributes);
procedure SetWordAttributes(Value: TRxTextAttributes);
procedure SetSelectionBar(Value: Boolean);
procedure SetUndoLimit(Value: Integer);
procedure UpdateTextModes(Plain: Boolean);
procedure AdjustFindDialogPosition(Dialog: TFindDialog);
procedure SetupFindDialog(Dialog: TFindDialog; const SearchStr,
ReplaceStr: string);
function FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean;
function GetCanFindNext: Boolean;
procedure FindDialogFind(Sender: TObject);
procedure ReplaceDialogReplace(Sender: TObject);
{$IFDEF RX_D3}
procedure FindDialogClose(Sender: TObject);
procedure SetUIActive(Active: Boolean);
procedure CMDocWindowActivate(var Message: TMessage); message CM_DOCWINDOWACTIVATE;
procedure CMUIDeactivate(var Message: TMessage); message CM_UIDEACTIVATE;
{$ENDIF}
{$IFDEF RX_D4}
procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
{$ENDIF}
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure EMReplaceSel(var Message: TMessage); message EM_REPLACESEL;
procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; // [dpv] See comment *3
{$IFDEF RX_D5}
procedure WMRButtonUp(var Message: TMessage); message WM_RBUTTONUP;
{$ENDIF}
{$IFDEF RX_ENH}
function GetRtfSelText: String;
procedure SetRtfSelText(const sRtf: String);
function GetRtfText: AnsiString; // [dpv]
procedure SetRtfText(const sRtf: AnsiString); // [dpv]
{$ENDIF}
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
function GetPopupMenu: TPopupMenu; override;
procedure TextNotFound(Dialog: TFindDialog); virtual;
procedure RequestSize(const Rect: TRect); virtual;
procedure SelectionChange; dynamic;
function ProtectChange(const Message: TMessage; StartPos,
EndPos: Integer): Boolean; dynamic;
function SaveClipboard(NumObj, NumChars: Integer): Boolean; dynamic;
procedure URLClick(const URLText: string; Button: TMouseButton); dynamic;
{procedure FileDropped(EndDropFiles: TEndDropFiles); dynamic; // [dpv] See comment *3 }
procedure SetPlainText(Value: Boolean); virtual;
{$IFDEF RX_D3}
procedure CloseFindDialog(Dialog: TFindDialog); virtual;
procedure DoSetMaxLength(Value: Integer); override;
function GetSelLength: Integer; override;
function GetSelStart: Integer; override;
function GetSelText: string; override;
procedure SetSelLength(Value: Integer); override;
procedure SetSelStart(Value: Integer); override;
function GetSelVisibleText: string; // [dpv]
function GetVisibleText: string; // [dpv]
property AllowInPlace: Boolean read FAllowInPlace write FAllowInPlace default True;
{$ENDIF}
property AllowObjects: Boolean read FAllowObjects write SetAllowObjects default True;
property AutoURLDetect: Boolean read GetAutoURLDetect write SetAutoURLDetect default True;
property AutoVerbMenu: Boolean read FAutoVerbMenu write FAutoVerbMenu default True;
property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
property HideScrollBars: Boolean read FHideScrollBars
write SetHideScrollBars default True;
property Title: string read FTitle write SetTitle;
property LangOptions: TRichLangOptions read GetLangOptions write SetLangOptions default [rlAutoFont];
property Lines: TStrings read FRichEditStrings write SetRichEditStrings;
property PlainText: Boolean read FPlainText write SetPlainText default False;
property SelectionBar: Boolean read FSelectionBar write SetSelectionBar default True;
property StreamFormat: TRichStreamFormat read GetStreamFormat write SetStreamFormat default sfDefault;
property StreamMode: TRichStreamModes read GetStreamMode write SetStreamMode default [];
property UndoLimit: Integer read FUndoLimit write SetUndoLimit default 100;
property WordSelection: Boolean read GetWordSelection write SetWordSelection default True;
property ScrollBars default ssBoth;
property TabStop default True;
property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard
write FOnSaveClipboard;
property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
property OnProtectChange: TRichEditProtectChange read FOnProtectChange
write FOnProtectChange; { obsolete }
property OnProtectChangeEx: TRichEditProtectChangeEx read FOnProtectChangeEx
write FOnProtectChangeEx;
property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest
write FOnResizeRequest;
property OnURLClick: TRichEditURLClickEvent read FOnURLClick write FOnURLClick;
property OnFileDropped: TRichEditFileDroppedEvent read FOnFileDropped write SetOnFileDropped; // [dpv] See comment *3
property OnTextNotFound: TRichEditFindErrorEvent read FOnTextNotFound write FOnTextNotFound;
{$IFDEF RX_D3}
property OnCloseFindDialog: TRichEditFindCloseEvent read FOnCloseFindDialog
write FOnCloseFindDialog;
{$ENDIF}
public
{$IFDEF RX_ENHPRINT}
PercentDone:byte;
PrnPreviews:TList;
PrnPreview:Tmetafile;
{$ENDIF RX_ENHPRINT}
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Clear; {$IFDEF RX_D3} override; {$ENDIF}
procedure SetSelection(StartPos, EndPos: Longint; ScrollCaret: Boolean);
function GetSelection: TCharRange;
function GetTextRange(StartPos, EndPos: Longint): string;
function LineFromChar(CharIndex: Integer): Integer;
function GetLineIndex(LineNo: Integer): Integer;
function GetLineLength(CharIndex: Integer): Integer;
function GetFirstVisibleLine: Integer; // [dpv]
property SelVisibleText: string read GetSelVisibleText; // [dpv]
property VisibleText: string read GetVisibleText; // [dpv]
function TextLength: integer; // [dpv]
function TextPlain (Selection: boolean= False): string; // [dpv] Alternative to TCumstomEdit.Text (GetText), returning RAWTEXT
procedure AddText(const Str: String); // [dpv]
procedure SetMargins(Left, Right: integer); // [dpv]
function WordAtCursor: string;
function FindText(const SearchStr: string;
StartPos, Length: Integer; Options: TRichSearchTypes): Integer;
function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
{$IFDEF RX_D3} override; {$ENDIF}
function GetCaretPos: TPoint; {$IFDEF RX_V110} override; {$ENDIF}
function GetCharPos(CharIndex: Integer): TPoint;
function GetCharFromPos(Point: TPoint): integer; // [dpv]
procedure ScrollLinesBy(inc: integer); // [dpv]
function InsertObjectDialog: Boolean;
function ObjectPropertiesDialog: Boolean;
//function PasteSpecialDialog: boolean;
function PasteSpecialDialog (PasteImg: boolean= true): integer; // [dpv]
function PasteIRichEditOLE(cfFormat: TClipFormat): Boolean; // [dpv]
function FindDialog(const SearchStr: string): TFindDialog;
function ReplaceDialog(const SearchStr, ReplaceStr: string): TReplaceDialog;
function FindNext: Boolean;
procedure Print(const Caption: string); virtual;
{$IFDEF RX_ENHPRINT}
procedure CreatePrnPrew(const Caption: string); virtual;
{$ENDIF RX_ENHPRINT}
class procedure RegisterConversionFormat(const AExtension: string;
APlainText: Boolean; AConversionClass: TConversionClass);
procedure ClearUndo;
procedure SuspendUndo; // [dpv]
procedure ResumeUndo; // [dpv]
procedure Redo;
procedure StopGroupTyping;
procedure BeginUpdate; // [dpv]
procedure EndUpdate; // [dpv]
property CanFindNext: Boolean read GetCanFindNext;
property CanRedo: Boolean read GetCanRedo;
property CanPaste: Boolean read GetCanPaste;
{$IFNDEF RX_V110}
procedure Undo;
property CanUndo: Boolean read GetCanUndo;
property CaretPos: TPoint read GetCaretPos;
{$ENDIF}
property RedoName: TUndoName read GetRedoName;
property UndoName: TUndoName read GetUndoName;
property DefaultConverter: TConversionClass read FDefaultConverter
write FDefaultConverter;
property DefAttributes: TRxTextAttributes read FDefAttributes write SetDefAttributes;
property SelAttributes: TRxTextAttributes read FSelAttributes write SetSelAttributes;
property WordAttributes: TRxTextAttributes read FWordAttributes write SetWordAttributes;
property PageRect: TRect read FPageRect write FPageRect;
property Paragraph: TRxParaAttributes read FParagraph;
property SelectionType: TRichSelectionType read GetSelectionType;
{$IFDEF RX_ENH}
property LinesUpdating: Boolean read FLinesUpdating write FLinesUpdating; //when assembling a string from pieces so that the selection does not flicker (при сборке строки из кусочков, чтобы не мерцало выделение)
property RtfSelText: String read GetRtfSelText write SetRtfSelText; //selected text in native format (RTF) (выделеный текст в native формате)
property LinkClickRange: TCharRange read FClickRange; //+GetTextRange What was clicked on (на чём кликнули)
property RtfText: AnsiString read GetRtfText write SetRtfText; // [dpv]
procedure PutRtfText (const sRTF: string; const DoInsert: boolean;
const SelectionOnly: boolean = true; const KeepSelected: boolean = false); overload; // [dpv]
procedure PutRtfText (const sRTF: RawByteString; const DoInsert: boolean;
const SelectionOnly: boolean = true; const KeepSelected: boolean = false); overload; // [dpv]
{$ENDIF}
{$IFDEF RX_ENHPRINT}
property DrawEndPage: Boolean read FDrawEndPage write FDrawEndPage;
{$ENDIF RX_ENHPRINT}
end;
{$IFDEF RX_D16}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
TRxRichEdit = class(TRxCustomRichEdit)
published
{$IFDEF RX_ENHPRINT}
property DrawEndPage;
{$ENDIF RX_ENHPRINT}
property Align;
property Alignment;
property AutoURLDetect;
property AutoVerbMenu;
property AllowObjects;
{$IFDEF RX_D3}
property AllowInPlace;
{$ENDIF}
{$IFDEF RX_D4}
property Anchors;
property BiDiMode;
property BorderWidth;
property DragKind;
{$ENDIF}
property BorderStyle;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property HideScrollBars;
property Title;
{$IFNDEF VER90}
property ImeMode;
property ImeName;
{$ENDIF}
{$IFDEF RX_D4}
property Constraints;
property ParentBiDiMode;
{$ENDIF}
property LangOptions;
property Lines;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PlainText;
property PopupMenu;
property ReadOnly;
property ScrollBars;
property SelectionBar;
property ShowHint;
property StreamFormat;
property StreamMode;
property TabOrder;
property TabStop;
property UndoLimit;
property Visible;
property WantTabs;
property WantReturns;
property WordSelection;
property WordWrap;
property OnChange;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
{$IFDEF RX_D5}
property OnContextPopup;
{$ENDIF}
{$IFDEF RX_D4}
property OnEndDock;
property OnStartDock;
{$ENDIF}
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{$IFDEF RX_D4}
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
{$ENDIF}
property OnProtectChange; { obsolete }
property OnProtectChangeEx;
property OnResizeRequest;
property OnSaveClipboard;
property OnSelectionChange;
property OnStartDrag;
property OnTextNotFound;
{$IFDEF RX_D3}
property OnCloseFindDialog;
{$ENDIF}
property OnURLClick;
property OnFileDropped; // [dpv]
end;
{$IFDEF RX_SELECTDLL} // [dpv]
procedure GetDLLProductVersion (out sModulePath: string;
out DLLProductVersion: Single;
out RichEditVersion: TRichEditVersion);
function LoadRichEditDLL(const RichEditLibraryPath: string = ''): TRichEditVersion;
{$ENDIF}
var
RichEditVersion: TRichEditVersion;
implementation
uses
Vcl.Printers, Vcl.ComStrs, Vcl.OleConst, Winapi.OleDlg, {$IFDEF RX_D3} Vcl.OleCtnrs, {$ENDIF}
{$IFDEF RX_D12}Winapi.CommDlg,{$ENDIF}
RxMaxMin,
Vcl.Clipbrd, tom_TLB // [dpv] tom_TLB -> ITextDocument
{$IFDEF RX_ENH}
, gf_strings // [dpv] -> CanSaveAsANSI
{$ENDIF}
, kn_ClipUtils, ShellAPI // [dpv] kn_ClipUtils -> GetDropFiles, ShellAPI -> DragAcceptFiles)
{$IFDEF KNT_DEBUG}
, GFLog, kn_Global // [dpv]
{$ENDIF}
//, IOUtils // [dpv] See comment *5
;
{
// ---------------- gf_strings -> CanSaveAsANSI
function CanSaveAsANSI(const cad: string): boolean;
var
ch: Char;
begin
for ch in cad do
if Ord (ch) >= 256 then begin
Result:= false;
exit;
end;
Result:= true;
end;
// ---------------- tom_TLB -> ITextDocument
-> SuspendUndo, ResumeUndo
// ---------------- kn_ClipUtils -> GetDropFiles
function GetDropFiles(hDrop: THANDLE): TStringList;
var
CFileName : array[0..MAX_PATH] of Char;
FileList : TStringList;
i, count : integer;
begin
FileList := TStringList.Create;
try
count := DragQueryFile( hDrop, $FFFFFFFF, CFileName, MAX_PATH );
if ( count > 0 ) then begin
for i := 0 to count-1 do begin
DragQueryFile( hDrop, i, CFileName, MAX_PATH );
FileList.Add( CFileName );
end;
end;
Result:= FileList;
finally
DragFinish(hDrop);
end;
end;
}
{ *3 NOTES ON USING DRAG AND DROP IN RxRichEdit [dpv]
Using the existing AllowObjects (FAllowObjects) property affects how objects that are dragged into the control are treated, as well as whether
or not inserting objects through the InsertObjectDialog is allowed.
Viewed individually it seems reasonable: if set to True, objects will be allowed to be added by dragging or via InsertObjectDialog,
treating files that can be interpreted as images differently (except for MetaFiles, which always treats them as objects).
Set to False, files that are not interpreted as images (including Metafiles) are ignored and cannot be added to the editor.
But this behavior can get confusing if combined with the result returned by TRichEditOleCallback.QueryAcceptData
When QueryAcceptData = SR_FALSE, insertion of any file is only prevented precisely if FAllowObjects=True
If FAllowObjects=False, regardless of the result of QueryAcceptData, you can drag files (that are interpreted as an image)
* FAllowObjects=True and QueryAcceptData = SR_FALSE
=> Dragging any file (of any type) is not allowed. It also does not allow dragging texts (or anything), neither from outside nor inside the application
=> Yes it is allowed to insert objects through the InsertObjectDialog window
* If DragAcceptFiles(..,true) was called
--> the WM_DROPFILES message will be received. Default handling is allowed (not intercepting it or with a custom handler that calls inherited)
--> All files will be embedded as objects, even if they are of image type.
* FAllowObjects=True and QueryAcceptData = SR_OK
=> It is allowed to drag (or insert with InsertObjectDialog) any type of file, as well as texts, etc., from outside or inside the application
-> image files will be embedded as images, and the rest as objects (the usual behavior until now)
* Even if DragAcceptFiles(..,true) had been called --> the WM_DROPFILES message will NOT be received (nor CN_DROPFILES if we had configured it)
* FAllowObjects=False and QueryAcceptData = SR_OK
=> Allows dragging files that can be converted to images, but does not allow dragging (or InsertObjectDialog) other files (.txt, .wmf, .emf...)
=> Allows you to drag text from other applications (and from the editor itself)
* If DragAcceptFiles was called...
-> The WM_DROPFILES message will only be received for files that are not image files (Those that are image files will be directly embedded as such.)
Even if we allow default processing of WM_DROPFILES the remaining files will be ignored
* FAllowObjects=False and QueryAcceptData = SR_FALSE
=> Same behavior as FAllowObjects=False and QueryAcceptData = SR_OK
=> NOTE: If image files and other non-image files are dragged, they will all be treated as if they were not image files (regarding the treatment
indicated before WM_DROPFILES). Querying DragQueryFile will return all files, whether image or not, and regardless of whether FAllowObjects
is True or False
----
We want to allow the Host application of this control to decide how to manage the dragged files, through a new
event: OnFileDropped. That event will return a list with the names of all the files dragged into the editor.
The objective is, for example, to allow the insertion of dragged image files to be done in a controlled manner, processing
the images to be inserted as appropriate, and making the necessary format conversions.
Obtaining the list of names has been obtained through calls to calls to DragQueryFile, using the handler received in
the WM_DROPFILES event.
In order to receive that message we need to have previously enabled it by calling DragAcceptFiles(Handle, True)
(In principle it would also have been possible to obtain that list directly from the received IDataObject object
TRichEditOleCallback.QueryAcceptData or using the IDropTarget interface (Winapi.ActiveX unit)
https://stackoverflow.com/questions/21245887/retrieving-filename-from-idataobject-in-delphi
https://www.freepascal.org/~michael/articles/dragdrop3/dragdrop3.pdf
)
Not calling DragAcceptFiles(Handle, True) means that the WM_DROPFILES event will not be raised and there will be no option to allow default handling.
But it can be seen that even if that message is enabled, it will only be received in certain situations (see above).
In any case, even if the RxRichEdit control receives the WM_DROPFILES message it will not call the handler by default, and will only call OnFileDropped
when (logically) it is assigned to the application's interest in controlling it.
We'll assume that if the application offers a handler for our OnFileDropped event, it will want to be able to handle all files
that are dragged, regardless of whether they can be converted to an image or not.
Therefore, we will take into account whether a handler has been defined for OnFileDropped:
- NOT assigned(OnFileDropped) -> QueryAcceptData = SR_OK. We will leave the operation described as established for FAllowObjects
-> The behavior will be as expected: the images will be embedded. And objects will be allowed based on FAllowObjects
- assigned(OnFileDropped)
-> QueryAcceptData: SR_FALSE if files have been dragged, SR_OK otherwise.
-> FAllowObjects will always be treated as True, regardless of what is set by the user.
------------------
We will not use EN_DROPFILES. WM_DROPFILES is enough for us. The TEndDropFiles parameter of the EN_DROPFILES notification gives us more information
than the TWMDropFiles parameter of WM_DROPFILES (such as the position at which it would be inserted and whether it is text with the protected flag),
But it is information that we can easily find out if we need it, and also, to receive the notification we must call the handler
default of WM_DROPFILES, which does not interest us.
-> We will not use the FileDropped(EndDropFiles: TEndDropFiles);
---------------
Note: We could also receive the WM_DROPFILES and CN_DROPFILES events if we set the ES_NOOLEDRAGDROP style
(Disables support for dragging and dropping OLE objects.) during control creation, but we are not interested in this.
At the very least, this would make it difficult to simply select an inserted object (even if you inserted it via code, using RTF code).
From Create it's done, at the end, FCallback := TRichEditOleCallback.Create(Self);
If RevokeDragDrop(Handle) were subsequently called -> unregister default IDropTarget interface of Rich Edit
and we would also receive the WM_DROPFILES and CN_DROPFILES events, but we would lose all functionality
from that interface, so we could not, among other things, drag text from another application, e.g.
(would receive those events if DragMode=dmAutomatic or if it was dmManual and BeginDrag... is called)
-------------------
References:
https://www.freepascal.org/~michael/articles/dragdrop2/dragdrop2.pdf (y dragdrop.pdf, dragdrop3.pdf)
CF_HDROP This data format signifies existing files in the system
https://www.freepascal.org/~michael/articles/dragdrop/dragdrop.pdf
https://www.freepascal.org/~michael/articles/dragdrop3/dragdrop3.pdf
https://stackoverflow.com/questions/21245887/retrieving-filename-from-idataobject-in-delphi
Shell Clipboard Formats - Win32 apps | Microsoft Learn
https://learn.microsoft.com/en-us/windows/win32/shell/clipboard?redirectedfrom=MSDN
Standard clipboard format identifiers have the form CF_XXX. A common example is CF_TEXT, which is used for transferring ANSI text data.
These identifiers have predefined values and can be used directly with FORMATETC structures. With the exception of CF_HDROP, Shell format
identifiers are not predefined. With the exception of DragWindow, they have the form CFSTR_XXX. To differentiate these values from predefined
formats, they are often referred to as simply formats. However, unlike predefined formats, they must be registered by both source and target
before they can be used to transfer data. To register a Shell format, include the Shlobj.h header file and pass the CFSTR_XXX format identifier
to RegisterClipboardFormat. This function returns a valid clipboard format value, which can then be used as the cfFormat member of a FORMATETC structure.
----------
*4 OnStartDrag, OnEndDrag, called from TRichEditOleCallback.QueryAcceptData.
It is not a clean solution, but it works for our needs. Events are not firing exactly when they should
(at least OnEndDrag) and we are not providing all the parameters to the handler.
If we did DragMode := dmManual then we could use the events OnStartDrag and OnEndDrag of RichEdit, but would
lose the behaviour of TRichEditOleCallback, configured as described above
}
const
RTFConversionFormat: TRichConversionFormat = (
ConversionClass: TConversion;
Extension: 'rtf';
PlainText: False;
Next: nil);
TextConversionFormat: TRichConversionFormat = (
ConversionClass: TConversion;
Extension: 'txt';
PlainText: True;
Next: @RTFConversionFormat);
var
ConversionFormatList: PRichConversionFormat = @TextConversionFormat;
const
RichEdit10ModuleName = 'RICHED32.DLL';
RichEdit20ModuleName = 'RICHED20.DLL';
RichEdit41ModuleName = 'MSFTEDIT.DLL';
{$IFNDEF RX_D3}
RICHEDIT_CLASSA = 'RichEdit20A'; { Richedit 2.0 Window Class }
RICHEDIT_CLASSW = 'RichEdit20W'; { Richedit 2.0 Unicode }
RICHEDIT_CLASS10A = 'RICHEDIT'; { Richedit 1.0 }
RICHEDIT_CLASS = RICHEDIT_CLASSA;
{$ENDIF}
MSFTEDIT_CLASS = 'RichEdit50W'; //comes with RichEdit 4.1 (beginning in Win XP SP2)
RICHEDIT_CLASS50W = 'RichEdit50W'; // [dpv]
RICHEDIT_CLASS60W = 'RichEdit60W'; // [dpv]
{$IFNDEF RX_D3}
const
EM_SETUNDOLIMIT = WM_USER + 82;
EM_REDO = WM_USER + 84;
EM_CANREDO = WM_USER + 85;
EM_GETUNDONAME = WM_USER + 86;
EM_GETREDONAME = WM_USER + 87;
EM_STOPGROUPTYPING = WM_USER + 88;
EM_SETTEXTMODE = WM_USER + 89;
EM_GETTEXTMODE = WM_USER + 90;