richmemo: manual reading of RTF file

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3732 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2014-11-16 06:46:18 +00:00
parent bd2ef6579f
commit 23db2b81b2
6 changed files with 135 additions and 55 deletions
--- a/components/richmemo/richmemo.pas
+++ b/components/richmemo/richmemo.pas
@ -383,13 +383,17 @@ function TCustomRichMemo.LoadRichText(Source: TStream): Boolean;
 begin
  if not HandleAllocated then HandleNeeded;
  if Assigned(Source) and HandleAllocated then begin
-    Result := TWSCustomRichMemoClass(WidgetSetClass).LoadRichText(Self, Source);
-    if not Result and Assigned(RTFLoadStream) then begin
+    if Assigned(RTFLoadStream) then begin
      Self.Lines.BeginUpdate;
-      Self.Lines.Clear;
-      Result:=RTFLoadStream(Self, Source);
-      Self.Lines.EndUpdate;
+      try
+        Self.Lines.Clear;
+        Result:=RTFLoadStream(Self, Source);
+      finally
+        Self.Lines.EndUpdate;
+      end;
    end;
+    if not Result then
+      Result := TWSCustomRichMemoClass(WidgetSetClass).LoadRichText(Self, Source);
  end else
    Result := false;
 end;
--- a/components/richmemo/richmemortf.pas
+++ b/components/richmemo/richmemortf.pas
@ -6,8 +6,6 @@ uses
  Classes, SysUtils, LCLProc, LCLIntf,
  RichMemo, RTFParsPre211, Graphics;

-//todo: formatting support!
-
 function MVCParserLoadStream(ARich: TCustomRichMemo; Source: TStream): Boolean;

 implementation
@ -20,17 +18,24 @@ type
    txtbuf   : String; // keep it UTF8 encoded!

    fcolor    : TColor;      // Foreground color
+    txtlen    : Integer;
+    pm : TParaMetric;
+    pa : TParaAlignment;
+    fnum: Integer;
+    fsz : double;
+    fst : TFontStyles;
  protected
    procedure classUnk;
    procedure classText;
    procedure classControl;
    procedure classGroup;
    procedure classEof;
+    procedure doChangePara(aminor, aparam: Integer);

    procedure doSpecialChar;
-    procedure doChangeCharAttr;
+    procedure doChangeCharAttr(aminor, aparam: Integer);

-    function GefaultTextColor: TColor;
+    function DefaultTextColor: TColor;
    procedure PushText;
  public
    Memo  : TCustomRichMemo;
@ -47,20 +52,24 @@ end;

 procedure TRTFMemoParser.classText;
 begin
-  //writeln('txt:  ', rtfMajor, ' ',rtfMinor,' ', rtfParam);
+  //writeln('txt:  ', rtfMajor, ' ',rtfMinor,' ', rtfParam,' ',Self.GetRtfText);
  case rtfMinor of
    rtfOptDest: {skipping option generator};
  else
    txtbuf:=txtbuf+Self.GetRtfText;
+    txtlen:=length(txtbuf);
+
  end;
 end;

 procedure TRTFMemoParser.classControl;
 begin
+  if txtbuf<>'' then PushText;
  //writeln('ctrl: ', rtfClass,' ', rtfMajor, ' ', Self.GetRtfText, ' ',rtfMinor,' ', rtfParam);
  case rtfMajor of
    rtfSpecialChar: doSpecialChar;
-    rtfCharAttr: doChangeCharAttr;
+    rtfCharAttr: doChangeCharAttr(rtfMinor, rtfParam);
+    rtfParAttr: doChangePara(rtfMinor, rtfParam);
  end;
 end;

@ -74,6 +83,32 @@ begin
  PushText;
 end;

+procedure TRTFMemoParser.doChangePara(aminor, aparam: Integer);
+begin
+  case aminor of
+    rtfParDef:begin
+      FillChar(pm, sizeof(pm), 0);
+      pa:=paLeft;
+    end;
+    rtfQuadLeft:    pa:=paLeft;
+    rtfQuadRight:   pa:=paRight;
+    rtfQuadJust:    pa:=paJustify;
+    rtfQuadCenter:  pa:=paCenter;
+    rtfFirstIndent: begin
+      pm.FirstLine:=aparam / 20;
+      pm.FirstLine:=pm.FirstLine+pm.HeadIndent;
+    end;
+    rtfLeftIndent: begin
+      pm.HeadIndent:=aparam / 20;
+      pm.FirstLine:=pm.FirstLine+pm.HeadIndent;
+    end;
+    rtfRightIndent:  pm.TailIndent  := aparam / 20;
+    rtfSpaceBefore:  pm.SpaceBefore := aparam / 20;
+    rtfSpaceAfter:   pm.SpaceAfter  := aparam / 20;
+    rtfSpaceBetween: pm.LineSpacing := aparam / 240;
+  end;
+end;
+
 procedure TRTFMemoParser.doSpecialChar;
 const
  {$ifdef MSWINDOWS}
@ -91,25 +126,33 @@ begin
  end;
 end;

-procedure TRTFMemoParser.doChangeCharAttr;
+procedure TRTFMemoParser.doChangeCharAttr(aminor, aparam: Integer);
 var
  p : PRTFColor;
 begin
  if txtbuf<>'' then PushText;

-  case rtfMinor of
+  case aminor of
+    rtfPlain: fst:=[];
+    rtfBold: if aparam=0 then Exclude(fst,fsBold)  else Include(fst, fsBold);
+    rtfItalic: if aparam=0 then Exclude(fst,fsItalic)  else Include(fst, fsItalic);
+    rtfStrikeThru: if aparam=0 then Exclude(fst,fsStrikeOut)  else Include(fst, fsStrikeOut);
+    rtfFontNum: fnum:=aparam;
+    rtfFontSize: fsz:=aparam/2;
+    rtfUnderline: if aparam=0 then Exclude(fst,fsUnderline)  else Include(fst, fsUnderline);
+    rtfNoUnderline: Exclude(fst, fsUnderline);
    rtfForeColor: begin
      if rtfParam<>0 then p:=Colors[rtfParam]
      else p:=nil;
      if not Assigned(p) then
-        fcolor:=GefaultTextColor
+        fcolor:=DefaultTextColor
      else
        fcolor:=RGBToColor(p^.rtfCRed, p^.rtfCGreen, p^.rtfCBlue);
    end;
  end;
 end;

-function TRTFMemoParser.GefaultTextColor:TColor;
+function TRTFMemoParser.DefaultTextColor:TColor;
 begin
  Result:=ColorToRGB(Memo.Font.Color);
 end;
@ -117,22 +160,37 @@ end;
 procedure TRTFMemoParser.PushText;
 var
  len   : Integer;
-  ofs   : Integer;
-  para  : TFontParams;
+  font  : TFontParams;
+  pf    : PRTFFONT;
+  selst : Integer;
 begin
  len:=UTF8Length(txtbuf);
  if len=0 then Exit;

-  ofs:=Memo.GetTextLen;
-  Memo.SelStart:=ofs;
+  Memo.SelStart:=MaxInt;
+  selst:=Memo.SelStart;
+  // in order to get the start selection, we need to switch to the last character
+  // and then get the value. SelStart doesn't match GetTextLen, since
+  // "StartSel" is based on number of visible characters (i.e. line break is 1 character)
+  // while GetTextLen is based on number of actual string characters
+  // selst:=Memo.GetTextLen;
+
+  Memo.SelStart:=selst;
  Memo.SelLength:=0;
  Memo.SelText:=txtbuf;

-  txtbuf:='';
+  Memo.SetParaMetric(selst, 1, pm);
+  Memo.SetParaAlignment(selst, 1, pa);

-  Memo.GetTextAttributes(ofs, para);
-  para.Color:=ColorToRGB(fColor);
-  Memo.SetTextAttributes(ofs, len, para);
+  Memo.GetTextAttributes(selst, font);
+  pf:=Fonts[fnum];
+  if Assigned(pf) then
+    font.Name:=pf^.rtfFName;
+  font.Size:=round(fsz);
+  font.Style:=fst;
+  font.Color:=ColorToRGB(fColor);
+  Memo.SetTextAttributes(selst, len, font);
+  txtbuf:='';
 end;

 constructor TRTFMemoParser.Create(AMemo:TCustomRichMemo;AStream:TStream);
@ -150,6 +208,9 @@ procedure TRTFMemoParser.StartReading;
 begin
  Memo.Lines.BeginUpdate;
  try
+    fsz:=12;//\fsN Font size in half-points (the default is 24).
+    fnum:=0;
+
    inherited StartReading;
    PushText;
    Memo.SelStart:=0;
@ -178,5 +239,4 @@ end;
 initialization
  RTFLoadStream:=@MVCParserLoadStream;

-
 end.
--- a/components/richmemo/samples/testsimple/unit1.lfm
+++ b/components/richmemo/samples/testsimple/unit1.lfm
@ -1,11 +1,11 @@
 object Form1: TForm1
  Left = 281
-  Height = 457
+  Height = 483
  Top = 198
  Width = 634
  ActiveControl = RichMemo1
  Caption = 'Form1'
-  ClientHeight = 457
+  ClientHeight = 483
  ClientWidth = 634
  OnCreate = FormCreate
  LCLVersion = '1.2.4.0'
@ -29,9 +29,9 @@ object Form1: TForm1
    TabOrder = 0
  end
  object Button1: TButton
-    Left = 24
+    Left = 16
    Height = 25
-    Top = 382
+    Top = 368
    Width = 160
    Anchors = [akLeft, akBottom]
    Caption = 'Make Bold and Red'
@ -42,7 +42,7 @@ object Form1: TForm1
  object Button2: TButton
    Left = 192
    Height = 25
-    Top = 382
+    Top = 368
    Width = 97
    Anchors = [akLeft, akBottom]
    Caption = 'Get Attribs'
@ -53,7 +53,7 @@ object Form1: TForm1
  object Button3: TButton
    Left = 304
    Height = 25
-    Top = 382
+    Top = 368
    Width = 96
    Anchors = [akLeft, akBottom]
    Caption = 'Select Font'
@ -64,7 +64,7 @@ object Form1: TForm1
  object Button4: TButton
    Left = 528
    Height = 25
-    Top = 382
+    Top = 368
    Width = 75
    Anchors = [akLeft, akBottom]
    Caption = 'Save RTF'
@ -75,7 +75,7 @@ object Form1: TForm1
  object Button5: TButton
    Left = 440
    Height = 25
-    Top = 382
+    Top = 368
    Width = 75
    Anchors = [akLeft, akBottom]
    Caption = 'Load RTF'
@ -84,9 +84,9 @@ object Form1: TForm1
    TabStop = False
  end
  object Button6: TButton
-    Left = 24
+    Left = 16
    Height = 25
-    Top = 415
+    Top = 400
    Width = 160
    Anchors = [akLeft, akBottom]
    Caption = 'Next Style Range'
@ -188,23 +188,31 @@ object Form1: TForm1
    OnClick = Button12Click
    TabOrder = 14
  end
+  object Label3: TLabel
+    Left = 16
+    Height = 15
+    Top = 434
+    Width = 34
+    Caption = 'Label3'
+    ParentColor = False
+  end
  object FontDialog1: TFontDialog
    MinFontSize = 0
    MaxFontSize = 0
    left = 352
-    top = 429
+    top = 389
  end
  object SaveDialog1: TSaveDialog
    DefaultExt = '.rtf'
    Filter = 'RichText file (*.rtf)|*.rtf'
    Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
    left = 280
-    top = 429
+    top = 389
  end
  object OpenDialog1: TOpenDialog
    DefaultExt = '.rtf'
    Filter = 'RichText file (*.rtf)|*.rtf'
    left = 208
-    top = 429
+    top = 389
  end
 end
--- a/components/richmemo/samples/testsimple/unit1.lrs
+++ b/components/richmemo/samples/testsimple/unit1.lrs
@ -1,30 +1,30 @@
 { This is an automatically generated lazarus resource file }

 LazarusResources.Add('TForm1','FORMDATA',[
-  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#25#1#6'Height'#3#201#1#3'Top'#3#198#0#5'W'
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#25#1#6'Height'#3#227#1#3'Top'#3#198#0#5'W'
  +'idth'#3'z'#2#13'ActiveControl'#7#9'RichMemo1'#7'Caption'#6#5'Form1'#12'Clie'
-  +'ntHeight'#3#201#1#11'ClientWidth'#3'z'#2#8'OnCreate'#7#10'FormCreate'#10'LC'
+  +'ntHeight'#3#227#1#11'ClientWidth'#3'z'#2#8'OnCreate'#7#10'FormCreate'#10'LC'
  +'LVersion'#6#7'1.2.4.0'#0#9'TRichMemo'#9'RichMemo1'#4'Left'#2#15#6'Height'#3
  +#8#1#3'Top'#2'`'#5'Width'#3'a'#2#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'
  +#8'akBottom'#0#11'Font.Height'#2#243#9'Font.Name'#6#6'Tahoma'#13'HideSelecti'
  +'on'#8#13'Lines.Strings'#1#6#9'RichMemo1'#0#8'OnChange'#7#15'RichMemo1Change'
  +#7'OnKeyUp'#7#14'RichMemo1KeyUp'#9'OnMouseUp'#7#16'RichMemo1MouseUp'#10'Pare'
  +'ntFont'#8#10'ScrollBars'#7#10'ssVertical'#8'TabOrder'#2#0#0#0#7'TButton'#7
-  +'Button1'#4'Left'#2#24#6'Height'#2#25#3'Top'#3'~'#1#5'Width'#3#160#0#7'Ancho'
+  +'Button1'#4'Left'#2#16#6'Height'#2#25#3'Top'#3'p'#1#5'Width'#3#160#0#7'Ancho'
  +'rs'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#17'Make Bold and Red'#7'OnClick'
  +#7#12'Button1Click'#8'TabOrder'#2#1#7'TabStop'#8#0#0#7'TButton'#7'Button2'#4
-  +'Left'#3#192#0#6'Height'#2#25#3'Top'#3'~'#1#5'Width'#2'a'#7'Anchors'#11#6'ak'
+  +'Left'#3#192#0#6'Height'#2#25#3'Top'#3'p'#1#5'Width'#2'a'#7'Anchors'#11#6'ak'
  +'Left'#8'akBottom'#0#7'Caption'#6#11'Get Attribs'#7'OnClick'#7#12'Button2Cli'
  +'ck'#8'TabOrder'#2#2#7'TabStop'#8#0#0#7'TButton'#7'Button3'#4'Left'#3'0'#1#6
-  +'Height'#2#25#3'Top'#3'~'#1#5'Width'#2'`'#7'Anchors'#11#6'akLeft'#8'akBottom'
+  +'Height'#2#25#3'Top'#3'p'#1#5'Width'#2'`'#7'Anchors'#11#6'akLeft'#8'akBottom'
  +#0#7'Caption'#6#11'Select Font'#7'OnClick'#7#12'Button3Click'#8'TabOrder'#2#3
  +#7'TabStop'#8#0#0#7'TButton'#7'Button4'#4'Left'#3#16#2#6'Height'#2#25#3'Top'
-  +#3'~'#1#5'Width'#2'K'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#8'S'
+  +#3'p'#1#5'Width'#2'K'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#8'S'
  +'ave RTF'#7'OnClick'#7#12'Button4Click'#8'TabOrder'#2#4#7'TabStop'#8#0#0#7'T'
-  +'Button'#7'Button5'#4'Left'#3#184#1#6'Height'#2#25#3'Top'#3'~'#1#5'Width'#2
+  +'Button'#7'Button5'#4'Left'#3#184#1#6'Height'#2#25#3'Top'#3'p'#1#5'Width'#2
  +'K'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#8'Load RTF'#7'OnClick'
  +#7#12'Button5Click'#8'TabOrder'#2#5#7'TabStop'#8#0#0#7'TButton'#7'Button6'#4
-  +'Left'#2#24#6'Height'#2#25#3'Top'#3#159#1#5'Width'#3#160#0#7'Anchors'#11#6'a'
+  +'Left'#2#16#6'Height'#2#25#3'Top'#3#144#1#5'Width'#3#160#0#7'Anchors'#11#6'a'
  +'kLeft'#8'akBottom'#0#7'Caption'#6#16'Next Style Range'#7'OnClick'#7#12'Butt'
  +'on6Click'#8'TabOrder'#2#6#7'TabStop'#8#0#0#7'TButton'#7'Button7'#4'Left'#2
  +#15#6'Height'#2#25#3'Top'#2#16#5'Width'#2'3'#7'Caption'#6#4'Left'#7'OnClick'
@ -49,11 +49,13 @@ LazarusResources.Add('TForm1','FORMDATA',[
  +#2#25#3'Top'#2'4'#5'Width'#2'K'#7'Caption'#6#6'Bullet'#7'OnClick'#7#13'Butto'
  +'n11Click'#8'TabOrder'#2#13#0#0#7'TButton'#8'Button12'#4'Left'#2'h'#6'Height'
  +#2#25#3'Top'#2'4'#5'Width'#2'K'#7'Caption'#6#6'Number'#7'OnClick'#7#13'Butto'
-  +'n12Click'#8'TabOrder'#2#14#0#0#11'TFontDialog'#11'FontDialog1'#11'MinFontSi'
-  +'ze'#2#0#11'MaxFontSize'#2#0#4'left'#3'`'#1#3'top'#3#173#1#0#0#11'TSaveDialo'
-  +'g'#11'SaveDialog1'#10'DefaultExt'#6#4'.rtf'#6'Filter'#6#27'RichText file (*'
-  +'.rtf)|*.rtf'#7'Options'#11#17'ofOverwritePrompt'#14'ofEnableSizing'#12'ofVi'
-  +'ewDetail'#0#4'left'#3#24#1#3'top'#3#173#1#0#0#11'TOpenDialog'#11'OpenDialog'
-  +'1'#10'DefaultExt'#6#4'.rtf'#6'Filter'#6#27'RichText file (*.rtf)|*.rtf'#4'l'
-  +'eft'#3#208#0#3'top'#3#173#1#0#0#0
+  +'n12Click'#8'TabOrder'#2#14#0#0#6'TLabel'#6'Label3'#4'Left'#2#16#6'Height'#2
+  +#15#3'Top'#3#178#1#5'Width'#2'"'#7'Caption'#6#6'Label3'#11'ParentColor'#8#0#0
+  +#11'TFontDialog'#11'FontDialog1'#11'MinFontSize'#2#0#11'MaxFontSize'#2#0#4'l'
+  +'eft'#3'`'#1#3'top'#3#133#1#0#0#11'TSaveDialog'#11'SaveDialog1'#10'DefaultEx'
+  +'t'#6#4'.rtf'#6'Filter'#6#27'RichText file (*.rtf)|*.rtf'#7'Options'#11#17'o'
+  +'fOverwritePrompt'#14'ofEnableSizing'#12'ofViewDetail'#0#4'left'#3#24#1#3'to'
+  +'p'#3#133#1#0#0#11'TOpenDialog'#11'OpenDialog1'#10'DefaultExt'#6#4'.rtf'#6'F'
+  +'ilter'#6#27'RichText file (*.rtf)|*.rtf'#4'left'#3#208#0#3'top'#3#133#1#0#0
+  +#0
 ]);
--- a/components/richmemo/samples/testsimple/unit1.pas
+++ b/components/richmemo/samples/testsimple/unit1.pas
@ -5,9 +5,9 @@ unit Unit1;
 interface

 uses
-  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  Classes, SysUtils, LCLIntf, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, Spin,
-  RichMemo;
+  RichMemo, RichMemoRTF, Win32RichMemo;

 type

@ -26,6 +26,7 @@ type
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
+    Label3: TLabel;
    StartIdent: TFloatSpinEdit;
    FontDialog1: TFontDialog;
    Label1: TLabel;
@ -138,6 +139,7 @@ end;
 procedure TForm1.Button5Click(Sender: TObject);
 var
  fs : TFileStream;
+  tm : longWord;
 begin
  if OpenDialog1.Execute then begin
    fs := nil;
@ -211,6 +213,7 @@ procedure TForm1.RichMemo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
 begin
  ParaMetricRead;
+  Label3.Caption:='Sel start: '+IntToStr(RichMemo1.SelStart);
 end;

 procedure TForm1.ParaMetricRead;
--- a/components/richmemo/win32/win32richmemo.pas
+++ b/components/richmemo/win32/win32richmemo.pas
@ -419,7 +419,10 @@ begin
    //round(AMetrics.HeadIndent*20);
  para.dySpaceAfter:=round(AMetrics.SpaceAfter*20);
  para.dySpaceBefore:=round(AMetrics.SpaceBefore*20);
-  para.dyLineSpacing:=round(AMetrics.LineSpacing*20);
+  if AMetrics.LineSpacing > 0 then begin
+    para.dyLineSpacing:=round(AMetrics.LineSpacing*20);
+    para.bLineSpacingRule:=5; // always line spacing?
+  end;
  RichEditManager.SetPara2(AWinControl.Handle, TextStart, TextLength, para);
 end;