• Delphi 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.

  • 相关阅读:
    IDEA创建test测试类
    SpringBoot Unable to find a @SpringBootConfiguration, you need to use @ContextConfiguration
    Mysql在线加索引锁表归纳
    工作感悟--对上一份工作总结
    ESP8266获取网络NTP时间(转)
    Python中的CGI编程 config配置(windows、Apache) 以及后期的编写(转)
    CGI与FastCGI(转)
    JSON-RPC轻量级远程调用协议介绍及使用
    java插件化编程(动态加载)
    PF4J入门指南
  • 原文地址:https://www.cnblogs.com/zhangzhifeng/p/5381683.html
Copyright © 2020-2023  润新知