How to make a plain text editor based on TRichViewEditCode: 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;