qexport4html.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

  for i := 0 to Footer.Count - 1 do
    GetWriter.WriteLn(Footer[i]);

  if (MaxRecords > 0) and (GetWriter.Stream is TFileStream) then
    THTMLPageOption(FPages[FCurrPass - 1]).BottomLocationLinkPos := FStr.Position;

  GetWriter.EndBODY;
  GetWriter.EndHTML;

  inherited;
end;

procedure TQExport4HTML.BeginExport;

  procedure CheckDefaultOptions(Indent: Integer);
  var
    S: string;
  begin
    SetLength(S, Indent);
    FillChar(S[1], Indent, ' ');
    if not (doFontName in FHTMLOptions.DefaultOptions) then
      SStyle.Add(S + 'font-family: ' + FHTMLOptions.FTextFont.Name + ';');
    if not (doFontSize in FHTMLOptions.DefaultOptions) then
      SStyle.Add(Format(S + SFontSize, [FHTMLOptions.FTextFont.Size]));
  end;

begin
  inherited;
  ClearPages;
  SStyle.Clear;
  with FHTMLOptions do begin
    SStyle.Add('  BODY { background: ' +
      IntToHexStr(D2HTMLColor(FBackgroundcolor)) + ';' +
      ' color: ' + IntToHexStr(D2HTMLColor(FTextFont.Color)) + ';');
    CheckDefaultOptions(9);
    if FBackgroundFileName <> '' then begin
      SStyle.Add(Format('background-image: url(%s)', [FBackgroundFileName]));
    end;
    SStyle.Add('  }');
    SStyle.Add('  A:link { color: ' +
      IntToHexStr(D2HTMLColor(FLinkColor)) + ' }');
    SStyle.Add('  A:visited { color: ' +
      IntToHexStr(D2HTMLColor(FVLinkColor)) + ' }');
    SStyle.Add('  A:active { color: ' +
      IntToHexStr(D2HTMLColor(FALinkColor)) + ' }');
  end;
  FUseBorderColor := FTableOptions.BorderColor <> clWhite;
  with FTableOptions do begin
    if AllowCaptions then begin
      SStyle.Add('  .ThRows { ');
      if not IsTableBGDefined then
        SStyle.Add(Format('            background-color: %s;',
          [IntToHexStr(D2HTMLColor(FHeadersRowBgColor))]));
      SStyle.Add(Format('            color: %s;',
        [IntToHexStr(D2HTMLColor(FHeadersRowFontColor))]));

      SStyle.Add('            font-weight: bold; text-align: center;');
      CheckDefaultOptions(12);
      SStyle.Add('  }');
    end;
    SStyle.Add('  .TrRows {');
    if not IsTableBGDefined then
      SStyle.Add(Format('            background-color: %s;',
        [IntToHexStr(D2HTMLColor(FTableBgColor))]));
    SStyle.Add(Format('            color: %s;',
      [IntToHexStr(D2HTMLColor(FTableFontColor))]));
    CheckDefaultOptions(12);
    SStyle.Add('  }');
    SStyle.Add('  .TrOdd  {');
    if not IsTableBGDefined then
      SStyle.Add(Format('            background-color: %s;',
        [IntToHexStr(D2HTMLColor(FOddRowBgColor))]));
    SStyle.Add(Format('            color: %s;',
      [IntToHexStr(D2HTMLColor(FTableFontColor))]));
    CheckDefaultOptions(12);
    SStyle.Add('  }');
    if FUseBorderColor then
      SStyle.Add('  .TrBC { background-color: ' +
        IntToHexStr(D2HTMLColor(BorderColor)) + ' }');
  end;
  FCurrPass := 0;
end;

procedure TQExport4HTML.BeforeExport;
begin
  inherited;
  if IsEmpty then
    WritePageHeader(FileName);
end;

constructor TQExport4HTML.Create(AOwner: TComponent);
begin
  inherited;
  FUsingCSS := usInternal;
  FHTMLOptions := THTMLOptions.Create;
  FTableOptions := TTableOptions.Create;
  FMaxRecords := 0;
  FGenerateIndex := false;
  FBoolAsCheckBox := false;
  Header.Add('<br>'); Footer.Add('<br>');
  HTMLTemplate := htClassic;
  SStyle := TStringList.Create;
  FNavigation := TQExportHTMLNavigation.Create;
  FPages := TList.Create;
  FOverwriteCSSFile := true;
  FInterpretTags := True;
end;

destructor TQExport4HTML.Destroy;
begin
  SStyle.Free;
  FTableOptions.Free;
  FHTMLOptions.Free;
  FNavigation.Free;

  ClearPages;
  FPages.Free;
  inherited;
end;


procedure TQExport4HTML.DoGenerateIndex;
var
  FS: TFileStream;
  WR: TQHTMLWriter;
  i: integer;
  sNumber, sName: string;
begin
  sName := FileName;
  FS := TFileStream.Create(sName, fmCreate);
  WR := TQHTMLWriter.Create(Self, FS);
  try
    with WR do begin
      StartHTML;
      StartHEAD;
      if FUsingCss = usInternal then begin
        StartSTYLE;
        for i := 0 to SStyle.Count - 1 do Writeln(SStyle[i]);
        EndSTYLE;
      end
      else WriteCSSLink(FCSSFileName);
      EndHEAD;
      StartBODY;
      StartUI;
      for i := 1 to FCurrPass do begin
        LI;
        if i < 10 then sNumber := '0' + IntToStr(i)
        else sNumber := IntToStr(i);

        sName := ExtractFileName(FileName);
        if Navigation.IndexLinkTemplate = EmptyStr then
          Writeln(Format('<a href="%s">%s</a>',
                  [ExtractFName(sName) + sNumber + ExtractFileExt(sName),
                   ExtractFName(sName) + sNumber + ExtractFileExt(sName)]))
        else
          Writeln(Format('<a href="%s">%s</a>',
                  [ExtractFName(sName) + sNumber + ExtractFileExt(sName),
                   Navigation.IndexLinkTemplate + sNumber]));

      end;
      EndUI;
      EndBODY;
      EndHTML;
    end;
  finally
    WR.Free;
    FS.Free;
  end;
end;

procedure TQExport4HTML.EndExport;
var
  i: integer;
  FS: TFileStream;
  MS: TMemoryStream;
  sFileName: string;
  Strings: TStringList;
begin
  if FMaxRecords > 0 then begin
    if FGenerateIndex and (GetWriter.Stream is TFileStream) then
      DoGenerateIndex;
    if (FNavigation.OnTop or FNavigation.OnBottom) and (FCurrPass > 1) then begin

      FStr.Free;
      FStr := nil;

      MS := TMemoryStream.Create;
      try
        Strings := TStringList.Create;
        try
          for i := 1 to FCurrPass do begin

            sFileName := AddNumberToFileName(FileName, i, 2);

            FS := TFileStream.Create(sFileName,
              fmOpenReadWrite or fmShareExclusive);
            GetWriter.Stream := FS;
            try
              if FNavigation.OnTop then begin
                MS.Size := 0;
                FS.Seek(THTMLPageOption(FPages[i - 1]).TopLocationLinkPos, soFromBeginning);
                MS.CopyFrom(FS, FS.Size - FS.Position);
                FS.Seek(THTMLPageOption(FPages[i - 1]).TopLocationLinkPos, soFromBeginning);
                GetWriter.WriteLocationLinks(FNavigation.IndexLinkTitle,
                  FNavigation.FirstLinkTitle, FNavigation.PriorLinkTitle,
                  FNavigation.NextLinkTitle, FNavigation.LastLinkTitle,
                  FileName,  FCurrPass, i, true, GenerateIndex, Strings);
                Strings.SaveToStream(FS);
                FS.CopyFrom(MS, 0);

                if FNavigation.OnBottom then
                  THTMLPageOption(FPages[i - 1]).BottomLocationLinkPos :=
                    THTMLPageOption(FPages[i - 1]).BottomLocationLinkPos +
                    Length(Strings.Text);
              end;

              if FNavigation.OnBottom then begin
                MS.Size := 0;
                FS.Seek(THTMLPageOption(FPages[i - 1]).BottomLocationLinkPos, soFromBeginning);
                MS.CopyFrom(FS, FS.Size - FS.Position);
                FS.Seek(THTMLPageOption(FPages[i - 1]).BottomLocationLinkPos, soFromBeginning);
                GetWriter.WriteLocationLinks(FNavigation.IndexLinkTitle,
                  FNavigation.FirstLinkTitle, FNavigation.PriorLinkTitle,
                  FNavigation.NextLinkTitle, FNavigation.LastLinkTitle,
                  FileName,  FCurrPass, i, false, GenerateIndex, Strings);
                Strings.SaveToStream(FS);
                FS.CopyFrom(MS, 0);
              end;
            finally
              FS.Free;
            end;
          end;
        finally
          Strings.Free;
        end;
      finally
        MS.Free;
      end;
    end;
  end;
  inherited;
end;

procedure TQExport4HTML.Execute;
begin
  FStr := TFileStream.Create(FileName, fmCreate);
  try
    ExportToStream(FStr);
  finally
    FStr.Free;
  end;
  ShowResult;
end;

function TQExport4HTML.GetColData(ColValue: QEString;
  Column: TQExportColumn): QEString;
var
  AlignStr,
  InlineStyleStr: string;
  CurrAlign: TQExportColAlign;
  fInlineStyle: boolean;
  CurrBackground: TColor;
  CurrFont: TFont;
  Index: integer;
//  GCD: TQExportGetColData;

  procedure CheckInlineStyle;
  begin
    InlineStyleStr := InlineStyleStr + ' ';
    fInlineStyle := true;
  end;

begin
  Result := inherited GetColData(ColValue, Column);

{  GCD := ExportRow.GetColData;
  try
    ExportRow.GetColData := nil;
    Result := ExportRow[Index].GetExportedValue(true);
  finally
    ExportRow.GetColData := GCD;
  end;}
  Index := Column.Index;
  AlignStr := '';
  CurrAlign := Columns[Index].ColAlign;
  InlineStyleStr := '';
  fInlineStyle := false;
  if (Columns[Index].ColType = ectBoolean) and FBoolAsCheckBox then
  begin
    if AnsiCompareText(Result, Formats.BooleanFalse) = 0 then
      Result := '<Input type="checkbox"/>'
    else if AnsiCompareText(Result, Formats.BooleanTrue) = 0 then
      Result := '<Input type="checkbox" checked=""/>';
  end;
  if Result = '' then Result := '&nbsp';
  if Odd(RecordCounter) then CurrBackground := TableOptions.TableBgColor
  else CurrBackground := TableOptions.OddRowBgColor;
  CurrFont := TFont.Create;
  try
    CurrFont.Assign(FHTMLOptions.TextFont);
    GetCellParams(RecordCounter, Index, Result, CurrAlign, CurrFont, CurrBackground);
    AlignStr := ' ' + Format(SAlign, [GetWriter.AlignToStr(CurrAlign)]);
    // Background color
    if Odd(RecordCounter) then begin
      if CurrBackground <> TableOptions.TableBgColor then begin
        InlineStyleStr := Format(SBackgroundColor,
          [IntToHexStr(D2HTMLColor(CurrBackground))]);
        CheckInlineStyle;
      end;
    end
    else begin
      if CurrBackground <> TableOptions.OddRowBgColor then begin
        InlineStyleStr := Format(SBackgroundColor,
          [IntToHexStr(D2HTMLColor(CurrBackground))]);
        CheckInlineStyle;
      end;
    end;
    // Font.Name
    if CompareText(CurrFont.Name, FHTMLOptions.TextFont.Name) <> 0 then begin
      InlineStyleStr := InlineStyleStr + Format(SFontFamily,
        [CurrFont.Name]);
      CheckInlineStyle;
    end;
    // Font.Size
    if (CurrFont.Size <> FHTMLOptions.TextFont.Size) then begin
      InlineStyleStr := InlineStyleStr + Format(SFontSize,
        [CurrFont.Size]);
      CheckInlineStyle;
    end;
    // Font.Color
    if CurrFont.Color <> FHTMLOptions.TextFont.Color then begin
      InlineStyleStr := InlineStyleStr + Format(SColor,
        [IntToHexStr(D2HTMLColor(CurrFont.Color))]);
      CheckInlineStyle;
    end;
    // Bold
    if (fsBold in CurrFont.Style) and
      (not (fsBold in FHTMLOptions.TextFont.Style)) then begin
      InlineStyleStr := InlineStyleStr + Format(SFontWeight, [SBold]);
      CheckInlineStyle;
    end;
    if (not (fsBold in CurrFont.Style)) and
      (fsBold in FHTMLOptions.TextFont.Style) then begin
      InlineStyleStr := InlineStyleStr + Format(SFontWeight, [SNormal]);
      CheckInlineStyle;
    end;
    // Italic
    if (fsItalic in CurrFont.Style) and
      (not (fsItalic in FHTMLOptions.TextFont.Style)) then begin
      InlineStyleStr := InlineStyleStr + Format(SFontStyle, [SItalic]);
      CheckInlineStyle;
    end;
    if (not (fsItalic in CurrFont.Style)) and
      (fsItalic in FHTMLOptions.TextFont.Style) then begin
      InlineStyleStr := InlineStyleStr + Format(SFontStyle, [SNormal]);
      CheckInlineStyle;
    end;
    // Underline
    if (fsUnderline in CurrFont.Style) and
      (not (fsUnderline in FHTMLOptions.TextFont.Style)) then begin
      InlineStyleStr := InlineStyleStr + Format(STextDecoration, [SUnderline]);
      CheckInlineStyle;
    end;
    if (not (fsUnderline in CurrFont.Style)) and
      (fsUnderline in FHTMLOptions.TextFont.Style) then begin
      InlineStyleStr := InlineStyleStr + Format(STextDecoration, [SNone]);
      CheckInlineStyle;
    end;
    if fInlineStyle then begin
      Delete(InlineStyleStr, Length(InlineStyleStr) - 1, 2);
      InlineStyleStr := ' style="' + InlineStyleStr + '"';
    end;

    Result := AlignStr + InlineStyleStr + '>' + Result;
  finally
    CurrFont.Free;
  end;
end;

function TQExport4HTML.GetSpecialCharacters: TSpecialCharacters;