{$I '..\NxSuite6.inc'}
unit NxGridCtrls6;

interface

uses
  { Standard }
  Types, Classes, Graphics,
  { Next Standard 6 }
  NxTypes6, NxClasses6, NxIntf6, NxGraphics6, NxXMLDoc6,
  { NextGrid 6 }
  NxColumns6, NxCustomGrid6;

const
  stHTML5 = '<!DOCTYPE html>';

const
  clGridColor = $00f0f0f0;
  clHeaderBackroundColor = $00fcfcfc;
  clHeaderGridColor = $00fbf1e8;

type
  { TNxGridHTMLExport6 }

  TNxHTMLExportOptions = set of (exCaption, exFooter, exHeader);

  TNxColorPalette = class(TPersistent)
  private
    FGridColor: TColor;
    FHeaderBackgroundColor: TColor;
    FHeaderGridColor: TColor;
  public
    constructor Create;
  published
    property HeaderBackgroundColor: TColor read FHeaderBackgroundColor write FHeaderBackgroundColor
      default clHeaderBackroundColor;
    property HeaderGridColor: TColor read FHeaderGridColor write FHeaderGridColor
      default clHeaderGridColor;
    property GridColor: TColor read FGridColor write FGridColor default clGridColor;
  end;

  TNxGridHTMLExport6 = class(TComponent)
  private
    FAssociate: TNxCustomGrid6;
    FCaption: WideString;
    FColors: TNxColorPalette;
    FFileName: string;
    FImagesFolder: string;
    FOnGetCellText: TNxGetTextEvent;
    FOptions: TNxHTMLExportOptions;
    FStylesFileName: string;
    FStylesFolder: string;
    { Property Accessors }
    function GetDocument: TNxXMLDocument6;
    function GetStyles: TStrings;
    function GetTableXMLNode: INxXMLNode;
    procedure SetAssociate(const Value: TNxCustomGrid6);
  protected
    procedure DoGetCellText(ACol, ARow: Integer; var Text: WideString); dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetHTML: WideString; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Methods }
    function GetStylesRelativePath: string;
    procedure SaveToFile(const FileName: string);
    procedure SaveImages(Path: string);
    procedure SaveStyles(Path: string);
    { Properties }
    property Document: TNxXMLDocument6 read GetDocument;
    property HTML: WideString read GetHTML;
    property Styles: TStrings read GetStyles;
    property TableXMLNode: INxXMLNode read GetTableXMLNode;
  published
    { Properties }
    property Associate: TNxCustomGrid6 read FAssociate write SetAssociate;
    property Caption: WideString read FCaption write FCaption;
    property Colors: TNxColorPalette read FColors write FColors;
    property FileName: string read FFileName write FFileName;
    property ImagesFolder: string read FImagesFolder write FImagesFolder;
    property Options: TNxHTMLExportOptions read FOptions write FOptions
      default [];
    property StylesFileName: string read FStylesFileName write FStylesFileName;
    property StylesFolder: string read FStylesFolder write FStylesFolder;
    { Events }
    property OnGetCellText: TNxGetTextEvent read FOnGetCellText write FOnGetCellText;
  end;

implementation

uses
  SysUtils,
  { NextGrid 6 }
  NxCells6;

{ TNxColorPalette }

constructor TNxColorPalette.Create;
begin
  FGridColor := clGridColor;
  FHeaderBackgroundColor := clHeaderBackroundColor;
  FHeaderGridColor := clHeaderGridColor;
end;

{ TNxGridHTMLExport6 }

constructor TNxGridHTMLExport6.Create(AOwner: TComponent);
begin
  inherited;
  FAssociate := nil;
  FCaption := '';
  FColors := TNxColorPalette.Create;
  FFileName := '';
  FImagesFolder := 'images';
  FOptions := [];
  FStylesFileName := 'styles.css';
  FStylesFolder := 'styles';
end;

destructor TNxGridHTMLExport6.Destroy;
begin
  FreeAndNil(FColors);
  inherited;
end;

procedure TNxGridHTMLExport6.DoGetCellText(ACol, ARow: Integer;
  var Text: WideString);
begin
  if Assigned(FOnGetCellText) then FOnGetCellText(Self, ACol, ARow, Text);
end;

function TNxGridHTMLExport6.GetDocument: TNxXMLDocument6;
var
  RootNode, HeadNode, BodyNode: INxXMLNode;
begin
  Result := TNxXMLDocument6.Create(nil);
  Result.FileHeader := stHTML5;

  Result.DocumentElement := TNxXMLNode.Create('html');

  RootNode := Result.DocumentElement;

  { Head }
  HeadNode := RootNode.ChildNodes.Add('head');

  { Link }
  with HeadNode.ChildNodes.Add('link') do
  begin
    Attributes['href'] := GetStylesRelativePath + StylesFileName;
    Attributes['rel'] := 'stylesheet';
    Attributes['type'] := 'text/css';
  end;

  { Meta }
  with HeadNode.ChildNodes.Add('meta') do
  begin
    Attributes['charset'] := 'UTF-8';
  end;

  BodyNode := Result.DocumentElement.ChildNodes.Add('body');

  BodyNode.ChildNodes.Add(TableXMLNode);
end;

function TNxGridHTMLExport6.GetHTML: WideString;
begin
  with Document do
  begin
    SaveToXML(Result);
    Free;
  end;
end;

function TNxGridHTMLExport6.GetStyles: TStrings;
begin
  Result := TStringList.Create;

  Result.Add(#9'table {');
  Result.Add(#9#9'border: 1px;');
  Result.Add(#9#9'border-collapse: collapse;');
  Result.Add(#9'}');

  Result.Add('');

  Result.Add(#9'td, th {');
  Result.Add(#9#9'padding: 0.25em 0.5em;');
  Result.Add(#9#9'border: 1px solid ' + ColorToWebColor(Colors.GridColor) + ';');
  Result.Add(#9'}');

  Result.Add('');

  Result.Add(#9'thead th {');
  Result.Add(#9#9'background-color: ' + ColorToWebColor(Colors.HeaderBackgroundColor) + ';');
  Result.Add(#9#9'border: 1px solid ' + ColorToWebColor(Colors.HeaderGridColor) + ';');
  Result.Add(#9#9'font-weight: normal;');
  Result.Add(#9#9'text-align: left;');
  Result.Add(#9'}');

  Result.Add('');

  Result.Add(#9'tfoot td {');
  Result.Add(#9#9'border-top: 4px solid ' + ColorToWebColor(Colors.GridColor) + ';');
  Result.Add(#9'}');
end;

function TNxGridHTMLExport6.GetStylesRelativePath: string;
begin
  Result := '';
  if StylesFolder <> '' then Result := Result + StylesFolder + '\';
end;

function TNxGridHTMLExport6.GetTableXMLNode: INxXMLNode;
var
  TableHeadNode, TableBodyNode, TableFootNode: INxXMLNode;
  StyleAttribute: string;
  c, r: Integer;
  Cell: INxCell;
  CellText: WideString;

  procedure AddStyleAttribute(Attribute: string);
  begin
    if StyleAttribute <> ''
      then StyleAttribute := StyleAttribute + '; ';
    StyleAttribute := StyleAttribute + Attribute;
  end;

begin
  Result := TNxXMLNode.Create('table');

  { `<caption>` }
  if exCaption in Options then
  begin
    Result.ChildNodes.Add('caption').AsString := Caption;
  end;

  { Table Headers `<thead>` }
  TableHeadNode := Result.ChildNodes.Add('thead');

  with TableHeadNode.ChildNodes.Add('tr') do
  begin

    for c := 0 to Associate.ColCount - 1 do
      if Associate.Columns.PositionItem[c].Visible then
      begin
        ChildNodes.Add('th').AsString := Associate.Columns.PositionItem[c].Header.Caption;
      end;

  end;

  { Table Body `<tbody>` }
  TableBodyNode := Result.ChildNodes.Add('tbody');

  for r := 0 to Pred(Associate.RowCount) do
  begin

    if Associate.Row[r].Visible then
    begin

      { tr }
      with TableBodyNode.ChildNodes.Add('tr') do
      begin

        for c := 0 to Associate.ColCount - 1 do
          if Associate.Columns.PositionItem[c].Visible then
          begin

            with ChildNodes.Add('td') do
            begin
              Cell := Associate.Cell[c, r];
              CellText := Associate.Columns.PositionItem[c].GetHTML(Cell, c, r);

              { Trigger event }
              DoGetCellText(c, r, CellText);

              AsString := CellText;

              StyleAttribute := '';

              case Associate.Columns.PositionItem[c].Alignment of
                Classes.taCenter:       StyleAttribute := 'text-align: center';
                Classes.taRightJustify: StyleAttribute := 'text-align: right';
              end;

              if Cell.Color <> Associate.Color then
              begin
                AddStyleAttribute('background-color: ' + ColorToWebColor(Cell.Color));
              end;

              if fsBold in Cell.Font.Style then
              begin
                AddStyleAttribute('font-weight: bold');
              end;

              if fsItalic in Cell.Font.Style then
              begin
                AddStyleAttribute('font-style: italic');
              end;

              if StyleAttribute <> '' then Attributes['style'] := StyleAttribute;
            end;
          end;

      end;

    end;

  end;

  { Footer }
  if exFooter in Options then
  begin
    TableFootNode := Result.ChildNodes.Add('tfoot');

    with TableFootNode do
      with TableFootNode.ChildNodes.Add('tr') do
      begin

        for c := 0 to Associate.ColCount - 1 do
          if Associate.Columns.PositionItem[c].Visible then
          begin
            ChildNodes.Add('td').AsString := Associate.Columns.PositionItem[c].Footer.GetHTML;
          end;
      end;
  end;
end;

procedure TNxGridHTMLExport6.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
    if AComponent = FAssociate then Associate := nil;
end;

procedure TNxGridHTMLExport6.SaveImages(Path: string);
var
  i, j: Integer;
  Graphic: TGraphic;
  Ref: INxGraphicCells;
begin
  for i := 0 to FAssociate.ColCount - 1 do
  begin

    if Supports(FAssociate.Columns[i], INxGraphicCells, Ref) then
    begin
      Ref.SaveToPath(Path);

      for j := 0 to Pred(FAssociate.RowCount) do
      begin
        Graphic := Ref.GetGraphic(FAssociate.Cell[i, j], i, j);
        if Assigned(Graphic) then
        begin
          Graphic.SaveToFile(Path + LowerCase(FAssociate.Columns[i].Name) + '_' + IntToStr(i) + '_' + IntToStr(j) + '.png');
        end;
      end;
    end;
  end;
end;

procedure TNxGridHTMLExport6.SaveStyles(Path: string);
var
  FStyles: TStrings;
  FLines: TStringList;
begin
  FLines := TStringList.Create;

  FLines.Add('@media all {');

  FLines.Add(#9'body {');
  FLines.Add(#9#9'font: normal 100% "Segoe UI", Tahoma, Arial, sans-serif;');
  FLines.Add(#9'}');

  FLines.Add('');

  FStyles := Styles;

  FLines.AddStrings(FStyles);

  FLines.Add('}');

  try
    FLines.SaveToFile(Path + StylesFileName{$IFDEF UNICODE}, TEncoding.UTF8{$ENDIF});
  finally
    FStyles.Free;
    FLines.Free;
  end;
end;

procedure TNxGridHTMLExport6.SaveToFile(const FileName: string);
var
  StylesPath, ImagesPath: string;
begin
  if Assigned(Associate) then
  begin
    StylesPath := ExtractFilePath(FileName);

    if StylesFolder <> EmptyStr then
    begin
      StylesPath := StylesPath + StylesFolder + '\';
      if not DirectoryExists(StylesPath) then
      begin
        CreateDir(StylesPath);
      end;
    end;

    SaveStyles(StylesPath);

    ImagesPath := ExtractFilePath(FileName);
    if ImagesFolder <> EmptyStr then
    begin
      ImagesPath := ImagesPath + ImagesFolder + '\';
      if not DirectoryExists(ImagesPath) then
      begin
        CreateDir(ImagesPath);
      end;
    end;

    SaveImages(ImagesPath);

    with Document do
    begin
      SaveToFile(FileName);
      Free;
    end;
  end;
end;

procedure TNxGridHTMLExport6.SetAssociate(const Value: TNxCustomGrid6);
begin
  if FAssociate <> Value then
  begin
    if Assigned(Value) then
    begin
      Value.FreeNotification(Self);
    end else
    begin
      FAssociate.RemoveFreeNotification(Self);
    end;
    FAssociate := Value;
  end;
end;

end.
