RxRichEdit高级操作

unit InsertRichEditUnit;




interface




uses


Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,


StdCtrls, RichEdit, UHISRichEd;




type


TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint;


var pcb: Longint): DWORD; stdcall;




TEditStream = record


dwCookie: Longint;


dwError: Longint;


pfnCallback: TEditStreamCallBack;


end;




procedure GetRTFSelection(aRichEdit: TUHISRichEdit; IntoStream: TStream);


procedure PutRTFSelection(aRichEdit: TUHISRichEdit; SourceStream: TStream);


procedure InsertRTF(aRichEdit: TUHISRichEdit; S: string);


procedure CopyRTF(aSource, aDest: TUHISRichEdit);


procedure CopyAllRTF(aSource, aDest: TUHISRichEdit);


procedure AppendRTF(aRichEdit: TUHISRichEdit; S: string);




implementation




function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint;


var pcb: Longint): DWORD; stdcall;


var


TheStream: TStream;


DataAvail: LongInt;


begin


TheStream := TStream(dwCookie);


with TheStream do


begin


DataAvail := Size - Position;


Result := 0;


if DataAvail <= cb then


begin


pcb := Read(pbBuff^, DataAvail);


if pcb <> DataAvail then


result := DWord(E_FAIL);


end


else


begin


pcb := Read(pbBuff^, cb);


if pcb <> cb then


result := DWord(E_FAIL);


end;


end;


TheStream := TStream(dwCookie);


end;




function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint;


var pcb: Longint): DWORD; stdcall;


var


TheStream: TStream;


begin


TheStream := TStream(dwCookie);


with TheStream do


begin


if cb > 0 then


pcb := Write(pbBuff^, cb);


Result := 0;


end;


end;




procedure GetRTFSelection(aRichEdit: TUHISRichEdit; IntoStream: TStream);


var


EditStream: TEditStream;


begin


with EditStream do


begin


dwCookie := Longint(IntoStream);


dwError := 0;


pfnCallback := EditStreamOutCallBack;


end;


aRichEdit.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@EditStream));


end;




procedure PutRTFSelection(aRichEdit: TUHISRichEdit; SourceStream: TStream);


var


EditStream: TEditStream;


begin


with EditStream do


begin


dwCookie := Longint(SourceStream);


dwError := 0;


pfnCallback := EditStreamInCallBack;


end;


aRichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@EditStream));


end;




procedure InsertRTF(aRichEdit: TUHISRichEdit; S: string);


var


aMemStream: TMemoryStream;


begin


if Length(S) > 0 then


begin


aMemStream := TMemoryStream.Create;


try


aMemStream.Write(S[1], length(S));


aMemStream.Position := 0;


PutRTFSelection(aRichEdit, aMemStream);


finally


aMemStream.Free;


end;


end;


end;




procedure CopyRTF(aSource, aDest: TUHISRichEdit);


var


aMemStream: TMemoryStream;


begin


aMemStream := TMemoryStream.Create;


try


GetRTFSelection(aSource, aMemStream);


aMemStream.Position := 0;


PutRTFSelection(aDest, aMemStream);


finally


aMemStream.Free;


end;


end;




procedure CopyAllRTF(aSource, aDest: TUHISRichEdit);


var


aMemStream: TMemoryStream;


begin


aMemStream := TMemoryStream.Create;


try


aSource.SelectAll;


GetRTFSelection(aSource, aMemStream);


aMemStream.Position := 0;


aDest.SelStart := Length(aDest.Lines.Text);


PutRTFSelection(aDest, aMemStream);


finally


aMemStream.Free;


end;


end;




procedure AppendRTF(aRichEdit: TUHISRichEdit; S: string);


var


Start, Length, EventMask: Integer;


begin


EventMask := SendMessage(aRichEdit.Handle, EM_SETEventMask, 0, 0);


SendMessage(aRichEdit.Handle, WM_SETREDRAW, 0, 0);


Start := aRichEdit.SelStart;


Length := aRichEdit.SelLength;


aRichEdit.SelLength := 0;


aRichEdit.SelStart := System.Length(aRichEdit.Text);


InsertRTF(aRichEdit, s);


aRichEdit.SelStart := Start;


aRichEdit.SelLength := Length;


SendMessage(aRichEdit.Handle, WM_SETREDRAW, 1, 0);


InvalidateRect(aRichEdit.Handle, nil, True);


SendMessage(aRichEdit.Handle, EM_SETEventMask, 0, EventMask);


end;




end.