qexport4latex.pas

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

unit QExport4LaTeX;

interface

uses QExport4, Classes, QExport4Types;

type
  TQLaTeXWriter = class(TQExportWriter)
  public
    procedure UsePackage(const APackage, Options: string);
    procedure NewLine;
    procedure HLine;
    procedure BeginEnv(const Environment, Params: string);
    procedure EndEnv(const Environment: string);
  end;

  TLaTeXVersion = (LaTeX209, LaTeX2e);
  TLaTeXDocStyle = (dsArticle, dsBook);

  TLaTeXOptions = class(TPersistent)
  private
    FDocumentStyle: TLaTeXDocStyle;
    FDocumentParams: string;
    FLaTeXVersion: TLaTeXVersion;
    FLanguages: string;
    FCodePage: integer;

    procedure SetCodePage(const Value: integer);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property LaTeXVersion: TLaTeXVersion read FLaTeXVersion write FLaTeXVersion default LaTex2e;
    property DocumentStyle: TLaTeXDocStyle read FDocumentStyle write FDocumentStyle default dsArticle;
    property DocumentParams : string read FDocumentParams write FDocumentParams;
    property CodePage: integer read FCodePage write SetCodePage;
    property Languages : string read FLanguages write FLanguages;
  end;

  TQExport4LaTeX = class(TQExport4FormatText)
  private
    FOptions: TLaTeXOptions;
    FPreambula: TStrings;
    procedure SetOptions(const Value: TLaTeXOptions);
    procedure SetPreambula(const Value: TStrings);
  protected
    procedure WriteDataRow; override;
    function GetDataRow: QEString; override;
    function GetColData(ColValue: QEString;
      Column: TQExportColumn): QEString; override;
    function GetColCaption(Index: integer): string; override;
    function GetCaptionRow: string; override;
    procedure WriteCaptionRow; override;
    function GetSpecialCharacters: TSpecialCharacters; override;

    function GetWriter: TQLaTeXWriter;
    function GetWriterClass: TQExportWriterClass; override;

    procedure BeginExport; override;
    procedure EndExport; override;

    function StyleToStr(Value: TLaTeXDocStyle): string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Abort; override;
    function NormalString(const S: QEString): QEString; override;
  published
    property Options: TLaTeXOptions read FOptions write SetOptions;
    property Preambula: TStrings read FPreambula write SetPreambula;
  end;

implementation

uses
  SysUtils{$IFDEF WIN32}, Windows{$ENDIF},
  {$IFDEF VCL6}StrUtils,{$ENDIF} QExport4EmsWideStrUtils;

{ TQLaTeXWriter }

procedure TQLaTeXWriter.BeginEnv(const Environment, Params: string);
var
  s: string;
begin
  s := '\begin' + '{' + Environment + '}';
  if Params <> EmptyStr then s := s + '{' + Params + '}';
  WriteLn(s);
end;

procedure TQLaTeXWriter.EndEnv(const Environment: string);
begin
  WriteLn('\end' + '{' + Environment + '}');
end;

procedure TQLaTeXWriter.HLine;
begin
  WriteLn('\hline');
end;

procedure TQLaTeXWriter.NewLine;
begin
  WriteLn('\\');
end;

procedure TQLaTeXWriter.UsePackage(const APackage, Options: string);
begin
  WriteLn('\usepackage' + '[' + Options + ']' + '{' + APackage + '}');
end;

{ TQExport4LaTeX }

procedure TQExport4LaTeX.WriteDataRow;
begin
  GetWriter.WriteLn(GetDataRow);
  GetWriter.NewLine;
  GetWriter.HLine;
end;

function TQExport4LaTeX.NormalString(const S: QEString): QEString;
var
  i, p: integer;
const
  SearchSym: array [0..2] of WideString = ('>', '<', '\');
  ReplSym: array [0..2] of WideString = ('$>$', '$<$', '\backslash');
begin
//  for j := 1 to Length(S) do
//    if (S[j] in GetSpecialCharacters) then
//      if S[j] = '\' then Result := Result + '\backslash'
//      else Result := Result + '\' + S[j]
//    else
//      case S[j] of
//       '>': Result := Result + '$>$';
//       '<': Result := Result + '$<$';
//      else Result := Result + S[j];
//      end;
  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 then
      begin
        QEDelete(Result, p, 1);
        QEInsert(ReplSym[i], Result, p);
        Inc(p, 3);
      end;
    end;
  end;
end;

procedure TQExport4LaTeX.BeginExport;
var
  s: string;
  i: integer;
begin
  inherited;
  with FOptions do begin
    s := DocumentParams;
    if FOptions.LaTeXVersion = LaTeX209 then begin
      if s <> EmptyStr then
        GetWriter.WriteLn('\documentstyle' + '[' + s + ']' + '{' + StyleToStr(DocumentStyle) + '}')
      else GetWriter.WriteLn('\documentstyle' + '{' + StyleToStr(DocumentStyle) + '}');
    end
    else begin
      if s <> EmptyStr then
        GetWriter.WriteLn('\documentclass' + '[' + s + ']' + '{' + StyleToStr(DocumentStyle) + '}')
      else GetWriter.WriteLn('\documentclass' + '{' + StyleToStr(DocumentStyle) + '}');
      GetWriter.UsePackage('inputenc', 'cp' + IntToStr(CodePage));
      GetWriter.UsePackage('babel', Languages);
      if FPreambula.Count > 0 then begin
        for i := 0 to FPreambula.Count - 1 do GetWriter.WriteLn(FPreambula[i]);
        GetWriter.EmptyLine;
      end;
    end;
  end;

  GetWriter.BeginEnv('document', '');
  if Pos('RUSSIAN', UpperCase(FOptions.Languages)) > 0 then GetWriter.WriteLn('\Rus');
  GetWriter.EmptyLine;
  for i := 0 to Header.Count - 1 do GetWriter.WriteLn(Header[i]);
  GetWriter.WriteLn('\par\bigskip');

  s := '|';
  for i := 0 to Columns.Count - 1 do
    if Columns[i].IsNumeric then s := s + 'r' + '|'
    else s := s + 'l' + '|';
  GetWriter.BeginEnv('tabular', s);
  GetWriter.HLine;
end;

procedure TQExport4LaTeX.SetOptions(const Value: TLaTeXOptions);
begin
  FOptions.Assign(Value);
end;

constructor TQExport4LaTeX.Create(AOwner: TComponent);
begin
  inherited;
  FOptions := TLaTeXOptions.Create;
  FPreambula := TStringList.Create;
end;

destructor TQExport4LaTeX.Destroy;
begin
  FPreambula.Free;
  FOptions.Free;
  inherited;
end;

procedure TQExport4LaTeX.SetPreambula(const Value: TStrings);
begin
  FPreambula.Assign(Value);
end;

procedure TQExport4LaTeX.EndExport;
var
  i: integer;
begin
  GetWriter.EndEnv('tabular');
  GetWriter.EmptyLine;
  for i := 0 to Footer.Count-1 do GetWriter.Writeln(Footer[i]);
  GetWriter.EndEnv('document');
  inherited;
end;

function TQExport4LaTeX.GetColData(ColValue: QEString;
  Column: TQExportColumn): QEString;
begin
  Result := inherited GetColData(ColValue, Column);
  Result := Result + ' & ';
end;

function TQExport4LaTeX.GetDataRow: QEString;
begin
  Result := inherited GetDataRow;
  Delete(Result, Length(Result) - 2, 3);
end;

function TQExport4LaTeX.GetColCaption(Index: integer): string;
begin
  Result := inherited GetColCaption(Index);
  Result := Result + ' & ';
end;

function TQExport4LaTeX.GetCaptionRow: string;
begin
  Result := inherited GetCaptionRow;
  Delete(Result, Length(Result) - 2, 3);
end;

procedure TQExport4LaTeX.WriteCaptionRow;
begin
  GetWriter.WriteLn(GetCaptionRow);
  GetWriter.NewLine;
  GetWriter.HLine;
end;

function TQExport4LaTeX.GetSpecialCharacters: TSpecialCharacters;
begin
  Result := ['#', '$', '%', '&', '~', '_', '^', '\', '{', '}'];
end;

function TQExport4LaTeX.GetWriter: TQLaTeXWriter;
begin
  Result := TQLaTeXWriter(inherited GetWriter);
end;

function TQExport4LaTeX.GetWriterClass: TQExportWriterClass;
begin
  Result := TQLaTeXWriter;
end;

function TQExport4LaTeX.StyleToStr(Value: TLaTeXDocStyle): string;
begin
  case Value of
    dsArticle: Result := 'article';
    dsBook: Result := 'book';
    else Result := EmptyStr;
  end;
end;

procedure TQExport4LaTeX.Abort;
begin
  GetWriter.HLine;
  GetWriter.EndEnv('tabular');
  GetWriter.EmptyLine;
  GetWriter.EndEnv('document');
  inherited;
end;

{ TLaTeXOptions }

procedure TLaTeXOptions.Assign(Source: TPersistent);
begin
  if Source is TLaTeXOptions then begin
    DocumentStyle := (Source as TLaTeXOptions).DocumentStyle;
    DocumentParams := (Source as TLaTeXOptions).DocumentParams;
    LaTeXVersion := (Source as TLaTeXOptions).LaTeXVersion;
    Languages := (Source as TLaTeXOptions).Languages;
    CodePage := (Source as TLaTeXOptions).CodePage;
    Exit;
  end;
  inherited;
end;

constructor TLaTeXOptions.Create;
begin
  inherited Create;
  FLaTeXVersion := LaTeX2e;
  FDocumentStyle := dsArticle;
  {$IFDEF WIN32}
  FCodePage := GetACP;
  {$ENDIF}
  FDocumentParams := 'a4paper';
  FLanguages := 'english';
end;

procedure TLaTeXOptions.SetCodePage(const Value: integer);
begin
  if FCodePage <> Value then FCodePage := Value;
  {$IFDEF WIN32} if FCodePage <= 0 then  FCodePage := GetACP;{$ENDIF}
end;

end.