cxhtmlxmltxtexport.pas
来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,750 行 · 第 1/4 页
PAS
1,750 行
begin
ABuffer := ABuffer + ' ALIGN=';
case AlignText of
catLeft:
ABuffer := ABuffer + 'LEFT';
catCenter:
ABuffer := ABuffer + 'CENTER';
catRight:
ABuffer := ABuffer + 'RIGHT';
end;
ABuffer := ABuffer + ' CLASS=Style' + IntToStr(FCache[J, I].StyleIndex);
ABuffer := ABuffer + ' HEIGHT=' + IntToStr(Rows[I])+'px';
ABuffer := ABuffer + '>';
if Cache[J, I].InternalCache.Cache <> nil then
begin
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '';
ADisplayValue := '';
Cache[J, I].InternalCache.Cache.CommitCache(AStream, nil);
end
else
begin
if Cache[J, I].DataType = cxDataTypeGraphic then
begin
SetLength(AStringValue, Cache[J, I].DataSize);
GetCellData(J, I, AStringValue[1]);
ADisplayValue := GraphicNeeded(ExtractFilePath(FileName), AStringValue);
end
else
if Cache[J, I].DataType = cxDataTypeString then
begin
if Cache[J, I].DataSize > 0 then
begin
SetLength(AStringValue, Cache[J, I].DataSize);
if GetCellData(J, I, AStringValue[1]) then
ADisplayValue := ConvertCRLFSymbols(ConvertSpecialCharacters(AStringValue))
end
end
else if Cache[J, I].DataType = cxDataTypeWideString then
begin
if Cache[J, I].DataSize > 0 then
begin
SetLength(AWideStringValue, Cache[J, I].DataSize shr 1);
if GetCellData(J, I, AWideStringValue[1]) then
ADisplayValue := ConvertCRLFSymbols(ConvertSpecialCharacters(AWideStringValue))
end
end
else if Cache[J, I].DataType = cxDataTypeDouble then
begin
if GetCellData(J, I, ADoubleValue) then
ADisplayValue := FloatToStr(ADoubleValue)
end
else if Cache[J, I].DataType = cxDataTypeInteger then
begin
if GetCellData(J, I, AIntegerValue) then
ADisplayValue := IntToStr(AIntegerValue)
end
end;
end;
if ADisplayValue = '' then
ADisplayValue := cxExportDefaultEmptyString;
ABuffer := ABuffer + ADisplayValue + '</TD>'#13#10;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '';
end;
ABuffer := ABuffer + '</TR>'#13#10;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '';
end;
ABuffer := ABuffer + '</TABLE>'#13#10;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
end;
procedure TcxHTMLExportProvider.CommitStyle(AStream: TStream; AParam: Pointer);
var
ABuffer: string;
I: Integer;
begin
SetEmptyCellsStyle;
for I := 0 to FStyleManager.Count - 1 do
begin
ABuffer := ABuffer + '.Style' + IntToStr(I) + ' {' +
GetStyle(FStyleManager[I]) + '}' + #13#10#13#10 ;
end;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
end;
function TcxHTMLExportProvider.GetContentWidth: Integer;
var
J: Integer;
begin
Result := 0;
for J := 0 to ColCount - 1 do
Inc(Result, Columns[J]);
end;
procedure TcxHTMLExportProvider.CommitHTML(AStream: TStream);
var
ABuffer: string;
begin
ABuffer := '<HTML>'#13#10 +
'<HEAD>'#13#10 + '<TITLE>' + FileName + '</TITLE>'#13#10 +
'<STYLE TYPE="text/css"><!--'#13#10;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '';
CommitStyle(AStream, nil);
ABuffer := ABuffer + '--></STYLE>'#13#10 +
'</HEAD>'#13#10 + '<BODY>'#13#10;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '';
CommitCache(AStream, nil);
ABuffer := ABuffer + '</BODY>'#13#10 + '</HTML>';
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
end;
function TcxHTMLExportProvider.GetStyle(AStyle: TcxCacheCellStyle): string;
var
ABorderWidth: array[0..3] of Integer;
ABorderColor: array[0..3] of Integer;
I: Integer;
begin
Result := '';
with AStyle do
begin
for I := 0 to 3 do
begin
if Borders[I].IsDefault then
begin
ABorderWidth[I] := 0;
ABorderColor[I] := 0;
end
else
begin
ABorderWidth[I] := Borders[I].Width;
ABorderColor[I] := Borders[I].Color;
end;
end;
Result := Result + ' border-style: solid;';
if FontSize = 1 then
Result := Result + 'padding:0px;'
else
Result := Result + ' padding:3;';
Result := Result + ' border-left-width: ' + IntToStr(ABorderWidth[0]) + ';';
Result := Result + ' border-top-width: ' + IntToStr(ABorderWidth[1]) + ';';
Result := Result + ' border-right-width: ' + IntToStr(ABorderWidth[2]) + ';';
Result := Result + ' border-bottom-width: ' + IntToStr(ABorderWidth[3]) + ';';
Result := Result + ' border-left-color: ' + GetHTMLColor(ABorderColor[0]) + ';';
Result := Result + ' border-top-color: ' + GetHTMLColor(ABorderColor[1]) + ';';
Result := Result + ' border-right-color: ' + GetHTMLColor(ABorderColor[2]) + ';';
Result := Result + ' border-bottom-color: ' + GetHTMLColor(ABorderColor[3]) + ';';
Result := Result + ' font-family: ''' + FontName + ''';';
Result := Result + ' mso-font-charset: ' + IntToStr(FontCharset) + ';';
if cfsBold in FontStyle then
Result := Result + ' font-weight: bold;';
if cfsItalic in FontStyle then
Result := Result + ' font-style: italic;';
if cfsUnderline in FontStyle then
Result := Result + ' text-decoration: underline;'
else if cfsStrikeOut in FontStyle then
Result := Result + ' text-decoration: line-through;';
Result := Result + ' font-size: ' + IntToStr(FontSize) + 'pt;';
Result := Result + ' color: ' + GetHTMLColor(FontColor) + ';';
Result := Result + ' background-color: ' + GetHTMLColor(BrushBkColor);
end;
end;
function TcxHTMLExportProvider.GetScaleRow: string;
var
J: Integer;
begin
Result := '<TR>'#13#10;
for J := 0 to ColCount - 1 do
begin
Result := Result + '<TD ';
Result := Result + ' WIDTH=' + IntToStr(Columns[J]);
Result := Result + ' HEIGHT=0>';
Result := Result + '</TD>'#13#10;
end;
Result := Result + '</TR>';
end;
{ TcxXMLExportProvider }
constructor TcxXMLExportProvider.Create(const AFileName: string);
begin
inherited Create(AFileName);
FHideDotsOn := True;
FXSLFileName := '_';
end;
procedure TcxXMLExportProvider.Commit;
var
AXMLStream: TFileStream;
AXSLStream: TFileStream;
begin
AXMLStream := cxFileStreamClass.Create(cxUnicodeToStr(FileName), fmCreate);
FXSLFileName := cxChangeFileExtExW(FileName, '.xsl');
AXSlStream := cxFileStreamClass.Create(cxUnicodeToStr(FXSLFileName), fmCreate);
try
CommitXML(AXMLStream);
CommitXSL(AXSLStream);
finally
AXSlStream.Free;
AXMLStream.Free;
end;
end;
class function TcxXMLExportProvider.ExportType: Integer;
begin
Result := cxExportToXML;
end;
class function TcxXMLExportProvider.ExportName: string;
begin
Result := cxGetResString(@scxExportToXML);
end;
procedure TcxXMLExportProvider.CommitCache(AStream: TStream; AParam: Pointer);
var
ABuffer: string;
I, J: Integer;
AValue: string;
begin
inherited CommitCache(AStream, AParam);
if FHideDotsOn then
begin
HideDots;
FHideDotsOn := False;
Exit;
end;
ABuffer := '<LINES ColCount="' + IntToStr(ColCount) +
'" RowCount="' + IntToStr(RowCount) + '">'#13#10;
ABuffer := ABuffer + GetScaleLine;
for I := 0 to RowCount - 1 do
begin
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '<LINE>'#13#10;
for J := 0 to ColCount - 1 do
begin
if Cache[J, I].IsHidden then
Continue;
ABuffer := ABuffer + '<CELL' + GetCellParams(J, I);
ABuffer := ABuffer + '>';
with Cache[J, I] do
begin
if DataType = cxDataTypeGraphic then
begin
SetLength(AValue, DataSize);
GetCellData(J, I, AValue[1]);
AValue := GraphicNeeded(ExtractFilePath(FileName), AValue, False);
ABuffer := ABuffer + '<IMAGE Src="' + AValue + '"></IMAGE>';
end;
end;
if Cache[J, I].InternalCache.Cache <> nil then
begin
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '';
Cache[J, I].InternalCache.Cache.CommitCache(AStream, nil);
end
else
ABuffer := ABuffer + {'<![CDATA[' + }ConvertTextToXml({ConvertCRLFSymbols(}GetData(J, I){)}, J, I){ + ']]>'};
ABuffer := ABuffer + '</CELL>'#13#10;
end;
ABuffer := ABuffer + '</LINE>';
end;
ABuffer := ABuffer + '</LINES>';
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
end;
procedure TcxXMLExportProvider.CommitStyle(AStream: TStream; AParam: Pointer);
var
I: Integer;
ABuffer: string;
begin
SetEmptyCellsStyle;
ABuffer := '<STYLES>'#13#10;
for I := 0 to FStyleManager.Count - 1 do
begin
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
ABuffer := '<STYLE Id="' + IntToStr(I) + '" ' +
GetStyle(FStyleManager[I]) + '>'#13#10 + GetBorderStyle(FStyleManager[I]);
ABuffer := ABuffer + '</STYLE>'#13#10
end;
ABuffer := ABuffer + '</STYLES>'#13#10;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer))
end;
procedure TcxXMLExportProvider.CommitXML(AStream: TStream);
var
ABuffer: string;
AFileExt: string;
AFileName: string;
begin
AFileName := FileName;
AFileExt := ExtractFileExt(AFileName);
if AFileExt <> '' then
Delete(AFileName, Length(AFileName) - Length(AFileExt) + 1, Length(AFileExt));
ABuffer := '<?xml version="1.0"?>'#13#10;
ABuffer := ABuffer + '<?xml-stylesheet type="text/xsl" href="' + FXSLFileName + '"?>'#13#10;
// CheckedUnicodeStringW(cxExtractFileNameExW(FXSLFileName)) + '"?>'#13#10;
ABuffer := ABuffer + '<CACHE>'#13#10;
ABuffer := ABuffer + '<TITLE>' +
CheckedUnicodeStringW(cxExtractFileNameExW(cxChangeFileExtExW(FXSLFileName, ''))) + '</TITLE>'#13#10;
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
CommitCache(nil, nil);
CommitStyle(AStream, nil);
CommitCache(AStream, nil);
ABuffer := '</CACHE>';
AStream.WriteBuffer(ABuffer[1], Length(ABuffer));
end;
procedure TcxXMLExportProvider.CommitXSL(AStream: TStream);
var
ABuffer: string;
begin
ABuffer := '<?xml version="1.0"?>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">'#13#10;
ABuffer := ABuffer + '<xsl:template match="/">'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="CACHE" />'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="CACHE">'#13#10;
ABuffer := ABuffer + '<html>'#13#10;
ABuffer := ABuffer + '<head>'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="TITLE" />'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="STYLES" />'#13#10;
ABuffer := ABuffer + '</head>'#13#10;
ABuffer := ABuffer + '<body>'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="LINES" />'#13#10;
ABuffer := ABuffer + '</body>'#13#10;
ABuffer := ABuffer + '</html>'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="TITLE">'#13#10;
ABuffer := ABuffer + '<title>'#13#10;
ABuffer := ABuffer + '<xsl:value-of select="." />'#13#10;
ABuffer := ABuffer + '</title>'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="STYLES">'#13#10;
ABuffer := ABuffer + '<style type="text/css">'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="STYLE" />'#13#10;
ABuffer := ABuffer + '</style>'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="STYLE">'#13#10;
ABuffer := ABuffer + '.Style<xsl:value-of select="@Id" />'#13#10;
ABuffer := ABuffer + '{ border-style: solid;'#13#10;
ABuffer := ABuffer + ' padding: <xsl:value-of select="@CellPadding" />;'#13#10;
ABuffer := ABuffer + ' font-family: <xsl:value-of select="@FontName" />;'#13#10;
ABuffer := ABuffer + ' mso-font-charset: <xsl:value-of select="@FontCharset" />;'#13#10;
ABuffer := ABuffer + ' font-size: <xsl:value-of select="@FontSize" />pt;'#13#10;
ABuffer := ABuffer + ' color: <xsl:value-of select="@FontColor" />;'#13#10;
ABuffer := ABuffer + ' background-color: <xsl:value-of select="@BrushBkColor" />;'#13#10;
ABuffer := ABuffer + '<xsl:if test="@Bold=''True''">'#13#10;
ABuffer := ABuffer + ' font-weight: bold;'#13#10;
ABuffer := ABuffer + '</xsl:if>'#13#10;
ABuffer := ABuffer + '<xsl:if test="@Italic=''True''">'#13#10;
ABuffer := ABuffer + ' font-style: italic;'#13#10;
ABuffer := ABuffer + '</xsl:if>'#13#10;
ABuffer := ABuffer + '<xsl:if test="@Underline=''True''">'#13#10;
ABuffer := ABuffer + ' text-decoration: underline;'#13#10;
ABuffer := ABuffer + '</xsl:if>'#13#10;
ABuffer := ABuffer + '<xsl:if test="@StrikeOut=''True''">'#13#10;
ABuffer := ABuffer + ' text-decoration: line-through;'#13#10;
ABuffer := ABuffer + '</xsl:if>'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="BORDER_LEFT" />'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="BORDER_UP" />'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="BORDER_RIGHT" />'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="BORDER_DOWN" />'#13#10;
ABuffer := ABuffer + '}'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="BORDER_LEFT">'#13#10;
ABuffer := ABuffer + 'border-left-width: <xsl:value-of select="@Width" />px;'#13#10;
ABuffer := ABuffer + 'border-left-color: <xsl:value-of select="@Color" />;'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="BORDER_UP">'#13#10;
ABuffer := ABuffer + 'border-top-width: <xsl:value-of select="@Width" />px;'#13#10;
ABuffer := ABuffer + 'border-top-color: <xsl:value-of select="@Color" />;'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="BORDER_RIGHT">'#13#10;
ABuffer := ABuffer + 'border-right-width: <xsl:value-of select="@Width" />px;'#13#10;
ABuffer := ABuffer + 'border-right-color: <xsl:value-of select="@Color" />;'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="BORDER_DOWN">'#13#10;
ABuffer := ABuffer + 'border-bottom-width: <xsl:value-of select="@Width" />px;'#13#10;
ABuffer := ABuffer + 'border-bottom-color: <xsl:value-of select="@Color" />;'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="LINES">'#13#10;
ABuffer := ABuffer + '<table border="0" cellspacing="0">'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="LINE" />'#13#10;
ABuffer := ABuffer + '</table>'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="LINE">'#13#10;
ABuffer := ABuffer + '<tr>'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="CELL" />'#13#10;
ABuffer := ABuffer + '</tr>'#13#10;
ABuffer := ABuffer + '</xsl:template>'#13#10#13#10;
ABuffer := ABuffer + '<xsl:template match="CELL">'#13#10;
ABuffer := ABuffer + '<td>'#13#10;
ABuffer := ABuffer + '<xsl:attribute name="nowrap"></xsl:attribute>'#13#10;
ABuffer := ABuffer + '<xsl:attribute name="width"><xsl:value-of select="@Width" /></xsl:attribute>'#13#10;
ABuffer := ABuffer + '<xsl:attribute name="height"><xsl:value-of select="@Height" /></xsl:attribute>'#13#10;
ABuffer := ABuffer + '<xsl:attribute name="align"><xsl:value-of select="@Align" /></xsl:attribute>'#13#10;
ABuffer := ABuffer + '<xsl:attribute name="colspan"><xsl:value-of select="@ColSpan" /></xsl:attribute>'#13#10;
ABuffer := ABuffer + '<xsl:attribute name="rowspan"><xsl:value-of select="@RowSpan" /></xsl:attribute>'#13#10;
ABuffer := ABuffer + '<xsl:attribute name="class">Style<xsl:value-of select="@StyleClass" /></xsl:attribute>'#13#10;
ABuffer := ABuffer + '<xsl:choose>'#13#10;
ABuffer := ABuffer + '<xsl:when test="LINES">'#13#10;
ABuffer := ABuffer + '<xsl:apply-templates select="LINES" />'#13#10;
ABuffer := ABuffer + '</xsl:when>'#13#10;
ABuffer := ABuffer + '<xsl:when test="IMAGE">'#13#10;
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?