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

components/richmemo/richmemofactory.pas

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

components/richmemo/richmemortf.pas

@@ -4,7 +4,7 @@ interface
 
 uses
   Classes, SysUtils, LCLProc, LCLIntf,
-  RichMemo, RTFParsPre211;
+  RichMemo, RTFParsPre211, Graphics;
 
 //todo: formatting support!
 
@@ -16,26 +16,42 @@ type
   { TRTFMemoParser }
 
   TRTFMemoParser = class(TRTFParser)
+  private
+    txtbuf   : String; // keep it UTF8 encoded!
+
+    fcolor    : TColor;      // Foreground color
   protected
+    procedure classUnk;
     procedure classText;
     procedure classControl;
+    procedure classGroup;
+    procedure classEof;
 
     procedure doSpecialChar;
+    procedure doChangeCharAttr;
+
+    function GefaultTextColor: TColor;
+    procedure PushText;
   public
-    txt   : String;
     Memo  : TCustomRichMemo;
     constructor Create(AMemo: TCustomRichMemo; AStream: TStream);
+    procedure StartReading;
   end;
 
-
 { TRTFMemoParserr }
+
+procedure TRTFMemoParser.classUnk;
+begin
+  //writelN('unk: ', rtfMajor, ' ',rtfMinor,' ', rtfParam,' ', GetRtfText);
+end;
+
 procedure TRTFMemoParser.classText;
 begin
   //writeln('txt:  ', rtfMajor, ' ',rtfMinor,' ', rtfParam);
   case rtfMinor of
-    rtfOptDest:;
+    rtfOptDest: {skipping option generator};
   else
-    txt:=txt+Self.GetRtfText;
+    txtbuf:=txtbuf+Self.GetRtfText;
   end;
 end;
 
@@ -44,28 +60,103 @@ begin
   //writeln('ctrl: ', rtfClass,' ', rtfMajor, ' ', Self.GetRtfText, ' ',rtfMinor,' ', rtfParam);
   case rtfMajor of
     rtfSpecialChar: doSpecialChar;
+    rtfCharAttr: doChangeCharAttr;
   end;
 end;
 
+procedure TRTFMemoParser.classGroup;
+begin
+  //writeln('group:  ', rtfMajor, ' ',rtfMinor,' ', rtfParam, ' ', GetRtfText);
+end;
+
+procedure TRTFMemoParser.classEof;
+begin
+  PushText;
+end;
+
 procedure TRTFMemoParser.doSpecialChar;
 const
+  {$ifdef MSWINDOWS}
+  CharPara = #13#10;
+  {$else}
   CharPara = #10;
+  {$endif}
   CharTab  = #9;
   CharLine = #13;
 begin
   case rtfMinor of
-    rtfLine: txt:=txt+CharLine;
-    rtfPar:  txt:=txt+CharPara;
-    rtfTab:  txt:=txt+CharTab;
+    rtfLine: txtbuf:=txtbuf+CharLine;
+    rtfPar:  txtbuf:=txtbuf+CharPara;
+    rtfTab:  txtbuf:=txtbuf+CharTab;
   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);
 begin
   inherited Create(AStream);
   Memo:=AMemo;
   ClassCallBacks[rtfText]:=@classText;
   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;
 
 function MVCParserLoadStream(ARich: TCustomRichMemo; Source: TStream): Boolean;
@@ -78,9 +169,6 @@ begin
   p:=TRTFMemoParser.Create(ARich, Source);
   try
     p.StartReading;
-    ARich.SelStart:=0;
-    ARich.SelLength:=0;
-    ARich.Text:=p.txt;
   finally
     p.Free;
   end;

components/richmemo/win32/win32richmemo.pas

@@ -60,6 +60,8 @@ type
     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 SaveRichText(const AWinControl: TWinControl; Dst: TStream): Boolean; override;
+
+    class procedure InDelText(const AWinControl: TWinControl; const TextUTF8: String; DstStart, DstLen: Integer); override;
   end;
   
 implementation
@@ -316,6 +318,7 @@ class function TWin32WSCustomRichMemo.LoadRichText(
   const AWinControl: TWinControl; Source: TStream): Boolean;  
 begin
   Result := false;
+  Exit;
   if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
   Result := RichEditManager.LoadRichText(AWinControl.Handle, Source);
 end;
@@ -328,5 +331,11 @@ begin
   Result := RichEditManager.SaveRichText(AWinControl.Handle, Dst);
 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.
 

components/richmemo/win32/win32richmemoproc.pas

@@ -48,6 +48,7 @@ type
     class procedure SetHideSelection(RichEditWnd: Handle; AValue: Boolean); virtual;
     class function LoadRichText(RichEditWnd: Handle; ASrc: 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;
   TRichManagerClass = class of TRichEditManager;
                      
@@ -373,5 +374,28 @@ begin
   Result := cbs.dwError = 0;
 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.