Back to... Excel Writer

Source file : excel_out.adb



-- Version 01 is derived from ExcelOut by Frank Schoonjans in Modula-2 - thanks!
-- Modula-2 code has been translated with Mod2Pas and P2Ada.
--
-- References to documentation are to: http://www.openoffice.org/sc/excelfileformat.pdf
--
-- To do:
-- =====
--  - Unicode (for binary Excel: requires BIFF8, but BIFF8 is pretty difficult)
--  - border line styles (5.115 XF - Extended Format)
--  - XML-based formats support
--  - ...

with Ada.Unchecked_Deallocation, Ada.Unchecked_Conversion;
with Ada.Strings.Fixed;

with Interfaces;                        use Interfaces;

-- Package IEEE_754 is from: Simple components for Ada by Dmitry A. Kazakov
-- http://www.dmitry-kazakov.de/ada/components.htm
with IEEE_754.Generic_Double_Precision;

package body Excel_Out is

  use Ada.Streams.Stream_IO, Ada.Streams;

  --  Very low level part which deals with transferring data in an endian-neutral way,
  --  and floats in the IEEE format. This is needed for having Excel Writer
  --  totally portable on all systems and processor architectures.

  type Byte_buffer is array (Integer range <>) of Unsigned_8;
  empty_buffer: constant Byte_buffer:= (1..0 => 0);

  -- Put numbers with correct endianess as bytes:
  generic
    type Number is mod <>;
    size: Positive;
  function Intel_x86_buffer( n: Number ) return Byte_buffer;
  pragma Inline(Intel_x86_buffer);

  function Intel_x86_buffer( n: Number ) return Byte_buffer is
    b: Byte_buffer(1..size);
    m: Number:= n;
  begin
    for i in b'Range loop
      b(i):= Unsigned_8(m and 255);
      m:= m / 256;
    end loop;
    return b;
  end Intel_x86_buffer;

  function Intel_32 is new Intel_x86_buffer( Unsigned_32, 4 );

  function Intel_16( n: Unsigned_16 ) return Byte_buffer is
    pragma Inline(Intel_16);
  begin
    return (Unsigned_8(n and 255), Unsigned_8(Shift_Right(n, 8)));
  end Intel_16;

  --  2.5.2 Byte Strings, 8-bit string length (BIFF2-BIFF5), p. 187
  function To_buf_8_bit_length(s: String) return Byte_buffer is
    b: Byte_buffer(s'Range);
  begin
    if s'Length > 255 then -- length doesn't fit in a byte
      raise Constraint_Error;
    end if;
    for i in b'Range loop
      b(i):= Character'Pos(s(i));
    end loop;
    return Unsigned_8(s'Length) & b;
  end To_buf_8_bit_length;

  --  2.5.2 Byte Strings, 16-bit string length (BIFF2-BIFF5), p. 187
  function To_buf_16_bit_length(s: String) return Byte_buffer is
    b: Byte_buffer(s'Range);
  begin
    if s'Length > 2**16-1 then -- length doesn't fit in a 16-bit number
      raise Constraint_Error;
    end if;
    for i in b'Range loop
      b(i):= Character'Pos(s(i));
    end loop;
    return Intel_16(s'Length) & b;
  end To_buf_16_bit_length;

  --  --  2.5.3 Unicode Strings, 16-bit string length (BIFF2-BIFF5), p. 17
  --  function To_buf_16_bit_length(s: Wide_String) return Byte_buffer is
  --    b: Byte_buffer(1 .. 2 * s'Length);
  --    j: Integer:= 1;
  --  begin
  --    if s'Length > 2**16-1 then -- length doesn't fit in a 16-bit number
  --      raise Constraint_Error;
  --    end if;
  --    for i in s'Range loop
  --      b(j)  := Unsigned_8(Unsigned_32'(Wide_Character'Pos(s(i))) and 255);
  --      b(j+1):= Unsigned_8(Shift_Right(Unsigned_32'(Wide_Character'Pos(s(i))), 8));
  --      j:= j + 2;
  --    end loop;
  --    return
  --      Intel_16(s'Length) &
  --      (1 => 1) &  --  Character compression (ccompr): 1 = Uncompressed (16-bit characters)
  --      b;
  --  end To_buf_16_bit_length;

  -- Gives a byte sequence of an IEEE 64-bit number as if taken
  -- from an Intel machine (i.e. with the same endianess).
  --
  -- http://en.wikipedia.org/wiki/IEEE_754-1985#Double-precision_64_bit
  --

   package IEEE_LF is new IEEE_754.Generic_Double_Precision (Long_Float);

  function IEEE_Double_Intel_Portable(x: Long_Float) return Byte_buffer is
    pragma Inline(IEEE_Double_Intel_Portable);
    d : Byte_buffer(1..8);
    --
    f64: constant IEEE_LF.Float_64:= IEEE_LF.To_IEEE(x);
  begin
    for i in d'Range loop
      d(i):= f64(9-i); -- Order is reversed
    end loop;
    -- Fully tested in Test_IEEE.adb
    return d;
  end IEEE_Double_Intel_Portable;

  -- Just spit the bytes of the long float - fast way.
  -- Of course this will work only on an Intel(-like) machine. We check this later.
  subtype Byte_buffer_8 is Byte_buffer(0..7);
  function IEEE_Double_Intel_Native is new
    Ada.Unchecked_Conversion(Long_Float, Byte_buffer_8);

  x_test: constant Long_Float:= -12345.0e-67;
  Can_use_native_IEEE: constant Boolean:=
    IEEE_Double_Intel_Portable(x_test) = IEEE_Double_Intel_Native(x_test);

  function IEEE_Double_Intel(x: Long_Float) return Byte_buffer is
    pragma Inline(IEEE_Double_Intel);
  begin
    if Can_use_native_IEEE then
      return IEEE_Double_Intel_Native(x);   -- Fast, non-portable
    else
      return IEEE_Double_Intel_Portable(x); -- Slower but portable
    end if;
  end IEEE_Double_Intel;

  -- Workaround for the severe xxx'Read xxx'Write performance
  -- problems in the GNAT and ObjectAda compilers (as in 2009)
  -- This is possible if and only if Byte = Stream_Element and
  -- arrays types are both packed and aligned the same way.
  --
  subtype Size_test_a is Byte_buffer(1..19);
  subtype Size_test_b is Ada.Streams.Stream_Element_Array(1..19);
  workaround_possible: constant Boolean:=
    Size_test_a'Size = Size_test_b'Size and
    Size_test_a'Alignment = Size_test_b'Alignment;

  procedure Block_Write(
    stream : in out Ada.Streams.Root_Stream_Type'Class;
    buffer : in     Byte_buffer
  )
  is
    pragma Inline(Block_Write);
    SE_Buffer   : Stream_Element_Array (1 .. buffer'Length);
    for SE_Buffer'Address use buffer'Address;
    pragma Import (Ada, SE_Buffer);
  begin
    if workaround_possible then
      Ada.Streams.Write(stream, SE_Buffer);
    else
      Byte_buffer'Write(stream'Access, buffer);
      -- ^ This was 30x to 70x slower on GNAT 2009
      --   Test in the Zip-Ada project.
    end if;
  end Block_Write;

  ----------------
  -- Excel BIFF --
  ----------------

  -- The original Modula-2 code counted on certain assumptions about
  -- record packing & endianess. We write data without these assumptions.

  procedure WriteBiff(
    xl     : Excel_Out_Stream'Class;
    biff_id: Unsigned_16;
    data   : Byte_buffer
  )
  is
    pragma Inline(WriteBiff);
  begin
    Block_Write(xl.xl_stream.all, Intel_16(biff_id));
    Block_Write(xl.xl_stream.all, Intel_16(Unsigned_16(data'Length)));
    Block_Write(xl.xl_stream.all, data);
  end WriteBiff;

  -- 5.8  BOF: Beginning of File, p.135
  procedure Write_BOF(xl : Excel_Out_Stream'Class) is

    function BOF_suffix return Byte_buffer is  --  5.8.1 Record BOF
    begin
      case xl.format is
        when BIFF2 =>
          return empty_buffer;
        when BIFF3 | BIFF4 =>
          return (0,0);  --  Not used
        --  when BIFF8 =>
        --    return (1,1,1,1);
      end case;
    end BOF_suffix;

    --  0005H = Workbook globals
    --  0006H = Visual Basic module
    --  0010H = Sheet or dialogue (see SHEETPR, S5.97)
    Sheet_or_dialogue: constant:= 16#10#;
    --  0020H = Chart
    --  0040H = Macro sheet
    biff_record_identifier: constant array(Excel_type) of Unsigned_16:=
      (BIFF2 => 16#0009#,
       BIFF3 => 16#0209#,
       BIFF4 => 16#0409#
       --  BIFF8 => 16#0809#
      );
    biff_version: constant array(Excel_type) of Unsigned_16:=
      (BIFF2 => 16#0200#,
       BIFF3 => 16#0300#,
       BIFF4 => 16#0400#
       --  BIFF8 => 16#0600#
      );
  begin
    WriteBiff(xl,
      biff_record_identifier(xl.format),
      Intel_16(biff_version(xl.format)) &
      Intel_16(Sheet_or_dialogue) &
      BOF_suffix
    );
  end Write_BOF;

  -- 5.49 FORMAT (number format)
  procedure WriteFmtStr (xl : Excel_Out_Stream'Class; s : String) is
  begin
    case xl.format is
      when BIFF2 | BIFF3 =>
        WriteBiff(xl, 16#001E#, To_buf_8_bit_length(s));
      when BIFF4 =>
        WriteBiff(xl, 16#041E#, (0, 0) & To_buf_8_bit_length(s));
     --   when BIFF8 =>
     --     WriteBiff(xl, 16#041E#, (0, 0) &  --  should be: format index used in other records
     --       To_buf_8_bit_length(s));
    end case;
  end WriteFmtStr;

  -- Write built-in number formats (internal)
  procedure WriteFmtRecords (xl : Excel_Out_Stream'Class) is
    sep_1000: constant Character:= ','; -- US format
    sep_deci: constant Character:= '.'; -- US format
    -- ^ If there is any evidence of an issue with those built-in separators,
    -- we may make them configurable. NB: MS Excel 2002 and 2007 use only
    -- the index of built-in formats and discards the strings for BIFF2, but not for BIFF3...
  begin
    -- 5.12 BUILTINFMTCOUNT
    case xl.format is
      when BIFF2 =>
        WriteBiff(xl, 16#001F#, Intel_16(Unsigned_16(last_built_in - 5)));
      when BIFF3 =>
        WriteBiff(xl, 16#0056#, Intel_16(Unsigned_16(last_built_in - 3)));
      when BIFF4 =>
        WriteBiff(xl, 16#0056#, Intel_16(Unsigned_16(last_built_in + 1)));
      --  when BIFF8 =>
      --    null;
    end case;
    -- loop & case avoid omitting any choice
    for n in Number_format_type'First .. last_custom loop
      case n is
        when general    =>  WriteFmtStr(xl, "General");
        when decimal_0  =>  WriteFmtStr(xl, "0");
        when decimal_2  =>  WriteFmtStr(xl, "0" & sep_deci & "00"); -- 'Comma' built-in style
        when decimal_0_thousands_separator =>
          WriteFmtStr(xl, "#" & sep_1000 & "##0");
        when decimal_2_thousands_separator =>
          WriteFmtStr(xl, "#" & sep_1000 & "##0" & sep_deci & "00");
        when no_currency_0       =>
          if xl.format >= BIFF4 then
            WriteFmtStr(xl, "#" & sep_1000 & "##0;-#" & sep_1000 & "##0");
          end if;
        when no_currency_red_0   =>
          if xl.format >= BIFF4 then
            WriteFmtStr(xl, "#" & sep_1000 & "##0;-#" & sep_1000 & "##0");
          -- [Red] doesn't go with non-English versions of Excel !!
          end if;
        when no_currency_2       =>
          if xl.format >= BIFF4 then
            WriteFmtStr(xl,  "#" & sep_1000 & "##0" & sep_deci & "00;" &
                          "-#" & sep_1000 & "##0" & sep_deci & "00");
          end if;
        when no_currency_red_2   =>
          if xl.format >= BIFF4 then
            WriteFmtStr(xl,  "#" & sep_1000 & "##0" & sep_deci & "00;" &
                          "-#" & sep_1000 & "##0" & sep_deci & "00");
          end if;
        when currency_0       =>
          WriteFmtStr(xl, "$ #" & sep_1000 & "##0;$ -#" & sep_1000 & "##0");
        when currency_red_0   =>
          WriteFmtStr(xl, "$ #" & sep_1000 & "##0;$ -#" & sep_1000 & "##0");
          -- [Red] doesn't go with non-English versions of Excel !!
        when currency_2       =>
          WriteFmtStr(xl,  "$ #" & sep_1000 & "##0" & sep_deci & "00;" &
                          "$ -#" & sep_1000 & "##0" & sep_deci & "00");
        when currency_red_2   =>
          WriteFmtStr(xl,  "$ #" & sep_1000 & "##0" & sep_deci & "00;" &
                          "$ -#" & sep_1000 & "##0" & sep_deci & "00");
        when percent_0        =>  WriteFmtStr(xl, "0%");   -- 'Percent' built-in style
        when percent_2        =>  WriteFmtStr(xl, "0" & sep_deci & "00%");
        when scientific       =>  WriteFmtStr(xl, "0" & sep_deci & "00E+00");
        when fraction_1       =>
          if xl.format >= BIFF3 then
            WriteFmtStr(xl, "#\ ?/?");
          end if;
        when fraction_2       =>
          if xl.format >= BIFF3 then
            WriteFmtStr(xl, "#\ ??/??");
          end if;
        when dd_mm_yyyy       =>  WriteFmtStr(xl, "dd/mm/yyyy");
        when dd_mmm_yy        =>  WriteFmtStr(xl, "dd/mmm/yy");
        when dd_mmm           =>  WriteFmtStr(xl, "dd/mmm");
        when mmm_yy           =>  WriteFmtStr(xl, "mmm/yy");
        when h_mm_AM_PM       =>  WriteFmtStr(xl, "h:mm\ AM/PM");
        when h_mm_ss_AM_PM    =>  WriteFmtStr(xl, "h:mm:ss\ AM/PM");
        when hh_mm            =>  WriteFmtStr(xl, "hh:mm");
        when hh_mm_ss         =>  WriteFmtStr(xl, "hh:mm:ss");
        when dd_mm_yyyy_hh_mm =>  WriteFmtStr(xl, "dd/mm/yyyy\ hh:mm");
        when percent_0_plus  =>
          WriteFmtStr(xl, "+0%;-0%;0%");
        when percent_2_plus  =>
          WriteFmtStr(xl, "+0" & sep_deci & "00%;-0" & sep_deci & "00%;0" & sep_deci & "00%");
        when date_iso        => WriteFmtStr(xl, "yyyy\-mm\-dd");
        when date_h_m_iso    => WriteFmtStr(xl, "yyyy\-mm\-dd\ hh:mm");
        when date_h_m_s_iso  => WriteFmtStr(xl, "yyyy\-mm\-dd\ hh:mm:ss");
          -- !! Trouble: Excel (German Excel/French locale) writes yyyy, reads it,
          --    understands it and translates it into aaaa, but is unable to
          --    understand *our* yyyy
          -- Same issue as [Red] vs [Rot] above.
      end case;
    end loop;
    -- ^ Some formats in the original list caused problems, probably
    --   because of regional placeholder symbols
    case xl.format is
      when BIFF2 =>
        for i in 1..6 loop
          WriteFmtStr(xl, "@");
        end loop;
      when BIFF3 =>
        for i in 1..4 loop
          WriteFmtStr(xl, "@");
        end loop;
      when BIFF4 =>
        null;
    end case;
    -- ^ Stuffing for having the same number of built-in and EW custom
  end WriteFmtRecords;

  -- 5.35 DIMENSION
  procedure Write_Dimensions(xl: Excel_Out_Stream'Class) is
    -- sheet bounds:   0 2 Index to first used row
    --                 2 2 Index to last used row, increased by 1
    --                 4 2 Index to first used column
    --                 6 2 Index to last used column, increased by 1
    --
    -- Since our row / column counts are 1-based, no need to increase by 1.
    sheet_bounds: constant Byte_buffer:=
      Intel_16(0) &
      Intel_16(Unsigned_16(xl.maxrow)) &
      Intel_16(0) &
      Intel_16(Unsigned_16(xl.maxcolumn));
    --  sheet_bounds_32_16: constant Byte_buffer:=
    --    Intel_32(0) &
    --    Intel_32(Unsigned_32(xl.maxrow)) &
    --    Intel_16(0) &
    --    Intel_16(Unsigned_16(xl.maxcolumn));
  begin
    case xl.format is
      when BIFF2 =>
        WriteBiff(xl, 16#0000#, sheet_bounds);
      when BIFF3 | BIFF4 =>
        WriteBiff(xl, 16#0200#, sheet_bounds & (0,0));
      --  when BIFF8 =>
      --    WriteBiff(xl, 16#0200#, sheet_bounds_32_16 & (0,0));
    end case;
  end Write_Dimensions;

  procedure Define_number_format(
    xl           : in out Excel_Out_Stream;
    format       :    out Number_format_type;
    format_string: in     String
  )
  is
  begin
    xl.number_fmt:= xl.number_fmt + 1;
    format:= xl.number_fmt;
    WriteFmtStr(xl, format_string);
  end Define_number_format;

  procedure Write_Worksheet_header(xl : in out Excel_Out_Stream'Class) is

    procedure Define_style(fmt: Format_type; style_id: Unsigned_8) is
      Base_Level: constant:= 255;
    begin
      WriteBiff(xl,
        16#0293#,
        Intel_16(Unsigned_16(fmt) + 16#8000#) & style_id & Base_Level
      );
    end Define_style;
    --
    Comma_Style     : constant:= 3;
    Currency_Style  : constant:= 4;
    Percent_Style   : constant:= 5;
    font_for_styles, font_2, font_3 : Font_type;
    --
    function Encoding_code return Unsigned_16 is  --  5.17 CODEPAGE, p. 145
    begin
      case xl.encoding is
        when Windows_CP_874  => return 874;
        when Windows_CP_932  => return 932;
        when Windows_CP_936  => return 936;
        when Windows_CP_949  => return 949;
        when Windows_CP_950  => return 950;
        when Windows_CP_1250 => return 1250;
        when Windows_CP_1251 => return 1251;
        when Windows_CP_1252 =>
          case xl.format is
            when BIFF2 .. BIFF3 =>
              return 16#8001#;
            when BIFF4 =>
              return 1252;
          end case;
        when Windows_CP_1253 => return 1253;
        when Windows_CP_1254 => return 1254;
        when Windows_CP_1255 => return 1255;
        when Windows_CP_1256 => return 1256;
        when Windows_CP_1257 => return 1257;
        when Windows_CP_1258 => return 1258;
        when Windows_CP_1361 => return 1361;
        when Apple_Roman     => return 10000;
      end case;
    end Encoding_code;
    --
  begin
    Write_BOF(xl);
    --  5.17 CODEPAGE, p. 145
    case xl.format is
      --  when BIFF8 =>   --  UTF-16
      --    WriteBiff(xl, 16#0042#, Intel_16(16#04B0#));
      when others =>
        WriteBiff(xl, 16#0042#, Intel_16(Encoding_code));
    end case;
    -- 5.14 CALCMODE
    WriteBiff(xl, 16#000D#, Intel_16(1)); --  1 => automatic
    -- 5.85 REFMODE
    WriteBiff(xl, 16#000F#, Intel_16(1)); --  1 => A1 mode
    -- 5.28 DATEMODE
    WriteBiff(xl, 16#0022#, Intel_16(0)); --  0 => 1900; 1 => 1904 Date system
    -- NB: the 1904 variant (Mac) is ignored by LibreOffice (<= 3.5), then wrong dates !
    --
    Define_font(xl,"Arial",   10, xl.def_font);
    Define_font(xl,"Arial",   10, font_for_styles); -- Used by BIFF3+'s styles
    Define_font(xl,"Calibri", 10, font_2); -- Defined in BIFF3 files written by Excel 2002
    Define_font(xl,"Calibri", 10, font_3); -- Defined in BIFF3 files written by Excel 2002
    WriteFmtRecords(xl);
    -- 5.111 WINDOWPROTECT
    WriteBiff(xl, 16#0019#, Intel_16(0));
    -- Define default format
    Define_format(xl, xl.def_font, general, xl.def_fmt);
    if xl.format >= BIFF3 then
      -- Don't ask why we need the following useless formats, but it is as Excel 2002
      -- write formats. Additionally, the default format is turned into decimal_2
      -- when a file without those useless formats is opened in Excel (2002) !
      Define_format(xl, font_for_styles, general, xl.def_fmt);
      Define_format(xl, font_for_styles, general, xl.def_fmt);
      Define_format(xl, font_2, general, xl.def_fmt);
      Define_format(xl, font_2, general, xl.def_fmt);
      for i in 5..15 loop
        Define_format(xl, xl.def_font, general, xl.def_fmt);
      end loop;
      -- Final default format index is the last changed xl.def_fmt
    end if;
    Use_default_format(xl);
    -- Define formats for the BIFF3+ "styles":
    Define_format(xl, font_for_styles, decimal_2, xl.cma_fmt);
    Define_format(xl, font_for_styles, currency_0, xl.ccy_fmt);
    Define_format(xl, font_for_styles, percent_0, xl.pct_fmt);
    -- Define styles - 5.103 STYLE p. 212
    -- NB: - it is BIFF3+ (we cheat a bit if selected format is BIFF2).
    --     - these "styles" seem to be a zombie feature of Excel 3
    --     - the whole purpose of including this is because format
    --       buttons (%)(,) in Excel 95 through 2007 are using these styles;
    --       if the styles are not defined, those buttons are not working
    --       when an Excel Writer sheet is open in MS Excel.
    Define_style(xl.cma_fmt, Comma_Style);
    Define_style(xl.ccy_fmt, Currency_Style);
    Define_style(xl.pct_fmt, Percent_Style);
    xl.dimrecpos:= Index(xl);
    Write_Dimensions(xl);
    xl.is_created:= True;
  end Write_Worksheet_header;

  type Font_or_Background is (for_font, for_background);
  type Color_pair is array(Font_or_Background) of Unsigned_16;
  auto_color: constant Color_pair:=
    (16#7FFF#, -- system window text colour
     16#0019#  -- system window background colour
    );

  color_code: constant array(Excel_type, Color_type) of Color_pair :=
    ( BIFF2 =>
       (
         black      => (0, 0),
         white      => (1, 1),
         red        => (2, 2),
         green      => (3, 3),
         blue       => (4, 4),
         yellow     => (5, 5),
         magenta    => (6, 6),
         cyan       => (7, 7),
         others     => auto_color
        ),
      BIFF3 | BIFF4 =>
        (black      => (8, 8),
         white      => (9, 9),
         red        => (10, 10),
         green      => (11, 11),
         blue       => (12, 12),
         yellow     => (13, 13),
         magenta    => (14, 14),
         cyan       => (15, 15),
         dark_red   => (16, 16),
         dark_green => (17, 17),
         dark_blue  => (18, 18),
         olive      => (19, 19),
         purple     => (20, 20),
         teal       => (21, 21),
         silver     => (22, 22),
         grey       => (23, 23),
         automatic  => auto_color
        )
     );

  -- *** Exported procedures **********************************************

  -- 5.115 XF - Extended Format
  procedure Define_format(
    xl               : in out Excel_Out_Stream;
    font             : in     Font_type;          -- Default_font(xl), or given by Define_font
    number_format    : in     Number_format_type; -- built-in, or given by Define_number_format
    cell_format      :    out Format_type;
    -- Optional parameters --
    horizontal_align : in     Horizontal_alignment:= general_alignment;
    border           : in     Cell_border:= no_border;
    shaded           : in     Boolean:= False;    -- Add a dotted background pattern
    background_color : in     Color_type:= automatic;
    wrap_text        : in     Boolean:= False;
    vertical_align   : in     Vertical_alignment:= bottom_alignment;
    text_orient      : in     Text_orientation:= normal
  )
  is
    actual_number_format: Number_format_type:= number_format;
    cell_is_locked: constant:= 1;
    -- ^ Means actually: cell formula protection is possible, and enabled when sheet is protected.
    procedure Define_BIFF2_XF is
      border_bits, mask: Unsigned_8;
    begin
      border_bits:= 0;
      mask:= 8;
      for s in Cell_border_single loop
        if border(s) then
          border_bits:= border_bits + mask;
        end if;
        mask:= mask * 2;
      end loop;
      -- 5.115.2 XF Record Contents, p. 221 for BIFF3
      WriteBiff(
        xl,
        16#0043#, -- XF code in BIFF2
        (Unsigned_8(font),
         -- ^ Index to FONT record
         0,
         -- ^ Not used
         Number_format_type'Pos(actual_number_format) + 16#40# * cell_is_locked,
         -- ^ Number format and cell flags
         Horizontal_alignment'Pos(horizontal_align) +
         border_bits +
         Boolean'Pos(shaded) * 128
         -- ^ Horizontal alignment, border style, and background
        )
      );
    end Define_BIFF2_XF;

    area_code: Unsigned_16;

    procedure Define_BIFF3_XF is
    begin
      -- 5.115.2 XF Record Contents, p. 221 for BIFF3
      WriteBiff(
        xl,
        16#0243#, -- XF code in BIFF3
        (Unsigned_8(font),
         -- ^ 0 - Index to FONT record
         Number_format_type'Pos(actual_number_format),
         -- ^ 1 - Number format and cell flags
         cell_is_locked,
         -- ^ 2 - XF_TYPE_PROT (5.115.1)
         16#FF#
         -- ^ 3 - XF_USED_ATTRIB
        ) &
        Intel_16(
          Horizontal_alignment'Pos(horizontal_align) +
          Boolean'Pos(wrap_text) * 8
        ) &
        -- ^ 4 - Horizontal alignment, text break, parent style XF
        Intel_16(area_code) &
        -- ^ 6 - XF_AREA_34
        (  Boolean'Pos(border(top_single)),
           Boolean'Pos(border(left_single)),
           Boolean'Pos(border(bottom_single)),
           Boolean'Pos(border(right_single))
        )
        -- ^ 8 - XF_BORDER_34 - thin (=1) line; we could have other line styles:
        --       Thin, Medium, Dashed, Dotted, Thick, Double, Hair
      );
    end Define_BIFF3_XF;

    procedure Define_BIFF4_XF is
    begin
      -- 5.115.2 XF Record Contents, p. 222 for BIFF4
      WriteBiff(
        xl,
        16#0443#, -- XF code in BIFF4
        (Unsigned_8(font),
         -- ^ 0 - Index to FONT record
         Number_format_type'Pos(actual_number_format),
         -- ^ 1 - Number format and cell flags
         cell_is_locked, 0,
         -- ^ 2 - XF type, cell protection, and parent style XF
         Horizontal_alignment'Pos(horizontal_align) +
         Boolean'Pos(wrap_text) * 8 +
         (Vertical_alignment'Pos(vertical_align) and 3) * 16 +
         Text_orientation'Pos(text_orient) * 64,
         -- ^ 4 - Alignment (hor & ver), text break, and text orientation
         16#FF#
         -- ^ 3 - XF_USED_ATTRIB
        ) &
        -- ^ 4 - Horizontal alignment, text break, parent style XF
        Intel_16(area_code) &
        -- ^ 6 - XF_AREA_34
        (  Boolean'Pos(border(top_single)),
           Boolean'Pos(border(left_single)),
           Boolean'Pos(border(bottom_single)),
           Boolean'Pos(border(right_single))
        )
        -- ^ 8 - XF_BORDER_34 - thin (=1) line; we could have other line styles:
        --       Thin, Medium, Dashed, Dotted, Thick, Double, Hair
      );
    end Define_BIFF4_XF;

  begin
    -- 2.5.12 Patterns for Cell and Chart Background Area
    -- This is for BIFF3+
    if shaded then
      area_code:=
        Boolean'Pos(shaded) * 17 +                        -- Sparse pattern, like BIFF2 "shade"
        16#40#  * color_code(BIFF3, black)(for_background) +           -- pattern colour
        16#800# * color_code(BIFF3, background_color)(for_background); -- pattern background
    elsif background_color = automatic then
      area_code:= 0;
    else
      area_code:=
        1 +                                                          -- Full pattern
        16#40#  * color_code(BIFF3, background_color)(for_background) +  -- pattern colour
        16#800# * color_code(BIFF3, background_color)(for_background);   -- pattern background
    end if;
    case xl.format is
      when BIFF2 =>
        case actual_number_format is
          when general .. no_currency_2 =>
            null;
          when currency_0 .. fraction_2 =>
            actual_number_format:= actual_number_format - 4;
          when dd_mm_yyyy .. last_custom =>
            actual_number_format:= actual_number_format - 6;
          when others =>
            null;
        end case;
        Define_BIFF2_XF;
      when BIFF3 =>
        if actual_number_format in currency_0 .. last_custom then
          actual_number_format:= actual_number_format - 4;
        end if;
        Define_BIFF3_XF;
      when BIFF4 =>
        Define_BIFF4_XF;
      --  when BIFF8 =>
      --    Define_BIFF8_XF;  --  BIFF8: 16#00E0#, p. 224
    end case;
    xl.xfs:= xl.xfs + 1;
    cell_format:= Format_type(xl.xfs);
    xl.xf_def(xl.xfs):= (font => font, numb => number_format);
  end Define_format;

  procedure Header(xl : Excel_Out_Stream; page_header_string: String) is
  begin
    WriteBiff(xl, 16#0014#, To_buf_8_bit_length(page_header_string)); -- 5.55 p.180
  end Header;

  procedure Footer(xl : Excel_Out_Stream; page_footer_string: String) is
  begin
    WriteBiff(xl, 16#0015#, To_buf_8_bit_length(page_footer_string)); -- 5.48 p.173
  end Footer;

  procedure Left_Margin(xl : Excel_Out_Stream; inches: Long_Float) is
  begin
    WriteBiff(xl, 16#0026#, IEEE_Double_Intel(inches));
  end Left_Margin;

  procedure Right_Margin(xl : Excel_Out_Stream; inches: Long_Float) is
  begin
    WriteBiff(xl, 16#0027#, IEEE_Double_Intel(inches));
  end Right_Margin;

  procedure Top_Margin(xl : Excel_Out_Stream; inches: Long_Float) is
  begin
    WriteBiff(xl, 16#0028#, IEEE_Double_Intel(inches));
  end Top_Margin;

  procedure Bottom_Margin(xl : Excel_Out_Stream; inches: Long_Float) is
  begin
    WriteBiff(xl, 16#0029#, IEEE_Double_Intel(inches));
  end Bottom_Margin;

  procedure Margins(xl : Excel_Out_Stream; left, right, top, bottom: Long_Float) is
  begin
    Left_Margin(xl, left);
    Right_Margin(xl, right);
    Top_Margin(xl, top);
    Bottom_Margin(xl, bottom);
  end Margins;

  procedure Print_Row_Column_Headers(xl : Excel_Out_Stream) is
  begin
    WriteBiff(xl, 16#002A#, Intel_16(1)); -- 5.81 PRINTHEADERS p.199
  end  Print_Row_Column_Headers;

  procedure Print_Gridlines(xl : Excel_Out_Stream) is
  begin
    WriteBiff(xl, 16#002B#, Intel_16(1)); -- 5.80 PRINTGRIDLINES p.199
  end Print_Gridlines;

  procedure Page_Setup(
    xl                     : Excel_Out_Stream;
    scaling_percents       : Positive:= 100;
    fit_width_with_n_pages : Natural:= 1; -- 0: as many as possible
    fit_height_with_n_pages: Natural:= 1; -- 0: as many as possible
    orientation            : Orientation_choice:= portrait;
    scale_or_fit           : Scale_or_fit_choice:= scale
  )
  is
  begin
    -- 5.73 PAGESETUP p.192 - this is BIFF4+ (cheat if xl.format below)!
    WriteBiff(xl,
      16#00A1#,
      Intel_16(0) & -- paper type undefined
      Intel_16(Unsigned_16(scaling_percents)) &
      Intel_16(1) & -- start page number
      Intel_16(Unsigned_16(fit_width_with_n_pages)) &
      Intel_16(Unsigned_16(fit_height_with_n_pages)) &
      Intel_16(2 * Orientation_choice'Pos(orientation))
    );
    -- 5.97 SHEETPR p.207 - this is BIFF3+ (cheat if xl.format below) !
    -- NB: this field contains other informations, should be delayed
    --       in case other preferences are to be set
    WriteBiff(xl,
      16#0081#,
      Intel_16(256 * Scale_or_fit_choice'Pos(scale_or_fit))
    );
  end Page_Setup;

  y_scale: constant:= 20; -- scaling to obtain character point (pt) units

  -- 5.31 DEFAULTROWHEIGHT
  procedure Write_default_row_height (
        xl     : Excel_Out_Stream;
        height : Positive
  )
  is
    default_twips: constant Byte_buffer:= Intel_16(Unsigned_16(height * y_scale));
    options_flags: constant Byte_buffer:= (1,0);
    -- 1 = Row height and default font height do not match
  begin
    case xl.format is
      when BIFF2 =>
        WriteBiff(xl, 16#0025#, default_twips);
      when BIFF3 | BIFF4 =>
        WriteBiff(xl, 16#0225#, options_flags & default_twips);
    end case;
  end Write_default_row_height;

  -- 5.32 DEFCOLWIDTH
  procedure Write_default_column_width (
        xl : in out Excel_Out_Stream;
        width  : Positive)
  is
  begin
    WriteBiff(xl, 16#0055#, Intel_16(Unsigned_16(width)));
    xl.defcolwdth:= 256 * width;
  end Write_default_column_width;

  procedure Write_column_width (
        xl     : in out Excel_Out_Stream;
        column : Positive;
        width  : Natural)
  is
  begin
    Write_column_width(xl, column, column, width);
  end Write_column_width;

  procedure Write_column_width(
    xl            : in out Excel_Out_Stream;
    first_column,
    last_column   : Positive;
    width         : Natural
  )
  is
  begin
    case xl.format is
      when BIFF2 =>
        -- 5.20 COLWIDTH (BIFF2 only)
        WriteBiff(xl, 16#0024#,
          Unsigned_8(first_column-1) &
          Unsigned_8(last_column-1) &
          Intel_16(Unsigned_16(width * 256)));
      when BIFF3 | BIFF4 =>
        -- 5.18 COLINFO (BIFF3+)
        WriteBiff(xl, 16#007D#,
          Intel_16(Unsigned_16(first_column-1)) &
          Intel_16(Unsigned_16(last_column-1)) &
          Intel_16(Unsigned_16(width * 256)) &
          Intel_16(0) & -- Index to XF record (5.115) for default column formatting
          Intel_16(0) & -- Option flags
          (0,0)         -- Not used
        );
        for j in first_column .. last_column loop
          xl.std_col_width(j):= False;
        end loop;
    end case;
  end Write_column_width;

  -- 5.88 ROW
  -- The OpenOffice documentation tells nice stories about row blocks,
  -- but single ROW commands can also be put before in the data stream,
  -- where the column widths are set. Excel saves with blocks of ROW
  -- commands, most of them useless.

  procedure Write_row_height(
    xl     : Excel_Out_Stream;
    row    : Positive;
    height : Natural
  )
  is
    row_info_base: Byte_buffer:=
      Intel_16(Unsigned_16(row - 1)) &
      Intel_16(0)   & -- col. min.
      Intel_16(255) & -- col. max.
      Intel_16(Unsigned_16(height * y_scale));
    fDyZero: Unsigned_8:= 0;
  begin
    case xl.format is
      when BIFF2 =>
        WriteBiff(xl, 16#0008#,
          row_info_base &
          (1..3 => 0) &
          Intel_16(0) -- offset to data
        );
      when BIFF3 | BIFF4 =>
        if height = 0 then -- proper hiding (needed with LibreOffice)
          fDyZero:= 1;
          row_info_base(row_info_base'Last - 1 .. row_info_base'Last):=
            Intel_16(16#8000#);
        end if;
        WriteBiff(xl, 16#0208#,
          row_info_base &
          -- http://msdn.microsoft.com/en-us/library/dd906757(v=office.12).aspx
          (0, 0,  -- reserved1 (2 bytes): MUST be zero, and MUST be ignored.
           0, 0,  -- unused1 (2 bytes): Undefined and MUST be ignored.
           fDyZero *  32 +  -- D - fDyZero (1 bit): row is hidden
                 1 *  64 +  -- E - fUnsynced (1 bit): row height was manually set
                 0 * 128,   -- F - fGhostDirty (1 bit): the row was formatted
           1) &   -- reserved3 (1 byte): MUST be 1, and MUST be ignored
           Intel_16(15)
           -- ^ ixfe_val, then 4 bits.
           --   If fGhostDirty is 0, ixfe_val is undefined and MUST be ignored.
        );
    end case;
  end Write_row_height;

  -- 5.45 FONT, p.171
  procedure Define_font(
    xl           : in out Excel_Out_Stream;
    font_name    :        String;
    height       :        Positive;
    font         :    out Font_type;
    style        :        Font_style:= regular;
    color        :        Color_type:= automatic
  )
  is
    style_bits, mask: Unsigned_16;
  begin
    style_bits:= 0;
    mask:= 1;
    for s in Font_style_single loop
      if style(s) then
        style_bits:= style_bits + mask;
      end if;
      mask:= mask * 2;
    end loop;
    xl.fonts:= xl.fonts + 1;
    if xl.fonts = 4 then
      xl.fonts:= 5;
      -- Anomaly! The font with index 4 is omitted in all BIFF versions.
      -- Numbering is 0, 1, 2, 3, *5*, 6,...
    end if;
    case xl.format is
      when BIFF2 =>
        WriteBiff(xl, 16#0031#,
          Intel_16(Unsigned_16(height * y_scale)) &
          Intel_16(style_bits) &
          To_buf_8_bit_length(font_name)
        );
        if color /= automatic then
          -- 5.47 FONTCOLOR
          WriteBiff(xl, 16#0045#, Intel_16(color_code(BIFF2, color)(for_font)));
        end if;
      when BIFF3 | BIFF4 =>  --  BIFF8 has 16#0031#, p. 171
        WriteBiff(xl, 16#0231#,
          Intel_16(Unsigned_16(height * y_scale)) &
          Intel_16(style_bits) &
          Intel_16(color_code(BIFF3, color)(for_font)) &
          To_buf_8_bit_length(font_name)
        );
    end case;
    font:= Font_type(xl.fonts);
  end Define_font;

  procedure Jump_to_and_store_max(xl: in out Excel_Out_Stream; r, c: Integer) is
    pragma Inline(Jump_to_and_store_max);
  begin
    if not xl.is_created then
      raise Excel_stream_not_created;
    end if;
    Jump_to(xl, r, c); -- Store and check current position
    if r > xl.maxrow then
      xl.maxrow := r;
    end if;
    if c > xl.maxcolumn then
      xl.maxcolumn := c;
    end if;
  end Jump_to_and_store_max;

  -- 2.5.13 Cell Attributes (BIFF2 only)
  function Cell_attributes(xl: Excel_Out_Stream) return Byte_buffer is
  begin
    return
      (Unsigned_8(xl.xf_in_use),
       Unsigned_8(xl.xf_def(xl.xf_in_use).numb) + 16#40# *
       Unsigned_8(xl.xf_def(xl.xf_in_use).font),
       0
      );
  end Cell_attributes;

  function Almost_zero(x: Long_Float) return Boolean is
  begin
    return abs x <= Long_Float'Model_Small;
  end Almost_zero;

  -- Internal
  --
  -- 5.71 NUMBER
  procedure Write_as_double (
        xl     : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Long_Float
  )
  is
    pragma Inline(Write_as_double);
  begin
    Jump_to_and_store_max(xl, r, c);
    case xl.format is
      when BIFF2 =>
        WriteBiff(xl, 16#0003#,
          Intel_16(Unsigned_16(r-1)) &
          Intel_16(Unsigned_16(c-1)) &
          Cell_attributes(xl) &
          IEEE_Double_Intel(num)
        );
      when BIFF3 | BIFF4 =>
        WriteBiff(xl, 16#0203#,
          Intel_16(Unsigned_16(r-1)) &
          Intel_16(Unsigned_16(c-1)) &
          Intel_16(Unsigned_16(xl.xf_in_use)) &
          IEEE_Double_Intel(num)
        );
    end case;
    Jump_to(xl, r, c+1); -- Store and check new position
  end Write_as_double;

  -- Internal. This is BIFF2 only. BIFF format choice unchecked here.
  --
  procedure Write_as_16_bit_unsigned (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Unsigned_16)
  is
    pragma Inline(Write_as_16_bit_unsigned);
  begin
    Jump_to_and_store_max(xl, r, c);
    -- 5.60 INTEGER
    WriteBiff(xl, 16#0002#,
      Intel_16(Unsigned_16(r-1)) &
      Intel_16(Unsigned_16(c-1)) &
      Cell_attributes(xl) &
      Intel_16(num)
    );
    Jump_to(xl, r, c+1); -- Store and check new position
  end Write_as_16_bit_unsigned;

  -- Internal. This is BIFF3+. BIFF format choice unchecked here.
  --
  procedure Write_as_30_bit_signed (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Integer_32)
  is
    pragma Inline(Write_as_30_bit_signed);
    RK_val: Unsigned_32;
    RK_code: constant:= 2; -- Code for signed integer. See 2.5.5 RK Values
  begin
    if num >= 0 then
      RK_val:= Unsigned_32(num) * 4 + RK_code;
    else
      RK_val:= (-Unsigned_32(-num)) * 4 + RK_code;
    end if;
    Jump_to_and_store_max(xl, r, c);
    -- 5.87 RK
    WriteBiff(xl, 16#027E#,
      Intel_16(Unsigned_16(r-1)) &
      Intel_16(Unsigned_16(c-1)) &
      Intel_16(Unsigned_16(xl.xf_in_use)) &
      Intel_32(RK_val)
    );
    Jump_to(xl, r, c+1); -- Store and check new position
  end Write_as_30_bit_signed;

  --
  -- Profile with floating-point number
  --
  procedure Write (
        xl     : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Long_Float
  )
  is
    max_16_u: constant:= 2.0 ** 16 - 1.0;
    min_30_s: constant:= -(2.0 ** 29);
    max_30_s: constant:= 2.0 ** 29 - 1.0;
  begin
    case xl.format is
      when BIFF2 =>
        if num >= 0.0 and then
           num <= max_16_u and then
           Almost_zero(num - Long_Float'Floor(num))
        then
          Write_as_16_bit_unsigned(xl, r, c, Unsigned_16(Long_Float'Floor(num)));
        else
          Write_as_double(xl, r, c, num);
        end if;
      when BIFF3 | BIFF4 =>
        if num >= min_30_s and then
           num <= max_30_s and then
           Almost_zero(num - Long_Float'Floor(num))
        then
          Write_as_30_bit_signed(xl, r, c, Integer_32(Long_Float'Floor(num)));
        else
          Write_as_double(xl, r, c, num);
        end if;
    end case;
  end Write;

  --
  -- Profile with integer number
  --
  procedure Write (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Integer)
  is
  begin
    -- We use an integer representation (and small storage) if possible;
    -- we need to use a floating-point in all other cases
    case xl.format is
      when BIFF2 =>
        if num in 0..2**16-1 then
          Write_as_16_bit_unsigned(xl, r, c, Unsigned_16(num));
        else
          Write_as_double(xl, r, c, Long_Float(num));
        end if;
      when BIFF3 | BIFF4 =>
        if num in -2**29..2**29-1 then
          Write_as_30_bit_signed(xl, r, c, Integer_32(num));
        else
          Write_as_double(xl, r, c, Long_Float(num));
        end if;
    end case;
  end Write;

  --  --  Function taken from Wasabee.Encoding.
  --  function ISO_8859_1_to_UTF_16(s: String) return Wide_String is
  --    --  This conversion is a trivial 8-bit to 16-bit copy.
  --    r: Wide_String(s'Range);
  --  begin
  --    for i in s'Range loop
  --      r(i):= Wide_Character'Val(Character'Pos(s(i)));
  --    end loop;
  --    return r;
  --  end ISO_8859_1_to_UTF_16;

  -- 5.63 LABEL
  procedure Write (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        str    : String)
  is
  begin
    Jump_to_and_store_max(xl, r, c);
    if str'Length > 0 then
      case xl.format is
        when BIFF2 =>
          WriteBiff(xl, 16#0004#,
            Intel_16(Unsigned_16(r-1)) &
            Intel_16(Unsigned_16(c-1)) &
            Cell_attributes(xl) &
            To_buf_8_bit_length(str)
          );
        when BIFF3 | BIFF4 =>
          WriteBiff(xl, 16#0204#,
            Intel_16(Unsigned_16(r-1)) &
            Intel_16(Unsigned_16(c-1)) &
            Intel_16(Unsigned_16(xl.xf_in_use)) &
            To_buf_16_bit_length(str)
          );
        --  when BIFF8 =>
        --    WriteBiff(xl, 16#0204#,
        --      Intel_16(Unsigned_16(r-1)) &
        --      Intel_16(Unsigned_16(c-1)) &
        --      Intel_16(Unsigned_16(xl.xf_in_use)) &
        --      To_buf_16_bit_length(ISO_8859_1_to_UTF_16(str))
        --    );
      end case;
    end if;
    Jump_to(xl, r, c+1); -- Store and check new position
  end Write;

  procedure Write(xl: in out Excel_Out_Stream; r,c : Positive; str : Unbounded_String)
  is
  begin
    Write(xl, r,c, To_String(str));
  end Write;

  function To_Number(date: Time) return Long_Float is
  begin
    return Long_Float(date - Time_Of(1901, 01, 01, 0.0)) / 86_400.0 + 367.0;
  end To_Number;

  procedure Write(xl: in out Excel_Out_Stream; r,c : Positive; date: Time)
  is
  begin
    Write(xl, r,c, To_Number(date));
  end Write;

  -- Ada.Text_IO - like. No need to specify row & column each time
  procedure Put(xl: in out Excel_Out_Stream; num : Long_Float) is
  begin
    Write(xl, xl.curr_row, xl.curr_col, num);
  end Put;

  procedure Put(xl    : in out Excel_Out_Stream;
                num   : in Integer;
                width : in Ada.Text_IO.Field := 0; -- ignored
                base  : in Ada.Text_IO.Number_Base := 10
            )
  is
  begin
    if base = 10 then
      Write(xl, xl.curr_row, xl.curr_col, num);
    else
      declare
        use Ada.Strings.Fixed;
        s: String(1..50 + 0*width);
        -- 0*width is just to skip a warning of width being unused
        package IIO is new Ada.Text_IO.Integer_IO(Integer);
      begin
        IIO.Put(s, num, Base => base);
        Put(xl, Trim(s, Ada.Strings.Left));
      end;
    end if;
  end Put;

  procedure Put(xl: in out Excel_Out_Stream; str : String) is
  begin
    Write(xl, xl.curr_row, xl.curr_col, str);
  end Put;

  procedure Put(xl: in out Excel_Out_Stream; str : Unbounded_String) is
  begin
    Put(xl, To_String(str));
  end Put;

  procedure Put(xl: in out Excel_Out_Stream; date: Time) is
  begin
    Put(xl, To_Number(date));
  end Put;

  procedure Merge(xl: in out Excel_Out_Stream; cells : Positive) is

    -- 5.7 BLANK
    procedure Blank (r, c: Positive) is
    begin
      Jump_to_and_store_max(xl, r, c);
      case xl.format is
        -- NB: Only with BIFF4, and only OpenOffice
        -- considers the cells really merged.
        when BIFF2 =>
          WriteBiff(xl, 16#0001#,
            Intel_16(Unsigned_16(r-1)) &
            Intel_16(Unsigned_16(c-1)) &
            Cell_attributes(xl)
          );
        when BIFF3 | BIFF4 =>
          WriteBiff(xl, 16#0201#,
            Intel_16(Unsigned_16(r-1)) &
            Intel_16(Unsigned_16(c-1)) &
            Intel_16(Unsigned_16(xl.xf_in_use))
          );
      end case;
      Jump_to(xl, r, c+1); -- Store and check new position
    end Blank;
  begin
    for i in 1..cells loop
      Blank(xl.curr_row, xl.curr_col);
    end loop;
  end Merge;

  procedure Write_cell_comment(xl: Excel_Out_Stream; row, column: Positive; text: String) is
  begin
    if text'Length >= 2048 then
      raise Constraint_Error;
    end if;
    -- 5.70 Note
    case xl.format is
      --  when BIFF8 =>  --  https://msdn.microsoft.com/en-us/library/dd945371(v=office.12).aspx
      --    WriteBiff(xl, 16#001C#,
      --      Intel_16(Unsigned_16(row-1)) &
      --      Intel_16(Unsigned_16(column-1)) &
      --      (0, 0) &  --  Show / hide options
      --      (0, 0) --  idObj - it begins to be tough there...
      --    );
      when others =>
        WriteBiff(xl, 16#001C#,
          Intel_16(Unsigned_16(row-1)) &
          Intel_16(Unsigned_16(column-1)) &
          To_buf_16_bit_length(text)
        );
    end case;
  end Write_cell_comment;

  procedure Write_cell_comment_at_cursor(xl: Excel_Out_Stream; text: String) is
  begin
    Write_cell_comment(xl, Row(xl), Column(xl), text);
  end Write_cell_comment_at_cursor;

  procedure Put_Line(xl: in out Excel_Out_Stream; num : Long_Float) is
  begin
    Put(xl, num);
    New_Line(xl);
  end Put_Line;

  procedure Put_Line(xl: in out Excel_Out_Stream; num : Integer) is
  begin
    Put(xl, num);
    New_Line(xl);
  end Put_Line;

  procedure Put_Line(xl: in out Excel_Out_Stream; str : String) is
  begin
    Put(xl, str);
    New_Line(xl);
  end Put_Line;

  procedure Put_Line(xl: in out Excel_Out_Stream; str : Unbounded_String) is
  begin
    Put_Line(xl, To_String(str));
  end Put_Line;

  procedure Put_Line(xl: in out Excel_Out_Stream; date: Time) is
  begin
    Put(xl, date);
    New_Line(xl);
  end Put_Line;

  procedure New_Line(xl: in out Excel_Out_Stream; Spacing : Positive := 1) is
  begin
    Jump_to(xl, xl.curr_row + Spacing, 1);
  end New_Line;

  function Col(xl: in Excel_Out_Stream) return Positive is
  begin
    return xl.curr_col;
  end Col;

  function Column(xl: in Excel_Out_Stream) return Positive renames Col;

  function Line(xl: in Excel_Out_Stream) return Positive is
  begin
    return xl.curr_row;
  end Line;

  function Row(xl: in Excel_Out_Stream) return Positive renames Line;

  -- Relative / absolute jumps
  procedure Jump(xl: in out Excel_Out_Stream; rows, columns: Natural) is
  begin
    Jump_to(xl, xl.curr_row + rows, xl.curr_col + columns);
  end Jump;

  procedure Jump_to(xl: in out Excel_Out_Stream; row, column: Positive) is
  begin
    if row < xl.curr_row then -- trying to overwrite cells ?...
      raise Decreasing_row_index;
    end if;
    if row = xl.curr_row and then
      column < xl.curr_col
    then -- trying to overwrite cells on same row ?...
      raise Decreasing_column_index;
    end if;
    if row > 65536 then
      raise Row_out_of_range;
    elsif column > 256 then
      raise Column_out_of_range;
    end if;
    xl.curr_row:= row;
    xl.curr_col:= column;
  end Jump_to;

  procedure Next (xl: in out Excel_Out_Stream; columns: Natural:= 1) is
  begin
    Jump(xl, rows => 0, columns => columns);
  end Next;

  procedure Next_Row (xl: in out Excel_Out_Stream; rows: Natural:= 1) is
  begin
    Jump(xl, rows => rows, columns => 0);
  end Next_Row;

  procedure Use_format(
    xl           : in out Excel_Out_Stream;
    format       : in     Format_type
  )
  is
  begin
    xl.xf_in_use:= XF_Range(format);
  end Use_format;

  procedure Use_default_format(xl: in out Excel_Out_Stream) is
  begin
    Use_format(xl, xl.def_fmt);
  end Use_default_format;

  function Default_font(xl: Excel_Out_Stream) return Font_type is
  begin
    return xl.def_font;
  end Default_font;

  function Default_format(xl: Excel_Out_Stream) return Format_type is
  begin
    return xl.def_fmt;
  end Default_format;

  procedure Freeze_Panes(xl: in out Excel_Out_Stream; row, column: Positive) is
  begin
    xl.frz_panes:= True;
    xl.freeze_row:= row;
    xl.freeze_col:= column;
  end Freeze_Panes;

  procedure Freeze_Panes_at_cursor(xl: in out Excel_Out_Stream) is
  begin
    Freeze_Panes(xl, xl.curr_row, xl.curr_col);
  end Freeze_Panes_at_cursor;

  procedure Freeze_Top_Row(xl: in out Excel_Out_Stream) is
  begin
    Freeze_Panes(xl, 2, 1);
  end Freeze_Top_Row;

  procedure Freeze_First_Column(xl: in out Excel_Out_Stream) is
  begin
    Freeze_Panes(xl, 1, 2);
  end Freeze_First_Column;

  procedure Zoom_level(xl: in out Excel_Out_Stream; numerator, denominator: Positive) is
  begin
    xl.zoom_num:= numerator;
    xl.zoom_den:= denominator;
  end Zoom_level;

  procedure Reset(
    xl           : in out Excel_Out_Stream'Class;
    excel_format :        Excel_type;
    encoding     :        Encoding_type
  )
  is
    dummy_xl_with_defaults: Excel_Out_Pre_Root_Type;
  begin
    -- Check if we are trying to re-use a half-finished object (ouch!):
    if xl.is_created and not xl.is_closed then
      raise Excel_stream_not_closed;
    end if;
    -- We will reset everything with defaults, except this:
    dummy_xl_with_defaults.format   := excel_format;
    dummy_xl_with_defaults.encoding := encoding;
    -- Now we reset xl:
    Excel_Out_Pre_Root_Type(xl):= dummy_xl_with_defaults;
  end Reset;

  procedure Finish(xl : in out Excel_Out_Stream'Class) is

    procedure Write_Window1 is
    begin
      -- 5.109 WINDOW1, p. 215
      case xl.format is
        when BIFF2 | BIFF3 | BIFF4 =>  --  NB: more options in BIFF8
          WriteBiff(xl, 16#003D#,
            Intel_16(120)   & -- Window x
            Intel_16(120)   & -- Window y
            Intel_16(21900) & -- Window w
            Intel_16(13425) & -- Window h
            Intel_16(0)       -- Hidden
          );
      end case;
    end Write_Window1;

    procedure Write_Window2 is
    begin
      -- 5.110 WINDOW2
      case xl.format is
        when BIFF2 =>
          WriteBiff(xl, 16#003E#,
            (0, -- Display formulas, not results
             1, -- Show grid lines
             1, -- Show sheet headers
             Boolean'Pos(xl.frz_panes),
             1  -- Show zero values as zeros, not empty cells
            )
             &
            Intel_16(0) & -- First visible row
            Intel_16(0) & -- First visible column
            (1, -- Use automatic grid line colour
             0,0,0,0) -- Grid line RGB colour
          );
        when BIFF3 | BIFF4 =>  --  NB: more options in BIFF8
          WriteBiff(xl, 16#023E#,
            -- http://msdn.microsoft.com/en-us/library/dd947893(v=office.12).aspx
            Intel_16(   -- Option flags:
              0 *   1 + -- Display formulas, not results
              1 *   2 + -- Show grid lines
              1 *   4 + -- Show sheet headers
              Boolean'Pos(xl.frz_panes)
                *   8 + -- Panes are frozen
              1 *  16 + -- Show zero values as zeros, not empty cells
              1 *  32 + -- Gridlines of the window drawn in the default window foreground color
              0 *  64 + -- Right-to-left mode
              1 * 128 + -- Show outlines (guts ?!)
              0 * 256   -- Frozen, not split
            ) &
            Intel_16(0) & -- First visible row
            Intel_16(0) & -- First visible column
            Intel_32(0)   -- Grid line colour
          );
      end case;
    end Write_Window2;

    procedure Write_Pane is
      active_pane: Unsigned_8;
    begin
      if xl.freeze_col = 1 then
        if xl.freeze_row = 1 then
          active_pane:= 3;
        else
          active_pane:= 2;
        end if;
      else
        if xl.freeze_row = 1 then
          active_pane:= 1;
        else
          active_pane:= 0;
        end if;
      end if;
      -- 5.75 PANE
      WriteBiff(xl, 16#0041#,
        Intel_16(Unsigned_16(xl.freeze_col) - 1) &
        Intel_16(Unsigned_16(xl.freeze_row) - 1) &
        Intel_16(Unsigned_16(xl.freeze_row) - 1) &
        Intel_16(Unsigned_16(xl.freeze_col) - 1) &
        ( 1 => active_pane )
      );
    end Write_Pane;

    col_bits: Byte_buffer(1..32):= (others => 0);
    byte_idx, bit_idx: Positive:= 1;

  begin
    -- Calling Window1 and Window2 is not necessary for default settings, but without these calls,
    -- a Write_row_height call with a positive height results, on all MS Excel versions, in a
    -- completely blank row, including the header letters - clearly an Excel bug !
    Write_Window1;
    Write_Window2;
    --  5.92 SCL = Zoom, Magnification. Defined for BIFF4+ only, but works with BIFF2, BIFF3.
    WriteBiff(xl, 16#00A0#,
      Intel_16(Unsigned_16(xl.zoom_num)) &
      Intel_16(Unsigned_16(xl.zoom_den))
    );
    if xl.frz_panes and xl.format > BIFF2 then
      -- Enabling PANE for BIFF2 causes a very strange behaviour on MS Excel 2002.
      Write_Pane;
    end if;
    -- 5.93 SELECTION here !!
    if xl.format >= BIFF4 then
      for i in 1..256 loop
        col_bits(byte_idx):= col_bits(byte_idx) +
          Boolean'Pos(xl.std_col_width(i)) * (2**(bit_idx-1));
        bit_idx:= bit_idx + 1;
        if bit_idx = 9 then
          bit_idx:= 1;
          byte_idx:= byte_idx + 1;
        end if;
      end loop;
      -- 5.51 GCW: Global Column Width - trying to get a correct display by LibreOffice
      -- Result: OK but useless on MS Excel, not working on LibreOffice :-(
      WriteBiff(xl, 16#00AB#, Intel_16(32) & col_bits);
      -- if xl.defcolwdth > 0 then
      --   -- 5.101 STANDARDWIDTH -- this confuses MS Excel...
      --   WriteBiff(xl, 16#0099#, Intel_16(Unsigned_16(xl.defcolwdth)));
      -- end if;
    end if;
    -- 5.37 EOF: End of File:
    WriteBiff(xl, 16#000A#, empty_buffer);
    Set_Index(xl, xl.dimrecpos); -- Go back to overwrite the DIMENSION record with correct data
    Write_Dimensions(xl);
    xl.is_closed:= True;
  end Finish;

  ----------------------
  -- Output to a file --
  ----------------------

  procedure Create(
    xl           : in out Excel_Out_File;
    file_name    :        String;
    excel_format :        Excel_type    := Default_Excel_type;
    encoding     :        Encoding_type := Default_encoding
  )
  is
  begin
    Reset(xl, excel_format, encoding);
    xl.xl_file:= new Ada.Streams.Stream_IO.File_Type;
    Create(xl.xl_file.all, Out_File, file_name);
    xl.xl_stream:= XL_Raw_Stream_Class(Stream(xl.xl_file.all));
    Write_Worksheet_header(xl);
  end Create;

  procedure Close(xl : in out Excel_Out_File) is
    procedure Dispose is new
      Ada.Unchecked_Deallocation(Ada.Streams.Stream_IO.File_Type, XL_file_acc);
  begin
    Finish(xl);
    Close(xl.xl_file.all);
    Dispose(xl.xl_file);
  end Close;

  -- Set the index on the file
  procedure Set_Index (xl: in out Excel_Out_File;
                       To: Ada.Streams.Stream_IO.Positive_Count)
  is
  begin
    Ada.Streams.Stream_IO.Set_Index(xl.xl_file.all, To);
  end Set_Index;

  -- Return the index of the file
  function Index (xl: Excel_Out_File) return Ada.Streams.Stream_IO.Count
  is
  begin
    return Ada.Streams.Stream_IO.Index(xl.xl_file.all);
  end Index;

  function Is_Open(xl : in Excel_Out_File) return Boolean is
  begin
    if xl.xl_file = null then
      return False;
    end if;
    return Ada.Streams.Stream_IO.Is_Open(xl.xl_file.all);
  end Is_Open;

  ------------------------
  -- Output to a string --
  ------------------------
  -- Code reused from Zip_Streams

  procedure Read
    (Stream : in out Unbounded_Stream;
     Item   : out Stream_Element_Array;
     Last   : out Stream_Element_Offset) is
  begin
    -- Item is read from the stream. If (and only if) the stream is
    -- exhausted, Last will be < Item'Last. In that case, T'Read will
    -- raise an End_Error exception.
    --
    -- Cf: RM 13.13.1(8), RM 13.13.1(11), RM 13.13.2(37) and
    -- explanations by Tucker Taft
    --
    Last:= Item'First - 1;
    -- if Item is empty, the following loop is skipped; if Stream.Loc
    -- is already indexing out of Stream.Unb, that value is also appropriate
    for i in Item'Range loop
      Item(i) := Character'Pos (Element(Stream.Unb, Stream.Loc));
      Stream.Loc := Stream.Loc + 1;
      Last := i;
    end loop;
  exception
    when Ada.Strings.Index_Error =>
      null; -- what could be read has been read; T'Read will raise End_Error
  end Read;

  procedure Write
    (Stream : in out Unbounded_Stream;
     Item   : Stream_Element_Array) is
  begin
    for I in Item'Range loop
      if Length(Stream.Unb) < Stream.Loc then
        Append(Stream.Unb, Character'Val(Item(I)));
      else
        Replace_Element(Stream.Unb, Stream.Loc, Character'Val(Item(I)));
      end if;
      Stream.Loc := Stream.Loc + 1;
    end loop;
  end Write;

  procedure Set_Index (S : access Unbounded_Stream; To : Positive) is
  begin
    if Length(S.Unb) < To then
      for I in Length(S.Unb) .. To loop
        Append(S.Unb, ASCII.NUL);
      end loop;
    end if;
    S.Loc := To;
  end Set_Index;

  function Index (S : access Unbounded_Stream) return Integer is
  begin
    return S.Loc;
  end Index;

  --- ***

  procedure Create(
    xl           : in out Excel_Out_String;
    excel_format :        Excel_type    := Default_Excel_type;
    encoding     :        Encoding_type := Default_encoding
  )
  is
  begin
    Reset(xl, excel_format, encoding);
    xl.xl_memory:= new Unbounded_Stream;
    xl.xl_memory.Unb:= Null_Unbounded_String;
    xl.xl_memory.Loc:= 1;
    xl.xl_stream:= XL_Raw_Stream_Class(xl.xl_memory);
    Write_Worksheet_header(xl);
  end Create;

  procedure Close(xl : in out Excel_Out_String) is
  begin
    Finish(xl);
  end Close;

  function Contents(xl: Excel_Out_String) return String is
  begin
    if not xl.is_closed then
      raise Excel_stream_not_closed;
    end if;
    return To_String(xl.xl_memory.Unb);
  end Contents;

  -- Set the index on the Excel string stream
  procedure Set_Index (xl: in out Excel_Out_String;
                       To: Ada.Streams.Stream_IO.Positive_Count)
  is
  begin
    Set_Index(xl.xl_memory, Integer(To));
  end Set_Index;

  -- Return the index of the Excel string stream
  function Index (xl: Excel_Out_String) return Ada.Streams.Stream_IO.Count
  is
  begin
    return Ada.Streams.Stream_IO.Count(Index(xl.xl_memory));
  end Index;

  function "&"(a,b: Font_style) return Font_style is
  begin
    return a or b; -- "or" is predefined for sets (=array of Boolean)
  end "&";

  function "&"(a,b: Cell_border) return Cell_border is
  begin
    return a or b; -- "or" is predefined for sets (=array of Boolean)
  end "&";

end Excel_Out;


Excel Writer: Ada package writing Excel files (.xls). Ada programming.
Some news about Excel Writer and other Ada projects on Gautier's blog.