richmemo: update custom rtf parser, win32 added InDel implementation

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1228 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2010-05-20 12:21:17 +00:00
parent 9238e84017
commit 3ac6af427e
4 changed files with 141 additions and 21 deletions

View File

@ -4,25 +4,24 @@ unit RichMemoFactory;
interface interface
{$define NoRichMemo}
{$ifdef LCLWin32}{$undef NoRichMemo}{$endif}
{$ifdef LCLCarbon}{$undef NoRichMemo}{$endif}
{$ifdef LCLGtk2}{$undef NoRichMemo}{$endif}
uses uses
WSLCLClasses, WSLCLClasses,
RichMemo, RichMemo
WSRichMemo {$ifdef NoRichMemo},WSRichMemo{$endif}
{$ifdef LCLWin32},Win32RichMemo{$endif} {$ifdef LCLWin32},Win32RichMemo{$endif}
{$ifdef LCLCarbon},CarbonRichMemo{$endif} {$ifdef LCLCarbon},CarbonRichMemo{$endif}
{$ifdef LCLGtk2},Gtk2RichMemo{$endif} {$ifdef LCLGtk2},RichMemoRTF, Gtk2RichMemo{$endif}
; ;
function RegisterCustomRichMemo: Boolean; function RegisterCustomRichMemo: Boolean;
implementation implementation
{$define NoRichMemo}
{$ifdef LCLWin32}{$undef NoRichMemo}{$endif}
{$ifdef LCLCarbon}{$undef NoRichMemo}{$endif}
{$ifdef LCLGtk2}{$undef NoRichMemo}{$endif}
function RegisterCustomRichMemo: Boolean; alias : 'WSRegisterCustomRichMemo'; function RegisterCustomRichMemo: Boolean; alias : 'WSRegisterCustomRichMemo';
begin begin
Result := True; Result := True;

View File

@ -4,7 +4,7 @@ interface
uses uses
Classes, SysUtils, LCLProc, LCLIntf, Classes, SysUtils, LCLProc, LCLIntf,
RichMemo, RTFParsPre211; RichMemo, RTFParsPre211, Graphics;
//todo: formatting support! //todo: formatting support!
@ -16,26 +16,42 @@ type
{ TRTFMemoParser } { TRTFMemoParser }
TRTFMemoParser = class(TRTFParser) TRTFMemoParser = class(TRTFParser)
private
txtbuf : String; // keep it UTF8 encoded!
fcolor : TColor; // Foreground color
protected protected
procedure classUnk;
procedure classText; procedure classText;
procedure classControl; procedure classControl;
procedure classGroup;
procedure classEof;
procedure doSpecialChar; procedure doSpecialChar;
procedure doChangeCharAttr;
function GefaultTextColor: TColor;
procedure PushText;
public public
txt : String;
Memo : TCustomRichMemo; Memo : TCustomRichMemo;
constructor Create(AMemo: TCustomRichMemo; AStream: TStream); constructor Create(AMemo: TCustomRichMemo; AStream: TStream);
procedure StartReading;
end; end;
{ TRTFMemoParserr } { TRTFMemoParserr }
procedure TRTFMemoParser.classUnk;
begin
//writelN('unk: ', rtfMajor, ' ',rtfMinor,' ', rtfParam,' ', GetRtfText);
end;
procedure TRTFMemoParser.classText; procedure TRTFMemoParser.classText;
begin begin
//writeln('txt: ', rtfMajor, ' ',rtfMinor,' ', rtfParam); //writeln('txt: ', rtfMajor, ' ',rtfMinor,' ', rtfParam);
case rtfMinor of case rtfMinor of
rtfOptDest:; rtfOptDest: {skipping option generator};
else else
txt:=txt+Self.GetRtfText; txtbuf:=txtbuf+Self.GetRtfText;
end; end;
end; end;
@ -44,28 +60,103 @@ begin
//writeln('ctrl: ', rtfClass,' ', rtfMajor, ' ', Self.GetRtfText, ' ',rtfMinor,' ', rtfParam); //writeln('ctrl: ', rtfClass,' ', rtfMajor, ' ', Self.GetRtfText, ' ',rtfMinor,' ', rtfParam);
case rtfMajor of case rtfMajor of
rtfSpecialChar: doSpecialChar; rtfSpecialChar: doSpecialChar;
rtfCharAttr: doChangeCharAttr;
end; end;
end; end;
procedure TRTFMemoParser.classGroup;
begin
//writeln('group: ', rtfMajor, ' ',rtfMinor,' ', rtfParam, ' ', GetRtfText);
end;
procedure TRTFMemoParser.classEof;
begin
PushText;
end;
procedure TRTFMemoParser.doSpecialChar; procedure TRTFMemoParser.doSpecialChar;
const const
{$ifdef MSWINDOWS}
CharPara = #13#10;
{$else}
CharPara = #10; CharPara = #10;
{$endif}
CharTab = #9; CharTab = #9;
CharLine = #13; CharLine = #13;
begin begin
case rtfMinor of case rtfMinor of
rtfLine: txt:=txt+CharLine; rtfLine: txtbuf:=txtbuf+CharLine;
rtfPar: txt:=txt+CharPara; rtfPar: txtbuf:=txtbuf+CharPara;
rtfTab: txt:=txt+CharTab; rtfTab: txtbuf:=txtbuf+CharTab;
end; end;
end; end;
procedure TRTFMemoParser.doChangeCharAttr;
var
p : PRTFColor;
begin
if txtbuf<>'' then PushText;
case rtfMinor of
rtfForeColor: begin
if rtfParam<>0 then p:=Colors[rtfParam]
else p:=nil;
if not Assigned(p) then
fcolor:=GefaultTextColor
else
fcolor:=RGBToColor(p^.rtfCRed, p^.rtfCGreen, p^.rtfCBlue);
end;
end;
end;
function TRTFMemoParser.GefaultTextColor:TColor;
begin
Result:=ColorToRGB(Memo.Font.Color);
end;
procedure TRTFMemoParser.PushText;
var
len : Integer;
ofs : Integer;
para : TFontParams;
begin
len:=UTF8Length(txtbuf);
if len=0 then Exit;
ofs:=Memo.GetTextLen;
Memo.SelStart:=ofs;
Memo.SelLength:=0;
Memo.SelText:=txtbuf;
txtbuf:='';
Memo.GetTextAttributes(ofs, para);
para.Color:=ColorToRGB(fColor);
Memo.SetTextAttributes(ofs, len, para);
end;
constructor TRTFMemoParser.Create(AMemo:TCustomRichMemo;AStream:TStream); constructor TRTFMemoParser.Create(AMemo:TCustomRichMemo;AStream:TStream);
begin begin
inherited Create(AStream); inherited Create(AStream);
Memo:=AMemo; Memo:=AMemo;
ClassCallBacks[rtfText]:=@classText; ClassCallBacks[rtfText]:=@classText;
ClassCallBacks[rtfControl]:=@classControl; ClassCallBacks[rtfControl]:=@classControl;
ClassCallBacks[rtfGroup]:=@classGroup;
ClassCallBacks[rtfUnknown]:=@classUnk;
ClassCallBacks[rtfEof]:=@classEof;
end;
procedure TRTFMemoParser.StartReading;
begin
Memo.Lines.BeginUpdate;
try
inherited StartReading;
PushText;
Memo.SelStart:=0;
Memo.SelLength:=0;
finally
Memo.Lines.EndUpdate;
end;
end; end;
function MVCParserLoadStream(ARich: TCustomRichMemo; Source: TStream): Boolean; function MVCParserLoadStream(ARich: TCustomRichMemo; Source: TStream): Boolean;
@ -78,9 +169,6 @@ begin
p:=TRTFMemoParser.Create(ARich, Source); p:=TRTFMemoParser.Create(ARich, Source);
try try
p.StartReading; p.StartReading;
ARich.SelStart:=0;
ARich.SelLength:=0;
ARich.Text:=p.txt;
finally finally
p.Free; p.Free;
end; end;

View File

@ -31,7 +31,7 @@ uses
// LCL headers // LCL headers
LCLType, LCLIntf, LCLProc, WSLCLClasses, LCLType, LCLIntf, LCLProc, WSLCLClasses,
Graphics, Controls, StdCtrls, Graphics, Controls, StdCtrls,
// Win32WidgetSet // Win32WidgetSet
Win32WSControls, Win32Int, Win32WSControls, Win32Int,
// RichMemo headers // RichMemo headers
WSRichMemo, Win32RichMemoProc; WSRichMemo, Win32RichMemoProc;
@ -54,12 +54,14 @@ type
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
class function GetTextAttributes(const AWinControl: TWinControl; TextStart: Integer; class function GetTextAttributes(const AWinControl: TWinControl; TextStart: Integer;
var Params: TIntFontParams): Boolean; override; var Params: TIntFontParams): Boolean; override;
class procedure SetTextAttributes(const AWinControl: TWinControl; TextStart, TextLen: Integer; class procedure SetTextAttributes(const AWinControl: TWinControl; TextStart, TextLen: Integer;
const Params: TIntFontParams); override; const Params: TIntFontParams); override;
class procedure SetHideSelection(const ACustomEdit: TCustomEdit; AHideSelection: Boolean); override; class procedure SetHideSelection(const ACustomEdit: TCustomEdit; AHideSelection: Boolean); override;
class function GetStyleRange(const AWinControl: TWinControl; TextStart: Integer; var RangeStart, RangeLen: Integer): Boolean; override; class function GetStyleRange(const AWinControl: TWinControl; TextStart: Integer; var RangeStart, RangeLen: Integer): Boolean; override;
class function LoadRichText(const AWinControl: TWinControl; Source: TStream): Boolean; override; class function LoadRichText(const AWinControl: TWinControl; Source: TStream): Boolean; override;
class function SaveRichText(const AWinControl: TWinControl; Dst: TStream): Boolean; override; class function SaveRichText(const AWinControl: TWinControl; Dst: TStream): Boolean; override;
class procedure InDelText(const AWinControl: TWinControl; const TextUTF8: String; DstStart, DstLen: Integer); override;
end; end;
implementation implementation
@ -316,6 +318,7 @@ class function TWin32WSCustomRichMemo.LoadRichText(
const AWinControl: TWinControl; Source: TStream): Boolean; const AWinControl: TWinControl; Source: TStream): Boolean;
begin begin
Result := false; Result := false;
Exit;
if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit; if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
Result := RichEditManager.LoadRichText(AWinControl.Handle, Source); Result := RichEditManager.LoadRichText(AWinControl.Handle, Source);
end; end;
@ -327,6 +330,12 @@ begin
if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit; if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
Result := RichEditManager.SaveRichText(AWinControl.Handle, Dst); Result := RichEditManager.SaveRichText(AWinControl.Handle, Dst);
end; end;
class procedure TWin32WSCustomRichMemo.InDelText(const AWinControl:TWinControl;
const TextUTF8:String;DstStart,DstLen:Integer);
begin
RichEditManager.SetText(AWinControl.Handle,UTF8Decode(TextUTF8),DstStart,DstLen);
end;
end. end.

View File

@ -48,6 +48,7 @@ type
class procedure SetHideSelection(RichEditWnd: Handle; AValue: Boolean); virtual; class procedure SetHideSelection(RichEditWnd: Handle; AValue: Boolean); virtual;
class function LoadRichText(RichEditWnd: Handle; ASrc: TStream): Boolean; virtual; class function LoadRichText(RichEditWnd: Handle; ASrc: TStream): Boolean; virtual;
class function SaveRichText(RichEditWnd: Handle; ADst: TStream): Boolean; virtual; class function SaveRichText(RichEditWnd: Handle; ADst: TStream): Boolean; virtual;
class procedure SetText(RichEditWnd: Handle; const Text: WideString; TextStart, ReplaceLength: Integer); virtual;
end; end;
TRichManagerClass = class of TRichEditManager; TRichManagerClass = class of TRichEditManager;
@ -373,5 +374,28 @@ begin
Result := cbs.dwError = 0; Result := cbs.dwError = 0;
end; end;
class procedure TRichEditManager.SetText(RichEditWnd:Handle;
const Text: WideString; TextStart, ReplaceLength:Integer);
var
AnsiText : AnsiString;
txt : PChar;
s, l : Integer;
begin
GetSelection(RichEditWnd, s, l);
SetSelection(RichEditWnd, TextStart, ReplaceLength);
txt:=nil;
if UnicodeEnabledOS then begin
if Text<>'' then txt:=@Text[1];
SendMessageW(RichEditWnd, EM_REPLACESEL, 0, LPARAM(txt));
end else begin
AnsiText:=Text;
if AnsiText<>'' then txt:=@AnsiText[1];
SendMessageA(RichEditWnd, EM_REPLACESEL, 0, LPARAM(txt));
end;
SetSelection(RichEditWnd, s, l);
end;
end. end.