⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 qexport4html.pas

📁 Advanced.Export.Component.v4.01.rar,delphi 第三方控件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
begin
  WriteLn('<LI>');
end;

procedure TQHTMLWriter.StartBODY;
begin
  WriteLn('<BODY>');
end;

procedure TQHTMLWriter.StartHEAD;
begin
  WriteLn('<HEAD>');
end;

procedure TQHTMLWriter.StartHTML;
begin
  WriteLn('<HTML>');
end;

procedure TQHTMLWriter.StartSTYLE;
begin
  WriteLn('<Style type="text/css">');
end;

procedure TQHTMLWriter.StartUI;
begin
  WriteLn('<UI>');
end;

procedure TQHTMLWriter.WriteLocationLinks(const Index, First, Prior, Next, Last,
  Template: string; PageCount, PageNumber: integer; IsTop, IsIndex: boolean;
  Strings: TStrings);
var
  sFirst, sPrior, sNext, sLast, sLink, sNumber: string;
  i: integer;
  nPrior, nNext: integer;
begin
  if PageNumber = 1
    then nPrior := PageCount
    else nPrior := PageNumber - 1;

  if PageNumber = PageCount
    then nNext := 1
    else nNext := PageNumber + 1;

  sFirst := AddNumberToFileName(ExtractFileName(Template), 1, 2);
  sPrior := AddNumberToFileName(ExtractFileName(Template), nPrior, 2);
  sNext := AddNumberToFileName(ExtractFileName(Template), nNext, 2);
  sLast := AddNumberToFileName(ExtractFileName(Template), PageCount, 2);

  Strings.BeginUpdate;
  try
    Strings.Clear;

    if not IsTop then Strings.Add('<br>');
    Strings.Add('<Table Border="0" Cellpadding="4" Cellspacing="1">');
    Strings.Add('  <tr>');
    if IsIndex then
      Strings.Add('    <td><a href="' + ExtractFileName(Template) + '">' + Index + '</a></td>');
    Strings.Add('    <td><a href="' + sFirst + '">' + First + '</a></td>');
    Strings.Add('    <td><a href="' + sPrior + '">' + Prior + '</a></td>');
    for i := 1 to PageCount do
      if i <> PageNumber then begin
        if i < 10
          then sNumber := Format('0%d', [i])
          else sNumber := IntToStr(i);

        sLink := AddNumberToFileName(ExtractFileName(Template), i, 2);

        Strings.Add('    <td><a href="' + sLink + '">' + sNumber + '</a></td>');
      end
      else begin
        if i < 10
          then sNumber := Format('0%d', [i])
          else sNumber := IntToStr(i);

        Strings.Add('    <td><b>' + sNumber + '</b></td>');
      end;

    Strings.Add('    <td><a href="' + sNext + '">' + Next + '</a></td>');
    Strings.Add('    <td><a href="' + sLast + '">' + Last + '</a></td>');
    Strings.Add('  </tr>');
    Strings.Add('</Table>');
    if IsTop then Strings.Add('<br>');
  finally
    Strings.EndUpdate;
  end;
end;

procedure TQHTMLWriter.WriteTITLE(const ATitle: string);
begin
  WriteLn(' <Title>' + ATitle + '</Title>');
end;

procedure TQHTMLWriter.WriteCaptionRowTD(const Data: string);
begin
  WriteLn(Format('    <td class="ThRows">%s</td>', [Data]));
end;

procedure TQHTMLWriter.WriteOddRowTD(const Data: QEString);
begin
  WriteLn(QEFormat('    <td class="TrOdd"%s</td>', [Data]));
end;

procedure TQHTMLWriter.WriteEvenRowTD(const Data: QEString);
begin
  WriteLn(QEFormat('    <td class="TrRows"%s</td>', [Data]));
end;

procedure TQHTMLWriter.WriteTABLE(BorderWidth, CellPadding,
  CellSpacing: integer; const BackgroundFileName: string);
begin
  if not FileExists(BackgroundFileName) then
    WriteLn(Format('<Table Border="%d" Cellpadding="%d" Cellspacing="%d">',
                   [BorderWidth, CellPadding, CellSpacing]))
  else
    WriteLn(Format('<Table Border="%d" Cellpadding="%d" Cellspacing="%d" Background="%s">',
                   [BorderWidth, CellPadding, CellSpacing, BackgroundFileName]))
end;

procedure TQHTMLWriter.WriteCSSLink(const FileName: string);
begin
  WriteLn(Format(' <link rel="stylesheet" type="text/css" href="%s">', [{ExtractFileName(}FileName{)}]));
end;

procedure TQHTMLWriter.EndFORM;
begin
  WriteLn('</Form>');
end;

procedure TQHTMLWriter.StartFORM;
begin
  WriteLn('<Form>');
end;

procedure TQHTMLWriter.EndTABLE;
begin
  Writeln('</Table>');
end;

{ TTableOptions }

constructor TTableOptions.Create;
begin
  inherited Create;
  FBorder := 1;
  FCellPadding := 4;
  FCellSpacing := 1;
  FBorderColor := clWhite;
  FAdvancedAttributes := TStringList.Create;
end;

destructor TTableOptions.Destroy;
begin
  FAdvancedAttributes.Free;
  inherited Destroy;
end;

procedure TTableOptions.Assign(Source: TPersistent);
var
  ATableOptions: TTableOptions;
begin
  if Source is TTableOptions then begin
    ATableOptions := TTableOptions(Source);
    Border := ATableOptions.Border;
    CellPadding := ATableOptions.CellPadding;
    CellSpacing := ATableOptions.CellSpacing;
    AdvancedAttributes := ATableOptions.AdvancedAttributes;
    HeadersRowBgColor := ATableOptions.HeadersRowBgColor;
    HeadersRowFontColor := ATableOptions.HeadersRowFontColor;
    TableBgColor := ATableOptions.TableBgColor;
    TableFontColor := ATableOptions.TableFontColor;
    OddRowBgColor := ATableOptions.OddRowBgColor;
    BorderColor := ATableOptions.BorderColor;
  end;
end;

procedure TTableOptions.SaveToIniFile(IniFile: TQIniFile;
  const Section: string);
begin
  with IniFile do begin
    WriteInteger(S_HTML, S_HTML_CellPadding, CellPadding);
    WriteInteger(S_HTML, S_HTML_CellSpacing, CellSpacing);
    WriteInteger(S_HTML, S_HTML_BorderWidth, Border);
    WriteString(S_HTML, S_HTML_TableBackground, BackgroundFileName);
    WriteString(S_HTML, S_HTML_TableAdvanced, AdvancedAttributes.Text);
    WriteString(S_HTML, S_HTML_OddRowBackgroundColor,
      ColorToString(OddRowBgColor));
    WriteString(S_HTML, S_HTML_HeadFontColor,
      ColorToString(HeadersRowFontColor));
    WriteString(S_HTML, S_HTML_DataFontColor,
      ColorToString(TableFontColor));
    WriteString(S_HTML, S_HTML_EvenRowBackgroundColor,
      ColorToString(TableBgColor));
    WriteString(S_HTML, S_HTML_HeadBackgroundColor,
      ColorToString(HeadersRowBgColor));
  end;
end;

procedure TTableOptions.LoadFromIniFile(IniFile: TQIniFile;
  const Section: string);
begin
  with IniFile do begin
    CellPadding := ReadInteger(S_HTML, S_HTML_CellPadding, 4);
    CellSpacing := ReadInteger(S_HTML, S_HTML_CellSpacing, 1);
    Border := ReadInteger(S_HTML, S_HTML_BorderWidth, 1);
    BackgroundFileName := ReadString(S_HTML, S_HTML_TableBackground, EmptyStr);
    AdvancedAttributes.Text := ReadString(S_HTML,
      S_HTML_TableAdvanced, EmptyStr);
    OddRowBgColor := StringToColor(ReadString(S_HTML,
      S_HTML_OddRowBackgroundColor, ColorToString(RhtClassic.ROddRowBgColor)));
    HeadersRowFontColor := StringToColor(ReadString(S_HTML,
      S_HTML_HeadFontColor, ColorToString(RhtClassic.RHeadersRowFontColor)));
    TableFontColor := StringToColor(ReadString(S_HTML,
      S_HTML_DataFontColor, ColorToString(RhtClassic.RTableFontColor)));
    TableBgColor := StringToColor(ReadString(S_HTML,
      S_HTML_EvenRowBackgroundColor, ColorToString(RhtClassic.RTableBgColor)));
    HeadersRowBgColor := StringToColor(ReadString(S_HTML,
      S_HTML_HeadBackgroundColor, ColorToString(RhtClassic.RHeadersRowBgColor)));
  end;
end;

procedure TTableOptions.SetAdvancedAttributes(const Value: TStrings);
begin
  if Assigned(Value) then
    FAdvancedAttributes.Assign(Value);
end;

procedure TTableOptions.SetBorder(const Value: integer);
begin
  if FBorder <> Value then
    FBorder := Value;
end;

procedure TTableOptions.SetCellPadding(const Value: integer);
begin
  if FCellPadding <> Value then
    FCellPadding := Value;
end;

procedure TTableOptions.SetCellSpacing(const Value: integer);
begin
  if FCellSpacing <> Value then
    FCellSpacing := Value;
end;

procedure TTableOptions.SetHeadersRowBgColor(const Value: TColor);
begin
  if FHeadersRowBgColor <> Value then
    FHeadersRowBgColor := Value;
end;

procedure TTableOptions.SetHeadersRowFontColor(const Value: TColor);
begin
  if FHeadersRowFontColor <> Value then
    FHeadersRowFontColor := Value;
end;

procedure TTableOptions.SetOddRowBgColor(const Value: TColor);
begin
  if FOddRowBgColor <> Value then
    FOddRowBgColor := Value;
end;

procedure TTableOptions.SetTableBgColor(const Value: TColor);
begin
  if FTableBgColor <> Value then
    FTableBgColor := Value;
end;

procedure TTableOptions.SetTableFontColor(const Value: TColor);
begin
  if FTableFontColor <> Value then
    FTableFontColor := Value;
end;

{ THTMLOptions }

constructor THTMLOptions.Create;
begin
  inherited Create;
  FAdvancedAttributes := TStringList.Create;
  FTextFont := TFont.Create;
  FTextFont.Name := 'Arial';
  FDefaultOptions := [doFontSize];
end;

destructor THTMLOptions.Destroy;
begin
  FAdvancedAttributes.Free;
  FTextFont.Free;
  inherited Destroy;
end;

procedure THTMLOptions.Assign(Source: TPersistent);
begin
  if Source is THTMLOptions then begin
    BackgroundColor := (Source as THTMLOptions).BackgroundColor;
    BackgroundFileName := (Source as THTMLOptions).BackgroundFileName;
    LinkColor := (Source as THTMLOptions).LinkColor;
    VLinkColor := (Source as THTMLOptions).VLinkColor;
    ALinkColor := (Source as THTMLOptions).ALinkColor;
    TextFont := (Source as THTMLOptions).TextFont;
    AdvancedAttributes := (Source as THTMLOptions).AdvancedAttributes;
    Exit;
  end;
  inherited;
end;

procedure THTMLOptions.SaveToIniFile(IniFile: TQIniFile;
  const Section: string);
begin
  with IniFile do begin
    WriteString(S_HTML, S_HTML_BackgroundColor, ColorToString(BackgroundColor));
    WriteString(S_HTML, S_HTML_BackgroundFile, BackgroundFileName);
    WriteString(S_HTML, S_HTML_VLinkColor, ColorToString(VLinkColor));
    WriteString(S_HTML, S_HTML_LinkColor, ColorToString(LinkColor));
    WriteString(S_HTML, S_HTML_ALinkColor, ColorToString(ALinkColor));

    WriteString(S_HTML, S_HTML_FontName, TextFont.Name);
    WriteString(S_HTML, S_HTML_FontColor, ColorToString(TextFont.Color));
    WriteString(S_HTML, S_HTML_BodyAdvanced, AdvancedAttributes.Text);
  end;
end;

procedure THTMLOptions.LoadFromIniFile(IniFile: TQIniFile;
  const Section: string);
begin
  with IniFile do begin
    BackgroundColor := StringToColor(ReadString(S_HTML, S_HTML_BackgroundColor,
      ColorToString(RhtClassic.RBackgroundColor)));
    BackgroundFileName := ReadString(S_HTML, S_HTML_BackgroundFile, EmptyStr);
    VLinkColor := StringToColor(ReadString(S_HTML, S_HTML_VLinkColor,
      ColorToString(RhtClassic.RVLinkColor)));
    LinkColor := StringToColor(ReadString(S_HTML, S_HTML_LinkColor,
      ColorToString(RhtClassic.RLinkColor)));
    ALinkColor := StringToColor(ReadString(S_HTML, S_HTML_ALinkColor,
      ColorToString(RhtClassic.RALinkColor)));
    TextFont.Name := ReadString(S_HTML, S_HTML_FontName, 'arial');
    TextFont.Color := StringToColor(ReadString(S_HTML, S_HTML_FontColor,
      ColorToString(RhtClassic.RDefaultTextColor)));
  end;
end;

procedure THTMLOptions.SetAdvancedAttributes(const Value: TStrings);
begin
  if Assigned(Value) then
    FAdvancedAttributes.Assign(Value);
end;

procedure THTMLOptions.SetBackgroundFileName(const Value: string);
begin
  if FBackgroundFileName <> Value then FBackgroundFileName := Value;
end;

procedure THTMLOptions.SetTextFont(const Value: TFont);
begin
  if Assigned(Value) then
    FTextFont.Assign(Value);
end;

{ TQExport4HTML }

procedure TQExport4HTML.Abort;
begin
  inherited;

end;

procedure TQExport4HTML.AfterExport;
var
  i: integer;
begin
  if not IsEmpty then
  begin
    if FBoolAsCheckBox then
      GetWriter.EndFORM;
    GetWriter.EndTABLE;
  end;
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -