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

  • 相关阅读:
    全基因组关联分析学习资料(GWAS tutorial)
    GWAS研究可利用的数据库(20200424更新)
    本周最新文献速递20200614
    本周最新文献速递20200607
    甲基化数据QC: 使用甲基化数据推测SNP基因型(ewastools工具)
    文献速递20200531
    查找感兴趣的基因、基因组区域是否有调控元件的在线网页工具EpiRegio
    许嵩
    甲基化数据QC:使用甲基化数据计算样本间的相关性
    there is no package called 'GO.db'报错解决方案
  • 原文地址:https://www.cnblogs.com/zhangzhifeng/p/5381683.html
Copyright © 2020-2023  润新知