XML экспорт

отредактировано 15:47 Раздел: FastReport 3.0
В XML экспорте, если число с разделителем тысяч, то конструкция

s := UTF8Encode(TruncReturns(Obj.Memo.Text));
if (Obj.DisplayFormat.Kind = fkNumeric) and IsDigits(s) then
begin
s := StringReplace(s, ThousandSeparator, '', [rfReplaceAll]);
s := StringReplace(s, Obj.DisplayFormat.DecimalSeparator, '.', [rfReplaceAll]);
s := Trim(s);
si := ' ss:Type="Number"';
WriteExpLn('<Data' + si + '>' + s + '</Data>');
end
else
begin
si := ' ss:Type="String"';
s := ChangeReturns(s);
WriteExpLn('<Data' + si + '>' + s + '</Data>');
end;

экспортирует строку, а не число, а следующая конструкция работает

s := TruncReturns(Obj.Memo.Text);
if (Obj.DisplayFormat.Kind = fkNumeric) and IsDigits(s) then
begin
s := StringReplace(s, ThousandSeparator, '', [rfReplaceAll]);
s := StringReplace(s, 'р.', '', [rfReplaceAll]);
s := StringReplace(s, ',', '.', [rfReplaceAll]);
s := Trim(s);
si := ' ss:Type="Number"';
WriteExpLn('<Data' + si + '>' + UTF8Encode(s) + '</Data>');
end
else
begin
si := ' ss:Type="String"';
s := ChangeReturns(s);
WriteExpLn('<Data' + si + '>' + UTF8Encode(s) + '</Data>');
end;


После каждого релиза приходится исправлять экспорт.
Ниже приведенная процедура процедура правильно экспортирующая и форматы с разделителями тысяч и денежные

procedure TfrxXMLExport.ExportPage(Stream: TStream);
var
i, x, y, dx, dy, fx, fy, Page: Integer;
dcol, drow: Extended;
s, sb, si, su: String;
Vert, Horiz: String;
obj: TfrxIEMObject;
EStyle: TfrxIEMStyle;
St: String;
PageBreak: TStringList;

{!!!!!!}
k, m, nn : integer;
fs: string;
FormatList: TStringList;

function IsDigits(const Str: String): Boolean;
var
i: Integer;
begin
Result := True;
for i := 1 to Length(Str) do
if not((AnsiChar(Str) in ) or (Ord(Str) = 160)) then
begin
Result := False;
break;
end;
end;
{!!!!!!!}

procedure WriteExpLn(const str: String);
begin
if Length(str) > 0 then
Stream.Write(str[1], Length(str));
Stream.Write(#13#10, 2);
end;

procedure AlignFR2AlignExcel(HAlign: TfrxHAlign; VAlign: TfrxVAlign;
var AlignH, AlignV: String);
begin
if HAlign = haLeft then
AlignH := 'Left'
else if HAlign = haRight then
AlignH := 'Right'
else if HAlign = haCenter then
AlignH := 'Center'
else if HAlign = haBlock then
AlignH := 'Justify'
else
AlignH := '';
if VAlign = vaTop then
AlignV := 'Top'
else if VAlign = vaBottom then
AlignV := 'Bottom'
else if VAlign = vaCenter then
AlignV := 'Center'
else
AlignV := '';
end;

{!!!!!!}
function ConvertFormat(const fstr: string): string;
var
err, p : integer;
s: string;
begin
result := '';
s := '';
if length(fstr)>0 then
begin
p := pos('.', fstr);
if p > 0 then
begin
s := Copy(fstr, p+1, length(fstr)-p-1);
val(s, p ,err);
SetLength(s, p);
if p>0 then
begin
FillChar(s[1], p, '0');
s:='.'+s;
end;
end;
case fstr[length(fstr)] of
'n': result := '#,##0'+s;
'f': result := '0'+s;
'g': result := '0.##';
'm': result := '#,##0.00"р."';
else result := '#,##0.00';
end;
end;
end;
{!!!!!!}

begin
PageBreak := TStringList.Create;

{!!!!!!!!} FormatList := TStringList.Create; {!!!!!!!!!!}

if FShowProgress then
begin
FProgress := TfrxProgress.Create(nil);
FProgress.Execute(FMatrix.PagesCount, 'Exporting pages', True, True);
end;

WriteExpLn('<?xml version="1.0"?>');
WriteExpLn('<?mso-application progid="Excel.Sheet"?>');
WriteExpLn('<?fr-application created="' + UTF8Encode(FCreator) + '"?>');
WriteExpLn('<?fr-application homesite="http://www.fast-report.com"?>');
WriteExpLn('<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"');
WriteExpLn(' xmlns:o="urn:schemas-microsoft-com:office:office"');
WriteExpLn(' xmlns:x="urn:schemas-microsoft-com:office:excel"');
WriteExpLn(' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"');
WriteExpLn(' xmlns:html="http://www.w3.org/TR/REC-html40">');
WriteExpLn('<DocumentProperties xmlns="urn:schemas-microsoft-com:office:office">');
WriteExpLn('<Title>' + UTF8Encode(Report.ReportOptions.Name) + '</Title>');
WriteExpLn('<Author>' + UTF8Encode(Report.ReportOptions.Author) + '</Author>');
WriteExpLn('<Created>' + DateToStr(Date) + 'T' + TimeToStr(Time) + 'Z</Created>');
WriteExpLn('<Version>' + UTF8Encode(Report.ReportOptions.VersionMajor) + '.' +
UTF8Encode(Report.ReportOptions.VersionMinor) + '.' +
UTF8Encode(Report.ReportOptions.VersionRelease) + '.' +
UTF8Encode(Report.ReportOptions.VersionBuild) + '</Version>');
WriteExpLn('</DocumentProperties>');
WriteExpLn('<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">');
WriteExpLn('<ProtectStructure>False</ProtectStructure>');
WriteExpLn('<ProtectWindows>False</ProtectWindows>');
WriteExpLn('</ExcelWorkbook>');

if FExportStyles then
begin
WriteExpLn('<Styles>');
for x := 0 to FMatrix.StylesCount - 1 do
begin
EStyle := FMatrix.GetStyleById(x);
s := 's' + IntToStr(x);
WriteExpLn('<Style ss:ID="'+s+'">');
if fsBold in EStyle.Font.Style then
sb := ' ss:Bold="1"'
else
sb := '';
if fsItalic in EStyle.Font.Style then
si := ' ss:Italic="1"'
else
si := '';
if fsUnderline in EStyle.Font.Style then
su := ' ss:Underline="Single"'
else
su := '';
WriteExpLn('<Font '+
'ss:FontName="' + EStyle.Font.Name + '" '+
'ss:Size="' + IntToStr(EStyle.Font.Size) + '" ' +
'ss:Color="' + HTMLRGBColor(EStyle.Font.Color) + '"' + sb + si + su + '/>');
WriteExpLn('<Interior ss:Color="' + HTMLRGBColor(EStyle.Color) +
'" ss:Pattern="Solid"/>');
AlignFR2AlignExcel(EStyle.HAlign, EStyle.VAlign, Horiz, Vert);
if (EStyle.Rotation > 0) and (EStyle.Rotation <= 90) then
s := 'ss:Rotate="' + IntToStr(EStyle.Rotation) + '"'
else if (EStyle.Rotation < 360) and (EStyle.Rotation >= 270) then
s := 'ss:Rotate="' + IntToStr(EStyle.Rotation - 360) + '"'
else
s := '';
si := '" ss:WrapText="1" ';
WriteExpLn('<Alignment ss:Horizontal="' + Horiz + '" ss:Vertical="' + Vert + si + s +'/>');

WriteExpLn('<Borders>');
if EStyle.FrameWidth > 1 then
i := 3
else
i := 1;
s := 'ss:Weight="' + IntToStr(i) + '" ';
si := 'ss:Color="' + HTMLRGBColor(EStyle.FrameColor) + '" ';
if (ftLeft in EStyle.FrameTyp) then
WriteExpLn('<Border ss:Position="Left" ss:LineStyle="Continuous" ' + s + si + '/>');
if (ftRight in EStyle.FrameTyp) then
WriteExpLn('<Border ss:Position="Right" ss:LineStyle="Continuous" ' + s + si + '/>');
if (ftTop in EStyle.FrameTyp) then
WriteExpLn('<Border ss:Position="Top" ss:LineStyle="Continuous" ' + s + si + '/>');
if (ftBottom in EStyle.FrameTyp) then
WriteExpLn('<Border ss:Position="Bottom" ss:LineStyle="Continuous" ' + s + si + '/>');
WriteExpLn('</Borders>');

{!!!!!! МОE общее значение по умолчанию}
WriteExpLn('<NumberFormat ss:Format="#,##0.00"/>');
{!!!!!!!!!!!!}

WriteExpLn('</Style>');
end;
{!!!!!!!}
nn := FMatrix.StylesCount;
for k := 0 to FMatrix.Height - 2 do
for y := 0 to FMatrix.Width - 1 do
begin
m := FMatrix.GetCell(k, y);
if (m <> -1) then
begin
Obj := FMatrix.GetObjectById(m);
if (Obj.DisplayFormat.Kind = fkNumeric) and
(Obj.DisplayFormat.FormatStr <> '') and
(Obj.DisplayFormat.FormatStr <> '%2.2n') and
(FormatList.IndexOfName(Obj.DisplayFormat.FormatStr)<0) then
begin
s := 's'+IntToStr(nn);
WriteExpLn('<Style ss:ID="'+s+'">');
WriteExpLn('<NumberFormat ss:Format="'+UTF8Encode(ConVertFormat(Obj.DisplayFormat.FormatStr))+'"/>');
WriteExpLn('</Style>');
FormatList.Add(Obj.DisplayFormat.FormatStr+'='+s);
inc(nn);
end;
end;
end;
{!!!!!!!}
WriteExpLn('</Styles>');
end;

s := 'Page 1';
WriteExpLn('<Worksheet ss:Name="' + UTF8Encode(s) + '">');
WriteExpLn('<Table ss:ExpandedColumnCount="' + IntToStr(FMatrix.Width) + '"' +
' ss:ExpandedRowCount="' + IntToStr(FMatrix.Height) + '" x:FullColumns="1" x:FullRows="1">');
for x := 1 to FMatrix.Width - 1 do
begin
dcol := (FMatrix.GetXPosById(x) - FMatrix.GetXPosById(x - 1)) / Xdivider;
WriteExpLn('<Column ss:AutoFitWidth="0" ss:Width="' +
frFloat2Str(dcol, 2) + '"/>');
end;
st := '';
Page := 0;

for y := 0 to FMatrix.Height - 2 do
begin
drow := (FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) / Ydivider;
WriteExpLn('<Row ss:Height="' + frFloat2Str(drow, 2) + '">');
if FMatrix.PagesCount > Page then
if FMatrix.GetYPosById(y) >= FMatrix.GetPageBreak(Page) then
begin
Inc(Page);
PageBreak.Add(IntToStr(y + 1));
if FShowProgress then
begin
FProgress.Tick;
if FProgress.Terminated then
break;
end;
end;
for x := 0 to FMatrix.Width - 1 do
begin
if FShowProgress then
if FProgress.Terminated then
break;
si := ' ss:Index="' + IntToStr(x + 1) + '" ';
i := FMatrix.GetCell(x, y);
if (i <> -1) then
begin
Obj := FMatrix.GetObjectById(i);
if Obj.Counter = 0 then
begin
FMatrix.GetObjectPos(i, fx, fy, dx, dy);
Obj.Counter := 1;
if Obj.IsText then
begin
if dx > 1 then
begin
s := 'ss:MergeAcross="' + IntToStr(dx - 1) + '" ';
Inc(dx);
end
else
s := '';
if dy > 1 then
sb := 'ss:MergeDown="' + IntToStr(dy - 1) + '" '
else
sb := '';
if FExportStyles then
{!!!!!!!!!}
begin
if (Obj.DisplayFormat.Kind = fkNumeric) and
(Obj.DisplayFormat.FormatStr <> '') and
(Obj.DisplayFormat.FormatStr <> '%2.2n') then
begin
fs := FormatList.Values[Obj.DisplayFormat.FormatStr];
if fs <> '' then
st := 'ss:StyleID="' + fs + '" '
else
st := 'ss:StyleID="' + 's' + IntToStr(Obj.StyleIndex) + '" '
end
else
st := 'ss:StyleID="' + 's' + IntToStr(Obj.StyleIndex) + '" '
end {!!!!!!!!!!!}
else
st := '';
WriteExpLn('<Cell' + si + s + sb + st + '>');
s := TruncReturns(Obj.Memo.Text);
if (Obj.DisplayFormat.Kind = fkNumeric) and IsDigits(s) then
begin
s := StringReplace(s, ThousandSeparator, '', [rfReplaceAll]);
s := StringReplace(s, 'р.', '', [rfReplaceAll]);
s := StringReplace(s, ',', '.', [rfReplaceAll]);
s := Trim(s);
si := ' ss:Type="Number"';
WriteExpLn('<Data' + si + '>' + UTF8Encode(s) + '</Data>');
end
else
begin
si := ' ss:Type="String"';
s := ChangeReturns(s);
WriteExpLn('<Data' + si + '>' + UTF8Encode(s) + '</Data>');
end;
WriteExpLn('</Cell>');
end;
end
end
else
WriteExpLn('<Cell' + si + '/>');
end;
WriteExpLn('</Row>');
end;

WriteExpLn('</Table>');
WriteExpLn('<WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">');
WriteExpLn('<PageSetup>');
if FPageOrientation = poLandscape then
WriteExpLn('<Layout x:Orientation="Landscape"/>');
WriteExpLn('<PageMargins x:Bottom="' + frFloat2Str(FPageBottom / MargDiv, 2) +
'" x:Left="' + frFloat2Str(FPageLeft / MargDiv, 2) +
'" x:Right="' + frFloat2Str(FPageRight / MargDiv, 2) +
'" x:Top="' + frFloat2Str(FPageTop / MargDiv, 2) + '"/>');
WriteExpLn('</PageSetup>');
WriteExpLn('</WorksheetOptions>');

if FExportPageBreaks then
begin
WriteExpLn('<PageBreaks xmlns="urn:schemas-microsoft-com:office:excel">');
WriteExpLn('<RowBreaks>');
for i := 0 to FMatrix.PagesCount - 2 do
begin
WriteExpLn('<RowBreak>');
WriteExpLn('<Row>' + PageBreak + '</Row>');
WriteExpLn('</RowBreak>');
end;
WriteExpLn('</RowBreaks>');
WriteExpLn('</PageBreaks>');
end;
WriteExpLn('</Worksheet>');
WriteExpLn('</Workbook>');
PageBreak.Free;
{!!!!!!!!} FormatList.Free; {!!!!!!!}
if FShowProgress then
FProgress.Free;
end;

Оставить комментарий

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.