关闭

RxRichEdit高级操作

标签: stringintegerformsinterfacefunctionwindows
2238人阅读 评论(0) 收藏 举报
分类:

 

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, 00);
  SendMessage(aRichEdit.Handle, WM_SETREDRAW, 
00);
  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, 
10);
  InvalidateRect(aRichEdit.Handle, nil, True);
  SendMessage(aRichEdit.Handle, EM_SETEventMask, 
0, EventMask);
end;

end.
0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:167634次
    • 积分:2461
    • 等级:
    • 排名:第14956名
    • 原创:73篇
    • 转载:13篇
    • 译文:0篇
    • 评论:25条
    文章分类