TRichView.com

Code: Select all

procedure TForm1.rvePaste(Sender: TCustomRichViewEdit;
  var DoDefault: Boolean);
var s: String;
begin
  s := Clipboard.AsText;
  rve.InsertText(s, False);
  DoDefault := False;
end;

Code: Select all

uses Clipbrd, ActiveX, RVTypes;

{$I RV_Defs.inc}

// Returning one line string made from s.
// This function replaces all linebreaks with ' | '.
// You can change this function, for example to return the first line
function MakeOneLineString(const s: String): String;
var p: Integer;
begin
  Result := AdjustLineBreaks(s);
  while True do begin
    p := Pos(#13#10, Result);
    if p=0 then
      break;
    Delete(Result, p, 2);
    Insert(' | ', Result, p);
 end;
end;

procedure TForm3.RichViewEdit1OleDrop(Sender: TCustomRichView;
  const DataObject: IDataObject; Shift: TShiftState; X, Y: Integer;
  PossibleDropEffects: TRVOleDropEffects; var DropEffect: TRVOleDropEffect;
  var DoDefault: Boolean);
var FmtEtc: TFormatEtc;
  StgMedium: TStgMedium;
  ptr: Pointer;
  s: String;
  p: Integer;
begin
  DoDefault := False;

  FillChar(StgMedium, sizeof(StgMedium), 0);
  FillChar(FmtEtc, sizeof(FmtEtc), 0);
  {$IFDEF RVUNICODESTR} // <-- Defined in RV_Defs.inc
  FmtEtc.cfFormat := CF_UNICODETEXT;
  {$ELSE}
  FmtEtc.cfFormat := CF_TEXT;
  {$ENDIF}
  FmtEtc.dwAspect := DVASPECT_CONTENT;
  FmtEtc.lindex := -1;
  FmtEtc.tymed := TYMED_HGLOBAL;
  if DataObject.GetData(FmtEtc, StgMedium)<>S_OK then
    exit;
  if StgMedium.tymed=TYMED_HGLOBAL then begin
    ptr := GlobalLock(StgMedium.HGlobal);
    try
      SetLength(s, GlobalSize(StgMedium.HGlobal) div sizeof(Char));
      Move(ptr^, PChar(s)^, Length(s)*sizeof(Char));
    finally
      GlobalUnlock(StgMedium.HGlobal);
    end;
    p := Pos(#0, s);
    if p>0 then
      s := Copy(s, 1, p-1);
    RichViewEdit1.InsertText(MakeOneLineString(s), False);
  end;
  ReleaseStgMedium(StgMedium);
end;

procedure TForm3.RichViewEdit1Paste(Sender: TCustomRichViewEdit;
  var DoDefault: Boolean);
var s: String;
begin
  s := Clipboard.AsText;
  RichViewEdit1.InsertText(MakeOneLineString(s), False);
  DoDefault := False;
end;

Code: Select all

// Returning one line string made from s.
// This function replaces all linebreaks with ' | '.
// You can change this function, for example to return the first line
function MakeOneLineString(const s: TRVUnicodeString): TRVUnicodeString;

  procedure ReplaceLB(const LB: TRVUnicodeString; var Res: TRVUnicodeString);
  var p: Integer;
  begin
    while True do begin
      p := Pos(LB, Res);
      if p=0 then
        break;
      Delete(Res, p, 2);
      Insert(' | ', Res, p);
    end;
  end;
begin
  Result := s;
  ReplaceLB(#13#10, Result);
  ReplaceLB(#10#13, Result);
  ReplaceLB(#10, Result);
  ReplaceLB(#13, Result);
end;

function GetUnicodeStringFromHandle(mem: Cardinal): TRVUnicodeString;
var ptr: Pointer;
  p: Integer;
begin
  ptr := GlobalLock(mem);
  try
    SetLength(Result, GlobalSize(mem) div 2);
    Move(ptr^, PRVUnicodeChar(Result)^, Length(Result)*2);
  finally
    GlobalUnlock(mem);
  end;
  p := Pos(TRVUnicodeString(#0), Result);
  if p>0 then
    Result := Copy(Result, 1, p-1);
end;

procedure TForm1.RichViewEdit1OleDrop(Sender: TCustomRichView; const DataObject: IDataObject;
  Shift: TShiftState; X, Y: Integer; PossibleDropEffects: TRVOleDropEffects;
  var DropEffect: TRVOleDropEffect; var DoDefault: Boolean);
var FmtEtc: TFormatEtc;
  StgMedium: TStgMedium;
  s: TRVUnicodeString;
begin
  DoDefault := False;
  FillChar(StgMedium, sizeof(StgMedium), 0);
  FillChar(FmtEtc, sizeof(FmtEtc), 0);
  FmtEtc.cfFormat := CF_UNICODETEXT;
  FmtEtc.dwAspect := DVASPECT_CONTENT;
  FmtEtc.lindex := -1;
  FmtEtc.tymed := TYMED_HGLOBAL;
  if DataObject.GetData(FmtEtc, StgMedium)<>S_OK then
    exit;
  if StgMedium.tymed=TYMED_HGLOBAL then begin
    s := GetUnicodeStringFromHandle(StgMedium.HGlobal);
    RichViewEdit1.InsertTextW(MakeOneLineString(s), False);
  end;
  ReleaseStgMedium(StgMedium);
end;

function GetUnicodeStringFromClipboard: TRVUnicodeString;
var mem: Cardinal;
begin
  if not Clipboard.HasFormat(CF_UNICODETEXT) then begin
    Result := '';
    exit;
  end;
  Clipboard.Open;
  try
    mem := Clipboard.GetAsHandle(CF_UNICODETEXT);
    Result := GetUnicodeStringFromHandle(mem);
  finally
    Clipboard.Close;
  end;
end;

procedure TForm1.RichViewEdit1Paste(Sender: TCustomRichViewEdit; var DoDefault: Boolean);
begin
  Sender.InsertTextW(MakeOneLineString(GetUnicodeStringFromClipboard));
  DoDefault := False;
end;