-
Notifications
You must be signed in to change notification settings - Fork 0
/
excel_out.adb
1925 lines (1789 loc) · 66.9 KB
/
excel_out.adb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
-- References to documentation are to: http://www.openoffice.org/sc/excelfileformat.pdf
--
-- To do:
-- =====
-- - Expand supported formulas
-- - Unicode (for binary Excel: requires BIFF8, but BIFF8 is pretty difficult)
-- - border line styles (5.115 XF - Extended Format)
-- - XML-based formats support (XLSX, ODS, ...)
-- - ...
with Ada.Unchecked_Conversion,
Ada.Unchecked_Deallocation,
Ada.Strings.Fixed;
with Excel_Out.Formulas;
with Excel_Out.IEEE_754.Generic_Double_Precision;
package body Excel_Out is
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) := Interfaces.Unsigned_8 (m and 255);
m := m / 256;
end loop;
return b;
end Intel_x86_buffer;
function Intel_32_Inst is new Intel_x86_buffer (Interfaces.Unsigned_32, 4);
function Intel_32 (n : Interfaces.Unsigned_32) return Byte_Buffer renames Intel_32_Inst;
function Intel_16 (n : Interfaces.Unsigned_16) return Byte_Buffer is
use Interfaces;
begin
return (Unsigned_8 (n and 255), Unsigned_8 (Shift_Right (n, 8)));
end Intel_16;
use Ada.Strings.Unbounded, Interfaces;
-- 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 : Ada.Streams.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 Write_Biff (
xl : Excel_Out_Stream'Class;
biff_id : Unsigned_16;
data : Byte_Buffer
)
is
pragma Inline (Write_Biff);
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 Write_Biff;
-- 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.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
Write_Biff (xl,
biff_record_identifier (xl.xl_format),
Intel_16 (biff_version (xl.xl_format)) &
Intel_16 (Sheet_or_dialogue) &
BOF_suffix
);
end Write_BOF;
-- 5.49 FORMAT (actually, a number format; the full format is called XF (extended format))
procedure Write_Number_Format_String (xl : Excel_Out_Stream'Class; s : String) is
begin
case xl.xl_format is
when BIFF2 | BIFF3 =>
Write_Biff (xl, 16#001E#, To_buf_8_bit_length (s));
when BIFF4 =>
Write_Biff (xl, 16#041E#, (0, 0) & To_buf_8_bit_length (s));
-- when BIFF8 =>
-- Write_Biff(xl, 16#041E#, (0, 0) & -- should be: format index used in other records
-- To_buf_8_bit_length(s));
end case;
end Write_Number_Format_String;
-- Write built-in number formats (internal)
procedure Write_Default_Number_Formats (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.xl_format is
when BIFF2 =>
Write_Biff (xl, 16#001F#, Intel_16 (Unsigned_16 (last_built_in - 5)));
when BIFF3 =>
Write_Biff (xl, 16#0056#, Intel_16 (Unsigned_16 (last_built_in - 3)));
when BIFF4 =>
Write_Biff (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_number_format loop
case n is
when general => Write_Number_Format_String (xl, "General");
when decimal_0 => Write_Number_Format_String (xl, "0");
when decimal_2 => Write_Number_Format_String (xl, "0" & sep_deci & "00"); -- 'Comma' built-in style
when decimal_0_thousands_separator =>
Write_Number_Format_String (xl, "#" & sep_1000 & "##0");
when decimal_2_thousands_separator =>
Write_Number_Format_String (xl, "#" & sep_1000 & "##0" & sep_deci & "00");
when no_currency_0 =>
if xl.xl_format >= BIFF4 then
Write_Number_Format_String (xl, "#" & sep_1000 & "##0;-#" & sep_1000 & "##0");
end if;
when no_currency_red_0 =>
if xl.xl_format >= BIFF4 then
Write_Number_Format_String (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.xl_format >= BIFF4 then
Write_Number_Format_String (xl, "#" & sep_1000 & "##0" & sep_deci & "00;" &
"-#" & sep_1000 & "##0" & sep_deci & "00");
end if;
when no_currency_red_2 =>
if xl.xl_format >= BIFF4 then
Write_Number_Format_String (xl, "#" & sep_1000 & "##0" & sep_deci & "00;" &
"-#" & sep_1000 & "##0" & sep_deci & "00");
end if;
when currency_0 =>
Write_Number_Format_String (xl, "$ #" & sep_1000 & "##0;$ -#" & sep_1000 & "##0");
when currency_red_0 =>
Write_Number_Format_String (xl, "$ #" & sep_1000 & "##0;$ -#" & sep_1000 & "##0");
-- [Red] doesn't go with non-English versions of Excel !!
when currency_2 =>
Write_Number_Format_String (xl, "$ #" & sep_1000 & "##0" & sep_deci & "00;" &
"$ -#" & sep_1000 & "##0" & sep_deci & "00");
when currency_red_2 =>
Write_Number_Format_String (xl, "$ #" & sep_1000 & "##0" & sep_deci & "00;" &
"$ -#" & sep_1000 & "##0" & sep_deci & "00");
when percent_0 => Write_Number_Format_String (xl, "0%"); -- 'Percent' built-in style
when percent_2 => Write_Number_Format_String (xl, "0" & sep_deci & "00%");
when scientific => Write_Number_Format_String (xl, "0" & sep_deci & "00E+00");
when fraction_1 =>
if xl.xl_format >= BIFF3 then
Write_Number_Format_String (xl, "#\ ?/?");
end if;
when fraction_2 =>
if xl.xl_format >= BIFF3 then
Write_Number_Format_String (xl, "#\ ??/??");
end if;
when dd_mm_yyyy => Write_Number_Format_String (xl, "dd/mm/yyyy");
when dd_mmm_yy => Write_Number_Format_String (xl, "dd/mmm/yy");
when dd_mmm => Write_Number_Format_String (xl, "dd/mmm");
when mmm_yy => Write_Number_Format_String (xl, "mmm/yy");
when h_mm_AM_PM => Write_Number_Format_String (xl, "h:mm\ AM/PM");
when h_mm_ss_AM_PM => Write_Number_Format_String (xl, "h:mm:ss\ AM/PM");
when hh_mm => Write_Number_Format_String (xl, "hh:mm");
when hh_mm_ss => Write_Number_Format_String (xl, "hh:mm:ss");
when dd_mm_yyyy_hh_mm => Write_Number_Format_String (xl, "dd/mm/yyyy\ hh:mm");
when percent_0_plus =>
Write_Number_Format_String (xl, "+0%;-0%;0%");
when percent_2_plus =>
Write_Number_Format_String (xl, "+0" & sep_deci & "00%;-0" & sep_deci & "00%;0" & sep_deci & "00%");
when date_iso => Write_Number_Format_String (xl, "yyyy\-mm\-dd");
when date_h_m_iso => Write_Number_Format_String (xl, "yyyy\-mm\-dd\ hh:mm");
when date_h_m_s_iso => Write_Number_Format_String (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.xl_format is
when BIFF2 =>
for i in 1 .. 6 loop
Write_Number_Format_String (xl, "@");
end loop;
when BIFF3 =>
for i in 1 .. 4 loop
Write_Number_Format_String (xl, "@");
end loop;
when BIFF4 =>
null;
end case;
-- ^ Stuffing for having the same number of built-in and EW custom
end Write_Default_Number_Formats;
-- 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.xl_format is
when BIFF2 =>
Write_Biff (xl, 16#0000#, sheet_bounds);
when BIFF3 | BIFF4 =>
Write_Biff (xl, 16#0200#, sheet_bounds & (0, 0));
-- when BIFF8 =>
-- Write_Biff(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;
case xl.xl_format is
when BIFF2 =>
if xl.number_fmt > 63 then
raise Number_format_out_of_range
with "Only 64 number formats are allowed in the BIFF2 format";
-- Reason: see encoding in the Cell Attributes (2.5.13).
end if;
when BIFF3 .. BIFF4 =>
if xl.number_fmt > 255 then
raise Number_format_out_of_range
with "Only 256 number formats are allowed in the BIFF3, BIFF4 formats";
end if;
end case;
format := xl.number_fmt;
Write_Number_Format_String (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
Write_Biff (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.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.xl_format is
-- when BIFF8 => -- UTF-16
-- Write_Biff(xl, 16#0042#, Intel_16(16#04B0#));
when others =>
Write_Biff (xl, 16#0042#, Intel_16 (Encoding_code));
end case;
-- 5.14 CALCMODE
Write_Biff (xl, 16#000D#, Intel_16 (1)); -- 1 => automatic
-- 5.85 REFMODE
Write_Biff (xl, 16#000F#, Intel_16 (1)); -- 1 => A1 mode
-- 5.28 DATEMODE
Write_Biff (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
Write_Default_Number_Formats (xl);
-- 5.111 WINDOWPROTECT
Write_Biff (xl, 16#0019#, Intel_16 (0));
-- Define default format
Define_Format (xl, xl.def_font, general, xl.def_fmt);
if xl.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 BIFF2
Write_Biff (
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
Write_Biff (
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
Write_Biff (
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.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_number_format =>
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_number_format 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;
--
-- Now we will store the newly defined format.
--
xl.xfs := xl.xfs + 1;
if xl.xfs not in XF_Range then
raise Format_out_of_range
with
"Too many formats defined, maximum number of formats " &
"(including a few pre-defined) is" &
Integer'Image (XF_Range'Last + 1);
end if;
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
Write_Biff (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
Write_Biff (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
Write_Biff (xl, 16#0026#, IEEE_Double_Intel (inches));
end Left_Margin;
procedure Right_Margin (xl : Excel_Out_Stream; inches : Long_Float) is
begin
Write_Biff (xl, 16#0027#, IEEE_Double_Intel (inches));
end Right_Margin;
procedure Top_Margin (xl : Excel_Out_Stream; inches : Long_Float) is
begin
Write_Biff (xl, 16#0028#, IEEE_Double_Intel (inches));
end Top_Margin;
procedure Bottom_Margin (xl : Excel_Out_Stream; inches : Long_Float) is
begin
Write_Biff (xl, 16#0029#, IEEE_Double_Intel (inches));
end Bottom_Margin;
procedure Margins
(xl : Excel_Out_Stream;
left_inches,
right_inches,
top_inches,
bottom_inches : Long_Float)
is
begin
Left_Margin (xl, left_inches);
Right_Margin (xl, right_inches);
Top_Margin (xl, top_inches);
Bottom_Margin (xl, bottom_inches);
end Margins;
procedure Print_Row_Column_Headers (xl : Excel_Out_Stream) is
begin
Write_Biff (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
Write_Biff (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)!
Write_Biff (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
Write_Biff (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.xl_format is
when BIFF2 =>
Write_Biff (xl, 16#0025#, default_twips);
when BIFF3 | BIFF4 =>
Write_Biff (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
Write_Biff (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.xl_format is
when BIFF2 =>
-- 5.20 COLWIDTH (BIFF2 only)
Write_Biff (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+)
Write_Biff (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.xl_format is
when BIFF2 =>
Write_Biff (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;
Write_Biff (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 (5.45).
-- Numbering is 0, 1, 2, 3, *5*, 6,...
end if;
case xl.xl_format is
when BIFF2 =>
if xl.fonts > 3 then
raise Font_out_of_range with "Only 4 fonts are allowed in the BIFF2 format";
-- Reason: in the Cell Attributes (2.5.13), font index is encoded on 2 bits!
end if;
Write_Biff (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
Write_Biff (xl, 16#0045#, Intel_16 (color_code (BIFF2, color)(for_font)));
end if;
when BIFF3 | BIFF4 => -- BIFF8 has 16#0031#, p. 171
if xl.fonts > 255 then
raise Font_out_of_range with "Only 256 fonts are allowed in the BIFF3, BIFF4 formats";
end if;
Write_Biff (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;
-- 5.50 FORMULA, p.176 - Internal
--
procedure Write_as_Formula
(xl : in out Excel_Out_Stream;