Delphi控件源码

开发平台：

Delphi

RxRichEd.pas：源码内容

Frame := FFrameForm;
Doc := FDocForm;
CreateAccelTable;
with lpFrameInfo^ do begin
fMDIApp := False;
FFrameForm.GetWindow(hWndFrame);
hAccel := FAccelTable;
cAccelEntries := FAccelCount;
end;
Result := S_OK;
end
else Result := E_NOTIMPL;
{$ELSE}
Result := E_NOTIMPL;
{$ENDIF}
end;
function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
cp: Longint): HResult;
begin
Result := NOERROR;
end;
function TRichEditOleCallback.DeleteObject(const oleobj: IOleObject): HResult;
begin
if Assigned(oleobj) then oleobj.Close(OLECLOSE_NOSAVE);
Result := NOERROR;
end;
function TRichEditOleCallback.QueryAcceptData(const dataobj: IDataObject;
var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
hMetaPict: HGLOBAL): HResult;
begin
Result := S_OK;
end;
function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result := NOERROR;
end;
function TRichEditOleCallback.GetClipboardData(const chrg: TCharRange; reco: DWORD;
{$IFDEF RX_D3} out {$ELSE} var {$ENDIF} dataobj: IDataObject): HResult;
begin
Result := E_NOTIMPL;
end;
function TRichEditOleCallback.GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
var dwEffect: DWORD): HResult;
begin
Result := E_NOTIMPL;
end;
function TRichEditOleCallback.GetContextMenu(seltype: Word;
const oleobj: IOleObject; const chrg: TCharRange;
{$IFDEF RX_D3} out {$ELSE} var {$ENDIF} menu: HMENU): HResult;
begin
Result := E_NOTIMPL;
end;
function TRichEditOleCallback.ShowContainerUI(fShow: BOOL): HResult;
begin
{$IFDEF RX_D3}
if not fShow then AssignFrame;
if Assigned(FFrameForm) then begin
if fShow then begin
FFrameForm.SetMenu(0, 0, 0);
FFrameForm.ClearBorderSpace;
FRichEdit.SetUIActive(False);
DestroyAccelTable;
{$IFDEF RX_D4}
TForm(FFrameForm.Form).AutoScroll := FAutoScroll;
{$ENDIF}
FFrameForm := nil;
FDocForm := nil;
end
else begin
{$IFDEF RX_D4}
FAutoScroll := TForm(FFrameForm.Form).AutoScroll;
TForm(FFrameForm.Form).AutoScroll := False;
{$ENDIF}
FRichEdit.SetUIActive(True);
end;
Result := S_OK;
end
else Result := E_NOTIMPL;
{$ELSE}
Result := E_NOTIMPL;
{$ENDIF}
end;
{ TOleUIObjInfo - helper interface for Object Properties dialog }
type
{$IFDEF RX_D3}
TOleUIObjInfo = class(TInterfacedObject, IOleUIObjInfo)
{$ELSE}
TOleUIObjInfo = class(IOleUIObjInfo)
{$ENDIF}
private
FRichEdit: TRxCustomRichEdit;
FReObject: TReObject;
public
constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject);
{$IFNDEF RX_D3}
function QueryInterface(const iid: TIID; var obj): HResult; override;
function AddRef: Longint; override;
function Release: Longint; override;
{$ENDIF}
function GetObjectInfo(dwObject: Longint;
var dwObjSize: Longint; var lpszLabel: PChar;
var lpszType: PChar; var lpszShortType: PChar;
var lpszLocation: PChar): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function GetConvertInfo(dwObject: Longint; var ClassID: TCLSID;
var wFormat: Word; var ConvertDefaultClassID: TCLSID;
var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function ConvertObject(dwObject: Longint;
const clsidNew: TCLSID): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal;
var dvAspect: Longint; var nCurrentScale: Integer): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function SetViewInfo(dwObject: Longint; hMetaPict: HGlobal;
dvAspect: Longint; nCurrentScale: Integer;
bRelativeToOrig: BOOL): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
end;
constructor TOleUIObjInfo.Create(RichEdit: TRxCustomRichEdit;
ReObject: TReObject);
begin
inherited Create;
FRichEdit := RichEdit;
FReObject := ReObject;
end;
{$IFNDEF RX_D3}
function TOleUIObjInfo.QueryInterface(const iid: TIID; var obj): HResult;
begin
Pointer(obj) := nil;
Result := E_NOINTERFACE;
end;
function TOleUIObjInfo.AddRef: Longint;
begin
Result := 0;
end;
function TOleUIObjInfo.Release: Longint;
begin
Result := 0;
end;
{$ENDIF RX_D3}
function TOleUIObjInfo.GetObjectInfo(dwObject: Longint;
var dwObjSize: Longint; var lpszLabel: PChar;
var lpszType: PChar; var lpszShortType: PChar;
var lpszLocation: PChar): HResult;
begin
if @dwObjSize <> nil then
dwObjSize := -1 { Unknown size };
if @lpszLabel <> nil then
lpszLabel := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
if @lpszType <> nil then
lpszType := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
if @lpszShortType <> nil then
lpszShortType := CoAllocCStr(GetShortNameStr(FReObject.poleobj));
if (@lpszLocation <> nil) then begin
if Trim(FRichEdit.Title) <> '' then
lpszLocation := CoAllocCStr(Format('%s - %s',
[FRichEdit.Title, Application.Title]))
else
lpszLocation := CoAllocCStr(Application.Title);
end;
Result := S_OK;
end;
function TOleUIObjInfo.GetConvertInfo(dwObject: Longint; var ClassID: TCLSID;
var wFormat: Word; var ConvertDefaultClassID: TCLSID;
var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult;
begin
FReObject.poleobj.GetUserClassID(ClassID);
Result := S_OK;
end;
function TOleUIObjInfo.ConvertObject(dwObject: Longint;
const clsidNew: TCLSID): HResult;
begin
Result := E_NOTIMPL;
end;
function TOleUIObjInfo.GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal;
var dvAspect: Longint; var nCurrentScale: Integer): HResult;
begin
if @hMetaPict <> nil then
hMetaPict := GetIconMetaPict(FReObject.poleobj, FReObject.dvAspect);
if @dvAspect <> nil then dvAspect := FReObject.dvAspect;
if @nCurrentScale <> nil then nCurrentScale := 0;
Result := S_OK;
end;
function TOleUIObjInfo.SetViewInfo(dwObject: Longint; hMetaPict: HGlobal;
dvAspect: Longint; nCurrentScale: Integer;
bRelativeToOrig: BOOL): HResult;
var
Iconic: Boolean;
begin
if Assigned(FRichEdit.FRichEditOle) then begin
case dvAspect of
DVASPECT_CONTENT:
Iconic := False;
DVASPECT_ICON:
Iconic := True;
else
Iconic := FReObject.dvAspect = DVASPECT_ICON;
end;
IRichEditOle(FRichEdit.FRichEditOle).InPlaceDeactivate;
Result := OleSetDrawAspect(FReObject.poleobj, Iconic, hMetaPict,
FReObject.dvAspect);
if Succeeded(Result) then
IRichEditOle(FRichEdit.FRichEditOle).SetDvaspect(
Longint(REO_IOB_SELECTION), FReObject.dvAspect);
end
else Result := E_NOTIMPL;
end;
{ TOleUILinkInfo - helper interface for Object Properties dialog }
type
{$IFDEF RX_D3}
TOleUILinkInfo = class(TInterfacedObject, IOleUILinkInfo)
{$ELSE}
TOleUILinkInfo = class(IOleUILinkInfo)
{$ENDIF}
private
FReObject: TReObject;
FRichEdit: TRxCustomRichEdit;
FOleLink: IOleLink;
public
constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject);
{$IFNDEF RX_D3}
destructor Destroy; override;
function QueryInterface(const iid: TIID; var obj): HResult; override;
function AddRef: Longint; override;
function Release: Longint; override;
{$ENDIF}
function GetNextLink(dwLink: Longint): Longint;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function SetLinkUpdateOptions(dwLink: Longint;
dwUpdateOpt: Longint): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function GetLinkUpdateOptions(dwLink: Longint;
var dwUpdateOpt: Longint): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function SetLinkSource(dwLink: Longint; pszDisplayName: PChar;
lenFileName: Longint; var chEaten: Longint;
fValidateSource: BOOL): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function GetLinkSource(dwLink: Longint; var pszDisplayName: PChar;
var lenFileName: Longint; var pszFullLinkType: PChar;
var pszShortLinkType: PChar; var fSourceAvailable: BOOL;
var fIsSelected: BOOL): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function OpenLinkSource(dwLink: Longint): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function UpdateLink(dwLink: Longint; fErrorMessage: BOOL;
fErrorAction: BOOL): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function CancelLink(dwLink: Longint): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
function GetLastUpdate(dwLink: Longint;
var LastUpdate: TFileTime): HResult;
{$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
end;
{$IFDEF RX_D3}
procedure LinkError(const Ident: string);
begin
Application.MessageBox(PChar(Ident), PChar(SLinkProperties),
MB_OK or MB_ICONSTOP);
end;
{$ELSE}
procedure LinkError(Ident: Integer);
begin
Application.MessageBox(PChar(LoadStr(Ident)),
PChar(LoadStr(SLinkProperties)), MB_OK or MB_ICONSTOP);
end;
{$ENDIF}
constructor TOleUILinkInfo.Create(RichEdit: TRxCustomRichEdit;
ReObject: TReObject);
begin
inherited Create;
FReObject := ReObject;
FRichEdit := RichEdit;
{$IFDEF RX_D3}
OleCheck(FReObject.poleobj.QueryInterface(IOleLink, FOleLink));
{$ELSE}
OleCheck(FReObject.poleobj.QueryInterface(IID_IOleLink, FOleLink));
{$ENDIF}
end;
{$IFNDEF RX_D3}
destructor TOleUILinkInfo.Destroy;
begin
ReleaseObject(FOleLink);
inherited Destroy;
end;
function TOleUILinkInfo.QueryInterface(const iid: TIID; var obj): HResult;
begin
Pointer(obj) := nil;
Result := E_NOINTERFACE;
end;
function TOleUILinkInfo.AddRef: Longint;
begin
Result := 0;
end;
function TOleUILinkInfo.Release: Longint;
begin
Result := 0;
end;
{$ENDIF}
function TOleUILinkInfo.GetNextLink(dwLink: Longint): Longint;
begin
if dwLink = 0 then Result := Longint(FRichEdit)
else Result := 0;
end;
function TOleUILinkInfo.SetLinkUpdateOptions(dwLink: Longint;
dwUpdateOpt: Longint): HResult;
begin
Result := FOleLink.SetUpdateOptions(dwUpdateOpt);
if Succeeded(Result) then FRichEdit.Modified := True;
end;
function TOleUILinkInfo.GetLinkUpdateOptions(dwLink: Longint;
var dwUpdateOpt: Longint): HResult;
begin
Result := FOleLink.GetUpdateOptions(dwUpdateOpt);
end;
function TOleUILinkInfo.SetLinkSource(dwLink: Longint; pszDisplayName: PChar;
lenFileName: Longint; var chEaten: Longint;
fValidateSource: BOOL): HResult;
var
DisplayName: string;
Buffer: array[0..255] of WideChar;
begin
Result := E_FAIL;
if fValidateSource then begin
DisplayName := pszDisplayName;
if Succeeded(FOleLink.SetSourceDisplayName(StringToWideChar(DisplayName,
Buffer, SizeOf(Buffer) div 2))) then
begin
chEaten := Length(DisplayName);
try
OleCheck(FReObject.poleobj.Update);
except
Application.HandleException(FRichEdit);
end;
Result := S_OK;
end;
end
else LinkError(SInvalidLinkSource);
end;
function TOleUILinkInfo.GetLinkSource(dwLink: Longint; var pszDisplayName: PChar;
var lenFileName: Longint; var pszFullLinkType: PChar;
var pszShortLinkType: PChar; var fSourceAvailable: BOOL;
var fIsSelected: BOOL): HResult;
var
Moniker: IMoniker;
begin
if @pszDisplayName <> nil then
pszDisplayName := CoAllocCStr(GetDisplayNameStr(FOleLink));
if @lenFileName <> nil then begin
lenFileName := 0;
FOleLink.GetSourceMoniker(Moniker);
if Moniker <> nil then begin
lenFileName := OleStdGetLenFilePrefixOfMoniker(Moniker);
ReleaseObject(Moniker);
end;
end;
if @pszFullLinkType <> nil then
pszFullLinkType := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
if @pszShortLinkType <> nil then
pszShortLinkType := CoAllocCStr(GetShortNameStr(FReObject.poleobj));
Result := S_OK;
end;
function TOleUILinkInfo.OpenLinkSource(dwLink: Longint): HResult;
begin
try
OleCheck(FReObject.poleobj.DoVerb(OLEIVERB_SHOW, nil, FReObject.polesite,
0, FRichEdit.Handle, FRichEdit.ClientRect));
except
Application.HandleException(FRichEdit);
end;
Result := S_OK;
end;
function TOleUILinkInfo.UpdateLink(dwLink: Longint; fErrorMessage: BOOL;
fErrorAction: BOOL): HResult;
begin
try
OleCheck(FReObject.poleobj.Update);
except
Application.HandleException(FRichEdit);
end;
Result := S_OK;
end;
function TOleUILinkInfo.CancelLink(dwLink: Longint): HResult;
begin
LinkError(SCannotBreakLink);
Result := E_NOTIMPL;
end;
function TOleUILinkInfo.GetLastUpdate(dwLink: Longint;
var LastUpdate: TFileTime): HResult;
begin
Result := S_OK;
end;
{ Get RichEdit OLE interface }
function GetRichEditOle(Wnd: HWnd; var RichEditOle): Boolean;
begin
Result := SendMessage(Wnd, EM_GETOLEINTERFACE, 0, Longint(@RichEditOle)) <> 0;
end;
{ TRichEditStrings }
const
ReadError = $0001;
WriteError = $0002;
NoError = $0000;
type
TRichEditStrings = class(TStrings)
private
RichEdit: TRxCustomRichEdit;
FFormat: TRichStreamFormat;
FMode: TRichStreamModes;
FConverter: TConversion;
procedure EnableChange(const Value: Boolean);
protected
function Get(Index: Integer): string; override;
function GetCount: Integer; override;
procedure Put(Index: Integer; const S: string); override;
procedure SetUpdateState(Updating: Boolean); override;
procedure SetTextStr(const Value: string); override;
public
destructor Destroy; override;
procedure Clear; override;
procedure AddStrings(Strings: TStrings); override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: string); override;
procedure LoadFromFile(const FileName: string); override;
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToFile(const FileName: string); override;
procedure SaveToStream(Stream: TStream); override;
property Format: TRichStreamFormat read FFormat write FFormat;
property Mode: TRichStreamModes read FMode write FMode;
end;
destructor TRichEditStrings.Destroy;
begin
FConverter.Free;
inherited Destroy;
end;
procedure TRichEditStrings.AddStrings(Strings: TStrings);
var
SelChange: TNotifyEvent;
begin
SelChange := RichEdit.OnSelectionChange;
RichEdit.OnSelectionChange := nil;
try
inherited AddStrings(Strings);
finally
RichEdit.OnSelectionChange := SelChange;
end;
end;
function TRichEditStrings.GetCount: Integer;
begin
with RichEdit do begin
Result := SendMessage(Handle, EM_GETLINECOUNT, 0, 0);
if GetLineLength(GetLineIndex(Result - 1)) = 0 then Dec(Result);
end;
end;
function TRichEditStrings.Get(Index: Integer): string;
var
Text: array[0..4095] of Char;
L: Integer;
begin
Word((@Text)^) := SizeOf(Text);
L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2)
else if (RichEditVersion >= 2) and (Text[L - 1] = #13) then Dec(L);
SetString(Result, Text, L);
end;
procedure TRichEditStrings.Put(Index: Integer; const S: string);
var
Selection: TCharRange;
begin
if Index >= 0 then
begin
Selection.cpMin := RichEdit.GetLineIndex(Index);
if Selection.cpMin <> -1 then begin
Selection.cpMax := Selection.cpMin +
RichEdit.GetLineLength(Selection.cpMin);
SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
RichEdit.FLinesUpdating := True;
try
SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
finally
RichEdit.FLinesUpdating := False;
end;
end;
end;
end;
procedure TRichEditStrings.Insert(Index: Integer; const S: string);
var
L: Integer;
Selection: TCharRange;
Fmt: PChar;
Str: string;
begin
if Index >= 0 then begin
Selection.cpMin := RichEdit.GetLineIndex(Index);
if Selection.cpMin >= 0 then begin
if RichEditVersion = 1 then Fmt := '%s'#13#10
else Fmt := '%s'#13;
end
else begin
Selection.cpMin := RichEdit.GetLineIndex(Index - 1);
if Selection.cpMin < 0 then Exit;
L := RichEdit.GetLineLength(Selection.cpMin);
if L = 0 then Exit;
Inc(Selection.cpMin, L);
if RichEditVersion = 1 then Fmt := #13#10'%s'
else Fmt := #13'%s';
end;
Selection.cpMax := Selection.cpMin;
SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
Str := SysUtils.Format(Fmt, [S]);
RichEdit.FLinesUpdating := True;
try
SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(Str)));
finally
RichEdit.FLinesUpdating := False;
end;
if RichEditVersion = 1 then
if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then
raise EOutOfResources.Create(ResStr(sRichEditInsertError));
end;
end;
procedure TRichEditStrings.Delete(Index: Integer);
const
Empty: PChar = '';
var
Selection: TCharRange;
begin
if Index < 0 then Exit;
Selection.cpMin := RichEdit.GetLineIndex(Index);
if Selection.cpMin <> -1 then begin
Selection.cpMax := RichEdit.GetLineIndex(Index + 1);
if Selection.cpMax = -1 then
Selection.cpMax := Selection.cpMin +
RichEdit.GetLineLength(Selection.cpMin);
SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
RichEdit.FLinesUpdating := True;
try
SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
finally
RichEdit.FLinesUpdating := False;
end;
end;
end;
procedure TRichEditStrings.Clear;
begin
RichEdit.Clear;
end;
procedure TRichEditStrings.SetUpdateState(Updating: Boolean);
begin
if RichEdit.Showing then
SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
if not Updating then begin
RichEdit.Refresh;
RichEdit.Perform(CM_TEXTCHANGED, 0, 0);
end;
end;
procedure TRichEditStrings.EnableChange(const Value: Boolean);
var
EventMask: Longint;
begin
with RichEdit do begin
EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
if Value then
EventMask := EventMask or ENM_CHANGE
else
EventMask := EventMask and not ENM_CHANGE;
SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
end;
end;
procedure TRichEditStrings.SetTextStr(const Value: string);
begin
EnableChange(False);
try
inherited SetTextStr(Value);
finally
EnableChange(True);
end;
end;
function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
asm
PUSH ESI
PUSH EDI
MOV EDI,EAX
MOV ESI,EDX
MOV EDX,EAX
CLD
@@1: LODSB
@@2: OR AL,AL
JE @@4
CMP AL,0AH
JE @@3
STOSB
CMP AL,0DH
JNE @@1
MOV AL,0AH
STOSB
LODSB
CMP AL,0AH
JE @@1
JMP @@2
@@3: MOV EAX,0A0DH
STOSW
JMP @@1
@@4: STOSB
LEA EAX,[EDI-1]
SUB EAX,EDX
POP EDI
POP ESI
end;
function StreamSave(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
StreamInfo: PRichEditStreamInfo;
begin
Result := NoError;
StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
try
pcb := 0;
if StreamInfo^.Converter <> nil then
pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb);
except
Result := WriteError;
end;
end;
function StreamLoad(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
Buffer, pBuff: PChar;
StreamInfo: PRichEditStreamInfo;
begin
Result := NoError;
StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
Buffer := StrAlloc(cb + 1);
try
cb := cb div 2;
pcb := 0;
pBuff := Buffer + cb;
try
if StreamInfo^.Converter <> nil then
pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
if pcb > 0 then
begin
pBuff[pcb] := #0;
if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
pcb := AdjustLineBreaks(Buffer, pBuff);
Move(Buffer^, pbBuff^, pcb);
end;
except
Result := ReadError;
end;
finally
StrDispose(Buffer);
end;
end;
procedure TRichEditStrings.LoadFromStream(Stream: TStream);
var
EditStream: TEditStream;
Position: Longint;
TextType: Longint;
StreamInfo: TRichEditStreamInfo;
Converter: TConversion;
begin
StreamInfo.Stream := Stream;
if FConverter <> nil then Converter := FConverter
else Converter := RichEdit.DefaultConverter.Create;
StreamInfo.Converter := Converter;
try
with EditStream do
begin
dwCookie := Longint(Pointer(@StreamInfo));
pfnCallBack := @StreamLoad;
dwError := 0;
end;
Position := Stream.Position;
case FFormat of
sfDefault:
if RichEdit.PlainText then TextType := SF_TEXT
else TextType := SF_RTF;
sfRichText: TextType := SF_RTF;
else {sfPlainText} TextType := SF_TEXT;
end;
if TextType = SF_RTF then begin
if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF;
end;
if TextType = SF_TEXT then begin
if (smUnicode in Mode) and (RichEditVersion > 1) then
TextType := TextType or SF_UNICODE;
end;
if smSelection in Mode then TextType := TextType or SFF_SELECTION;
SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
if (EditStream.dwError <> 0) then begin
Stream.Position := Position;
if (TextType and SF_RTF = SF_RTF) then TextType := SF_TEXT
else TextType := SF_RTF;
SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
if EditStream.dwError <> 0 then
raise EOutOfResources.Create(ResStr(sRichEditLoadFail));
end;
RichEdit.SetSelection(0, 0, True);
finally
if FConverter = nil then Converter.Free;
end;
end;
procedure TRichEditStrings.SaveToStream(Stream: TStream);
var
EditStream: TEditStream;
TextType: Longint;
StreamInfo: TRichEditStreamInfo;
Converter: TConversion;
begin
if FConverter <> nil then Converter := FConverter
else Converter := RichEdit.DefaultConverter.Create;
StreamInfo.Stream := Stream;
StreamInfo.Converter := Converter;
try
with EditStream do
begin
dwCookie := Longint(Pointer(@StreamInfo));
pfnCallBack := @StreamSave;
dwError := 0;
end;
case FFormat of
sfDefault:
if RichEdit.PlainText then TextType := SF_TEXT
else TextType := SF_RTF;
sfRichText: TextType := SF_RTF;
else {sfPlainText} TextType := SF_TEXT;
end;
if TextType = SF_RTF then begin
if smNoObjects in Mode then TextType := SF_RTFNOOBJS;
if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF;
end
else if TextType = SF_TEXT then begin
if (smUnicode in Mode) and (RichEditVersion > 1) then
TextType := TextType or SF_UNICODE;
end;
if smSelection in Mode then TextType := TextType or SFF_SELECTION;
SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
if EditStream.dwError <> 0 then
raise EOutOfResources.Create(ResStr(sRichEditSaveFail));
finally
if FConverter = nil then Converter.Free;
end;
end;
procedure TRichEditStrings.LoadFromFile(const FileName: string);
var
Ext: string;
Convert: PRichConversionFormat;
SaveFormat: TRichStreamFormat;
begin
{$IFNDEF VER90}
Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
{$ELSE}
Ext := LowerCase(ExtractFileExt(Filename));
{$ENDIF}
System.Delete(Ext, 1, 1);
Convert := ConversionFormatList;
while Convert <> nil do
with Convert^ do
if Extension <> Ext then Convert := Next
else Break;
if (FConverter = nil) and (Convert <> nil) then
FConverter := Convert^.ConversionClass.Create;
try
SaveFormat := Format;
try
if Convert <> nil then begin
if Convert^.PlainText then FFormat := sfPlainText
else FFormat := sfRichText;
end;
inherited LoadFromFile(FileName);
finally
FFormat := SaveFormat;
end;
except
FConverter.Free;
FConverter := nil;
raise;
end;
end;
procedure TRichEditStrings.SaveToFile(const FileName: string);
var
Ext: string;
Convert: PRichConversionFormat;
SaveFormat: TRichStreamFormat;
begin
{$IFNDEF VER90}
Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
{$ELSE}
Ext := LowerCase(ExtractFileExt(Filename));
{$ENDIF}
System.Delete(Ext, 1, 1);
Convert := ConversionFormatList;
while Convert <> nil do
with Convert^ do
if Extension <> Ext then Convert := Next
else Break;
if (FConverter = nil) and (Convert <> nil) then
FConverter := Convert^.ConversionClass.Create;
try
SaveFormat := Format;
try
if Convert <> nil then begin
if Convert^.PlainText then FFormat := sfPlainText
else FFormat := sfRichText;
end;
inherited SaveToFile(FileName);
finally
FFormat := SaveFormat;
end;
except
FConverter.Free;
FConverter := nil;
raise;
end;
end;
{ TOEMConversion }
function TOEMConversion.ConvertReadStream(Stream: TStream; Buffer: PChar;
BufSize: Integer): Integer;
var
Mem: TMemoryStream;
begin
Mem := TMemoryStream.Create;
try
Mem.SetSize(BufSize);
Result := inherited ConvertReadStream(Stream, PChar(Mem.Memory), BufSize);
OemToCharBuff(PChar(Mem.Memory), Buffer, Result);
finally
Mem.Free;
end;
end;
function TOEMConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar;
BufSize: Integer): Integer;
var
Mem: TMemoryStream;
begin
Mem := TMemoryStream.Create;
try
Mem.SetSize(BufSize);
CharToOemBuff(Buffer, PChar(Mem.Memory), BufSize);
Result := inherited ConvertWriteStream(Stream, PChar(Mem.Memory), BufSize);
finally
Mem.Free;
end;
end;
{ TRxCustomRichEdit }
constructor TRxCustomRichEdit.Create(AOwner: TComponent);
var
DC: HDC;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csSetCaption];
FSelAttributes := TRxTextAttributes.Create(Self, atSelected);
FDefAttributes := TRxTextAttributes.Create(Self, atDefaultText);
FWordAttributes := TRxTextAttributes.Create(Self, atWord);
FParagraph := TRxParaAttributes.Create(Self);
FRichEditStrings := TRichEditStrings.Create;
TRichEditStrings(FRichEditStrings).RichEdit := Self;
TabStop := True;
Width := 185;
Height := 89;
AutoSize := False;
{$IFDEF RX_D4}
DoubleBuffered := False;
{$ENDIF}
FAllowObjects := True;
{$IFDEF RX_D3}
FAllowInPlace := True;
{$ENDIF}
FAutoVerbMenu := True;
FHideSelection := True;
FHideScrollBars := True;
ScrollBars := ssBoth;
FSelectionBar := True;
FLangOptions := [rlAutoFont];
DC := GetDC(0);
FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
ReleaseDC(0, DC);
DefaultConverter := TConversion;
FOldParaAlignment := TParaAlignment(Alignment);
FUndoLimit := 100;
FAutoURLDetect := True;
FWordSelection := True;
with FClickRange do begin
cpMin := -1;
cpMax := -1;
end;
FCallback := TRichEditOleCallback.Create(Self);
{$IFDEF RX_D4}
Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
{$ENDIF}
end;
destructor TRxCustomRichEdit.Destroy;
begin
FLastFind := nil;
FSelAttributes.Free;
FDefAttributes.Free;
FWordAttributes.Free;
FParagraph.Free;
FRichEditStrings.Free;
FMemStream.Free;
FPopupVerbMenu.Free;
FFindDialog.Free;
FReplaceDialog.Free;
inherited Destroy;
{ be sure that callback object is destroyed after inherited Destroy }
TRichEditOleCallback(FCallback).Free;
end;
procedure TRxCustomRichEdit.Clear;
begin
CloseObjects;
inherited Clear;
Modified := False;
end;
procedure TRxCustomRichEdit.CreateParams(var Params: TCreateParams);
const
HideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0);
HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
SelectionBars: array[Boolean] of DWORD = (0, ES_SELECTIONBAR);
begin
inherited CreateParams(Params);
case RichEditVersion of
1: CreateSubClass(Params, RICHEDIT_CLASS10A);
else CreateSubClass(Params, RICHEDIT_CLASS);
end;
with Params do begin
Style := (Style and not (WS_HSCROLL or WS_VSCROLL)) or ES_SAVESEL or
(WS_CLIPSIBLINGS or WS_CLIPCHILDREN);
{ NOTE: WS_CLIPCHILDREN and WS_CLIPSIBLINGS are essential otherwise }
{ once the object is inserted you see some painting problems. }
Style := Style and not (WS_HSCROLL or WS_VSCROLL);
if ScrollBars in [ssVertical, ssBoth] then
Style := Style or WS_VSCROLL;
if (ScrollBars in [ssHorizontal, ssBoth]) and not WordWrap then
Style := Style or WS_HSCROLL;
Style := Style or HideScrollBars[FHideScrollBars] or
SelectionBars[FSelectionBar] or HideSelections[FHideSelection] and
not WordWraps[WordWrap];
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TRxCustomRichEdit.CreateWnd;
var
StreamFmt: TRichStreamFormat;
Mode: TRichStreamModes;
DesignMode: Boolean;
Mask: Longint;
begin
StreamFmt := TRichEditStrings(Lines).Format;
Mode := TRichEditStrings(Lines).Mode;
inherited CreateWnd;
{$IFNDEF VER90}
if (SysLocale.FarEast) and not (SysLocale.PriLangID = LANG_JAPANESE) then
Font.Charset := GetDefFontCharSet;
{$ENDIF}
Mask := ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_PROTECTED;
if RichEditVersion >= 2 then Mask := Mask or ENM_LINK;
SendMessage(Handle, EM_SETEVENTMASK, 0, Mask);
SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color));
{$IFDEF RX_D3}
DoSetMaxLength(MaxLength);
{$ENDIF}
SetWordSelection(FWordSelection);
if RichEditVersion >= 2 then begin
SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0);
FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, FUndoLimit, 0);
UpdateTextModes(PlainText);
SetLangOptions(FLangOptions);
end;
if FAllowObjects then begin
SendMessage(Handle, EM_SETOLECALLBACK, 0,
LPARAM(TRichEditOleCallback(FCallback) as IRichEditOleCallback));
GetRichEditOle(Handle, FRichEditOle);
UpdateHostNames;
end;
if FMemStream <> nil then begin
FMemStream.ReadBuffer(DesignMode, SizeOf(DesignMode));
if DesignMode then begin
TRichEditStrings(Lines).Format := sfPlainText;
TRichEditStrings(Lines).Mode := [];
end;
try
Lines.LoadFromStream(FMemStream);
FMemStream.Free;
FMemStream := nil;
finally
TRichEditStrings(Lines).Format := StreamFmt;
TRichEditStrings(Lines).Mode := Mode;
end;
end;
if RichEditVersion < 2 then
SendMessage(Handle, WM_SETFONT, 0, 0);
Modified := FModified;
end;
procedure TRxCustomRichEdit.DestroyWnd;
var
StreamFmt: TRichStreamFormat;
Mode: TRichStreamModes;
DesignMode: Boolean;
begin
FModified := Modified;
FMemStream := TMemoryStream.Create;
StreamFmt := TRichEditStrings(Lines).Format;
Mode := TRichEditStrings(Lines).Mode;
DesignMode := (csDesigning in ComponentState);
FMemStream.WriteBuffer(DesignMode, SizeOf(DesignMode));
if DesignMode then begin
TRichEditStrings(Lines).Format := sfPlainText;
TRichEditStrings(Lines).Mode := [];
end;
try
Lines.SaveToStream(FMemStream);
FMemStream.Position := 0;
finally
TRichEditStrings(Lines).Format := StreamFmt;
TRichEditStrings(Lines).Mode := Mode;
end;
inherited DestroyWnd;
end;
procedure TRxCustomRichEdit.SetAllowObjects(Value: Boolean);
begin
if FAllowObjects <> Value then begin
FAllowObjects := Value;
RecreateWnd;
end;
end;
procedure TRxCustomRichEdit.UpdateHostNames;
var
AppName: string;
begin
if HandleAllocated and Assigned(FRichEditOle) then begin
AppName := Application.Title;
if Trim(AppName) = '' then
AppName := ExtractFileName(Application.ExeName);
if Trim(Title) = '' then
IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(AppName))
else
IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(Title));
end;
end;
procedure TRxCustomRichEdit.SetTitle(const Value: string);
begin
if FTitle <> Value then begin
FTitle := Value;
UpdateHostNames;
end;
end;
function TRxCustomRichEdit.GetPopupMenu: TPopupMenu;
var
EnumOleVerb: IEnumOleVerb;
OleVerb: TOleVerb;
Item: TMenuItem;
ReObject: TReObject;
begin
FPopupVerbMenu.Free;
FPopupVerbMenu := nil;
Result := inherited GetPopupMenu;
if FAutoVerbMenu and (SelectionType = [stObject]) and
Assigned(FRichEditOle) then
begin
FillChar(ReObject, SizeOf(ReObject), 0);
ReObject.cbStruct := SizeOf(ReObject);
if Succeeded(IRichEditOle(FRichEditOle).GetObject(
Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ)) then
try
if Assigned(ReObject.poleobj) and
(ReObject.dwFlags and REO_INPLACEACTIVE = 0) then
begin
FPopupVerbMenu := TPopupMenu.Create(Self);
if ReObject.poleobj.EnumVerbs(EnumOleVerb) = 0 then
try
while (EnumOleVerb.Next(1, OleVerb, nil) = 0) and
(OleVerb.lVerb >= 0) and
(OleVerb.grfAttribs and OLEVERBATTRIB_ONCONTAINERMENU <> 0) do
begin
Item := TMenuItem.Create(FPopupVerbMenu);
Item.Caption := WideCharToString(OleVerb.lpszVerbName);
Item.Tag := OleVerb.lVerb;
Item.Default := (OleVerb.lVerb = OLEIVERB_PRIMARY);
Item.OnClick := PopupVerbClick;
FPopupVerbMenu.Items.Add(Item);
end;
finally
ReleaseObject(EnumOleVerb);
end;
if (Result <> nil) and (Result.Items.Count > 0) then begin
Item := TMenuItem.Create(FPopupVerbMenu);
Item.Caption := '-';
Result.Items.Add(Item);
Item := TMenuItem.Create(FPopupVerbMenu);
Item.Caption := Format(ResStr(SPropDlgCaption),
[GetFullNameStr(ReObject.poleobj)]);
Item.OnClick := ObjectPropsClick;
Result.Items.Add(Item);
if FPopupVerbMenu.Items.Count > 0 then begin
FPopupVerbMenu.Items.Caption := GetFullNameStr(ReObject.poleobj);
Result.Items.Add(FPopupVerbMenu.Items);
end;
end
else if FPopupVerbMenu.Items.Count > 0 then begin
Item := TMenuItem.Create(FPopupVerbMenu);
Item.Caption := Format(ResStr(SPropDlgCaption),
[GetFullNameStr(ReObject.poleobj)]);
Item.OnClick := ObjectPropsClick;
FPopupVerbMenu.Items.Insert(0, Item);
Result := FPopupVerbMenu;
end;
end;
finally
ReleaseObject(ReObject.poleobj);
end;
end;
end;
procedure TRxCustomRichEdit.PopupVerbClick(Sender: TObject);
var
ReObject: TReObject;
begin
if Assigned(FRichEditOle) then begin
FillChar(ReObject, SizeOf(ReObject), 0);
ReObject.cbStruct := SizeOf(ReObject);
if Succeeded(IRichEditOle(FRichEditOle).GetObject(
Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ or
REO_GETOBJ_POLESITE)) then
try
if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then
OleCheck(ReObject.poleobj.DoVerb((Sender as TMenuItem).Tag, nil,
ReObject.polesite, 0, Handle, ClientRect));
finally
ReleaseObject(ReObject.polesite);
ReleaseObject(ReObject.poleobj);
end;
end;
end;
procedure TRxCustomRichEdit.ObjectPropsClick(Sender: TObject);
begin
ObjectPropertiesDialog;
end;
procedure TRxCustomRichEdit.WMSetFont(var Message: TWMSetFont);
begin
FDefAttributes.Assign(Font);
end;
procedure TRxCustomRichEdit.CMFontChanged(var Message: TMessage);
begin
inherited;
FDefAttributes.Assign(Font);
end;
procedure TRxCustomRichEdit.CreateWindowHandle(const Params: TCreateParams);
var
Bounds: TRect;
begin
Bounds := BoundsRect;
inherited CreateWindowHandle(Params);
if HandleAllocated then BoundsRect := Bounds;
end;
{$IFDEF RX_D3}
procedure TRxCustomRichEdit.DoSetMaxLength(Value: Integer);
begin
{ The rich edit control's default maximum amount of text is 32K }
{ Let's set it at 16M by default }
if Value = 0 then Value := $FFFFFF;
SendMessage(Handle, EM_EXLIMITTEXT, 0, Value);
end;
{$ENDIF}
function TRxCustomRichEdit.GetCaretPos: TPoint;
var
CharRange: TCharRange;
begin
SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
Result.X := CharRange.cpMax;
Result.Y := LineFromChar(Result.X);
Dec(Result.X, GetLineIndex(-1));
end;
{$IFDEF RX_D3}
function TRxCustomRichEdit.GetSelLength: Integer;
begin
with GetSelection do
Result := cpMax - cpMin;
end;
function TRxCustomRichEdit.GetSelStart: Integer;
begin
Result := GetSelection.cpMin;
end;
function TRxCustomRichEdit.GetSelText: string;
begin
with GetSelection do
Result := GetTextRange(cpMin, cpMax);
end;
{$ENDIF RX_D3}
function TRxCustomRichEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
var
S: string;
begin
S := SelText;
Result := Length(S);
if BufSize < Length(S) then Result := BufSize;
StrPLCopy(Buffer, S, Result);
end;
{$IFDEF RX_D4}
procedure TRxCustomRichEdit.CMBiDiModeChanged(var Message: TMessage);
var
AParagraph: TParaFormat2;
begin
HandleNeeded; { we REALLY need the handle for BiDi }
inherited;
Paragraph.GetAttributes(AParagraph);
AParagraph.dwMask := PFM_ALIGNMENT;
AParagraph.wAlignment := Ord(Alignment) + 1;
Paragraph.SetAttributes(AParagraph);
end;
{$ENDIF}
procedure TRxCustomRichEdit.SetHideScrollBars(Value: Boolean);
begin
if HideScrollBars <> Value then begin
FHideScrollBars := Value;
RecreateWnd;
end;
end;
procedure TRxCustomRichEdit.SetSelectionBar(Value: Boolean);
begin
if FSelectionBar <> Value then begin
FSelectionBar := Value;
RecreateWnd;
end;
end;
procedure TRxCustomRichEdit.SetHideSelection(Value: Boolean);
begin
if HideSelection <> Value then begin
FHideSelection := Value;
SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LPARAM(True));
end;
end;
function TRxCustomRichEdit.GetAutoURLDetect: Boolean;
begin
Result := FAutoURLDetect;
if HandleAllocated and not (csDesigning in ComponentState) then begin
if RichEditVersion >= 2 then
Result := Boolean(SendMessage(Handle, EM_GETAUTOURLDETECT, 0, 0));
end;
end;
procedure TRxCustomRichEdit.SetAutoURLDetect(Value: Boolean);
begin
if Value <> FAutoURLDetect then begin
FAutoURLDetect := Value;
if HandleAllocated and (RichEditVersion >= 2) then
SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0);
end;
end;
function TRxCustomRichEdit.GetWordSelection: Boolean;
begin
Result := FWordSelection;
if HandleAllocated then
Result := (SendMessage(Handle, EM_GETOPTIONS, 0, 0) and
ECO_AUTOWORDSELECTION) <> 0;
end;
procedure TRxCustomRichEdit.SetWordSelection(Value: Boolean);
var
Options: LPARAM;
begin
FWordSelection := Value;
if HandleAllocated then begin
Options := SendMessage(Handle, EM_GETOPTIONS, 0, 0);
if Value then Options := Options or ECO_AUTOWORDSELECTION
else Options := Options and not ECO_AUTOWORDSELECTION;
SendMessage(Handle, EM_SETOPTIONS, ECOOP_SET, Options);
end;
end;
const
RichLangOptions: array[TRichLangOption] of DWORD = (IMF_AUTOKEYBOARD,
IMF_AUTOFONT, IMF_IMECANCELCOMPLETE, IMF_IMEALWAYSSENDNOTIFY);
function TRxCustomRichEdit.GetLangOptions: TRichLangOptions;
var
Flags: Longint;
I: TRichLangOption;
begin
Result := FLangOptions;
if HandleAllocated and not (csDesigning in ComponentState) and
(RichEditVersion >= 2) then
begin
Result := [];
Flags := SendMessage(Handle, EM_GETLANGOPTIONS, 0, 0);
for I := Low(TRichLangOption) to High(TRichLangOption) do
if Flags and RichLangOptions[I] <> 0 then Include(Result, I);
end;
end;
procedure TRxCustomRichEdit.SetLangOptions(Value: TRichLangOptions);
var
Flags: DWORD;
I: TRichLangOption;
begin
FLangOptions := Value;
if HandleAllocated and (RichEditVersion >= 2) then begin
Flags := 0;
for I := Low(TRichLangOption) to High(TRichLangOption) do
if I in Value then Flags := Flags or RichLangOptions[I];
SendMessage(Handle, EM_SETLANGOPTIONS, 0, LPARAM(Flags));
end;
end;
procedure TRxCustomRichEdit.SetSelAttributes(Value: TRxTextAttributes);
begin
FSelAttributes.Assign(Value);
end;
function TRxCustomRichEdit.GetCanRedo: Boolean;
begin
Result := False;
if HandleAllocated and (RichEditVersion >= 2) then
Result := SendMessage(Handle, EM_CANREDO, 0, 0) <> 0;
end;
function TRxCustomRichEdit.GetCanPaste: Boolean;
begin
Result := False;
if HandleAllocated then
Result := SendMessage(Handle, EM_CANPASTE, 0, 0) <> 0;
end;
{$IFNDEF RX_V110}
function TRxCustomRichEdit.GetCanUndo: Boolean;
begin
Result := False;
if HandleAllocated then
Result := SendMessage(Handle, EM_CANUNDO, 0, 0) <> 0;
end;
{$ENDIF}
function TRxCustomRichEdit.GetRedoName: TUndoName;
begin
Result := unUnknown;
if (RichEditVersion >= 2) and HandleAllocated then
Result := TUndoName(SendMessage(Handle, EM_GETREDONAME, 0, 0));
end;
function TRxCustomRichEdit.GetUndoName: TUndoName;
begin
Result := unUnknown;
if (RichEditVersion >= 2) and HandleAllocated then
Result := TUndoName(SendMessage(Handle, EM_GETUNDONAME, 0, 0));
end;
function TRxCustomRichEdit.GetSelectionType: TRichSelectionType;
const
SelTypes: array[TRichSelection] of Integer = (
SEL_TEXT, SEL_OBJECT, SEL_MULTICHAR, SEL_MULTIOBJECT);
var
Selection: Integer;
I: TRichSelection;
begin
Result := [];
if HandleAllocated then begin
Selection := SendMessage(Handle, EM_SELECTIONTYPE, 0, 0);
for I := Low(TRichSelection) to High(TRichSelection) do
if SelTypes[I] and Selection <> 0 then Include(Result, I);
end;
end;
function TRxCustomRichEdit.GetSelection: TCharRange;
begin
SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Result));
end;
procedure TRxCustomRichEdit.SetSelection(StartPos, EndPos: Longint;
ScrollCaret: Boolean);
var
CharRange: TCharRange;
begin
with CharRange do begin
cpMin := StartPos;
cpMax := EndPos;
end;
SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
if ScrollCaret then SendMessage(Handle, EM_SCROLLCARET, 0, 0);
end;
{$IFDEF RX_D3}
procedure TRxCustomRichEdit.SetSelLength(Value: Integer);
begin
with GetSelection do SetSelection(cpMin, cpMin + Value, True);
end;
procedure TRxCustomRichEdit.SetSelStart(Value: Integer);
begin
SetSelection(Value, Value, False);
end;
{$ENDIF RX_D3}
function TRxCustomRichEdit.GetCharPos(CharIndex: Integer): TPoint;
var
Res: Longint;
begin
FillChar(Result, SizeOf(Result), 0);
if HandleAllocated then begin
if RichEditVersion = 2 then begin
Res := SendMessage(Handle, Messages.EM_POSFROMCHAR, CharIndex, 0);
Result.X := LoWord(Res);
Result.Y := HiWord(Res);
end
else { RichEdit 1.0 and 3.0 }
SendMessage(Handle, Messages.EM_POSFROMCHAR, WPARAM(@Result), CharIndex);
end;
end;
function TRxCustomRichEdit.GetTextRange(StartPos, EndPos: Longint): string;
var
TextRange: TTextRange;
begin
SetLength(Result, EndPos - StartPos + 1);
TextRange.chrg.cpMin := StartPos;
TextRange.chrg.cpMax := EndPos;
TextRange.lpstrText := PAnsiChar(Result);
SetLength(Result, SendMessage(Handle, EM_GETTEXTRANGE, 0, Longint(@TextRange)));
end;
function TRxCustomRichEdit.WordAtCursor: string;
var
Range: TCharRange;
begin
Result := '';
if HandleAllocated then begin
Range.cpMax := SelStart;
if Range.cpMax = 0 then Range.cpMin := 0
else if SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMax) <> 0 then
Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_MOVEWORDLEFT, Range.cpMax)
else
Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_LEFT, Range.cpMax);
while SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMin) <> 0 do
Inc(Range.cpMin);
Range.cpMax := SendMessage(Handle, EM_FINDWORDBREAK, WB_RIGHTBREAK, Range.cpMax);
Result := Trim(GetTextRange(Range.cpMin, Range.cpMax));
end;
end;
function TRxCustomRichEdit.LineFromChar(CharIndex: Integer): Integer;
begin
Result := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, CharIndex);
end;
function TRxCustomRichEdit.GetLineIndex(LineNo: Integer): Integer;
begin
Result := SendMessage(Handle, EM_LINEINDEX, LineNo, 0);
end;
function TRxCustomRichEdit.GetLineLength(CharIndex: Integer): Integer;
begin
Result := SendMessage(Handle, EM_LINELENGTH, CharIndex, 0);
end;
procedure TRxCustomRichEdit.SetUndoLimit(Value: Integer);
begin
if (Value <> FUndoLimit) then begin
FUndoLimit := Value;
if (RichEditVersion >= 2) and HandleAllocated then
FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, Value, 0);
end;
end;
procedure TRxCustomRichEdit.SetDefAttributes(Value: TRxTextAttributes);
begin
FDefAttributes.Assign(Value);
end;
procedure TRxCustomRichEdit.SetWordAttributes(Value: TRxTextAttributes);
begin
FWordAttributes.Assign(Value);
end;
function TRxCustomRichEdit.GetStreamFormat: TRichStreamFormat;
begin
Result := TRichEditStrings(Lines).Format;
end;
function TRxCustomRichEdit.GetStreamMode: TRichStreamModes;
begin
Result := TRichEditStrings(Lines).Mode;
end;
procedure TRxCustomRichEdit.SetStreamFormat(Value: TRichStreamFormat);
begin
TRichEditStrings(Lines).Format := Value;
end;
procedure TRxCustomRichEdit.SetStreamMode(Value: TRichStreamModes);
begin
TRichEditStrings(Lines).Mode := Value;
end;
procedure TRxCustomRichEdit.SetPlainText(Value: Boolean);
var
MemStream: TStream;
StreamFmt: TRichStreamFormat;
Mode: TRichStreamModes;
begin
if PlainText <> Value then begin
if HandleAllocated and (RichEditVersion >= 2) then begin
MemStream := TMemoryStream.Create;
try
StreamFmt := TRichEditStrings(Lines).Format;
Mode := TRichEditStrings(Lines).Mode;
try
if (csDesigning in ComponentState) or Value then
TRichEditStrings(Lines).Format := sfPlainText
else TRichEditStrings(Lines).Format := sfRichText;
TRichEditStrings(Lines).Mode := [];
Lines.SaveToStream(MemStream);
MemStream.Position := 0;
TRichEditStrings(Lines).EnableChange(False);
try
SendMessage(Handle, WM_SETTEXT, 0, 0);
UpdateTextModes(Value);
FPlainText := Value;
finally
TRichEditStrings(Lines).EnableChange(True);
end;
Lines.LoadFromStream(MemStream);
finally
TRichEditStrings(Lines).Format := StreamFmt;
TRichEditStrings(Lines).Mode := Mode;
end;
finally
MemStream.Free;
end;
end;
FPlainText := Value;
end;
end;
procedure TRxCustomRichEdit.UpdateTextModes(Plain: Boolean);
const
TextModes: array[Boolean] of DWORD = (TM_RICHTEXT, TM_PLAINTEXT);
UndoModes: array[Boolean] of DWORD = (TM_SINGLELEVELUNDO, TM_MULTILEVELUNDO);
begin
if (RichEditVersion >= 2) and HandleAllocated then begin
SendMessage(Handle, EM_SETTEXTMODE, TextModes[Plain] or
UndoModes[FUndoLimit > 1], 0);
end;
end;
procedure TRxCustomRichEdit.CMColorChanged(var Message: TMessage);
begin
inherited;
SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color))
end;
procedure TRxCustomRichEdit.EMReplaceSel(var Message: TMessage);
var
CharRange: TCharRange;
begin
Perform(EM_EXGETSEL, 0, Longint(@CharRange));
with CharRange do
cpMax := cpMin + Integer(StrLen(PChar(Message.lParam)));
if (FUndoLimit > 1) and (RichEditVersion >= 2) and not FLinesUpdating then
Message.wParam := 1; { allow Undo }
inherited;
if not FLinesUpdating then begin
Perform(EM_EXSETSEL, 0, Longint(@CharRange));
Perform(EM_SCROLLCARET, 0, 0);
end;
end;
procedure TRxCustomRichEdit.SetRichEditStrings(Value: TStrings);
begin
FRichEditStrings.Assign(Value);
end;
procedure TRxCustomRichEdit.CloseObjects;
var
I: Integer;
ReObject: TReObject;
begin
if Assigned(FRichEditOle) then begin
FillChar(ReObject, SizeOf(ReObject), 0);
ReObject.cbStruct := SizeOf(ReObject);
with IRichEditOle(FRichEditOle) do begin
for I := GetObjectCount - 1 downto 0 do
if Succeeded(GetObject(I, ReObject, REO_GETOBJ_POLEOBJ)) then begin
if ReObject.dwFlags and REO_INPLACEACTIVE <> 0 then
IRichEditOle(FRichEditOle).InPlaceDeactivate;
ReObject.poleobj.Close(OLECLOSE_NOSAVE);
ReleaseObject(ReObject.poleobj);
end;
end;
end;
end;
function TRxCustomRichEdit.PasteSpecialDialog: Boolean;
procedure SetPasteEntry(var Entry: TOleUIPasteEntry; Format: TClipFormat;
tymed: DWORD; const FormatName, ResultText: string; Flags: DWORD);
begin
with Entry do begin
fmtetc.cfFormat := Format;
fmtetc.dwAspect := DVASPECT_CONTENT;
fmtetc.lIndex := -1;
fmtetc.tymed := tymed;
if FormatName <> '' then lpstrFormatName := PChar(FormatName)
else lpstrFormatName := '%s';
if ResultText <> '' then lpstrResultText := PChar(ResultText)
else lpstrResultText := '%s';
dwFlags := Flags;
end;
end;
const
PasteFormatCount = 6;
var
Data: TOleUIPasteSpecial;
PasteFormats: array[0..PasteFormatCount - 1] of TOleUIPasteEntry;
Format: Integer;
OleClientSite: IOleClientSite;
Storage: IStorage;
OleObject: IOleObject;
ReObject: TReObject;
Selection: TCharRange;
begin
Result := False;
if not CanPaste or not Assigned(FRichEditOle) then Exit;
FillChar(Data, SizeOf(Data), 0);
FillChar(PasteFormats, SizeOf(PasteFormats), 0);
with Data do begin
cbStruct := SizeOf(Data);
hWndOwner := Handle;
arrPasteEntries := @PasteFormats;
cPasteEntries := PasteFormatCount;
arrLinkTypes := @CFLinkSource;
cLinkTypes := 1;
dwFlags := PSF_SELECTPASTE;
end;
SetPasteEntry(PasteFormats[0], CFEmbeddedObject, TYMED_ISTORAGE, '', '',
OLEUIPASTE_PASTE or OLEUIPASTE_ENABLEICON);
SetPasteEntry(PasteFormats[1], CFLinkSource, TYMED_ISTREAM, '', '',
OLEUIPASTE_LINKTYPE1 or OLEUIPASTE_ENABLEICON);
SetPasteEntry(PasteFormats[2], CFRtf, TYMED_ISTORAGE,
CF_RTF, CF_RTF, OLEUIPASTE_PASTE);
SetPasteEntry(PasteFormats[3], CFRtfNoObjs, TYMED_ISTORAGE,
CF_RTFNOOBJS, CF_RTFNOOBJS, OLEUIPASTE_PASTE);
SetPasteEntry(PasteFormats[4], CF_TEXT, TYMED_HGLOBAL,
'Unformatted text', 'text without any formatting', OLEUIPASTE_PASTE);
SetPasteEntry(PasteFormats[5], CF_BITMAP, TYMED_GDI,
'Windows Bitmap', 'bitmap image', OLEUIPASTE_PASTE);
try
if OleUIPasteSpecial(Data) = OLEUI_OK then begin
Result := True;
if Data.nSelectedIndex in [0, 1] then begin
{ CFEmbeddedObject, CFLinkSource }
FillChar(ReObject, SizeOf(TReObject), 0);
IRichEditOle(FRichEditOle).GetClientSite(OleClientSite);
Storage := nil;
try
CreateStorage(Storage);
case Data.nSelectedIndex of
0: OleCheck(OleCreateFromData(Data.lpSrcDataObj,
{$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF},
OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject));
1: OleCheck(OleCreateLinkFromData(Data.lpSrcDataObj,
{$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF},
OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject));
end;
try
with ReObject do begin
cbStruct := SizeOf(TReObject);
cp := REO_CP_SELECTION;
poleobj := OleObject;
OleObject.GetUserClassID(clsid);
pstg := Storage;
polesite := OleClientSite;
dvAspect := DVASPECT_CONTENT;
dwFlags := REO_RESIZABLE;
OleCheck(OleSetDrawAspect(OleObject,
Data.dwFlags and PSF_CHECKDISPLAYASICON <> 0,
Data.hMetaPict, dvAspect));
end;
SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection));
Selection.cpMax := Selection.cpMin + 1;
OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject));
SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection));
IRichEditOle(FRichEditOle).SetDvaspect(
Longint(REO_IOB_SELECTION), ReObject.dvAspect);
finally
ReleaseObject(OleObject);
end;
finally
ReleaseObject(OleClientSite);
ReleaseObject(Storage);
end;
end
else begin
Format := PasteFormats[Data.nSelectedIndex].fmtetc.cfFormat;
OleCheck(IRichEditOle(FRichEditOle).ImportDataObject(
Data.lpSrcDataObj, Format, Data.hMetaPict));
end;
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
end;
finally
DestroyMetaPict(Data.hMetaPict);
ReleaseObject(Data.lpSrcDataObj);
end;
end;
function TRxCustomRichEdit.InsertObjectDialog: Boolean;
var
Data: TOleUIInsertObject;
NameBuffer: array[0..255] of Char;
OleClientSite: IOleClientSite;
Storage: IStorage;
OleObject: IOleObject;
ReObject: TReObject;
IsNewObject: Boolean;
Selection: TCharRange;
begin
FillChar(Data, SizeOf(Data), 0);
FillChar(NameBuffer, SizeOf(NameBuffer), 0);
FillChar(ReObject, SizeOf(TReObject), 0);
if Assigned(FRichEditOle) then begin
IRichEditOle(FRichEditOle).GetClientSite(OleClientSite);
Storage := nil;
try
CreateStorage(Storage);
with Data do begin
cbStruct := SizeOf(Data);
dwFlags := IOF_SELECTCREATENEW or IOF_VERIFYSERVERSEXIST or
IOF_CREATENEWOBJECT or IOF_CREATEFILEOBJECT or IOF_CREATELINKOBJECT;
hWndOwner := Handle;
lpszFile := NameBuffer;
cchFile := SizeOf(NameBuffer);
iid := {$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF};
oleRender := OLERENDER_DRAW;
lpIOleClientSite := OleClientSite;
lpIStorage := Storage;
ppvObj := @OleObject;
end;
try
Result := OleUIInsertObject(Data) = OLEUI_OK;
if Result then
try
IsNewObject := Data.dwFlags and IOF_SELECTCREATENEW = IOF_SELECTCREATENEW;
with ReObject do begin
cbStruct := SizeOf(TReObject);
cp := REO_CP_SELECTION;
clsid := Data.clsid;
poleobj := OleObject;
pstg := Storage;
polesite := OleClientSite;
dvAspect := DVASPECT_CONTENT;
dwFlags := REO_RESIZABLE;
if IsNewObject then dwFlags := dwFlags or REO_BLANK;
OleCheck(OleSetDrawAspect(OleObject,
Data.dwFlags and IOF_CHECKDISPLAYASICON <> 0,
Data.hMetaPict, dvAspect));
end;
SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection));
Selection.cpMax := Selection.cpMin + 1;
OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject));
SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection));
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
IRichEditOle(FRichEditOle).SetDvaspect(
Longint(REO_IOB_SELECTION), ReObject.dvAspect);
if IsNewObject then OleObject.DoVerb(OLEIVERB_SHOW, nil,
OleClientSite, 0, Handle, ClientRect);
finally
ReleaseObject(OleObject);
end;
finally
DestroyMetaPict(Data.hMetaPict);
end;
finally
ReleaseObject(OleClientSite);
ReleaseObject(Storage);
end;
end
else Result := False;
end;
function TRxCustomRichEdit.ObjectPropertiesDialog: Boolean;
var
ObjectProps: TOleUIObjectProps;
PropSheet: TPropSheetHeader;
GeneralProps: TOleUIGnrlProps;
ViewProps: TOleUIViewProps;
LinkProps: TOleUILinkProps;
DialogCaption: string;
ReObject: TReObject;
begin
Result := False;
if not Assigned(FRichEditOle) or (SelectionType <> [stObject]) then Exit;
FillChar(ObjectProps, SizeOf(ObjectProps), 0);
FillChar(PropSheet, SizeOf(PropSheet), 0);
FillChar(GeneralProps, SizeOf(GeneralProps), 0);
FillChar(ViewProps, SizeOf(ViewProps), 0);
FillChar(LinkProps, SizeOf(LinkProps), 0);
FillChar(ReObject, SizeOf(ReObject), 0);
ReObject.cbStruct := SizeOf(ReObject);
if Succeeded(IRichEditOle(FRichEditOle).GetObject(Longint(REO_IOB_SELECTION),
ReObject, REO_GETOBJ_POLEOBJ or REO_GETOBJ_POLESITE)) then
try
if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then begin
ObjectProps.cbStruct := SizeOf(ObjectProps);
ObjectProps.dwFlags := OPF_DISABLECONVERT;
ObjectProps.lpPS := @PropSheet;
ObjectProps.lpObjInfo := TOleUIObjInfo.Create(Self, ReObject);
if (ReObject.dwFlags and REO_LINK) <> 0 then begin
ObjectProps.dwFlags := ObjectProps.dwFlags or OPF_OBJECTISLINK;
ObjectProps.lpLinkInfo := TOleUILinkInfo.Create(Self, ReObject);
end;
ObjectProps.lpGP := @GeneralProps;
ObjectProps.lpVP := @ViewProps;
ObjectProps.lpLP := @LinkProps;
PropSheet.dwSize := SizeOf(PropSheet);
PropSheet.hWndParent := Handle;
{$IFDEF RX_D3}
PropSheet.hInstance := MainInstance;
{$ELSE}
PropSheet.hInstance := HInstance;
{$ENDIF}
DialogCaption := Format(ResStr(SPropDlgCaption),
[GetFullNameStr(ReObject.poleobj)]);
PropSheet.pszCaption := PChar(DialogCaption);
GeneralProps.cbStruct := SizeOf(GeneralProps);
ViewProps.cbStruct := SizeOf(ViewProps);
ViewProps.dwFlags := VPF_DISABLESCALE;
LinkProps.cbStruct := SizeOf(LinkProps);
LinkProps.dwFlags := ELF_DISABLECANCELLINK;
Result := OleUIObjectProperties(ObjectProps) = OLEUI_OK;
end;
finally
{$IFNDEF RX_D3}
ObjectProps.lpLinkInfo.Free;
ObjectProps.lpObjInfo.Free;
ReleaseObject(ReObject.polesite);
ReleaseObject(ReObject.poleobj);
{$ENDIF}
end;
end;
procedure TRxCustomRichEdit.Print(const Caption: string);
var
Range: TFormatRange;
LastChar, MaxLen, LogX, LogY, OldMap: Integer;
SaveRect: TRect;
TextLenEx: TGetTextLengthEx;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
with Printer, Range do begin
Title := Caption;
BeginDoc;
hdc := Handle;
hdcTarget := hdc;
LogX := GetDeviceCaps(Handle, LOGPIXELSX);
LogY := GetDeviceCaps(Handle, LOGPIXELSY);
if IsRectEmpty(PageRect) then begin
rc.right := PageWidth * 1440 div LogX;
rc.bottom := PageHeight * 1440 div LogY;
end
else begin
rc.left := PageRect.Left * 1440 div LogX;
rc.top := PageRect.Top * 1440 div LogY;
rc.right := PageRect.Right * 1440 div LogX;
rc.bottom := PageRect.Bottom * 1440 div LogY;
end;
rcPage := rc;
SaveRect := rc;
LastChar := 0;
if RichEditVersion >= 2 then begin
with TextLenEx do begin
flags := GTL_DEFAULT;
codepage := CP_ACP;
end;
MaxLen := Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
end
else MaxLen := GetTextLen;
chrg.cpMax := -1;
{ ensure printer DC is in text map mode }
OldMap := SetMapMode(hdc, MM_TEXT);
SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); { flush buffer }
try
repeat
rc := SaveRect;
chrg.cpMin := LastChar;
LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
until (LastChar >= MaxLen) or (LastChar = -1);
EndDoc;
finally
SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); { flush buffer }
SetMapMode(hdc, OldMap); { restore previous map mode }
end;
end;
end;
var
Painting: Boolean = False;
procedure TRxCustomRichEdit.WMPaint(var Message: TWMPaint);
var
R, R1: TRect;
begin
if RichEditVersion >= 2 then
inherited
else begin
if GetUpdateRect(Handle, R, True) then
begin
with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom);
if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True);
end;
if Painting then
Invalidate
else begin
Painting := True;
try
inherited;
finally
Painting := False;
end;
end;
end;
end;
procedure TRxCustomRichEdit.WMDestroy(var Msg: TWMDestroy);
begin
CloseObjects;
ReleaseObject(FRichEditOle);
inherited;
end;
procedure TRxCustomRichEdit.WMMouseMove(var Message: TMessage);
begin
inherited;
end;
procedure TRxCustomRichEdit.WMSetCursor(var Message: TWMSetCursor);
begin
inherited;
end;
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
{ RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
{ so we get no WM_CONTEXTMENU message. Simulate message here. }
if Win32MajorVersion < 5 then
Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
inherited;
end;
{$ENDIF}
procedure TRxCustomRichEdit.CNNotify(var Message: TWMNotify);
var
AMsg: TMessage;
begin
with Message do
case NMHdr^.code of
EN_SELCHANGE: SelectionChange;
EN_REQUESTRESIZE: RequestSize(PReqSize(NMHdr)^.rc);
EN_SAVECLIPBOARD:
with PENSaveClipboard(NMHdr)^ do
if not SaveClipboard(cObjectCount, cch) then Result := 1;
EN_PROTECTED:
with PENProtected(NMHdr)^ do begin
AMsg.Msg := Msg;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
if not ProtectChange(AMsg, chrg.cpMin, chrg.cpMax) then
Result := 1;
end;
EN_LINK:
with PENLink(NMHdr)^ do begin
case Msg of
WM_RBUTTONDOWN:
begin
FClickRange := chrg;
FClickBtn := mbRight;
end;
WM_RBUTTONUP:
begin
if (FClickBtn = mbRight) and (FClickRange.cpMin = chrg.cpMin) and
(FClickRange.cpMax = chrg.cpMax) then
URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbRight);
with FClickRange do begin
cpMin := -1;
cpMax := -1;
end;
end;
WM_LBUTTONDOWN:
begin
FClickRange := chrg;
FClickBtn := mbLeft;
end;
WM_LBUTTONUP:
begin
if (FClickBtn = mbLeft) and (FClickRange.cpMin = chrg.cpMin) and
(FClickRange.cpMax = chrg.cpMax) then
URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbLeft);
with FClickRange do begin
cpMin := -1;
cpMax := -1;
end;
end;
end;
end;
EN_STOPNOUNDO:
begin
{ cannot allocate enough memory to maintain the undo state }
end;
end;
end;
function TRxCustomRichEdit.SaveClipboard(NumObj, NumChars: Integer): Boolean;
begin
Result := True;
if Assigned(OnSaveClipboard) then
OnSaveClipboard(Self, NumObj, NumChars, Result);
end;
function TRxCustomRichEdit.ProtectChange(const Message: TMessage; StartPos,
EndPos: Integer): Boolean;
begin
Result := False;
if Assigned(OnProtectChangeEx) then
OnProtectChangeEx(Self, Message, StartPos, EndPos, Result)
else if Assigned(OnProtectChange) then
OnProtectChange(Self, StartPos, EndPos, Result);
end;
procedure TRxCustomRichEdit.SelectionChange;
begin
if Assigned(OnSelectionChange) then OnSelectionChange(Self);
end;
procedure TRxCustomRichEdit.RequestSize(const Rect: TRect);
begin
if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect);
end;
procedure TRxCustomRichEdit.URLClick(const URLText: string; Button: TMouseButton);
begin
if Assigned(OnURLClick) then OnURLClick(Self, URLText, Button);
end;
function TRxCustomRichEdit.FindText(const SearchStr: string;
StartPos, Length: Integer; Options: TRichSearchTypes): Integer;
var
Find: TFindTextEx;
Flags: Integer;
begin
with Find.chrg do begin
cpMin := StartPos;
cpMax := cpMin + Abs(Length);
end;
if RichEditVersion >= 2 then begin
if not (stBackward in Options) then Flags := FT_DOWN
else Flags := 0;
end
else begin
Options := Options - [stBackward];
Flags := 0;
end;
if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD;
if stMatchCase in Options then Flags := Flags or FT_MATCHCASE;
Find.lpstrText := PChar(SearchStr);
Result := SendMessage(Handle, EM_FINDTEXTEX, Flags, Longint(@Find));
if (Result >= 0) and (stSetSelection in Options) then begin
SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Find.chrgText));
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
end;
end;
procedure TRxCustomRichEdit.ClearUndo;
begin
SendMessage(Handle, EM_EMPTYUNDOBUFFER, 0, 0);
end;
procedure TRxCustomRichEdit.Redo;
begin
SendMessage(Handle, EM_REDO, 0, 0);
end;
{$IFNDEF RX_V110}
procedure TRxCustomRichEdit.Undo;
begin
SendMessage(Handle, WM_UNDO, 0, 0);
end;
{$ENDIF}
procedure TRxCustomRichEdit.StopGroupTyping;
begin
if (RichEditVersion >= 2) and HandleAllocated then
SendMessage(Handle, EM_STOPGROUPTYPING, 0, 0);
end;
{$IFDEF RX_D3}
procedure TRxCustomRichEdit.SetUIActive(Active: Boolean);
var
Form: TCustomForm;
begin
try
Form := GetParentForm(Self);
if Form <> nil then
if Active then begin
if (Form.ActiveOleControl <> nil) and
(Form.ActiveOleControl <> Self) then
Form.ActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0);
Form.ActiveOleControl := Self;
if AllowInPlace and CanFocus then SetFocus;
end
else begin
if Form.ActiveOleControl = Self then Form.ActiveOleControl := nil;
if (Form.ActiveControl = Self) and AllowInPlace then begin
Windows.SetFocus(Handle);
SelectionChange;
end;
end;
except
Application.HandleException(Self);
end;
end;
procedure TRxCustomRichEdit.CMDocWindowActivate(var Message: TMessage);
begin
if Assigned(FCallback) then
with TRichEditOleCallback(FCallback) do
if Assigned(FDocForm) and IsFormMDIChild(FDocForm.Form) then begin
if Message.WParam = 0 then begin
FFrameForm.SetMenu(0, 0, 0);
FFrameForm.ClearBorderSpace;
end;
end;
end;
procedure TRxCustomRichEdit.CMUIDeactivate(var Message: TMessage);
begin
if (GetParentForm(Self) <> nil) and Assigned(FRichEditOle) and
(GetParentForm(Self).ActiveOleControl = Self) then
{IRichEditOle(FRichEditOle).InPlaceDeactivate};
end;
{$ENDIF RX_D3}
{ Find & Replace Dialogs }
procedure TRxCustomRichEdit.SetupFindDialog(Dialog: TFindDialog;
const SearchStr, ReplaceStr: string);
begin
with Dialog do begin
if SearchStr <> '' then FindText := SearchStr;
if RichEditVersion = 1 then
Options := Options + [frHideUpDown, frDown];
OnFind := FindDialogFind;
{$IFDEF RX_D3}
OnClose := FindDialogClose;
{$ENDIF}
end;
if Dialog is TReplaceDialog then
with TReplaceDialog(Dialog) do begin
if ReplaceStr <> '' then ReplaceText := ReplaceStr;
OnReplace := ReplaceDialogReplace;
end;
end;
function TRxCustomRichEdit.FindDialog(const SearchStr: string): TFindDialog;
begin
if FFindDialog = nil then begin
FFindDialog := TFindDialog.Create(Self);
if FReplaceDialog <> nil then
FFindDialog.FindText := FReplaceDialog.FindText;
end;
Result := FFindDialog;
SetupFindDialog(FFindDialog, SearchStr, '');
FFindDialog.Execute;
end;
function TRxCustomRichEdit.ReplaceDialog(const SearchStr,
ReplaceStr: string): TReplaceDialog;
begin
if FReplaceDialog = nil then begin
FReplaceDialog := TReplaceDialog.Create(Self);
if FFindDialog <> nil then
FReplaceDialog.FindText := FFindDialog.FindText;
end;
Result := FReplaceDialog;
SetupFindDialog(FReplaceDialog, SearchStr, ReplaceStr);
FReplaceDialog.Execute;
end;
function TRxCustomRichEdit.GetCanFindNext: Boolean;
begin
Result := HandleAllocated and (FLastFind <> nil) and
(FLastFind.FindText <> '');
end;
function TRxCustomRichEdit.FindNext: Boolean;
begin
if CanFindNext then Result := FindEditText(FLastFind, False, True)
else Result := False;
end;
procedure TRxCustomRichEdit.AdjustFindDialogPosition(Dialog: TFindDialog);
var
TextRect, R: TRect;
begin
if Dialog.Handle = 0 then Exit;
with TextRect do begin
TopLeft := ClientToScreen(GetCharPos(SelStart));
BottomRight := ClientToScreen(GetCharPos(SelStart + SelLength));
Inc(Bottom, 20);
end;
with Dialog do begin
GetWindowRect(Handle, R);
if PtInRect(R, TextRect.TopLeft) or PtInRect(R, TextRect.BottomRight) then
begin
if TextRect.Top > R.Bottom - R.Top + 20 then
OffsetRect(R, 0, TextRect.Top - R.Bottom - 20)
else begin
if TextRect.Top + R.Bottom - R.Top < GetSystemMetrics(SM_CYSCREEN) then
OffsetRect(R, 0, 40 + TextRect.Top - R.Top);
end;
Position := R.TopLeft;
end;
end;
end;
function TRxCustomRichEdit.FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean;
var
Length, StartPos: Integer;
SrchOptions: TRichSearchTypes;
begin
with TFindDialog(Dialog) do begin
SrchOptions := [stSetSelection];
if frDown in Options then begin
StartPos := Max(SelStart, SelStart + SelLength);
Length := System.Length(Text) - StartPos + 1;
end
else begin
SrchOptions := SrchOptions + [stBackward];
StartPos := Min(SelStart, SelStart + SelLength);
Length := StartPos + 1;
end;
if frMatchCase in Options then
SrchOptions := SrchOptions + [stMatchCase];
if frWholeWord in Options then
SrchOptions := SrchOptions + [stWholeWord];
Result := Self.FindText(FindText, StartPos, Length, SrchOptions) >= 0;
if FindText <> '' then FLastFind := Dialog;
if Result then begin
if AdjustPos then AdjustFindDialogPosition(Dialog);
end
else if Events then TextNotFound(Dialog);
end;
end;
procedure TRxCustomRichEdit.TextNotFound(Dialog: TFindDialog);
begin
with Dialog do
if Assigned(FOnTextNotFound) then FOnTextNotFound(Self, FindText);
end;
procedure TRxCustomRichEdit.FindDialogFind(Sender: TObject);
begin
FindEditText(TFindDialog(Sender), True, True);
end;
procedure TRxCustomRichEdit.ReplaceDialogReplace(Sender: TObject);
var
Cnt: Integer;
SaveSelChange: TNotifyEvent;
begin
with TReplaceDialog(Sender) do begin
if (frReplaceAll in Options) then begin
Cnt := 0;
SaveSelChange := FOnSelChange;
TRichEditStrings(Lines).EnableChange(False);
try
FOnSelChange := nil;
while FindEditText(TFindDialog(Sender), False, False) do begin
SelText := ReplaceText;
Inc(Cnt);
end;
if Cnt = 0 then TextNotFound(TFindDialog(Sender))
else AdjustFindDialogPosition(TFindDialog(Sender));
finally
TRichEditStrings(Lines).EnableChange(True);
FOnSelChange := SaveSelChange;
if Cnt > 0 then begin
Change;
SelectionChange;
end;
end;
end
else if (frReplace in Options) then begin
if FindEditText(TFindDialog(Sender), True, True) then
SelText := ReplaceText;
end;
end;
end;
{$IFDEF RX_D3}
procedure TRxCustomRichEdit.FindDialogClose(Sender: TObject);
begin
CloseFindDialog(Sender as TFindDialog);
end;
procedure TRxCustomRichEdit.CloseFindDialog(Dialog: TFindDialog);
begin
if Assigned(FOnCloseFindDialog) then FOnCloseFindDialog(Self, Dialog);
end;
{$ENDIF RX_D3}
{ Conversion formats }
procedure AppendConversionFormat(const Ext: string; Plain: Boolean;
AClass: TConversionClass);
var
NewRec: PRichConversionFormat;
begin
New(NewRec);
with NewRec^ do begin
{$IFNDEF VER90}
Extension := AnsiLowerCaseFileName(Ext);
{$ELSE}
Extension := LowerCase(Ext);
{$ENDIF}
PlainText := Plain;
ConversionClass := AClass;
Next := ConversionFormatList;
end;
ConversionFormatList := NewRec;
end;
class procedure TRxCustomRichEdit.RegisterConversionFormat(const AExtension: string;
APlainText: Boolean; AConversionClass: TConversionClass);
begin
AppendConversionFormat(AExtension, APlainText, AConversionClass);
end;
{ Initialization part }
var
OldError: Longint;
FLibHandle: THandle;
Ver: TOsVersionInfo;
initialization
RichEditVersion := 1;
OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
try
{$IFNDEF RICHEDIT_VER_10}
FLibHandle := LoadLibrary(RichEdit20ModuleName);
if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0;
{$ELSE}
FLibHandle := 0;
{$ENDIF}
if FLibHandle = 0 then begin
FLibHandle := LoadLibrary(RichEdit10ModuleName);
if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0;
end
else begin
RichEditVersion := 2;
Ver.dwOSVersionInfoSize := SizeOf(Ver);
GetVersionEx(Ver);
with Ver do begin
if (dwPlatformId = VER_PLATFORM_WIN32_NT) and
(dwMajorVersion >= 5) then
RichEditVersion := 3;
end;
end;
finally
SetErrorMode(OldError);
end;
CFEmbeddedObject := RegisterClipboardFormat(CF_EMBEDDEDOBJECT);
CFLinkSource := RegisterClipboardFormat(CF_LINKSOURCE);
CFRtf := RegisterClipboardFormat(CF_RTF);
CFRtfNoObjs := RegisterClipboardFormat(CF_RTFNOOBJS);
finalization
if FLibHandle <> 0 then FreeLibrary(FLibHandle);
end.