pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

richmemo: update RTF saving - specify range to extract as rtf

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3801 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2014-11-28 04:51:32 +00:00
parent 179c8192f6
commit fc26c9c573
1 changed files with 55 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
components/richmemo/richmemortf.pas
View File

@@ -19,13 +19,15 @@ function LangConvGet(lang: Integer; var convproc: TEncConvProc): Boolean;
type type
TSaveParams = record // reserved TSaveParams = record // reserved
start : Integer; // the first character for the extract
len : Integer; // the number of characters to extract
end; end;
// the function depends on GetStyleRange and to be implemented properly // the function depends on GetStyleRange and to be implemented properly
// if GetStyleRange, GetParaMetric, GetParaAlignment is not working properly // if GetStyleRange, GetParaMetric, GetParaAlignment is not working properly
// the resulting RTF would not contain any styles or the text styles would be wrong // the resulting RTF would not contain any styles or the text styles would be wrong
procedure IntSaveStream(ARich: TcustomRichMemo; SaveParams: TSaveParams; Dst: TStream); procedure IntSaveStream(ARich: TcustomRichMemo; SaveParams: TSaveParams; Dst: TStream);
function SaveStream(ARich: TcustomRichMemo; Dst: TStream): Boolean; function SaveStream(ARich: TCustomRichMemo; Dst: TStream): Boolean;
procedure RegisterRTFSaver; procedure RegisterRTFSaver;
implementation implementation
@@ -470,6 +472,8 @@ var
p : TSaveParams; p : TSaveParams;
begin begin
FillChar(p, sizeof(p), 0); FillChar(p, sizeof(p), 0);
p.start:=-1;
p.len:=-1;
IntSaveStream(ARich, p, Dst); IntSaveStream(ARich, p, Dst);
Result:=True; Result:=True;
end; end;
@@ -558,7 +562,12 @@ begin
isNewPara:=false; isNewPara:=false;
while i<=length(u) do begin while i<=length(u) do begin
if u[i]='\' then Result:=Result+'\\' if u[i]='\' then Result:=Result+'\\'
else if u[i]=#13 then begin else if u[i]=#10 then begin
Result:=Result+'\par ';
isNewPara:=true;
inc(i);
Break;
end else if u[i]=#13 then begin
Result:=Result+'\par '; Result:=Result+'\par ';
isNewPara:=true; isNewPara:=true;
inc(i); inc(i);
@@ -573,6 +582,8 @@ end;
procedure IntSaveStream(ARich: TCustomRichMemo; SaveParams: TSaveParams; Dst: TStream); procedure IntSaveStream(ARich: TCustomRichMemo; SaveParams: TSaveParams; Dst: TStream);
var var
ofs : Integer; ofs : Integer;
needlen : Integer;
endless : Boolean;
root : TStyleRange; // first in the list root : TStyleRange; // first in the list
last : TStyleRange; // last in the list last : TStyleRange; // last in the list
rng : TStyleRange; // temproray rng : TStyleRange; // temproray
@@ -591,21 +602,28 @@ var
pm : TParaMetric; pm : TParaMetric;
procedure WriteOut(const s: string); procedure RtfOut(const s: string);
begin begin
write(s);
Dst.Write(s[1], length(s)); Dst.Write(s[1], length(s));
end; end;
begin begin
ofs:=0; if SaveParams.start<0 then ofs:=0
else ofs:=SaveParams.start;
root:=nil; root:=nil;
last:=nil; last:=nil;
needlen:=SaveParams.len;
endless:=needlen<0;
while ARich.GetStyleRange(ofs, st, len) do begin while ARich.GetStyleRange(ofs, st, len) do begin
rng:=TStyleRange.Create; rng:=TStyleRange.Create;
rng.textStart:=st; rng.textStart:=st;
rng.textLength:=len; if not endless then begin
if needlen<len then rng.textLength:=needlen
else rng.textLength:=len;
dec(needLen, len);
end else
rng.textLength:=len;
ARich.GetTextAttributes(ofs, rng.font); ARich.GetTextAttributes(ofs, rng.font);
if not Assigned(root) then root:=rng; if not Assigned(root) then root:=rng;
@@ -613,6 +631,7 @@ begin
last:=rng; last:=rng;
inc(ofs, len); inc(ofs, len);
if not endless and (needLen<=0) then break;
end; end;
if root=nil then begin if root=nil then begin
@@ -630,25 +649,25 @@ begin
PrepareFontTable(root, fontTable); PrepareFontTable(root, fontTable);
PrepareColorTable(root, colorTable); PrepareColorTable(root, colorTable);
WriteOut('{\rtf1\ansi\ansicp1252\deff0\deflan1033'); RtfOut('{\rtf1\ansi\ansicp1252\deff0\deflan1033');
// start of RTF // start of RTF
if fontTable.Count>0 then begin if fontTable.Count>0 then begin
// at least on font should be present anyway. // at least on font should be present anyway.
WriteOut('{\fonttbl'); RtfOut('{\fonttbl');
for i:=0 to fontTable.Count-1 do begin for i:=0 to fontTable.Count-1 do begin
// setting font id, charset to 0 and name // setting font id, charset to 0 and name
WriteOut('{\f'+IntToStR(i)+'\fcharset0 '+fontTable[i]+';}'); RtfOut('{\f'+IntToStR(i)+'\fcharset0 '+fontTable[i]+';}');
end; end;
WriteOut('}'); RtfOut('}');
end; end;
if colorTable.Count>1 then begin if colorTable.Count>1 then begin
WriteOut('{\colortbl'); RtfOut('{\colortbl');
for i:=0 to colorTable.Count-1 do begin for i:=0 to colorTable.Count-1 do begin
WriteOut( colortable[i] ); RtfOut( colortable[i] );
WriteOut( ';'); RtfOut( ';');
end; end;
WriteOut('}'); RtfOut('}');
end; end;
isnewpara := true; isnewpara := true;
@@ -660,63 +679,62 @@ begin
ARich.SelStart:=rng.textStart; ARich.SelStart:=rng.textStart;
ARich.SelLength:=rng.textLength; ARich.SelLength:=rng.textLength;
u:=UTF8Decode(ARich.SelText); u:=UTF8Decode(ARich.SelText);
WriteOut('\f'+IntToStr(rng.fontId)); RtfOut('\f'+IntToStr(rng.fontId));
WriteOut('\fs'+IntToStr(rng.font.Size*2)); RtfOut('\fs'+IntToStr(rng.font.Size*2));
if (fsBold in rng.font.Style) then begin if (fsBold in rng.font.Style) then begin
WriteOut('\b'); RtfOut('\b');
isbold:=true; isbold:=true;
end else begin end else begin
if isbold then WriteOut('\b0'); if isbold then RtfOut('\b0');
isbold:=false; isbold:=false;
end; end;
if (fsUnderline in rng.font.Style) then begin if (fsUnderline in rng.font.Style) then begin
WriteOut('\ul'); RtfOut('\ul');
isuline:=true isuline:=true
end else begin end else begin
if isuline then Write('\ulnone'); if isuline then RtfOut('\ulnone');
isuline:=false; isuline:=false;
end; end;
if isColor<>rng.colorId then begin if isColor<>rng.colorId then begin
WriteOut('\cf'+IntToStR(rng.colorId)); RtfOut('\cf'+IntToStR(rng.colorId));
isColor:=rng.ColorId; isColor:=rng.ColorId;
end; end;
if (fsItalic in rng.font.Style) then begin if (fsItalic in rng.font.Style) then begin
WriteOut('\i'); RtfOut('\i');
isitalic:=true; isitalic:=true;
end else begin end else begin
if isitalic then WriteOut('\i0'); if isitalic then RtfOut('\i0');
isitalic:=false; isitalic:=false;
end; end;
WriteOut(' '); RtfOut(' ');
i:=1; i:=1;
while i<=length(u) do begin while i<=length(u) do begin
if isNewPara then begin if isNewPara then begin
//todo: WriteOut() paragraph info
ARich.GetParaMetric(i+rng.textStart, pm); ARich.GetParaMetric(i+rng.textStart, pm);
WriteOut('\pard'); RtfOut('\pard');
case ARich.GetParaAlignment(i+rng.TextStart) of case ARich.GetParaAlignment(i+rng.TextStart) of
paRight: WriteOut('\qr'); paRight: RtfOut('\qr');
paCenter: WriteOut('\qc'); paCenter: RtfOut('\qc');
paJustify: WriteOut('\qj'); paJustify: RtfOut('\qj');
else else
end; end;
WriteOut('\li'+IntToStr(round(pm.HeadIndent*20))); RtfOut('\li'+IntToStr(round(pm.HeadIndent*20)));
if pm.FirstLine-pm.HeadIndent<>0 then if pm.FirstLine-pm.HeadIndent<>0 then
WriteOut('\fi'+IntToStr(round((pm.FirstLine-pm.HeadIndent)*20))); RtfOut('\fi'+IntToStr(round((pm.FirstLine-pm.HeadIndent)*20)));
if pm.TailIndent<>0 then WriteOut('\ri'+IntToStr(round(pm.TailIndent*20))); if pm.TailIndent<>0 then RtfOut('\ri'+IntToStr(round(pm.TailIndent*20)));
if pm.SpaceAfter<>0 then WriteOut('\sa'+IntToStr(round(pm.SpaceAfter*20))); if pm.SpaceAfter<>0 then RtfOut('\sa'+IntToStr(round(pm.SpaceAfter*20)));
if pm.SpaceBefore<>0 then WriteOut('\sb'+IntToStr(round(pm.SpaceBefore*20))); if pm.SpaceBefore<>0 then RtfOut('\sb'+IntToStr(round(pm.SpaceBefore*20)));
WriteOut(' '); RtfOut(' ');
end; end;
s:=GetRTFWriteText(u, i, isnewpara); s:=GetRTFWriteText(u, i, isnewpara);
WriteOut(s); RtfOut(s);
end; end;
rng:=rng.next; rng:=rng.next;
end; end;
// end of RTF // end of RTF
WriteOut('}'); RtfOut('}');
finally finally
fontTable.Free; fontTable.Free;
colorTable.Free; colorTable.Free;