Intelligent page breaks (Delphi)

Note

This demo is available in your FlexCel installation at <FlexCel Install Folder>\Demo\Delphi\Modules\10.API\72.Intelligent Page Breaks and also at https://github.com/tmssoftware/TMS-FlexCel.VCL-demos/tree/master/Delphi/Modules/10.API/72.Intelligent Page Breaks

Overview

While there is no direct support in Excel for Widow/Orphan control, FlexCel has the capacity to add page breaks to your file, so you can keep interesting sections together.

Make sure to read the conceptual documentation about Intelligent Page Breaks to better understand what we are doing here.

Concepts

How to add automatic page breaks to a sheet. In this case, we are dumping a Pascal file to PDF, and we want to keep procedures in the same page is possible.
How to deal with different levels of "keep together". FlexCel allows you to make some rows more "keep together" than others, if it can't fit everything in the same page, it will try to keep the rows of higher "keep together". We use this here to try to keep full classes first, if it is not possible full procedures, if not full for/while loops, etc.
Each begin sign in the source file means higher level of "keep together", and each end decreases the level.
The method TExcelFile.AutoPageBreaks must be called after everything is done, so the sheet is in a final state when applying the page breaks.

Files

UIntelligentPageBreaks.pas

unit UIntelligentPageBreaks;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, UPaths,
  Dialogs, StdCtrls, Generics.Collections, FlexCel.VCLSupport, FlexCel.Core, FlexCel.XlsAdapter,
  FlexCel.Render,
  {$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
  ShellAPI;

type
  TFIntelligentPageBreaks = class(TForm)
    Memo1: TMemo;
    btnCreateFile: TButton;
    SaveDialog: TSaveDialog;
    procedure btnCreateFileClick(Sender: TObject);
  private
    Keywords: TDictionary<string, boolean>;
    procedure AddData(const Xls: TExcelFile);
    procedure AutoRun;
    class function CreateKeywords: TDictionary<string, boolean>; static;
    procedure DumpFile(const Xls: TExcelFile; var Row: Int32);
    function SyntaxColor(const Xls: TExcelFile; const NormalFont, CommentFont,
      HighlightFont: TFlxFont; const line: String): TRichString;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  FIntelligentPageBreaks: TFIntelligentPageBreaks;

implementation
uses Character, IOUtils, StrUtils;
{$R *.dfm}

{$region 'Base'}
procedure TFIntelligentPageBreaks.btnCreateFileClick(Sender: TObject);
begin
  AutoRun;
end;

constructor TFIntelligentPageBreaks.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Keywords := CreateKeywords;
end;

destructor TFIntelligentPageBreaks.Destroy;
begin
  Keywords.Free;

  inherited;
end;

{$endregion}

{$region 'Syntax definitions'}
/// <summary>
/// A very silly syntax highlighter. We don't have any context here, so for example "write" will be highlighted when it is a property or when it is not, but it is ok for this demo.
/// </summary>
/// <returns></returns>
class function TFIntelligentPageBreaks.CreateKeywords: TDictionary<string, boolean>;
begin
  Result := TDictionary<string, boolean>.Create;
  Result.Add('interface', false);
  Result.Add('implementation', false);
  Result.Add('uses', false);
  Result.Add('unit', false);
  Result.Add('type', false);
  Result.Add('begin', false);
  Result.Add('end', false);
  Result.Add('inherited', false);
  Result.Add('const', false);
  Result.Add('var', false);
  Result.Add('private', false);
  Result.Add('public', false);
  Result.Add('protected', false);
  Result.Add('static', false);
  Result.Add('procedure', false);
  Result.Add('function', false);
  Result.Add('read', false);
  Result.Add('write', false);
  Result.Add('exit', false);
  Result.Add('while', false);
  Result.Add('for', false);
  Result.Add('true', false);
  Result.Add('false', false);
  Result.Add('try', false);
  Result.Add('finally', false);
  Result.Add('except', false);
  Result.Add('if', false);
  Result.Add('then', false);
  Result.Add('do', false);

end;
{$endregion}

function IsLetterOrDigit(const c: char): boolean;
begin
 {$if CompilerVersion >= 25.0}
      Result := c.IsLetterOrDigit;
 {$else}
      Result := TCharacter.IsLetterOrDigit(c);
 {$ifend}

end;

{$region 'Syntax highlight method'}
/// <summary>
/// This syntax highlighter is not serious, just to make output a little prettier.
/// </summary>
/// <param name="Xls"></param>
/// <param name="NormalFont"></param>
/// <param name="CommentFont"></param>
/// <returns></returns>
function TFIntelligentPageBreaks.SyntaxColor(const Xls: TExcelFile; const NormalFont: TFlxFont; const CommentFont: TFlxFont; const HighlightFont: TFlxFont; const line: String): TRichString;
var
  RTFRunList: TList<TRTFRun>;
  i: Int32;
  rtf: TRTFRun;
  start: Int32;
begin
  RTFRunList := TList<TRTFRun>.Create;
  try
    i := 1;
    while i <= Length(line) do
    begin
      if ((i > 1) and (line[i] = '/')) and (line[i - 1] = '/') then
      begin
        rtf.FirstChar := i - 1;
        rtf.Font := CommentFont;
        RTFRunList.Add(rtf);
        exit(TRichString.Create(line, RTFRunList.ToArray));
      end;

      start := i;
      while (i <= Length(line)) and IsLetterOrDigit(line[i]) do
      begin
        Inc(i);
      end;
      if (i > start) and Keywords.ContainsKey(System.Copy(line, start, i - start)) then
      begin
        rtf.FirstChar := start - 1;
        rtf.Font := HighlightFont;
        RTFRunList.Add(rtf);
        rtf.FirstChar := i - 1;
        rtf.Font := NormalFont;
        RTFRunList.Add(rtf);
      end;

      Inc(i);
    end;
    Result := TRichString.Create(line, RTFRunList.ToArray);
  finally
    RTFRunList.Free;
  end;
end;

{$endregion}

{$region 'Dump'}
procedure TFIntelligentPageBreaks.DumpFile(const Xls: TExcelFile; var Row: Int32);
var
  HighlightFont: TFlxFont;
  CommentFont: TFlxFont;
  Level: Int32;
  LevelStart: TStack<integer>;
  sr: TStreamReader;
  line: String;
  s: String;
begin
  HighlightFont := Xls.GetDefaultFont;
  HighlightFont.Color := clBlue;

  CommentFont := Xls.GetDefaultFont;
  CommentFont.Color := clGreen;

  Level := 0;
  LevelStart := TStack<integer>.Create;
  try
    LevelStart.Push(Row);
    sr := TStreamReader.Create(TPath.Combine(DataFolder, 'UIntelligentPageBreaks.pas'));
    try
      while not sr.EndOfStream do
      begin
        line := sr.ReadLine;
        s := Trim(line);  //Find the level of "keep together" for the row. We will use {$region and "begin" delimiters
                          //to increase the level. If possible, we would want those blocks together in one page.
        if StartsText('{$region', s) then
        begin
          Inc(Level);
          LevelStart.Push(Row);
        end;

        if (SameText('{$endregion}', s)) then
        begin
          Xls.KeepRowsTogether(Int32(LevelStart.Pop), Row, Level, false);
          Dec(Level);
        end;

        Xls.SetCellValue(Row, 1, SyntaxColor(Xls, Xls.GetDefaultFont, CommentFont, HighlightFont, StringReplace(line, #$0009, '    ', [rfReplaceAll])));
        Inc(Row);
      end;
    finally
      sr.Free;
    end;
  finally
    LevelStart.Free;
  end;
end;

{$endregion}
{$region 'Add data'}
procedure TFIntelligentPageBreaks.AddData(const Xls: TExcelFile);
var
  Row: Int32;
begin
  Row := 3;  //Fill the file with the contents of this pas file, many times so we can see many page breaks.
  DumpFile(Xls, Row);
  Xls.AutofitRowsOnWorkbook(false, true, 1);
  Xls.AutoPageBreaks(50, 95);

  Xls.Save(SaveDialog.FileName);
end;

{$endregion}
{$region 'Autorun'}

procedure TFIntelligentPageBreaks.AutoRun;
var
  Xls: TExcelFile;
  fmt: TFlxFormat;
begin
  if not SaveDialog.Execute then
    exit;

  Xls := TXlsFile.Create(true);
  try
    Xls.NewFile(1, TExcelFileFormat.v2019);
    Xls.SetColWidth(1, 78 * 256);  //;make longer lines wrap in the cell.
    fmt := Xls.GetFormat(Xls.GetColFormat(1));
    fmt.WrapText := true;
    Xls.SetColFormat(1, Xls.AddFormat(fmt));
    AddData(Xls);
    if MessageDlg('Do you want to open the generated file?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      ShellExecute(0, 'open', PCHAR(SaveDialog.FileName), nil, nil, SW_SHOWNORMAL);
    end;
  finally
    Xls.Free;
  end;

end;
{$endregion}


end.

Table of Contents

Intelligent page breaks (Delphi)

Note

Overview

Concepts

Files

UIntelligentPageBreaks.pas