qexport4html.pas

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

begin
  Result := ['<', '>', '&', '"'];
end;

function TQExport4HTML.GetWriter: TQHTMLWriter;
begin
  Result := TQHTMLWriter(inherited GetWriter);
end;

function TQExport4HTML.GetWriterClass: TQExportWriterClass;
begin
  Result := TQHTMLWriter;
end;

procedure TQExport4HTML.LoadTemplateFromFile(const FileName: string);
var
  TemplateFile: TQIniFile;
begin
  TemplateFile := TQIniFile.Create(FileName);
  try
    with TemplateFile, FHTMLOptions, FTableOptions do begin
      // Body options
      BackgroundColor := ReadInteger('HTML options', 'Background-color', BackgroundColor);
      TextFont.Color := ReadInteger('HTML options', 'Font-color', TextFont.Color);
      TextFont.Name := ReadString('HTML options', 'Font-family', TextFont.Name);
      LinkColor := ReadInteger('HTML options', 'LinkColor', LinkColor);
      VLinkColor := ReadInteger('HTML options', 'VLinkColor', VLinkColor);
      ALinkColor := ReadInteger('HTML options', 'ALinkColor', ALinkColor);
      // Table options
      HeadersRowBgColor := ReadInteger('Table options', 'Header-bgcolor', HeadersRowBgColor);
      HeadersRowFontColor := ReadInteger('Table options', 'Header-color', HeadersRowFontColor);
      TableFontColor := ReadInteger('Table options', 'Table-color', TableFontColor);
      TableBgColor := ReadInteger('Table options', 'Even_row-bgcolor', TableBgColor);
      OddRowBgColor := ReadInteger('Table options', 'Odd_row-bgcolor', OddRowBgColor);
      BorderColor := ReadInteger('Table options', 'Border-color', BorderColor);
    end;
  finally
    TemplateFile.Free;
  end;
end;

function TQExport4HTML.NormalString(const S: QEString): QEString;
var
  p, i: Integer;
const
  SearchSym: array [0..5] of QEString = ('&', '>', '<', '"', #13#10, ' ');
  ReplSym: array [0..5] of QEString = ('&amp;', '&gt;', '&lt;', '&quot;', '<br>', '&#160;');
begin
  Result := S;
  for i := 0 to Length(SearchSym) - 1 do
  begin
    p := 1;
    while p > 0 do
    begin
      p := QEPosEx(SearchSym[i], Result, p);
      if (p > 0) and ((i = Length(SearchSym) - 1) or FInterpretTags) then
      begin
        if SearchSym[i] <> #13#10 then
          QEDelete(Result, p, 1)
        else
          QEDelete(Result, p, 2);
        QEInsert(ReplSym[i], Result, p);
        Inc(p, 4);
      end;
    end;
  end;
end;

procedure TQExport4HTML.SaveTemplateToFile(const FileName: string);
var
  TemplateFile: TQIniFile;
begin
  TemplateFile := TQIniFile.Create(FileName);
  try
    with TemplateFile, FHTMLOptions, FTableOptions do begin
      // Body options
      WriteInteger('HTML options', 'Background-color', BackgroundColor);
      WriteInteger('HTML options', 'Font-color', TextFont.Color);
      WriteString('HTML options', 'Font-family', TextFont.Name);
      WriteInteger('HTML options', 'LinkColor', LinkColor);
      WriteInteger('HTML options', 'VLinkColor', VLinkColor);
      WriteInteger('HTML options', 'ALinkColor', ALinkColor);
      // Table options
      WriteInteger('Table options', 'Header-bgcolor', HeadersRowBgColor);
      WriteInteger('Table options', 'Header-color', HeadersRowFontColor);
      WriteInteger('Table options', 'Table-color', TableFontColor);
      WriteInteger('Table options', 'Even_row-bgcolor', TableBgColor);
      WriteInteger('Table options', 'Odd_row-bgcolor', OddRowBgColor);
      WriteInteger('Table options', 'Border-color', BorderColor);
    end;
  finally
    TemplateFile.Free;
  end;
end;

procedure TQExport4HTML.SetHTMLOptions(const Value: THTMLOptions);
begin
  if Assigned(Value) then FHTMLOptions.Assign(Value);
end;

procedure TQExport4HTML.SetHTMLTemplate(const Value: THTMLTemplate);

  procedure SetTemplate(const Template: RHTMLTemplate);
  begin
    with FHTMLOptions, FTableOptions, Template do begin
      FBackgroundColor := RBackgroundColor;
      FLinkColor := RLinkColor;
      FVLinkColor := RVLinkColor;
      FALinkColor := RALinkColor;
      FTextFont.Color := RDefaultTextColor;
      FTextFont.Name := RTextFontName;
      FHeadersRowBgColor := RHeadersRowBgColor;
      FHeadersRowFontColor := RHeadersRowFontColor;
      FTableBgColor := RTableBgColor;
      FTableFontColor := RTableFontColor;
      FOddRowBgColor := ROddRowBgColor;
    end;
  end;

begin
  if FHTMLTemplate <> Value then begin
    FHTMLTemplate := Value;
    case Value of
      htBW: SetTemplate(RhtBW);
      htClassic: SetTemplate(RhtClassic);
      htColorFul: SetTemplate(RhtColorFul);
      htGray: SetTemplate(RhtGray);
      htMS_Money: SetTemplate(RhtMS_Money);
      htMurky: SetTemplate(RhtMurky);
      htOlive: SetTemplate(RhtOlive);
      htPlain: SetTemplate(RhtPlain);
      htSimple: SetTemplate(RhtSimple);
    end;
  end;
end;

procedure TQExport4HTML.SetMaxRecords(const Value: integer);
begin
  if FMaxRecords <> Value then begin
    if Value < 0 then FMaxRecords := 0
    else FMaxRecords := Value;
  end;
end;

procedure TQExport4HTML.SetTableOptions(const Value: TTableOptions);
begin
  if Assigned(Value) then FTableOptions.Assign(Value);
end;

procedure TQExport4HTML.SetNavigation(const Value: TQExportHTMLNavigation);
begin
  if Assigned(Value) then FNavigation.Assign(Value);
end;

procedure TQExport4HTML.WriteCaptionRow;
begin
//
end;

procedure TQExport4HTML.WriteDataRow;
var
  i: integer;
  sName: string;
//  FCSS: TextFile;
  PgOpt: THTMLPageOption;
begin
  if (RecordCounter = 0) or
      ((MaxRecords > 0) and ((RecordCounter) mod MaxRecords = 0) and
     (GetWriter.Stream is TFileStream)) then begin
    sName := FileName;

    if (MaxRecords > 0) and (GetWriter.Stream is TFileStream) then begin

      if FCurrpass > 0 then
      begin
        if FBoolAsCheckBox then
          GetWriter.EndFORM;
        GetWriter.EndTABLE;
        for i := 0 to Footer.Count - 1 do GetWriter.WriteLn(Footer[i]);
        THTMLPageOption(FPages[FCurrPass - 1]).BottomLocationLinkPos := FStr.Position;
        GetWriter.EndBODY;
        GetWriter.EndHTML;
      end;

      inc(FCurrPass);

      sName := AddNumberToFileName(sName, FCurrPass, 2);

      FStr.Free;

      FStr := TFileStream.Create(sName, fmCreate);
      GetWriter.Stream := FStr;
      PgOpt := THTMLPageOption.Create;
      FPages.Add(PgOpt);
    end;

    WritePageHeader(sName);
{    GetWriter.StartHTML;
    GetWriter.StartHEAD;
    GetWriter.WriteTITLE(Title);
    if FUsingCss = usInternal then begin
      GetWriter.StartSTYLE;
      for i := 0 to SStyle.Count - 1 do GetWriter.WriteLn(SStyle[i]);
      GetWriter.EndSTYLE;
    end
    else begin
      if (GetWriter.Stream is TFileStream) then begin
        if FCSSFileName = EmptyStr then  FCSSFileName := ChangeFileExt(sName, '.css');
        GetWriter.WriteCSSLink(FCSSFileName);
        if (not FileExists(FCSSFileName)) or FOverwriteCSSFile then begin
          AssignFile(FCSS, FCSSFileName);
          Rewrite(FCSS);
          try
            for i := 0 to SStyle.Count - 1 do WriteLn(FCSS, SStyle[i]);
          finally
            CloseFile(FCSS);
          end;
        end;
      end;
    end;
    GetWriter.EndHEAD;
    GetWriter.StartBODY;

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

    for i := 0 to Header.Count - 1 do GetWriter.WriteLn(Header[i]);}
    if FUseBorderColor then begin
      GetWriter.WriteLn('<Table cellspacing=0 cellpadding=0 class="TrBC">');
      GetWriter.WriteLn('<tr><td>');
    end;
    with FTableOptions do
    begin
      GetWriter.WriteTABLE(Border, CellPadding, CellSpacing, BackgroundFileName);
      if FBoolAsCheckBox then
        GetWriter.StartFORM;
    end;
    {//Writing captions here}
    if AllowCaptions then begin
      GetWriter.WriteLn('  <tr>');
      for i := 0 to Columns.Count - 1 do
        GetWriter.WriteCaptionRowTD(GetColCaption(i));
      GetWriter.WriteLn('  </tr>');
    end;
  end;

  GetWriter.WriteLn('  <tr>');

  ///++++++++++++++++++++++

  for i := 0 to ExportRow.Count - 1 do begin
    if MaxRecords > 0 then begin
      if Odd((RecordCounter + 1) mod MaxRecords) or
         (Odd(MaxRecords) and ((RecordCounter + 1) mod MaxRecords = 0))
        then GetWriter.WriteOddRowTD(GetExportedValue(ExportRow[i]))
        else GetWriter.WriteEvenRowTD(GetExportedValue(ExportRow[i]))
    end
    else begin
      if Odd(RecordCounter + 1)
        then GetWriter.WriteOddRowTD(GetExportedValue(ExportRow[i]))
        else GetWriter.WriteEvenRowTD(GetExportedValue(ExportRow[i]))
    end;
  end;
  GetWriter.WriteLn('  </tr>');
end;

function TQExport4HTML.GetShowedFileName: string;
var
  sFirst: string;
begin
  Result := inherited GetShowedFileName;
  sFirst := AddNumberToFileName(Result, 1, 2);
  if (MaxRecords > 0) and (not GenerateIndex) and FileExists(sFirst) then
    Result := sFirst;
end;

function TQExport4HTML.GetPrintedFileName: string;
var
  sFirst: string;
begin
  Result := inherited GetShowedFileName;
  sFirst := AddNumberToFileName(Result, 1, 2);
  if (MaxRecords > 0) and (not GenerateIndex) and FileExists(sFirst) then
    Result := sFirst;
end;

procedure TQExport4HTML.ClearPages;
var
  i: integer;
begin
  for i := FPages.Count - 1 downto 0 do begin
    THTMLPageOption(FPages[i]).Free;
    FPages.Delete(i);
  end;
end;

function TQExport4HTML.IsTableBGDefined: boolean;
begin
  Result := FileExists(TableOptions.BackgroundFileName);
end;

procedure TQExport4HTML.WritePageHeader(const CurrFileName: string);
var
  i: integer;
  FCSS: TextFile;
begin
  GetWriter.StartHTML;
  GetWriter.StartHEAD;
  {$IFDEF QE_UNICODE}
  GetWriter.WriteUnicodeCharset(ectUTF8);
  {$ENDIF}
  GetWriter.WriteTITLE(Title);
  if FUsingCss = usInternal then begin
    GetWriter.StartSTYLE;
    for i := 0 to SStyle.Count - 1 do GetWriter.WriteLn(SStyle[i]);
    GetWriter.EndSTYLE;
  end
  else begin
    if (GetWriter.Stream is TFileStream) then begin
      if FCSSFileName = EmptyStr then  FCSSFileName :=
        ChangeFileExt(CurrFileName, '.css');
      GetWriter.WriteCSSLink(FCSSFileName);
      if (not FileExists(FCSSFileName)) or FOverwriteCSSFile then begin
        AssignFile(FCSS, FCSSFileName);
        Rewrite(FCSS);
        try
          for i := 0 to SStyle.Count - 1 do WriteLn(FCSS, SStyle[i]);
        finally
          CloseFile(FCSS);
        end;
      end;
    end;
  end;
  GetWriter.EndHEAD;
  GetWriter.StartBODY;

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

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

{ TQExportHTMLNavigation }

procedure TQExportHTMLNavigation.Assign(SOurce: TPersistent);
begin
  if Source is TQExportHTMLNavigation then begin
    IndexLinkTemplate := (Source as TQExportHTMLNavigation).IndexLinkTemplate;
    OnTop := (Source as TQExportHTMLNavigation).OnTop;
    OnBottom := (Source as TQExportHTMLNavigation).OnBottom;
    IndexLinkTitle := (Source as TQExportHTMLNavigation).IndexLinkTitle;
    FirstLinkTitle := (Source as TQExportHTMLNavigation).FirstLinkTitle;
    PriorLinkTitle := (Source as TQExportHTMLNavigation).PriorLinkTitle;
    NextLinkTitle := (Source as TQExportHTMLNavigation).NextLinkTitle;
    LastLinkTitle := (Source as TQExportHTMLNavigation).LastLinkTitle;
    Exit;
  end;
  inherited;
end;

constructor TQExportHTMLNavigation.Create;
begin
  inherited;
  FIndexLinkTemplate := EmptyStr;
  FOnTop := true;
  FOnBottom := true;
  FIndexLinkTitle := 'Index';
  FFirstLinkTitle := 'First';
  FPriorLinkTitle := 'Prior';
  FNextLinkTitle := 'Next';
  FLastLinkTitle := 'Last';
end;

end.