Examples / text_formatting / delphi

Text Formatting

A complete, runnable delphi program — 180 lines, shipped in your download.

Demonstrates Text

Same example, other languages: activex_cpp c cpp cpp_linux csharp php python vbnet

examples/delphi/text_formatting/Unit1.pas 180 lines
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellApi, UITypes, LumasPdfApi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    cboColumns: TComboBox;
    Label2: TLabel;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Error callback function
function ErrProc(const Data: Pointer; ErrCode: Integer; const ErrMessage: PAnsiChar; ErrType: Integer): Integer; stdcall;
begin
   MessageDlg(String(ErrMessage), mtError, [mbOK], 0);
   Result := -1; // we break processing if an error occurred.
end;

// Class to store the formatting options.
type TOutRect = class
  private
   FPDF: TPDF;         // Active PDF instance
  public
   PosX: Double;      // Original x-coordinate of first output rectangle
   PosY: Double;      // Original y-coordinate of first output rectangle
   Width: Double;     // Original width of first output rectangle
   Height: Double;    // Original height of first output rectangle
   Distance: Double;  // Space between columns
   Column: Integer;   // Current column
   ColCount: Integer; // Number of colummns
   constructor Create;
   destructor Destroy; override;
   property PDF: TPDF read FPDF;
end;

constructor TOutRect.Create;
begin
   inherited;
   FPDF := TPDF.Create;
   FPDF.SetOnErrorProc(nil, @ErrProc);
end;

destructor TOutRect.Destroy;
begin
   if FPDF <> nil then FPDF.Free;
   inherited;
end;

function OnPageBreakProc(const Data: Pointer; LastPosX, LastPosY: Double; PageBreak: LongBool): Integer; stdcall;
var r: TOutRect; x: Double;
begin
   r := TOutRect(Data);    // get a pointer to our structure
   r.pdf.SetPageCoords(pcTopDown); // we use top down coordinates
   Inc(r.Column);
   // PageBreak is true if the string contains a page break tag (see help file for further information).
   if not PageBreak and (r.Column < r.ColCount) then begin
      // Calulate the x-coordinate of the column
      x := r.PosX + r.Column * (r.Width + r.Distance);
      // change the output rectangle, do not close the page!
      r.pdf.SetTextRect(x, r.PosY, r.Width, r.Height);
      Result := 0; // we do not change the alignment
   end else begin
      // the page is full, close the current one and append a new page
      r.pdf.EndPage;
      r.pdf.Append;
      r.pdf.SetTextRect(r.PosX, r.PosY, r.Width, r.Height);
      r.Column := 0;
      Result := 0;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var r: TOutRect; outFile: String; fText: AnsiString; stream: TFileStream;
begin
   // The text is stored in a file
   try
      stream := TFileStream.Create('../../test_files/sample.txt', fmOpenRead + fmShareDenyNone);
      // Get the text.
      SetLength(fText, stream.Size);
      stream.Read(fText[1], stream.Size);
      stream.Free;
   except
      on E: Exception do begin
         MessageDlg(E.Message, mtError, [mbOK], 0);
         Exit;
      end;
   end;
   // The structure TOutRect holds all required variables to calculate
   // the output rectangle. We use it to avoid the usage of global 
   // variables.
   r := nil;
   try
      r := TOutRect.Create;
      r.PDF.SetDocInfo(diCreator, 'C++ test app');
      r.PDF.SetDocInfo(diSubject, 'Multi-column text');
      r.PDF.SetDocInfo(diTitle, 'Multi-column text');
      r.PDF.SetPageCoords(pcTopDown);

      if not r.PDF.CreateNewPDF('') then begin // The output file is opened later
         r.Free;
         Exit;
      end;
      // Initialize the output rectangle, number of columns and so on.
      r.ColCount := cboColumns.ItemIndex +1; // Set the number of columns
      r.Column   := 0;    // Current column
      r.Distance := 10.0; // Distance between two columns
      r.PosX     := 50.0; // X-coordiante of output rectangle
      r.PosY     := 50.0; // Y-coordiante of output rectangle
      r.Height   := r.PDF.GetPageHeight - 100.0;
      r.Width    := (r.PDF.GetPageWidth - 100.0 - (r.ColCount -1) * r.Distance) / r.ColCount;

      // The class is passed to the callback function now. Note that you must not use the adress @ operator
      // to pass the class pointer to the callback function.
      r.PDF.SetOnPageBreakProc(r, @OnPageBreakProc);
      // Append a new page
      r.PDF.Append;
      // Set the start output rectangle
      r.PDF.SetTextRect(r.PosX, r.PosY, r.Width, r.Height);
      // A font is always required.
      r.PDF.SetFont('Arial', fsNone, 9.0, true, cp1252);
      r.PDF.WriteFText(taJustify, fText); // Now we can print the text

      r.PDF.EndPage;    // Close the last page
      // No fatal error occurred?
      if r.PDF.HaveOpenDoc then begin
         // We write the file into the application directory. If the file cannot be opened
         // then we display a file open dialog. The error callback function
         // is not used here to avoid displaying of an error messages if the output file
         // cannot be opened.
         r.PDF.SetOnErrorProc(nil, nil);
         GetDir(0, outFile);
         outFile := outFile + '\out.pdf';
         while not r.PDF.OpenOutputFile(outFile) do begin
            if not OpenDialog1.Execute then begin
               r.PDF.Free;
               Exit;
            end;
            outFile := OpenDialog1.FileName;
            // The file open dialog changes the active directory. If the application is executed again
            // the input file cannot longer be found. So, we must set the active directory back to the
            // application directory.
            ChDir(ExtractFilePath(Application.ExeName));
         end;
         r.PDF.SetOnErrorProc(nil, @ErrProc);
      end;
      if r.PDF.CloseFile then begin
         ShellExecute(Handle, PChar('open'), PChar(outFile), nil, nil, SW_SHOWMAXIMIZED);
      end;
   except
      on E: Exception do MessageDlg(E.Message, mtError, [mbOK], 0);
   end;
   if r <> nil then r.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   cboColumns.ItemIndex := 2;
end;

end.

This file is in the SDK at examples/delphi/text_formatting/Unit1.pas. The build fails if this page and that file ever differ.