Travailler avec TBitmap et des fichiers bmp sous Linux

**Jipété** · 18/02/2019, 11h23

Salut,

je crois bien que je vais lâcher l'affaire, ça semble ingérable.

(c'est quand même le comble d'être sur un système où les images sont en 32 bits nativement et de ne pas pouvoir exploiter ça -- vais peut-être me tourner vers le C.
Depuis ce matin je regarde ImageMagick [mais leur doc en ligne est à vomir], qui a ouvert tous mes fichiers de test sans problème. Le souci c'est l'enregistrement : un seul essai, négatif. 32 -> 24 bits. Décourageant. Ou alors j'ai mal configuré ? Je ne sais pas encore...)

Oui, envie d'abandonner Lazarus car hier soir j'ai fait des essais, et il en ressort ces deux images :
1-) 3 fichiers 32 bits mais les deux du haut seulement sont visibles, le 3^e, en bas, a son canal Alpha à 0 dont les autres pixels sont invisibles (j'ai mis en surbrillance orange sur la 4^e ligne le 1^er pixel des datas, BGR puis Alpha -- sur la 1^re ligne 28 --> versionheader 1, sur la 2^e 20 --> pf32bit)
Nom : 3fic_32bits_v1.png
Affichages : 1190
Taille : 57,2 Ko

Nom : 3fic_32bits_v1.png
Affichages : 1190
Taille : 57,2 Ko

En gros ces 3 fichiers sont identiques sauf au niveau du canal Alpha pour le 3^e, la bonne question c'est : pourquoi son ouverture est-elle ok avec Gimp, le viewer Linux, imageJ, imageMagick et LibreOffice, mais pas avec Lazarus et LazPaint ?

Est-ce que ces programmes détectent le canal Alpha à 0 et l'inversent ? Ça me dit vaguement quelque chose, comme si Alpha à 0 devait être considéré comme Alpha à 255 (et on dirait que c'est ce que ferait ImageMagick, du peu que j'en ai vu).

2-) 2 fichiers avec le PixelFormat à 24 bits, en haut versionheader 4 en bas 1, en haut 3x2 et on voit bien que tout est flou d'agrandissement, en bas 5x2 et là aussi les pixels sont agrandis puisque c'est le même TImage avec Stretched à True qui affiche l'un ou l'autre quand je clique dans ma liste de choix. Pourquoi deux résultats si différents ?
Les imagettes d'affichage 192x128 sont réduites de moitié histoire de ne pas encombrer les datas.
Nom : 2fic-24bits_v1_v4.png
Affichages : 1306
Taille : 40,6 Ko

Nom : 2fic-24bits_v1_v4.png
Affichages : 1306
Taille : 40,6 Ko

Voilà.
Face à toutes ces déconvenues, comme dit le proverbe, "à l'impossible nul n'est tenu" et là, c'est particulièrement impossible...

**BeanzMaster** · 18/02/2019, 13h56

Envoyé par tourlourou

Pardonnez ma paresse, mais je ne sais plus trop où vous en êtes, et je crains de ne pas bien y coller en reprenant tous les posts de cette discussion (voire d'autres...).

Bref, je peux faire des tests avec CT 6.4 sous Ubuntu 18.04 avec widgetset gtk2, mais si vous pouviez me fournir les portions de code à tester et des images OK et KO, ce serait parfait ! Que ce soit sur le forum, ou par mail.

Bonjour Yves tu peux tester ce code simple JipeteBmp.Zip C'est le code que j'ai utilisé pour tester ici

**BeanzMaster** · 18/02/2019, 14h43

Envoyé par Jipété

post 58, bientôt 60...

Bon, ça ira comme ça pour aujourd'hui, j'en ai grave ma claque, là.

J'ai trouvé une combine (merci à toi, Jérôme, je me marre car on tourne en rond, à la fin : Je cherche une info sur le web et sur qui je tombe ? https://forum.lazarus.freepascal.org...topic=41674.15

)

Bref, en fin de matinée j'avais deux fichiers pas bons, ce soir je n'en ai plus qu'un ! Et si l'on considère qu'il est enregistré en pf32bit, ce n'est plus qu'une histoire d'affichage, mais là j'en peux plus...
....

Faut dire aussi qu'avec ses dimensions barbares, je n'arrange pas les choses. Mais ça doit passer !

La solution consiste donc à récupérer la version du header, à faire un case dessus et mettre ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
  procedure Setup_V1; // la manière d'origine, qui ne supporte pas les headers V4
  begin
    lii := TLazIntfImage.Create(0,0); // create the raw image
    lii.DataDescription := GetDescriptionFromDevice(0);
  end;
  procedure Setup_V4; // depuis la proc à Jérôme -- merci à toi, ça ne s'invente pas, des paramètres comme ça
  begin
    lii := TLazIntfImage.Create(0,0,[riqfRGB, riqfAlpha, riqfMask])
  end;

Je l'avais oublié cette discussion. Le truc c'est que ce genre de manips ne devraient pas être faites par nous

Envoyé par Jipété

Un dernier mot avant de plier : pendant que je parcourais les fichiers .pas, je suis tombé sur ça (je ne sais plus si c'est dans graphtype ou un autre, on s'en fiche), et je l'ai noté car ça m'a fait peur, au niveau du commentaire, 2^de phrase :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
function  GetDataLineStart(y: integer): Pointer;
  // similar to Delphi TBitmap.ScanLine. Only works with lines aligned to whole bytes.

Ou alors c'est comme bien souvent comme partout, c'est mal dit ? Pour moi, ça n'a pas de sens, lines aligned to whole bytes : depuis quand des lignes ne seraient pas alignées sur des bytes entiers ? Qu'est-ce qu'ils ont voulu dire ?
Parce que dans la vraie vie, avec les pf24bit il y a le padding pour nous sauver la vie et l'alignement, et pour le pf32bit avec donc 4 bytes par pixel, il n'y a pas de problème.

Sauf avec ma Lena à 397 de large,

Mais ce matin elle s'affichait pourtant bien, au prix d'en enregistrement en pf24, parfaitement inadmissible pour la suite, ah mais !

Le commentaire est signe de confusion même les devs originals ne s'y retrouve plus. "Only works with lines aligned to whole bytes" en gros ce je comprend c'est que cela fonctionne uniquement avec un tampon dant les pixels sont codés sur 32bits

Envoyé par Jipété

Salut,

je crois bien que je vais lâcher l'affaire, ça semble ingérable.

(c'est quand même le comble d'être sur un système où les images sont en 32 bits nativement et de ne pas pouvoir exploiter ça -- vais peut-être me tourner vers le C.
Depuis ce matin je regarde ImageMagick [mais leur doc en ligne est à vomir], qui a ouvert tous mes fichiers de test sans problème. Le souci c'est l'enregistrement : un seul essai, négatif. 32 -> 24 bits. Décourageant. Ou alors j'ai mal configuré ? Je ne sais pas encore...)

Oui, envie d'abandonner Lazarus car hier soir j'ai fait des essais, et il en ressort ces deux images :
1-) 3 fichiers 32 bits mais les deux du haut seulement sont visibles, le 3^e, en bas, a son canal Alpha à 0 dont les autres pixels sont invisibles (j'ai mis en surbrillance orange sur la 4^e ligne le 1^er pixel des datas, BGR puis Alpha -- sur la 1^re ligne 28 --> versionheader 1, sur la 2^e 20 --> pf32bit)
...

En gros ces 3 fichiers sont identiques sauf au niveau du canal Alpha pour le 3^e, la bonne question c'est : pourquoi son ouverture est-elle ok avec Gimp, le viewer Linux, imageJ, imageMagick et LibreOffice, mais pas avec Lazarus et LazPaint ?

Est-ce que ces programmes détectent le canal Alpha à 0 et l'inversent ? Ça me dit vaguement quelque chose, comme si Alpha à 0 devait être considéré comme Alpha à 255 (et on dirait que c'est ce que ferait ImageMagick, du peu que j'en ai vu).

Le problème est tu la découvert dans un de tes posts précédent c'est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 if Info.MaskSize.A <> 0 {Info.BitCount = 32}
  then CheckAlphaDescription(TheImage);

C'est une des cause de la mauvaise gestion du canal Alpha. Et il est normal que LazPaint se vautre aussi vu qu'il utilise les codes natifs de chargement des BMP.

Envoyé par Jipété

2-) 2 fichiers avec le PixelFormat à 24 bits, en haut versionheader 4 en bas 1, en haut 3x2 et on voit bien que tout est flou d'agrandissement, en bas 5x2 et là aussi les pixels sont agrandis puisque c'est le même TImage avec Stretched à True qui affiche l'un ou l'autre quand je clique dans ma liste de choix. Pourquoi deux résultats si différents ?
Les imagettes d'affichage 192x128 sont réduites de moitié histoire de ne pas encombrer les datas.
...

Voilà.
Face à toutes ces déconvenues, comme dit le proverbe, "à l'impossible nul n'est tenu" et là, c'est particulièrement impossible...

On s'écarte du sujet originel. Le problème ne vient pas des bmps ou du chargement (même si certains BMP "exotics" sont mal pris en charge) Le problème vient de l'initalisation du RawImage à la copie ou lors du chargement du dit BMP qui n'est pas faite comme il se doit en fonction du format de couleur des Pixels (24bits, 32bits) et la taille de stockage des pixels en eux-même. Tu cherches un chimère en persévérant dans cette voie.

Pour le floue du stretch je ne me rappel plus mais la aussi il y a une explication mais je ne m'en souviens plus. Tu avais déja été confronté à ce problème dans une de nos discussions

**BeanzMaster** · 18/02/2019, 14h45

Tiens je te redonnes mon unit de chargement (et sauvegardes en 32bits, je crois que j'ai une erreur avec le 24bits si je me souviens bien que je n'ai pas encore corrigé) des fichiers au format BMP. Il est bourré de commentaires, ils te donneront peut-être quelques explications sur certaines de tes questions. Cela pourrat peux-être t'aider.

Comme je l'ai toujours dis le format BMP est un des plus ancien format d'image qui existe, mais au fil du temps il est devenu plus complexe qu'il y parait. Il nettement plus compliquer à décoder que d'autre format comme le PNG ou le GIF

Ce code charge les données dans un tampon similaire au code russe que tu as trouvé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 type
   PPixel = ^TPixel;
   TPixel = packed record
     {$IFDEF WINDOWS}
     blue, green, red, alpha: byte;
     {$ENDIF}
     {$IFDEF LINUX}
     red, green, blue, alpha: byte;
     {$ENDIF}
   end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
(*
  @created(2017-04-17)
  @author(J.Delauney (BeanzMaster))
  Historique : @br
  @unorderedList(
    @item(17/04/2017 : Creation  )
  )
--------------------------------------------------------------------------------@br
 
    @bold(Description :)@br
    Prise en charge des Images au format BMP (Windows et Osx) en lecture et écriture.
 
 
    Spécifications :
    @unorderedList(
      @item(Méthode de compression    : Aucune, encodage BitField, RLE, Huffman 1D)
      @item(Nombre de couleurs	      : 1,2,4,8,15,16,24,32,64 bits
      @item(Supporte plusieurs images : Non, une seule image dans un même fichier)
      @item(Format des nombres	      : Mixte
      @item(Auteur                    : OSx, Windows)
      @item(Extensions                : *.bmp, *.rle, *.dib)
      @item(Version                   : de 1 à 5)
    )
 
  ------------------------------------------------------------------------------@br
  @bold(Notes) : @br
    Informations sur le format BMP :
    @unorderedList(
       @item(https://fr.wikipedia.org/wiki/Windows_bitmap)
       @item(http://fileformats.archiveteam.org/wiki/BMP)
       @item(https://en.wikipedia.org/wiki/BMP_file_format  (plus complet que la version française))
       @item(https://delphi.developpez.com/cours/graphiques/menugra/bitmap2.php)
       @item(http://www.alrj.org/docs/formats/bmp/BMP.htm)
       @item(http://netghost.narod.ru/gff/graphics/summary/os2bmp.htm)
       @item(http://www.drdobbs.com/the-bmp-file-format-part-2/184409533?pgno=5)
       @item(http://www.fileformat.info/format/bmp/egff.htm)
       @item(http://www.fileformat.info/format/os2bmp/egff.htm)
    )
 
    Encodage/Decodage :
    @unorderedList(
       @item(https://msdn.microsoft.com/en-us/library/windows/desktop/dd183376%28v=vs.85%29.aspx)
       @item(https://en.wikipedia.org/wiki/File:BitfieldsSLN.png)
       @item(http://netghost.narod.ru/gff/graphics/book/ch09_01.htm)
       @item(https://fr.wikipedia.org/wiki/Codage_de_Huffman)
       @item(http://tcharles.developpez.com/Huffman/)
    )
 
    Autres informations utiles :
    @unorderedList(
       @item(https://msdn.microsoft.com/en-us/library/windows/desktop/dd183393(v=vs.85).aspx)
       @item(https://msdn.microsoft.com/en-us/library/windows/desktop/dd183353(v=vs.85).aspx)
       @item(https://msdn.microsoft.com/en-us/library/windows/desktop/dd183376(v=vs.85).aspx)
    )
 
    Fichiers test : @br
      - http://entropymine.com/jason/bmpsuite/@br
      - https://samples.libav.org/image-samples/
      - + Divers
 
  ------------------------------------------------------------------------------@br
  @bold(BUGS :)@br
    - 
 
  ------------------------------------------------------------------------------@br
  @bold(TODO :)@br
  @unorderedList(
     @item(Sauvegarde du bitmap)
     @item(Fichier Icones et cusrseurs)
     @item(Decompression Huffman 1D)
     @item(Prise en charge pixelformat = 2 et 64 bits)
  )
 
  ------------------------------------------------------------------------------@br
  @bold(Credits :)
   @unorderedList(
     @item(FPC/Lazarus)
   )
 
  ------------------------------------------------------------------------------@br
  @bold(LICENCE :) MPL / GPL @br
  @br
 *==============================================================================*)
Unit BZImageFileBMP;
 
//------------------------------------------------------------------------------
//----------------------------[ TODO LIST ]-------------------------------------
 
    { TODO 0  -oBZBitmap -cSupport_Images_BMP : Prise en charge pixelformat = 64 bits    }
    { TODO 0  -oBZBitmap -cSupport_Images_BMP : Ecriture Format BMP }
    { TODO 5  -oBZBitmap -cSupport_Images_BMP : Decompression Huffman 1D  }
    { TODO 10 -oBZBitmap -cSupport_Images_BMP : Decompression RLE 24 pour les version OS/2x  }
    { TODO 10 -oBZBitmap -cSupport_Images_BMP : Decompression JPG et PNG  }
 
//------------------------------------------------------------------------------
{$mode objfpc}{$H+}
{$i ..\..\beanzlib_options.inc}
 
Interface
 
Uses
  Classes, SysUtils,
  BZClasses, BZGraphic,  BZBitmap, BZImageFileIO; //, FPWriteBMP;
 
Const
  { ID BMP
  @groupbegin }
  BMP_MAGIC_WINBMP = 'BM'; // 19778;
  BMP_MAGIC_OS2BMP = 'BA';
  BMP_MAGIC_OS21ICO = 'CI';
  BMP_MAGIC_OS21CUR = 'CP';
  BMP_MAGIC_OS22ICO = 'IC';
  BMP_MAGIC_OS22CUR = 'PT';
  { @groupend }
 
  { Types de compression pris en charge
  @groupbegin }
  BMP_COMPRESSION_NONE = Longword(0); // Non compressé
  BMP_COMPRESSION_RLE8 = Longword(1); // Compressé avec RLE 8bits
  BMP_COMPRESSION_RLE4 = Longword(2); // Compressé avec RLE 4bits
  BMP_COMPRESSION_BITF = Longword(3); // Nom compressé BitFields winV2 Mask RGB / V3 Mask RGBA,   et seulement 16 et 32 bits
  BMP_COMPRESSION_HUF1D = Longword(3); // OSX22 = Hufman1D seulement 1bit
  BMP_COMPRESSION_JPEG = Longword(4); // Compressé avec JPEG si OSX22 = RLE 24bits
  BMP_COMPRESSION_PNG = Longword(5);  // Compressé avec PNG
  BMP_COMPRESSION_ALPHABITF = Longword(6); // Compressé avec AlphaBitFields Mask RGBA (seulement WinCE5.0 et avec .NET > 4.0)
 
  //11,12,13 seulement Windows Metafile CMYK
  //       11 : "BI_CMYK - pas de compression
  //       12 : "BI_CMYKRLE8 - RLE-8
  //       13 : "BI_CMYKRLE4 - RLE-4
  { @groupend }
Type
  { L'entête principale d'un fichier BMP est composée de 4 champs :@br
    - La signature (sur 2 octets), indiquant qu'il s'agit d'un fichier BMP à l'aide de 2 caractères :
    @unorderedList(
      @item( BM $424D en hexadécimal, indique qu'il s'agit d'un Bitmap Windows.)
      @item( BA $4241 indique qu'il s'agit d'un Bitmap OS/2.)
      @item( CI $4349 indique qu'il s'agit d'une icone couleur OS/2.)
      @item( CP $4350 indique qu'il s'agit d'un pointeur de couleur OS/2.)
      @item( IC $4943 indique qu'il s'agit d'une icone OS/2.)
      @item( PT $5054 indique qu'il s'agit d'un pointeur OS/2.)
    - La taille totale du fichier en octets (codée sur 4 octets)@br
    - 2 champs réservés (de 2 octets)@br
    - L'offset de l'image (sur 4 octets), en français décalage }
  TBZBMPFileHeader = Packed Record   // < Taille de l'en-tête commune 14 octets
    bfType: Array[0..1] Of Char; // < bfType, Normalement Word;@brEn déclarant un array of char on evite de se prendre la tête avec  le "Little et Big Endian"
    bfSize: Longword;   // Taille totale du fichier
    bfReserved1: Word;  // Hospot X -> OS2x
    bfReserved2: Word;  // Hospot Y -> OS2x
    bfOffBits: Longword; // Position des données de l'image dans le fichier
  End;
 
  { Type de l'en-tête }
  TBZBMPHeaderType = (bmpht_unknown,
    bmpht_Os21x, bmpht_Os22x,
    bmpht_WindowsV1, bmpht_WindowsV2, bmpht_WindowsV3,
    bmpht_WindowsV4, bmpht_WindowsV5);
 
  { En-têtes BMP et OS/2 minimal@br
    biSize: LongWord; Taille de l'en-tête  = 12 octets @br
    ( biSize: LongWord pour la taille de l'en-tête )
  }
  TBZOs21xBMPInfoHeader = Packed Record  // Ici Taille 8, biSize est lu avant
    biWidth: Word;                  // Largeur de l'image en pixels
    biHeight: Word;                 // Hauteur de l'image en pixels
    biPlanes: Word;                 // Nombre de Plans de couleur
    biBitCount: Word;               // Nombre de bits par pixel
  End;
 
  { En-têtes BMP OS/2 V2@br
    biSize: LongWord; Taille de l'en-tête  = 64 octets }
  TBZOs22xBMPInfoHeader = Packed Record  // Ici Taille 60, biSize est lu avant
    biWidth: Longword;               // Largeur de l'image en pixels
    biHeight: Longword;              // Hauteur de l'image en pixels
    biPlanes: Word;                  // Nombre de Plans de couleur  = 1
    biBitCount: Word;                // Nombre de bits par pixel
    biCompression: Word;             // Type de compression
    biSizeImage: Longword;           // Taille de l'image  AVEC LE PADDING
    biXPixelsPerMeter: Longint;      // Nombre de pixel horizontal par mètre
    biYPixelsPerMeter: Longint;      // Nombre de pixel vertical par mètre
    biClrUsed: Longword;             // Nombre de couleurs utilisées (0 = toutes)
    biClrImportant: Longword;        // Nombre de couleurs importantes (0 = toutes)
    biUnits: Word;                   // Type d'unité utilisée pour mesurer les "distances"
    biReserved: Word;                // Réservé (Pad structure to 4-byte boundary)
    biRecording: Word;               // Algorithme d'enregistrement utilisé
    biRendering: Word;               // Algorithme d' "Halftoning" utilisé
    biSize1: Longword;               // Réservé pour l'algorithme d' "Halftoning"
    biSize2: Longword;               // Reserved for halftoning algorithm use
    biColorEncoding: Longword;       // Model de couleur utilisé
    biIdentifier: Longword;          // Réservé pour l'appication qui enregistre le fichier
  End;
 
  { En-têtes BMP OS/2 V2@br
    biSize: LongWord; Taille de l'en-tête  =  40 octets  }
  TBZWindowsBMPInfoHeaderV1 = Packed Record   // Ici Taille 36, biSize est lu avant
    biWidth: Longint;               // Largeur de l'image en pixels
    biHeight: Longint;              // Hauteur de l'image en pixels
    biPlanes: Word;                 // Nombre de Plans de couleur  = 1
    biBitCount: Word;               // Nombre de bits par pixel
    biCompression: Longword;        // Type de compression
    biSizeImage: Longword;          // Taille de l'image  AVEC LE PADDING
    biXPixelsPerMeter: Longint;     // Nombre de pixel horizontal par mètre
    biYPixelsPerMeter: Longint;     // Nombre de pixel vertical par mètre
    biClrUsed: Longword;            // Nombre de couleurs utilisées (0 = toutes)
    biClrImportant: Longword;       // Nombre de couleurs importantes (0 = toutes)
  End;
 
  { Definitions pour la prise en charge type de couleur spéciale CIExyz@br
   dans les en-têtes Windows V4 et V5
   @groupbegin }
  TBZBMP_CIEXYZCoord = Packed Record
    X: Longint;
    Y: Longint;
    Z: Longint;
  End;
 
  TBZBMP_CIEXYZCoordTriple = Packed Record
    CRed: TBZBMP_CIExyzCoord;
    CGreen: TBZBMP_CIExyzCoord;
    CBlue: TBZBMP_CIExyzCoord;
  End;
  { @groupend }
 
  { En-tête BMP Windows V2 (non documenté - Adobe Photoshop)@br
    biSize: LongWord; Taille de l'en-tête  = 52 octets }
  TBZWindowsBMPInfoHeaderV2 = Packed Record   //< Ici Taille 48, biSize est lu avant
    biWidth: Longint;                //< Largeur de l'image en pixels
    biHeight: Longint;               //< Hauteur de l'image en pixels
    biPlanes: Word;                  //< Nombre de Plans de couleur  = 1
    biBitCount: Word;                //< Nombre de bits par pixel
    biCompression: Longword;         //< Type de compression
    biSizeImage: Longword;           //< Taille de l'image  AVEC LE PADDING
    biXPixelsPerMeter: Longint;      //< hoizontal pixels per meter
    biYPixelsPerMeter: Longint;      //< vertical pixels per meter
    biClrUsed: Longword;             //< Nombre de couleurs utilisées (0 = toutes)
    biClrImportant: Longword;        //< Nombre de couleurs importantes (0 = toutes)
    biRedMask: Longword;             //< Masque Couleur Rouge
    biGreenMask: Longword;           //< Masque Couleur Vert
    biBlueMask: Longword;            //< Masque Couleur Bleu
  End;
 
  { En-tête BMP Windows V3 (Adobe Photoshop)@br
    biSize: LongWord; Taille de l'en-tête  = 56 octets  }
  TBZWindowsBMPInfoHeaderV3 = Packed Record  // < Ici Taille 52, biSize est lu avant
    biWidth: Longint;                //< Largeur de l'image en pixels
    biHeight: Longint;               //< Hauteur de l'image en pixels
    biPlanes: Word;                  //< Nombre de Plans de couleur  = 1
    biBitCount: Word;                //< Nombre de bits par pixel
    biCompression: Longword;         //< Type de compression
    biSizeImage: Longword;           //< Taille de l'image  AVEC LE PADDING
    biXPixelsPerMeter: Longint;      //< hoizontal pixels per meter
    biYPixelsPerMeter: Longint;      //< vertical pixels per meter
    biClrUsed: Longword;             //< Nombre de couleurs utilisées (0 = toutes)
    biClrImportant: Longword;        //< Nombre de couleurs importantes (0 = toutes)
    biRedMask: Longword;             //< Masque Couleur Rouge
    biGreenMask: Longword;           //< Masque Couleur Vert
    biBlueMask: Longword;            //< Masque Couleur Bleu
    biAlphaMask: Longword;           //< Masque Couleur Alpha
  End;
 
  { En-tête BMP Windows V4@br
    biSize: LongWord; Taille de l'en-tête  = 108 octets }
  TBZWindowsBMPInfoHeaderV4 = Packed Record   //< Ici Taille 104, biSize est lu avant
    biWidth: Longint;                //< Largeur de l'image en pixels
    biHeight: Longint;               //< Hauteur de l'image en pixels
    biPlanes: Word;                  //< Nombre de Plans de couleur  = 1
    biBitCount: Word;                //< Nombre de bits par pixel
    biCompression: Longword;         //< Type de compression
    biSizeImage: Longword;           //< Taille de l'image  AVEC LE PADDING peut être 0 si pas de compression
    biXPixelsPerMeter: Longint;      //< hoizontal pixels per meter
    biYPixelsPerMeter: Longint;      //< vertical pixels per meter
    biClrUsed: Longword;             //< Nombre de couleurs utilisées (0 = toutes)
    biClrImportant: Longword;        //< Nombre de couleurs importantes (0 = toutes)
    biRedMask: Longword;             //< Masque Couleur Rouge
    biGreenMask: Longword;           //< Masque Couleur Vert
    biBlueMask: Longword;            //< Masque Couleur Bleu
    biAlphaMask: Longword;           //< Masque Couleur Alpha
    biCSType: Longword;              //< Type de l'espace de couleur CIE
    biEndpoints: TBZBMP_CIEXYZCoordTriple; //< "Color space endpoints"
    biGammaRed: Longword;            //< Correction Gamma Rouge
    biGammaGreen: Longword;          //< Correction Gamma Vert
    biGammaBlue: Longword;           //< Correction Gamma Bleu
  End;
 
  { En-tête BMP Windows V5@br
    biSize: LongWord; Taille de l'en-tête  = 124 octets }
  TBZWindowsBMPInfoHeaderV5 = Packed Record  //< Ici Taille 120, biSize est lu avant
    biWidth: Longint;                //< Largeur de l'image en pixels
    biHeight: Longint;               //< Hauteur de l'image en pixels
    biPlanes: Word;                  //< Nombre de Plans de couleur  = 1
    biBitCount: Word;                //< Nombre de bits par pixel
    biCompression: Longword;         //< Type de compression
    biSizeImage: Longword;           //< Taille de l'image  AVEC LE PADDING
    biXPixelsPerMeter: Longint;      //< hoizontal pixels per meter
    biYPixelsPerMeter: Longint;      //< vertical pixels per meter
    biClrUsed: Longword;             //< Nombre de couleurs utilisées (0 = toutes)
    biClrImportant: Longword;        //< Nombre de couleurs importantes (0 = toutes)
    biRedMask: Longword;             //< Masque Couleur Rouge
    biGreenMask: Longword;           //< Masque Couleur Vert
    biBlueMask: Longword;            //< Masque Couleur Bleu
    biAlphaMask: Longword;           //< Masque Couleur Alpha
    biCSType: Longword;              //< Type de l'espace de couleur CIE
    biEndpoints: TBZBMP_CIEXYZCoordTriple; //< "Color space endpoints"
    biGammaRed: Longword;            //< Correction Gamma Rouge
    biGammaGreen: Longword;          //< Correction Gamma Vert
    biGammaBlue: Longword;           //< Correction Gamma Bleu
    biIntent: Longword;              //< "rendering intent"
    biProfileData: Longword;         //< Position des données du profile de couleur
    biProfileSize: Longword;         //< Taille des données du profile de couleur
    biReserved: Longword;            //< Réservé
  End;
 
  { En-tête BMP }
  TBZBitmapBMPInfoHeader = Packed Record
    Case Size: Longword Of
      0: (Offset: Array[0..0] Of Byte);
      8: (Os21x: TBZOs21xBMPInfoHeader);
      36: (WindowsV1: TBZWindowsBMPInfoHeaderV1);
      48: (WindowsV2: TBZWindowsBMPInfoHeaderV2);
      52: (WindowsV3: TBZWindowsBMPInfoHeaderV3);
      60: (Os22x: TBZOs22xBMPInfoHeader);
      104: (WindowsV4: TBZWindowsBMPInfoHeaderV4);
      120: (WindowsV5: TBZWindowsBMPInfoHeaderV5);
  End;
  PBZBitmapBMPInfoHeader = ^TBZBitmapBMPInfoHeader;
 
Type
  EBZSaveImageException = Class(EBZBitmapException);
 
  { TBZBitmapBMPImage : Classe de lecture et d"ecriture des images au format BMP }
  TBZBitmapBMPImage = Class(TBZCustomImageFileIO)
  private
    FBmpFileHeader: TBZBMPFileHeader;
    FInfoHeader: TBZBitmapBMPInfoHeader;
    FHeaderType: TBZBMPHeaderType;
    FInternalReadSize: Longword;
    FHeaderSize: Longword;
    FRowSize, FLineEndGapSize: Integer;
    FIgnoreAlpha: Boolean;
 
    FNeedAdjustBFH : Boolean;
    // Fonctions d'aide à la lecture des infos dans les en-têtes
    Function GetHeaderWidth: Integer;
    Function GetHeaderHeight: Integer;
    Function GetHeaderBitCount: Word;
    Function GetHeaderCompression: Longword;
    Function GetHeaderUsedColors: Longword;
    Function GetHeaderRedMask: Longword;
    Function GetHeaderGreenMask: Longword;
    Function GetHeaderBlueMask: Longword;
    Function GetHeaderAlphaMask: Longword;
    Function GetRowSize: Integer;
    Function GetPadding: Integer;
 
    function getInfoHeaderSize(aVersion : TBZBMPHeaderType): Integer;
    function ComputePaletteOrMaskSize:Integer;
    function ComputeCompressionType : LongWord;
    function CreateInfoHeader(aVersion : TBZBMPHeaderType):TBZBitmapBMPInfoHeader;
    procedure InitSaving(aVersion : TBZBMPHeaderType);
    procedure InitBitFieldMasks;
  protected
    // Variables utiles lors de l'encodage et du décodage des données
    RedMask, GreenMask, BlueMask, AlphaMask: Longword;
    RedBitShift, GreenBitShift, BlueBitShift, AlphaBitShift: Shortint;
    AbitCount, Padding: Byte;
    RowSize: Integer;
    Compression: Longword;
    bmpWidth, bmpHeight: Integer;
    TopDown: Boolean;
    GapSize1, GapSize2: Integer;
 
    procedure SaveHeader;
    procedure SavePalette;
    procedure SaveImageData;
 
    Procedure LoadFromMemory(); override;
    Function CheckFormat(): Boolean; override;
    Function ReadImageProperties: Boolean; override;
    Procedure SaveToMemory();Override;
  public
 
    Constructor Create(AOwner: TPersistent; AWidth, AHeight: Integer); override;
    Destructor Destroy; override;
 
    Class Function Capabilities: TBZDataFileCapabilities; override;
 
    Function getImagePropertiesAsString: String; override;
  End;
 
Implementation
 
Uses
  BZImageStrConsts,
  BZUtils
 {$IFDEF DEBUG}
 , Dialogs, BZLogger;
 {$ENDIF};
 
{%region%=====[ TBZBitmapBMPImage ]============================================}
 
Constructor TBZBitmapBMPImage.Create(AOwner: TPersistent; AWidth, AHeight: Integer);
Begin
  Inherited Create(AOwner, AWidth, AHeight);
  With DataFormatDesc Do
  Begin
    Name := 'BMP';
    Desc := 'Windows / OS2 Bitmap';  // , icone, curseur';
    FileMask := '*.bmp;*.dib;*.rle'; //*.ico;*.cur;
    Version := '';
    Encoding := etNone;
  End;
 
  SupportedColorFormat := SupportedColorFormat + [cfXRGB_1555, cfRGB_565, cfBGR_565, cfBGR, cfRGB, cfARGB, cfABGR, cfRGBA, cfBGRA];
  FInternalReadSize := 0;
End;
 
Destructor TBZBitmapBMPImage.Destroy;
Begin
  SupportedColorFormat := [];
  Inherited Destroy;
End;
 
Class Function TBZBitmapBMPImage.Capabilities: TBZDataFileCapabilities;
Begin
  Result := [dfcRead, dfcWrite]
End;
 
Function TBZBitmapBMPImage.getImagePropertiesAsString: String;
Var
  S: String;
Begin
  S := '';
  With DataFormatDesc Do
  Begin
    S := 'Format de fichier : ' + Name + #13 + #10; //+'('+Desc+')'+#13+#10;
  End;
  S := S + 'Version : ';
  Case FHeaderType Of
    bmpht_Os21x: S := S + 'OS2x Version 1';
    bmpht_WindowsV1: S := S + 'Windows Version 1';
    bmpht_WindowsV2: S := S + 'Windows Version 2';
    bmpht_WindowsV3: S := S + 'Windows Version 3';
    bmpht_Os22x: S := S + 'OS2x Version 2';
    bmpht_WindowsV4: S := S + 'Windows Version 4';
    bmpht_WindowsV5: S := S + 'Windows Version 5';
    Else
      S := S + 'Version Inconnue';
  End;
  S := S + #13 + #10 + 'Encodage : ';
  Case DataFormatDesc.Encoding Of
    etNone: S := S + 'Aucun';
    etRLE: S := S + 'RLE';
    etBitFields: S := S + 'BitFields';
    else S:='Non supporté';
  end;
{    BMP_COMPRESSION_JPEG: If FHeaderType = bmpht_Os22x Then
        S := S + 'RLE 24Bits'
      Else
        S := S + 'JPEG';
    BMP_COMPRESSION_PNG: S := S + 'PNG'; }
 
  Result := S;
End;
 
Function TBZBitmapBMPImage.GetHeaderWidth: Integer;
Begin
  Case FHeaderType Of
    bmpht_Os21x: Result := FInfoHeader.Os21x.biWidth;
    bmpht_WindowsV1: Result := FInfoHeader.WindowsV1.biWidth;
    bmpht_WindowsV2: Result := FInfoHeader.WindowsV2.biWidth;
    bmpht_WindowsV3: Result := FInfoHeader.WindowsV3.biWidth;
    bmpht_Os22x: Result := FInfoHeader.Os22x.biWidth;
    bmpht_WindowsV4: Result := FInfoHeader.WindowsV4.biWidth;
    bmpht_WindowsV5: Result := FInfoHeader.WindowsV5.biWidth;
    Else
      Result := 0;
  End;
  result:=abs(result); // La largeur ne peut pas être inversée comme la hauteur
End;
 
Function TBZBitmapBMPImage.GetHeaderHeight: Integer;
Begin
  Case FHeaderType Of
    bmpht_Os21x: Result := FInfoHeader.Os21x.biHeight;
    bmpht_WindowsV1: Result := FInfoHeader.WindowsV1.biHeight;
    bmpht_WindowsV2: Result := FInfoHeader.WindowsV2.biHeight;
    bmpht_WindowsV3: Result := FInfoHeader.WindowsV3.biHeight;
    bmpht_Os22x: Result := FInfoHeader.Os22x.biHeight;
    bmpht_WindowsV4: Result := FInfoHeader.WindowsV4.biHeight;
    bmpht_WindowsV5: Result := FInfoHeader.WindowsV5.biHeight;
    Else
      Result := 0;
  End;
End;
 
Function TBZBitmapBMPImage.GetHeaderBitCount: Word;
Begin
  Case FHeaderType Of
    bmpht_Os21x: Result := FInfoHeader.Os21x.biBitCount;
    bmpht_WindowsV1: Result := FInfoHeader.WindowsV1.biBitCount;
    bmpht_WindowsV2: Result := FInfoHeader.WindowsV2.biBitCount;
    bmpht_WindowsV3: Result := FInfoHeader.WindowsV3.biBitCount;
    bmpht_Os22x: Result := FInfoHeader.Os22x.biBitCount;
    bmpht_WindowsV4: Result := FInfoHeader.WindowsV4.biBitCount;
    bmpht_WindowsV5: Result := FInfoHeader.WindowsV5.biBitCount;
    Else
      Result := 0;
  End;
End;
 
Function TBZBitmapBMPImage.GetHeaderCompression: Longword;
Begin
  Case FHeaderType Of
    bmpht_WindowsV1: Result := FInfoHeader.WindowsV1.biCompression;
    bmpht_WindowsV2: Result := FInfoHeader.WindowsV2.biCompression;
    bmpht_WindowsV3: Result := FInfoHeader.WindowsV3.biCompression;
    bmpht_Os22x: Result := FInfoHeader.Os22x.biCompression;
    bmpht_WindowsV4: Result := FInfoHeader.WindowsV4.biCompression;
    bmpht_WindowsV5: Result := FInfoHeader.WindowsV5.biCompression;
    Else
      Result := 0;
  End;
End;
 
Function TBZBitmapBMPImage.GetHeaderUsedColors: Longword;
Begin
  Result:=0;
  Case FHeaderType Of
    {Pour detecter la présence d'une palette dans un fichier BMP OS2x.
     Au lieu de juste supposer la présence d'une palette, ou de se fier au
     parametre "biclrUsed" dans l'en-tête OS2x.
     Il faut mieux calculer le nombre de d'octets entre l'en-tête et les données
     puis diviser ce nombre par la taille d'un élément de la palette }
    bmpht_OS21x : Result := Round((FBMPFileHeader.bfOffBits - FInternalReadSize) / 3);
    bmpht_WindowsV1: Result := FInfoHeader.WindowsV1.biclrUsed;
    bmpht_WindowsV2: Result := FInfoHeader.WindowsV2.biclrUsed;
    bmpht_WindowsV3: Result := FInfoHeader.WindowsV3.biclrUsed;
    bmpht_Os22x: Result := Round((FBMPFileHeader.bfOffBits - FInternalReadSize) / 4);      //  Result := FInfoHeader.Os22x.biclrUsed;
    bmpht_WindowsV4: Result := FInfoHeader.WindowsV4.biclrUsed;
    bmpht_WindowsV5: Result := FInfoHeader.WindowsV5.biclrUsed;
    Else
      Result:=0;
  End;
  Result := abs(result);
End;
 
Function TBZBitmapBMPImage.GetHeaderRedMask: Longword;
Begin
  Result := 0;
  If FHeaderType >= bmpht_WindowsV2 Then
  Begin
    Case FHeaderType Of
      bmpht_WindowsV2: Result := (FInfoHeader.WindowsV2.biRedMask);
      bmpht_WindowsV3: Result := (FInfoHeader.WindowsV3.biRedMask);
      bmpht_WindowsV4: Result := (FInfoHeader.WindowsV4.biRedMask);
      bmpht_WindowsV5: Result := (FInfoHeader.WindowsV5.biRedMask);
    End;
  End;
End;
 
Function TBZBitmapBMPImage.GetHeaderGreenMask: Longword;
Begin
  Result := 0;
  If FHeaderType >= bmpht_WindowsV2 Then
  Begin
    Case FHeaderType Of
      bmpht_WindowsV2: Result := (FInfoHeader.WindowsV2.biGreenMask);
      bmpht_WindowsV3: Result := (FInfoHeader.WindowsV3.biGreenMask);
      bmpht_WindowsV4: Result := (FInfoHeader.WindowsV4.biGreenMask);
      bmpht_WindowsV5: Result := (FInfoHeader.WindowsV5.biGreenMask);
    End;
  End;
End;
 
Function TBZBitmapBMPImage.GetHeaderBlueMask: Longword;
Begin
  Result := 0;
  If FHeaderType >= bmpht_WindowsV2 Then
  Begin
    Case FHeaderType Of
      bmpht_WindowsV2: Result := (FInfoHeader.WindowsV2.biBlueMask);
      bmpht_WindowsV3: Result := (FInfoHeader.WindowsV3.biBlueMask);
      bmpht_WindowsV4: Result := (FInfoHeader.WindowsV4.biBlueMask);
      bmpht_WindowsV5: Result := (FInfoHeader.WindowsV5.biBlueMask);
    End;
  End;
End;
 
Function TBZBitmapBMPImage.GetHeaderAlphaMask: Longword;
Begin
  Result := 0;
  If FHeaderType >= bmpht_WindowsV3 Then
  Begin
    Case FHeaderType Of
      bmpht_WindowsV3: Result := (FInfoHeader.WindowsV3.biAlphaMask);
      bmpht_WindowsV4: Result := (FInfoHeader.WindowsV4.biAlphaMask);
      bmpht_WindowsV5: Result := (FInfoHeader.WindowsV5.biAlphaMask);
    End;
  End;
End;
 
Function TBZBitmapBMPImage.GetRowSize: Integer;
Begin
  // Alignement d'une LIGNE sur 4 octets
  Result := Round((GetHeaderBitCount * GetHeaderWidth + 31) shr 5) shl 2;
  //Result := ((getHeaderWidth * getHeaderBitCount + 31) and - 32) shr 3;
End;
 
Function TBZBitmapBMPImage.GetPadding: Integer;
Begin
  Result := 0;
  Case GetHeaderBitCount Of
    4: Result := GetRowSize - (getHeaderWidth shr 1);
    8: Result := GetRowSize - getHeaderWidth;
    16: Result := GetRowSize - (getHeaderWidth * 2);
    24:
    begin
      Result := GetRowSize - (getHeaderWidth * 3);
      //GlobalLogger.LogStatus('RowSize  :'+inttostr(GetRowSize));
      //GlobalLogger.LogStatus('Line Len :'+inttostr((getHeaderWidth * 3)));
      //GlobalLogger.LogStatus('Padding  :'+inttostr(GetRowSize- (getHeaderWidth * 3)));
    End;
  End;
  If Result > 3 Then
    Result := 0;
End;
 
Function TBZBitmapBMPImage.CheckFormat(): Boolean;
Var
  s : String;
  TmpBmpFileHeader :TBZBMPFileHeader;
Begin
  s := '';
  Result := False;
  Memory.Read(TmpBmpFileHeader{%H-}, SizeOf(TBZBMPFileHeader));
  //GlobalLogger.LogStatus('------------------- LOADING : '+FullFileName);
 
  // Fichier OS2.2 BGA (multi-image), on saute les 14 octets supplémentaires
  // Ici, on lit que la première image ( cf : http://fileformats.archiveteam.org/wiki/OS/2_Bitmap_Array )
  if (TmpBmpFileHeader.bfType = BMP_MAGIC_OS2BMP) then
  begin
    Memory.Seek(0,soBeginning);
    Memory.SeekForward(14);
    Memory.Read(TmpBmpFileHeader, SizeOf(TBZBMPFileHeader));
  End;
 
  With TmpBmpFileHeader Do
  Begin
    If (bfType = BMP_MAGIC_WINBMP)  or (bfType = BMP_MAGIC_OS21ICO) or
      (bfType = BMP_MAGIC_OS21CUR) or (bfType = BMP_MAGIC_OS22ICO) or (bfType = BMP_MAGIC_OS22CUR) Then
    Begin
      FHeaderSize := Memory.ReadLongWord;
      {$IFDEF FPC_BIG_ENDIAN}
        FHeaderSize := LEtoN(FHeaderSize);
        With  FBmpFileHeader do
        begin
          bfSize := LEToN(TmpBmpFileHeader.bfSize);
          bfReserved1 := LEToN(TmpBmpFileHeader.bfReserved1);
          bfReserved2 := LEToN(TmpBmpFileHeader.bfReserved2);
          bfOffBits := LEToN(TmpBmpFileHeader.bfOffBits);
        end;
      {$ELSE}
        FBmpFileHeader := TmpBmpFileHeader;
      {$ENDIF}
      Result := ReadImageProperties; // On Lit les propriétes de l'image
    End
    Else
    begin
      Result := False;
      s:= bfType[0] + bfType[1];
      RaiseInvalidImageHeader(Format(rsBadSignature,[s]));
    End;
  End;
End;
 
Function TBZBitmapBMPImage.ReadImageProperties: Boolean;
Var
  UsedColors : Integer;
  checkpalcount : Integer;
  checkSize : Int64;
Begin
  Result := True;
  // On lit le bon en-tête suivant sa taille.
  { NOTE : La structure With..Do est obligatoire ici pour assigner les paramètres.
    Sinon si sous la forme DataFormatDesc.Desc:='blablabla'; --> Error : Argument Cannot be assigned to }
  With DataFormatDesc do begin Desc:='Microsoft / OSx Bitmap' end;
  Case FHeaderSize Of
    12:
    Begin
      FHeaderType := bmpht_Os21x;
      Memory.Read(FInfoHeader.Os21x, 12);
      With DataFormatDesc do begin Version := 'OSx Bitmap 2.1'; end;
    End;
    40:
    Begin
      FHeaderType := bmpht_WindowsV1;
      Memory.Read(FInfoHeader.WindowsV1, 36);
      With DataFormatDesc do begin Version := 'Windows Bitmap 1.0'; end;
    End;
    52:
    Begin
      FHeaderType := bmpht_WindowsV2;
      Memory.Read(FInfoHeader.WindowsV2, 48);
      With DataFormatDesc do begin Version := 'Windows Bitmap 2.0'; end;
    End;
    56:
    Begin
      FHeaderType := bmpht_WindowsV3;
      Memory.Read(FInfoHeader.WindowsV3, 52);
      With DataFormatDesc do begin Version := 'Windows Bitmap 3.0'; end;
    End;
    64:
    Begin
      FHeaderType := bmpht_Os22x;
      Memory.Read(FInfoHeader.Os22x, 60);
      With DataFormatDesc do begin Version := 'OSx Bitmap 2.2'; end;
    End;
    108:
    Begin
      FHeaderType := bmpht_WindowsV4;
      Memory.Read(FInfoHeader.WindowsV4, 104);
      With DataFormatDesc do begin Version := 'Windows Bitmap 4.0'; end;
    End;
    124:
    Begin
      FHeaderType := bmpht_WindowsV5;
      Memory.Read(FInfoHeader.WindowsV5, 120);
      With DataFormatDesc do begin Version := 'Windows Bitmap 5.0'; end;
    End;
    Else
    begin
      Result:=false;
      RaiseInvalidImageHeader(Format(rsInvalidHeaderSize,[FHeaderSize]));
    end;
  End;
  // On verifie l'ID en cas de fichier OS22x Bitmap Array (BA)
  if FBmpFileHeader.bfType = BMP_MAGIC_OS2BMP then  With DataFormatDesc do begin Version := 'OSx Bitmap 2.2 BA'; end;
 
  //GlobalLogger.LogNotice('Version detected : '+DataFormatDesc.Version);
  // On calcul combien d'octets ont deja été lu dans le fichier (servira pour la calcul des "GapSize")
 
  //FInternalReadSize := 14 + FHeaderSize + 4;
  FInternalReadSize := Memory.Position;
  //GlobalLogger.LogNotice('InternalReadSize : '+inttostr(Memory.position));
 
  // On récupère les infos basiques
  bmpWidth := GetHeaderWidth;
  bmpHeight := GetHeaderHeight;
  ABitCount := GetHeaderBitCount;
  TopDown := (bmpHeight < 0);
  bmpHeight := abs(bmpHeight);
 
  (*GlobalLogger.LogStatus('Width  : '+Inttostr(bmpWidth));
  GlobalLogger.LogStatus('Height : '+Inttostr(bmpHeight));
  GlobalLogger.LogStatus('Bpp    : '+Inttostr(ABitCount));
  GlobalLogger.LogStatus('Bmp Size   : '+Inttostr(FBmpFileHeader.bfSize));
  GlobalLogger.LogStatus('Offset     : '+Inttostr(FBmpFileHeader.bfOffBits));
  GlobalLogger.LogStatus('File Size  : '+Inttostr(Memory.Size));*)
 
  // Vérification des dimensions
  checksize := (bmpWidth * BmpHeight) * 4;
  //{$ifdef cpu64}
  //If ((bmpWidth = 0) or (bmpHeight = 0)) or (checkSize>4096000000) Then // or ((bmpWidth > 32000) or (bmpHeight > 32000)) 
  //{$else}
   If ((bmpWidth = 0) or (bmpHeight = 0)) then //or (checkSize>2048000000) Then //or ((bmpWidth > 32000) or (bmpHeight > 32000)) //
  //{$endif}
  Begin
    Result := False;
    RaiseInvalidImageFile(Format(rsBadImageSize,[BmpWidth,BmpHeight]));
  End;
 
  // Taille du fichier incorrect, si le FBmpFileHeader.bfSize, ou FBmpFileHeader.bfOffBits est incorrect le chargement s'arrête ici. Donc pour la prise en charge de bmp mal encodé on continue
 (* if (FBmpFileHeader.bfSize>Memory.Size) or (((bmpWidth*bmpHeight)*(ABitCount div 8))>(Memory.Size-FBmpFileHeader.bfOffBits)) then
  Begin
     Result := False;
     RaiseInvalidImageFile('Taille du fichier invalide');
  End;  *)
 
  { On connait ou se trouve les données, on sait combien de données on a lu
    On peut donc déterminer le 1er "GapSize" c'est à dire l'espace perdu entre
    la palette de couleurs et les données.
    Le GapSize peut-être égal à 0.
    Cette espace perdu est présent surtout avec les en-tête Windows 1,4 et 5
    Si la compression est égale à BITFIELD si ce "GapSize" est égal à 12
    alors cet espace contient les masques RGBA donc BitCount = 24.
    Si égal à 16 alors cet espace contient les masques RGBA donc BitCount = 32.
    Si ce gapSize est egal à zero alors format par defaut BGRA. Et pour les version 4 et 5
    on doit utiliser les masques présents dans l'en-tête.
    La valeur de bfOffBits peut également être  "erronée", souvent de 4 octets (je n'arrive pas à comprendre pourquoi )
 
 
  If ((FInternalReadSize) > FBMPFileHeader.bfOffBits) Then
  Begin
   // Result := False;
    //RaiseInvalidImageFile('Erreur de lecture dans le fichier'+#13+#10+'InternalRead :'+Inttostr(FInternalReadSize)+#13+#10+
    //'OffBits : '+Inttostr(FBMPFileHeader.bfOffBits));
    //On se replace simplement
    //Memory.Seek(FBMPFileHeader.bfOffBits, soBeginning);
    //GapSize1 := 0;
  End
  Else
  Begin  
    GapSize1 := (FBMPFileHeader.bfOffBits) - (FInternalReadSize);
  End;
  //GlobalLogger.LogStatus('gapSize1 = ' + IntToStr(GapSize1)+' Cols 24 = ' + IntToStr(GapSize1 div 3));
  //GlobalLogger.LogStatus('gapSize1 = ' + IntToStr(GapSize1)+' Cols 32 = ' + IntToStr(GapSize1 div 4));
 
  // On fait un 1er test sur la valeur "Compression"
  Compression := GetHeaderCompression;
 
  If not (Compression in [BMP_COMPRESSION_NONE..BMP_COMPRESSION_ALPHABITF]) Then
  Begin
    Result := False;
    RaiseInvalidImageFile(rsCompressionMethodInvalid);
  End;
 
  // Compression Huffman 1D non supporté
  If (ABitCount = 1) and (Compression = BMP_COMPRESSION_HUF1D) Then
  Begin
    Result := False;
    RaiseInvalidImageFile(rsHUFFMAN1DCompressionNotSupported);
  End;
  { La compression PNG est uniquement supporté par Windows et  par les fonction StrechBits et
    pour l'affichage. cf : https://msdn.microsoft.com/en-us/library/dd145023(VS.85).aspx
  }
  If (Compression = BMP_COMPRESSION_PNG) Then
  Begin
    Result := False;
    RaiseInvalidImageFile(rsPNGCompressionNotSupported);
  End;
 
  { Idem que ci-dessus mais au format JPEG. Sauf si le fichier est de Type OS2 version en-tete 2.
    Dans ce cas la compression peut-être activer uniquement pour le format 24bits.
    L'algorithme utilisé sera alors le RLE 24bits
  }
  If not (FHeaderType = bmpht_Os22x) and (Compression = BMP_COMPRESSION_JPEG) Then
  Begin
    Result := False;
    RaiseInvalidImageFile(rsJPGCompressionNotSupported);
  End;
 
  Case Compression of
     BMP_COMPRESSION_NONE      : DataFormatDesc.Encoding := etNone;
     BMP_COMPRESSION_BITF,
     BMP_COMPRESSION_ALPHABITF : DataFormatDesc.Encoding := etBitFields;
     BMP_COMPRESSION_RLE4,
     BMP_COMPRESSION_RLE8      : DataFormatDesc.Encoding := etRLE;
 
     else DataFormatDesc.Encoding := etNotSupported;
  end;
 
  { On a récupéré nos informations, on met à jour le ImageDescription du TBZBitmap
     On charge la palette de couleur si besoins
     On initialise quelques variables utiles pour la lecture des données suivant
     le "PixelFormat"
   }
  With ImageDescription Do
  Begin
    //GlobalLogger.LogStatus('Read ABitCount = ' + IntToStr(ABitCount));
 
    InitDefault(bmpWidth, bmpHeight, ABitCount);
    //GlobalLogger.LogStatus('BPP == ' + IntToStr(BitsPerPixel));
 
    // Une palette existe ?
    UsedColors := GetHeaderUsedColors;
    //GlobalLogger.LogNotice('------> Used Color : '+inttostr(UsedColors));
    //GlobalLogger.LogStatus('GAPSIZE 1 = '+Inttostr(GapSize1));
    // Taile d'une ligne en octets avec Padding et suivant le format de pixel
    FRowSize := Compute_BytesPerLine(bmpWidth, AbitCount, bleDWordBoundary);
 
    Case ABitCount Of
      1:
      Begin
        PixelFormat := pf1Bit;
        ColorFormat := cfMono;
        UsedColors := GetHeaderUsedColors;
        //If (FHeaderType = bmpht_Os22x) or (FHeaderType = bmpht_Os21x) then
 
        // La description du nombre de couleur est fausse. Une palette est présente
        if ((GapSize1 > 0) and ((GapSize1 div 4)<=2) and (UsedColors = 0)) then UsedColors := 2;
 
        If (UsedColors > 0) Then
        begin
          PaletteCount := UsedColors;
          UsePalette := True;
        End;
      End;
      2:
      Begin
        PixelFormat := pf2Bits;
        UsePalette := True;
        PaletteCount := 4;
        //If (FHeaderType = bmpht_Os22x) or (FHeaderType = bmpht_Os21x) then
 
        // La description du nombre de couleur est fausse. Une palette est présente
        if ((GapSize1 > 0) and ((GapSize1 div 4)<=4) and (UsedColors = 0)) then UsedColors := (GapSize1 div 4);
        If (UsedColors >= 2) and (UsedColors <= PaletteCount) Then
        Begin
          PaletteCount := UsedColors;
        End
        Else If (UsedColors > PaletteCount) Then
        Begin
          //Raise exception.Create('Erreur : Trop de couleur dans la palette > 4');
          AddError(Format(rsTooManyColorInPalette,[UsedColors, PaletteCount]));
          Result := False;
        End;
      End;
      4:
      Begin
       // PixelFormat := pf4Bits;
        ColorFormat := cfBGRA;
        UsePalette := True;
        PaletteCount := 16;
        //If (FHeaderType = bmpht_Os22x) or (FHeaderType = bmpht_Os21x) then
 
        // La description du nombre de couleur est fausse. Une palette est présente
        if ((GapSize1 > 0) and ((GapSize1 div 4)<=16) and (UsedColors = 0)) then UsedColors := (GapSize1 div 4);
        if UsedColors>16 then PaletteCount:=16 else PaletteCount := UsedColors;
 
       (* CheckPalCount := GapSize1 div 3;
        If (UsedColors >= 2) and (UsedColors <= CheckPalCount) Then
        Begin
          PaletteCount := UsedColors;
        End else PaletteCount := CheckPalCount;
 
        If (UsedColors > CheckPalCount) Then
        Begin
          ShowMessage('Attention fichier invalide : '+#13+#10+
                      'Erreur dans la description du nombre de couleur dans la palette : '+InttoStr(UsedColors)+#13+#10+
                      'Au lieu de : '+InttoStr(CheckPalCount));
          // On tente de charger avec le bon nombre.
          PaletteCount := CheckPalCount;
        End;  *)
 
        If not (Compression = BMP_COMPRESSION_NONE) and not (Compression = BMP_COMPRESSION_RLE4) Then
        Begin
          Result := False;
          RaiseInvalidImageFile(rsCompressionMethodInvalid);
        End;
      End;
      8:
      Begin
       // PixelFormat := pf8Bits;
        ColorFormat := cfBGRA;
        UsePalette := True;
 
        { /!\ Normalement un fichier WINDOWS BMP VALIDE 8bits ne peut pas avoir une palette de plus de 256 couleurs.
        Cependant certain logiciels peuvent avoir avec des bugs dans leurs procedures d'enregistrement du format BMP.
        Et certain peuvent enregistré une palette des couleurs utilisées dans l'image (cf format 24 et 32 bits plus bas)
        De même certain fichier peuvent être invalide en indiquant un mauvais nombre de couleur dans la palette }
 
 
 
        If (FHeaderType = bmpht_Os22x) or (FHeaderType = bmpht_Os21x) then
        begin
          CheckPalCount := (GapSize1) div 3; // Div 3 --> Format OS2.x
          If (UsedColors = 0) then  PaletteCount := CheckPalCount
          else If (UsedColors > 0) then //and (UsedColors <= CheckPalCount) Then
          Begin
            PaletteCount := UsedColors;
          End;
          If (UsedColors > CheckPalCount) Then
          Begin
            // Erreur dans la description du nombre de couleur dans la palette
            AddError(Format(rsBMPBadHeaderPalcount,[UsedColors, CheckPalCount]));
            // On tente de charger avec le bon nombre.
            PaletteCount := CheckPalCount;
          End;
        End
        else
        Begin
          // La description du nombre de couleur est fausse. Une palette est présente
          if ((GapSize1 > 0) and ((GapSize1 div 4)<=256) and (UsedColors = 0)) then
          begin
            AddError(Format(rsBMPBadHeaderPalcount,[UsedColors,(GapSize1 div 4)]));
            UsedColors := (GapSize1 div 4);
          end;
          if UsedColors>256 then
          begin
            AddError(Format(rsBMPBadHeaderPalcount,[UsedColors,256]));
            PaletteCount:=256;
          End
          else PaletteCount := UsedColors;
        End;
 
        If not (Compression = BMP_COMPRESSION_NONE) and not (Compression = BMP_COMPRESSION_RLE8) Then
        Begin
          Result := False;
          RaiseInvalidImageFile(rsCompressionMethodInvalid);
        End;
      End;
      16:
      Begin
        If (UsedColors > 0) Then
        Begin
          //UsePalette := True;
          PaletteCount := UsedColors;
          // Le fichier contient une palette. On doit calculer la taille du GapSize1 en fonction du nombre de couleurs dans la palette
          // Au cas ou un champs de description pour les bitfields est présent
          if ((GapSize1 div 4) - UsedColors)>0 then GapSize1 := GapSize1 - (UsedColors*4);
        End;
 
        //PixelFormat := pf16Bits;
        If not (Compression = BMP_COMPRESSION_NONE) and not (Compression = BMP_COMPRESSION_BITF) Then
        Begin
          Result := False;
          RaiseInvalidImageFile(rsCompressionMethodInvalid);
        End;
        If (Compression = BMP_COMPRESSION_NONE) Then
        Begin
          With BitFields Do
          Begin
            //format XRGB 1555
            AlphaMask := $00008000;
            RedMask := $00007C00;
            GreenMask := $000003E0;
            BlueMask := $0000001F;
           {$ifdef ENDIAN_BIG}
            AlphaMask := LEtoN(AlphaMask);
            RedMask := LEtoN(RedMask);
            GreenMask := LEtoN(GreenMask);
            BlueMask := LEtoN(BlueMask);
           {$endif}
          End;
        End;
        If (Compression = BMP_COMPRESSION_BITF) Then
        Begin
          With BitFields Do
          Begin
            If (FHeaderType = bmpht_WindowsV1) or (FHeaderType = bmpht_WindowsV4) or (FHeaderType = bmpht_WindowsV5) Then
            Begin
              If GapSize1 = 12 Then
              Begin
                RedMask := (Memory.ReadLongWord);
                GreenMask := (Memory.ReadLongWord);
                BlueMask := (Memory.ReadLongWord);
              End
              Else If GapSize1 = 16 Then
              Begin
                RedMask := (Memory.ReadLongWord);
                GreenMask := (Memory.ReadLongWord);
                BlueMask := (Memory.ReadLongWord);
                AlphaMask := (Memory.ReadLongWord);
              End
              Else If GapSize1 = 0 Then
              Begin
                If (FHeaderType = bmpht_WindowsV4) or (FHeaderType = bmpht_WindowsV5) Then
                Begin
                  RedMask := GetHeaderRedMask;
                  GreenMask := GetHeaderGreenMask;
                  BlueMask := GetHeaderBlueMask;
                  AlphaMask := GetHeaderAlphaMask;
                End
                Else
                Begin
                  //AlphaMask := $0000;
                  RedMask := $00007C00;
                  GreenMask := $000003E0;
                  BlueMask := $0000001F;
                   {$ifdef ENDIAN_BIG}
                  AlphaMask := LEtoN(AlphaMask);
                  RedMask := LEtoN(RedMask);
                  GreenMask := LEtoN(GreenMask);
                  BlueMask := LEtoN(BlueMask);
                   {$endif}
                End;
              End;
            End
            Else
            Begin
              RedMask := GetHeaderRedMask;
              GreenMask := GetHeaderGreenMask;
              BlueMask := GetHeaderBlueMask;
              If (FHeaderType > bmpht_WindowsV2) Then
              Begin
                AlphaMask := GetHeaderAlphaMask;
              End;
            End;
          End;
        End;
        With BitFields Do
        Begin
          RedShift := GetMaskShift(RedMask);
          GreenShift := GetMaskShift(GreenMask);
          BlueShift := GetMaskShift(BlueMask);
          AlphaShift := GetMaskShift(AlphaMask);
 
          RedSize := GetMaskSize(RedMask, RedShift);
          GreenSize := GetMaskSize(GreenMask, GreenShift);
          BlueSize := GetMaskSize(BlueMask, BlueShift);
          AlphaSize := GetMaskSize(AlphaMask, AlphaShift);
 
          RedDeltaShift := GetMaskDeltaShift(RedSize);
          GreenDeltaShift := GetMaskDeltaShift(GreenSize);
          BlueDeltaShift := GetMaskDeltaShift(BlueSize);
          AlphaDeltaShift := GetMaskDeltaShift(AlphaSize);
          // Le Mask Alpha cache-t-il une autre composante de la couleur
          If (RedMask or GreenMask or BlueMask) and AlphaMask <> 0 Then
          Begin
            AlphaMask := 0;
            AlphaShift := 0;
            AlphaSize := 0;
          End;
        End;
      End;
      24:
      Begin
        PixelFormat := pf24Bits;
        ColorFormat := cfBGR;
 
        If (UsedColors > 0) Then
        Begin
        { On vérifie si une palette est présente. Normalement il n'y a pas de palette avec le format BMP 24 ou 32 bits.
          Cependant certains logiciels sauvegarde une palette pouvant servir de référence pour une réduction
          du nombre de couleur }
 
          //UsePalette := True;
          PaletteCount := UsedColors;
        End;
 
        If not (Compression = BMP_COMPRESSION_NONE) and not (Compression = BMP_COMPRESSION_BITF) Then
        Begin
          Result := False;
          // Avec la version de l'en-tête Os22x la compression JPEG correspond à une compression RLE (Uniquement pour les images 24Bits)
          If (FHeaderType = bmpht_Os22x) and (Compression = BMP_COMPRESSION_JPEG) Then Result := True;
          if Result=False then RaiseInvalidImageFile(rsCompressionMethodInvalid);
        End;
      End;
      32:
      Begin
        PixelFormat := pf32Bits;
        ColorFormat := cfBGRA;
 
        If (UsedColors > 0) Then
        Begin
          //UsePalette := True;
          PaletteCount := UsedColors;
          // Le fichier contient une palette. On doit calculer la taille du GapSize1 en fonction du nombre de couleurs dans la palette
          // Au cas ou un champs de description pour les bitfields est présent
          if ((GapSize1 div 4) - UsedColors)>0 then GapSize1 := GapSize1 - (UsedColors*4);
        End;
        If not (Compression = BMP_COMPRESSION_NONE) and not (Compression = BMP_COMPRESSION_BITF) Then
        Begin
          Result := False;
          RaiseInvalidImageFile(rsCompressionMethodInvalid);
        End;
 
        If (Compression = BMP_COMPRESSION_BITF) Then
        Begin
          With BitFields Do
          Begin
            If (FHeaderType = bmpht_WindowsV1) or (FHeaderType = bmpht_WindowsV4) or (FHeaderType = bmpht_WindowsV5) Then
            Begin
              If GapSize1 = 12 Then
              Begin
                Size := 12;
                RedMask := (Memory.ReadLongWord);
                GreenMask := (Memory.ReadLongWord);
                BlueMask := (Memory.ReadLongWord);
                AlphaMask := 0;
                AlphaShift := 0;
                AlphaSize := 0;
              End
              Else If GapSize1 = 16 Then
              Begin
                Size := 16;
                RedMask := (Memory.ReadLongWord);
                GreenMask := (Memory.ReadLongWord);
                BlueMask := (Memory.ReadLongWord);
                AlphaMask := (Memory.ReadLongWord);
              End
              Else If GapSize1 = 0 Then
              Begin
                If (FHeaderType = bmpht_WindowsV4) or (FHeaderType = bmpht_WindowsV5) Then
                Begin
                  Size := 16;
                  RedMask := GetHeaderRedMask;
                  GreenMask := GetHeaderGreenMask;
                  BlueMask := GetHeaderBlueMask;
                  AlphaMask := GetHeaderAlphaMask;
                End;
 
              End;
            End
            Else    // Version Windows 2 ou 3
            Begin
              Size := 12;
              RedMask := GetHeaderRedMask;
              GreenMask := GetHeaderGreenMask;
              BlueMask := GetHeaderBlueMask;
              AlphaSize := 0;
              AlphaMask := 0;
              If (FHeaderType > bmpht_WindowsV2) Then
              Begin
                Size := 16;
                AlphaMask := GetHeaderAlphaMask;
 
              End;
            End;
 
            RedShift := GetMaskShift(RedMask);
            GreenShift := GetMaskShift(GreenMask);
            BlueShift := GetMaskShift(BlueMask);
            AlphaShift := GetMaskShift(AlphaMask);
 
            RedSize := GetMaskSize(RedMask, RedShift);
            GreenSize := GetMaskSize(GreenMask, GreenShift);
            BlueSize := GetMaskSize(BlueMask, BlueShift);
            AlphaSize := GetMaskSize(AlphaMask, AlphaShift);
 
            If AlphaSize > 0 Then
            Begin
              // Le Mask Alpha cache-t-il une autre composante de la couleur
              If (RedMask or GreenMask or BlueMask) and AlphaMask <> 0 Then
              Begin
                AlphaMask := 0;
                AlphaShift := 0;
                AlphaSize := 0;
              End;
            End;
          End;
        End;
      End;
      else
      begin
        // Mauvais bitcount
         RaiseInvalidImageFile(Format(rsBitmapBitPerPixelNotSupported,[ABitCount]));
      End;
      // 64 : Notes les fichier DIB avec GDI+ peuvent avoir un bitcount de 64bits
    End;
 
    FLineEndGapSize := getPadding;
    If TopDown Then LineOrder := bloTopToBottom
    Else LineOrder := bloBottomToTop;
 (*   GlobalLogger.LogStatus('*Line Padding = ' + IntToStr(FLineEndGapSize));
    GlobalLogger.LogStatus('*BitCount = ' + IntToStr(ImageDescription.BitCount));
    With BitFields Do
    Begin
      GlobalLogger.LogStatus('Red Shift = ' + IntToStr(RedShift));
      GlobalLogger.LogStatus('Green Shift = ' + IntToStr(GreenShift));
      GlobalLogger.LogStatus('Blue Shift = ' + IntToStr(BlueShift));
      GlobalLogger.LogStatus('Alpha Shift = ' + IntToStr(AlphaShift));
 
      GlobalLogger.LogStatus('Red Size = ' + IntToStr(RedSize));
      GlobalLogger.LogStatus('Green Size = ' + IntToStr(GreenSize));
      GlobalLogger.LogStatus('Blue Size = ' + IntToStr(BlueSize));
      GlobalLogger.LogStatus('Alpha Size = ' + IntToStr(AlphaSize));
      GlobalLogger.LogStatus('BitFields Size = ' + IntToStr(Size));
    End; *)
 
  End;
End;
 
 
Procedure TBZBitmapBMPImage.LoadFromMemory();
Var
  YY, Y: Integer;
  X: Integer;
  DstColor, Color1, Color2: TBZColor;
  SrcPtrIdx : PByte;
  Idx:Byte;
  SrcPtr: PLongWord;
  SrcPtr16: PWord;
  SrcPtrRGB24: PBZColor24; //PBZColorBGR_24;
  DstLine: PBZColor;
  SrcColor: Longword;
  SrcColor16: Word;
  SrcColorRGB24: TBZColor24; // TBZColorBGR_24;
  LineBuffer: PByte;
  Done:Boolean;
  OpCode : TBZRLEOpCode;
  aCount, I, OpCodeSize : Integer;
  Data, Dx, Dy, low, hi : Byte;
  PaletteOS2x24, tmppal :PBZColorBGR_24;
  //PalCol : TBZColorBGR_24;
  //PalSize : Longint;
  Delta:Single;
  isOpaque : Boolean;
 
  procedure MakeOpaque;
  var
    i : Integer;
    PixPtr : PBZColor;
  begin
    i:=0;
    PixPtr := Self.GetScanLine(0);
    While i<Self.MaxSize do
    begin
      PixPtr^.Alpha:= 255;
      inc(PixPtr);
      inc(i);
    end;
  end;
 
Begin
  IsOpaque := True;
  FIgnoreAlpha := True;
  OpCode.Command:=0;
  OpCode.Count:=0;
  // On initialise les dimensions de notre bitmap
  SetSize(bmpWidth, bmpHeight);
  Clear(clrTransparent);
  InitProgress(bmpWidth,bmpHeight);
  StartProgressSection(0, ''); // On debute une nouvelle section globale
 
  Delta := 100 / Height;
  StartProgressSection(100 ,rsLoadingBitmapData);
 
  // Chargement de la palette si elle existe
  //GlobalLogger.LogNotice('Load palette : '+inttostr(ImageDescription.PaletteCount));
  if (ImageDescription.UsePalette) or (ImageDescription.PaletteCount>0) then  // and (ImageDescription.BitsPerPixel>8)
  begin
    If (FHeaderType = bmpht_OS21x)  then
    begin
      // On doit faire un saut en arriere de 4 octets. Pourquoi ????? je ne sais plus ;(
      // On pourrait également verifier avec FBMPInfoHeader.bfSize qui avec un format OSx indique
      // le debut de la palette et non pas la taille du fichier.
 
      Memory.SkipNextByte(-4);
      PaletteOs2x24:=nil;
      aCount := ImageDescription.PaletteCount-1;
      memReAlloc(PaletteOs2x24, ImageDescription.PaletteCount*3);
      Memory.Read(PaletteOs2x24^, ImageDescription.PaletteCount*3);
      tmppal:= PaletteOs2x24;
 
      Try
        For I:=0 to aCount do
        Begin
 
          //if ImageDescription.PixelFormat = pf4Bits then
          //begin
          //  With ImageDescription do
          //  begin
          //
          //    PaletteEntries^[I].Red:=tmppal^.Red;
          //    PaletteEntries^[I].Green:=tmppal^.Green;
          //    PaletteEntries^[I].Blue:=tmppal^.Blue;
          //    PaletteEntries^[I].Alpha:= 255;
          //  end;
          //End
          //else
          With ImageDescription do
          begin
            PaletteEntries^[I].Red:=tmppal^.Red;
            PaletteEntries^[I].Green:=tmppal^.Green;
            PaletteEntries^[I].Blue:=tmppal^.Blue;
            PaletteEntries^[I].Alpha:= 255;
          end;
          inc(tmppal);
        end;
      finally
        FreeMem(PaletteOs2x24);
        PaletteOs2x24:=nil
      end;
    End
    else
    begin
      //GlobalLogger.LogNotice('Palette Size : '+inttostr(ImageDescription.PaletteCount*4));
      Memory.Read(ImageDescription.PaletteEntries^, ImageDescription.PaletteCount*4);
      { les couleurs de la palette sont stockées au format BGR donc on Swap le canal Rouge et bleue
        Si c'est un fichier OS22 alors par défaut la valeur Alpha est à 0 (transparent).
        Il faut donc changer celle-ci par 255 (opaque) }
      if (FHeaderType = bmpht_OS22x) then
      begin
        For I:=0 to ImageDescription.PaletteCount-1 do
        Begin
          With ImageDescription do
          begin
            PaletteEntries^[I].Alpha:= 255;
            {$IFDEF LINUX}
            PaletteEntries^[I].AsInteger := PaletteEntries^[I].FastSwapRedBlue;
            {$ENDIF}
          end;
        end;
      end
      else
      begin
        {$IFDEF LINUX} // Sous Linux format couleur RGB on doit donc intervertir le Rouge et Blue
        For I:=0 to ImageDescription.PaletteCount-1 do
        Begin
          With ImageDescription do
          begin
           // PaletteEntries^[I].Alpha:= 255;
            PaletteEntries^[I].AsInteger := PaletteEntries^[I].FastSwapRedBlue;
            //GlobalLogger.LogStatus('Palette IDX : '+I.ToString+' : '+PaletteEntries^[I].ToString);
          end;
        end;
        {$ENDIF}
      End;
    End;
  End;
 
  Case ImageDescription.PixelFormat Of
    pf1bit:  // Compression Huffman1D possible. Utilisation palette possible, 2 couleurs
    Begin
      if (Memory.position<>FBMPFileHeader.bfOffBits) then Memory.Seek(FBMPFileHeader.bfOffBits,soBeginning);
 
      If (Compression = BMP_COMPRESSION_NONE) Then
      Begin
        Color1:=clrBlack;
        Color2:=clrWhite;
        if ImageDescription.PaletteCount>0 then
        begin
          Color1.AsInteger:= ImageDescription.PaletteEntries^[0].AsInteger;
          Color2.AsInteger:= ImageDescription.PaletteEntries^[1].AsInteger;
        end;
        LineBuffer := nil;
        memReAlloc(LineBuffer, FRowSize);
        Try
          Y:=0;
          Memory.Read(LineBuffer^, FRowSize);
          If TopDown Then  YY := Y Else YY := MaxHeight - Y;
          DstLine := GetPixelPtr(MaxWidth,YY);
          X:= Width;
          While (Y<Height) do
          begin
            // Blanc ou Noir ?
            //if ((PByte(SrcPtr+(X div 8))^ shr (7-(X and 7)) ) and 1)<>0 then Idx:=1 else Idx:=0;
            Idx := ExtractPixel1Bit(PByte(LineBuffer+(X div 8))^,X);
            if Idx <> 0 then  DstLine^:=Color2 else DstLine^:=Color1;
            FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
            Dec(X);
            Dec(DstLine);
 
            If X<=0 then
            begin
              Inc(Y);
              AdvanceProgress(Delta,0,1,False);
              Memory.Read(LineBuffer^, FRowSize);
              If TopDown Then  YY := Y Else YY := MaxHeight - Y;
              DstLine := GetPixelPtr(MaxWidth,YY);
              X:= Width;
            end;
          end;
        Finally
          FreeMem(LineBuffer);
          LineBuffer := nil;
        End;
      End;
     // Else If (Compression = BMP_COMPRESSION_BITF) Then // HUFFMAN1D
    End;
    pf2Bits :
    begin
      if (Memory.position<>FBMPFileHeader.bfOffBits) then Memory.Seek(FBMPFileHeader.bfOffBits,soBeginning);
 
      If (Compression = BMP_COMPRESSION_NONE) Then
      Begin
        LineBuffer := nil;
        memReAlloc(LineBuffer, FRowSize);
        Try
          Y:=0;
          Memory.Read(LineBuffer^, FRowSize);
          If TopDown Then  YY := Y Else YY := MaxHeight - Y;
          DstLine := GetPixelPtr(MaxWidth,YY);
          X:= Width;
          While (Y<Height) do
          begin
            Idx := ExtractPixel2Bits(PByte(LineBuffer+(X div 4))^,X);
 
            With Color1 do // on va chercher la couleur dans la palette
            Begin
              Red := ImageDescription.PaletteEntries^[Idx].Red;
              Green := ImageDescription.PaletteEntries^[Idx].Green;
              Blue := ImageDescription.PaletteEntries^[Idx].Blue;
              Alpha := ImageDescription.PaletteEntries^[Idx].Alpha;
            end;
            DstLine^:= Color1;
            FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
            Dec(X);
            Dec(DstLine);
 
            If X<=0 then
            begin
              Inc(Y);
              AdvanceProgress(Delta,0,1,False);
              Memory.Read(LineBuffer^, FRowSize);
              If TopDown Then  YY := Y Else YY := MaxHeight - Y;
              DstLine := GetPixelPtr(MaxWidth,YY);
              X:= Width;
            end;
          end;
        Finally
          FreeMem(LineBuffer);
          LineBuffer := nil;
        End;
      End;
    End;
    pf4bits: // Compression RLE possible Utilisation palette 16 couleurs
    Begin
      if (Memory.position<>FBMPFileHeader.bfOffBits) then Memory.Seek(FBMPFileHeader.bfOffBits,soBeginning);
      If (Compression = BMP_COMPRESSION_NONE) Then
      Begin
        LineBuffer := nil;
        memReAlloc(LineBuffer, FRowSize);
         Try
           Y := 0;
           Repeat
             Memory.Read(LineBuffer^, FRowSize);
             If TopDown Then  YY := Y Else YY := MaxHeight - Y;
             DstLine := GetPixelPtr(MaxWidth,YY);
             X:= MaxWidth;
             While (X>=0) Do
             Begin
               Idx := ExtractPixel4Bits(PByte(LineBuffer+(X shr 1))^,X);
               if (Idx<ImageDescription.PaletteCount) then
               begin
                 DstLine^.AsInteger:= ImageDescription.PaletteEntries^[Idx].AsInteger;
                 FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
               end;
              // else //GlobalLogger.LogWarning('Index : '+IntToStr(Idx)+' dans la pelette introuvable');
               Dec(DstLine);
               Dec(X);
             end;
             Inc(Y);
             AdvanceProgress(Delta,0,1,False);
           Until (Y > MaxHeight);
         Finally
           FreeMem(LineBuffer);
           LineBuffer := nil;
         End;
      End
      Else If (Compression = BMP_COMPRESSION_RLE4) Then
      Begin
        LineBuffer := nil;
        memReAlloc(LineBuffer, FRowSize);
        Y:=0;
        Try
          if TopDown Then  YY := Y Else YY := MaxHeight - Y;
          DstLine := GetScanLine(YY);
          X:=0;
          Done := False;
          OpCodeSize := sizeof(opcode);
          While not(Done) do
          begin
            aCount := Memory.Read(OpCode, OpCodeSize);
            if aCount <> OpCodeSize then
            begin
              RaiseInvalidImageFile(rsBMPRLE4BitDataCorrupted); //AddError
              //Continue;
            End;
            if aCount = OpCodeSize then
              if OpCode.Count = 0 then
              begin
                Case OpCode.Command of
                  0 : // Fin de ligne
                  begin
                    Inc(Y);
                    AdvanceProgress(Delta,0,1,False);
                    if TopDown Then  YY := Y Else YY := MaxHeight - Y;
                    DstLine := GetScanLine(YY);
                    X:=0;
                  end;
                  1 : Done := True; // Fin des données
                  2 :  // Déplacement
                  begin
                    Dx:= Memory.ReadByte;
                    Dy:= Memory.ReadByte;
                    Inc(X,Dx);
                    Dec(YY,Dy);
                    DstLine := GetPixelPtr(X,YY);
                  end;
                  else
                  begin
                    // OpCode.Command =  nombre de pixel
                    if (y > MaxHeight) or (X + OpCode.Command > Width) then
                    begin
                      AddError(rsBMPRLE4BitDataCorrupted); //RaiseInvalidImageFile();
                      //OpCode.Command := OpCode.Command - Width -(X + OpCode.Command);
                      Continue;
                    End;
                    Data:=0;
                    if (Y <= MaxHeight) or (X + OpCode.Command <= Width) then
                    for I := 0 to OpCode.Command - 1 do
                    begin
                      if (I and 1) = 0 then
                      begin
                        aCount := Memory.Read(Data,1);
                        if aCount <1 then
                        begin
                          RaiseInvalidImageFile(rsBMPRLE4BitInvalidInputBufferSize);
                          //continue;
                        End;
                        hi := (data and $F0) shr 4;
                        if (Hi<ImageDescription.PaletteCount) then
                        begin
                          DstLine^.AsInteger:= ImageDescription.PaletteEntries^[Hi].AsInteger;
                          FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
                        End;
                      end
                      else
                      begin
                        low := (data and $F);
                        if (Low<ImageDescription.PaletteCount) then
                        begin
                          DstLine^.AsInteger:= ImageDescription.PaletteEntries^[Low].AsInteger;
                          FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
                        End;
                      end;
                      Inc(X);
                      Inc(DstLine);
                    end;
                    // Un nombre impair d'octets est suivi d'un "padding" d'octet
                    if (byte(OpCode.command mod 4) in [1..2]) then
                    begin
                      aCount := Memory.Read(Data,1);
                      if aCount <1 then  RaiseInvalidImageFile(rsBMPRLE4BitInvalidInputBufferSize); // );
                    end;
                  end;
                end;
              end
              else
              begin
              if (y > MaxHeight) or (X + OpCode.Count > Width) then
              begin
                AddError(rsBMPRLE4BitDataCorrupted); //RaiseInvalidImageFile();
                //OpCode.Count := OpCode.Count - (Width -(X + OpCode.Count));
                Continue;
              End;
              if (y <= MaxHeight) or (X + OpCode.Count <= Width) then
              begin
                hi := (OpCode.Command and $F0) shr 4;
                low := (OpCode.Command and $F);
                for I := 0 to OpCode.Count - 1 do
                begin
                  if (I and 1) = 0 then
                  begin
                    if (Hi<ImageDescription.PaletteCount) then
                    begin
                      DstLine^.AsInteger:= ImageDescription.PaletteEntries^[Hi].AsInteger;
                      FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
                    End;
                  End
                  else
                  begin
                    if (low<ImageDescription.PaletteCount) then
                    begin
                      DstLine^.AsInteger:= ImageDescription.PaletteEntries^[Low].AsInteger;
                      FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
                    End;
                  End;
 
                  Inc(X);
                  Inc(DstLine);
                end;
              end;
            End;
          end;
        Finally
           FreeMem(LineBuffer);
           LineBuffer := nil;
         End;
      End;
    End;
    pf8Bits: // Compression RLE possible. Utilisation palette 256 couleurs
    Begin
      { Le GapSize existe ou est plus grand que la taille de la palette de couleurs
        On doit donc se repositionner sur le debut des données }
      if (Memory.position<>FBMPFileHeader.bfOffBits) then Memory.Seek(FBMPFileHeader.bfOffBits,soBeginning);
 
      If (Compression = BMP_COMPRESSION_NONE) Then
      Begin
         LineBuffer := nil;
         memReAlloc(LineBuffer, FRowSize);
         Try
           Y := 0;
           Repeat
             Memory.Read(LineBuffer^, FRowSize);
             If TopDown Then  YY := Y Else YY := MaxHeight - Y;
             DstLine := GetScanLine(YY);
             SrcPtrIdx:=PByte(LineBuffer);
             X:= Width;
             While (X>0) Do
             Begin
               Idx:=SrcPtrIdx^;
               if (Idx<ImageDescription.PaletteCount) then
               begin
                 DstLine^.AsInteger:= ImageDescription.PaletteEntries^[Idx].AsInteger;
                 FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
               end else AddError(Format(rsBitmapBadPaletteIndex,[Idx]));
               Inc(SrcPtrIdx);
               Inc(DstLine);
               Dec(X);
             end;
             Inc(Y);
             AdvanceProgress(Delta,0,1,False);
           Until (Y > MaxHeight);
         Finally
           FreeMem(LineBuffer);
           LineBuffer := nil;
         End;
      End
      Else If (Compression = BMP_COMPRESSION_RLE8) Then
      Begin
        LineBuffer := nil;
        memReAlloc(LineBuffer, FRowSize);
        Y:=0;
        Try
          if TopDown Then  YY := Y Else YY := MaxHeight - Y;
          DstLine := GetScanLine(YY);
          X:=0;
          Done := False;
          OpCodeSize := sizeof(opcode);
          While not(Done) do
          begin
            aCount := Memory.Read(OpCode, OpCodeSize);
            if acount<1 then
            begin
              Done := true;
              Continue;
            End;
            if aCount <> OpCodeSize then AddError(rsBMPRLE8BitInvalidInputBufferSize); //RaiseInvalidImageFile();
            if OpCode.Count = 0 then
            begin
              Case OpCode.Command of
                0 : // Fin de ligne
                begin
                  Inc(Y);
                  AdvanceProgress(Delta,0,1,False);
                  if TopDown Then  YY := Y Else YY := MaxHeight - Y;
                  DstLine := GetScanLine(YY);
                  X:=0;
                end;
                1 : Done := True; // Fin des données
                2 :  // Déplacement
                begin
                  Dx:= Memory.ReadByte;
                  Dy:= Memory.ReadByte;
                  Inc(X,Dx);
                  Dec(YY,Dy);
                  DstLine := GetPixelPtr(X,YY);
                end;
                else
                begin
                  if (Y > MaxHeight) or (X + OpCode.Command > Width) then
                  begin
                    AddError(rsBMPRLE8BitInvalidInputBufferSize);  //RaiseInvalidImageFile);
                    OpCode.Command :=OpCode.Command - (Width - (X + OpCode.Command));
                  end;
 
                  for I := 0 to OpCode.Command - 1 do
                  begin
                    aCount := Memory.Read(Data,1);
                    if aCount <1 then
                    Begin
                      AddError(rsBMPRLE8BitInvalidInputBufferSize); //RaiseInvalidImageFile);
                      Inc(X);
                      Inc(DstLine);
                      continue;
                    End
                    else
                    begin
                      if (Data<ImageDescription.PaletteCount) then
                      begin
                         if (X<Width) then
                         begin
                           DstLine^.AsInteger:= ImageDescription.PaletteEntries^[Data].AsInteger;
                           FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
                         End else AddError(rsBMPRLE8BitDataCorrupted);
                      End else AddError(rsBMPRLE8BitDataCorrupted);
                      Inc(X);
                      Inc(DstLine);
                    End;
                  end;
                  // An odd number of bytes is followed by a pad byte.
                  if ((OpCode.command mod 2) = 1) then
                  begin
                    aCount := Memory.Read(Data,1);
                    if aCount <1 then
                    begin
                      //RaiseInvalidImageFile(rsBMPRLE8BitInvalidInputBufferSize);
                      AddError(rsBMPRLE8BitInvalidInputBufferSize);//
                      //Memory.SeekBackward(1);
                    End;
                  end;
                end;
              end;
            end
            else
            begin
              if (y > MaxHeight) or (X + OpCode.Count > Width) then
              begin
                AddError(rsBMPRLE8BitDataCorrupted); //RaiseInvalidImageFile();
                OpCode.Count := Width;
              End;
              for I := 0 to OpCode.Count - 1 do
              begin
                if (OpCode.Command<ImageDescription.PaletteCount) then
                begin
                  if (X<Width) then
                  begin
                    DstLine^.AsInteger:= ImageDescription.PaletteEntries^[OpCode.Command].AsInteger;
                    FIgnoreAlpha := FIgnoreAlpha and (DstLine^.alpha = 0);
                  End else AddError(rsBMPRLE8BitDataCorrupted);
                End else AddError(rsBMPRLE8BitDataCorrupted);
                Inc(X);
                Inc(DstLine);
              end;
            end;
          end;
        Finally
           FreeMem(LineBuffer);
           LineBuffer := nil;
         End;
      End;
    End;
    pf16Bits: // Pas de compression, formats couleurs suivant "BitField" XRGB_1555, ARGB_4444, RGB/BGR_565
    Begin
      if (Memory.position<>FBMPFileHeader.bfOffBits) then Memory.Seek(FBMPFileHeader.bfOffBits,soBeginning);
      LineBuffer := nil;
      memReAlloc(LineBuffer, FRowSize);
      Try
        Y := 0;
        Repeat
          Memory.Read(LineBuffer^, FRowSize);
          If TopDown Then YY := Y Else YY := MaxHeight - Y;
          DstLine := GetScanLine(YY);
          SrcPtr16 := PWord(LineBuffer);
          For X := 0 To MaxWidth Do
          Begin
            SrcColor16 := PWord(SrcPtr16+X)^;
            DstColor := ConvertBitFieldsToBZColor(ImageDescription.BitFields, SrcColor16);
            FIgnoreAlpha := FIgnoreAlpha and (DstColor.alpha = 0);
            IsOpaque := IsOpaque and (DstColor.alpha = 255);
            //DstColor.Alpha := 255;
            DstLine^ := DstColor;
            Inc(DstLine);
          End;
          Inc(Y);
          AdvanceProgress(Delta,0,1,False);
        Until (Y > MaxHeight);
      finally
        FreeMem(LineBuffer);
        LineBuffer := nil;
      end;
    End;
    pf24Bits: // Pas de compression sauf si en-tête OS2x V2 alors compresion RLE. Formats couleurs suivant "BitField" sinon BGR
    Begin
      If (FHeaderType = bmpht_OS21x) or (FHeaderType = bmpht_OS22x) Then
      Begin
        if (FHeaderType = bmpht_OS21x) then  // --> Lecture Format BGR
        begin
          if (Memory.position<>FBMPFileHeader.bfOffBits) then Memory.Seek(FBMPFileHeader.bfOffBits,soBeginning);
          LineBuffer := nil;
          GetMem(LineBuffer, FRowSize);
          Try
            Y := 0;
            Repeat
              Memory.Read(LineBuffer^, FRowSize);
              If TopDown Then  YY := Y Else YY := MaxHeight - Y;
              DstLine := GetScanLine(YY);
              SrcPtrRGB24 := PBZColor24(LineBuffer);  //a Remplacer par --> PBZColorBGR_24  ???
              X:= Width;
              While (X>0) Do
              Begin
                SrcColorRGB24 := SrcPtrRGB24^;  // ! \ Les données sont au format BGR et pas RGB
                {$IFDEF WINDOWS} // BGRA
                DstColor.Blue := SrcColorRGB24.Red;
                DstColor.Green := SrcColorRGB24.Green;
                DstColor.Red :=  SrcColorRGB24.Blue;
                {$ELSE}
                DstColor.Red :=  SrcColorRGB24.Red;
                DstColor.Green := SrcColorRGB24.Green;
                DstColor.Blue := SrcColorRGB24.Blue;
                {$ENDIF}
                DstColor.Alpha := 255;
                DstLine^ := DstColor;
                Inc(SrcPtrRGB24);
                Inc(DstLine);
                Dec(X);
              End;
              Inc(Y);
              AdvanceProgress(Delta,0,1,False);
            Until (Y > MaxHeight);
          Finally
            FreeMem(LineBuffer);
            LineBuffer := nil;
          End;
        end
        else if (FHeaderType = bmpht_OS22x) then
        begin
          if ImageDescription.PaletteCount > 0 then Memory.Read(ImageDescription.PaletteEntries^, ImageDescription.PaletteCount*4);
          if (Compression = BMP_COMPRESSION_JPEG) then
          begin
          // Compression RLE 24 bits
          end
          else
          begin  // --> Lecture format BGR
            //GlobalLogger.LogNotice('Taille du Stream : ' + Memory.Size.ToString);
            //GlobalLogger.LogNotice('Taille d''une ligne : ' + FRowSize.ToString);
            LineBuffer := nil;
            GetMem(LineBuffer, FRowSize);
            Try
              Y := 0;
              Repeat
                With GlobalLogger do
                begin
                  LogNotice('Y = '+Y.ToString());
                  LogNotice('Adresse_Y = '+ Inttostr(Y * (Width * 4)));
                  LogNotice('Postion Memory Before Read : ' + Memory.Position.ToString);
                End;
                Memory.Read(LineBuffer^, FRowSize);
                //GlobalLogger.LogNotice('Postion Memory After Read : ' + Memory.Position.ToString);
                If TopDown Then  YY := Y Else YY := MaxHeight - Y;
                DstLine := GetScanLine(YY);
                SrcPtrRGB24 := PBZColor24(LineBuffer);
                X:= 0;
                While (X<=MaxWidth) Do
                Begin
                  SrcColorRGB24 := SrcPtrRGB24^;
                  {$IFDEF WINDOWS} // BGRA
                  DstColor.Blue := SrcColorRGB24.Red;
                  DstColor.Green := SrcColorRGB24.Green;
                  DstColor.Red :=  SrcColorRGB24.Blue;
                  {$ELSE}
                  DstColor.Red :=  SrcColorRGB24.Blue;
                  DstColor.Green := SrcColorRGB24.Green;
                  DstColor.Blue := SrcColorRGB24.Red;
                  {$ENDIF}
                  DstColor.Alpha := 255;
                  DstLine^ := DstColor;
 
                  Inc(SrcPtrRGB24);
                  Inc(DstLine);
                  Inc(X);
                End;
 
                Inc(Y);
 
                AdvanceProgress(Delta,0,1,False);
              Until (Y > MaxHeight);
            Finally
              FreeMem(LineBuffer);
              LineBuffer := nil;
            End;
          end;
        end;
      End
      Else
      Begin // --> Formats, Windows - Lecture Format BGR
        if (Memory.position<>FBMPFileHeader.bfOffBits) then Memory.Seek(FBMPFileHeader.bfOffBits,soBeginning);
        LineBuffer := nil;
        GetMem(LineBuffer, FRowSize);
        Try
          Y := 0;
          Repeat
            Memory.Read(LineBuffer^, FRowSize);
            If TopDown Then  YY := Y Else YY := MaxHeight - Y;
            DstLine := GetScanLine(YY);
            SrcPtrRGB24 := PBZColor24(LineBuffer);
            X:= 0;
            While (X<=MaxWidth) Do
            Begin
              SrcColorRGB24 := SrcPtrRGB24^;
              {$IFDEF WINDOWS} // BGRA
              DstColor.Blue := SrcColorRGB24.Red;
              DstColor.Green := SrcColorRGB24.Green;
              DstColor.Red :=  SrcColorRGB24.Blue;
              {$ELSE}
              DstColor.Blue:=  SrcColorRGB24.Red;
              DstColor.Green := SrcColorRGB24.Green;
              DstColor.Red := SrcColorRGB24.Blue;
              {$ENDIF}
              DstColor.Alpha := 255;
              DstLine^ := DstColor;
              Inc(SrcPtrRGB24);
              Inc(DstLine);
              Inc(X);
            End;
            Inc(Y);
            AdvanceProgress(Delta,0,1,False);
          Until (Y > MaxHeight);
        Finally
          FreeMem(LineBuffer);
          LineBuffer := nil;
        End;
      End;
    End;
    pf32Bits:  // Pas de compression, formats couleurs suivant "BitField" sinon format couleur par defaut BGRA
    Begin
      //GlobalLogger.LogNotice('Taille du Stream : ' + Memory.Size.ToString);
      //GlobalLogger.LogNotice('Taille d''une ligne : ' + FRowSize.ToString);
      LineBuffer := nil;
      GetMem(LineBuffer, FRowSize);
      Try
        Y := 0;
        //DstColor.Alpha:= 255;
        Repeat
          //With GlobalLogger do
          //begin
          //  LogNotice('Y = '+Y.ToString());
          //  LogNotice('Adresse_Y = '+ Inttostr(Y * (Width * 4)));
          //  LogNotice('Postion Memory Before Read : ' + Memory.Position.ToString);
          //End;
          Memory.Read(LineBuffer^, FRowSize);
          //GlobalLogger.LogNotice('Postion Memory After Read : ' + Memory.Position.ToString);
          If TopDown Then  YY := Y Else YY := MaxHeight - Y;
          DstLine := GetScanLine(YY);
          SrcPtr := PLongWord(LineBuffer);
          X:= Width;
          //GlobalLogger.LogNotice('Adresse_Dernier_pixel_ligne = '+ Inttostr(((Y * (Width * 4)) + (X-1)*4)));
          While (X>0) Do
          Begin
            SrcColor := SrcPtr^;
            DstColor := ConvertBitFieldsToBZColor(ImageDescription.BitFields, SrcColor);
            FIgnoreAlpha := FIgnoreAlpha and (DstColor.alpha = 0);
            IsOpaque := IsOpaque and (DstColor.alpha = 255);
            DstLine^ := DstColor;
            Inc(SrcPtr);
            Inc(DstLine);
            Dec(X);
          End;
 
          Inc(Y);
          AdvanceProgress(Delta,0,1,False);
        Until (Y > MaxHeight);
      Finally
        FreeMem(LineBuffer);
        LineBuffer := nil;
      End;
    End;
  End;
 
 
 
  // Dans le cas ou tous les pixels sont transparent
  If FIgnoreAlpha Then
  Begin
    //GlobalLogger.LogNotice('IgnoreAlpha');
    MakeOpaque;
    if (ImageDescription.PixelFormat = pf32bits) then
    begin
      if ((ImageDescription.BitFields.AlphaSize=0) and (ImageDescription.BitFields.Size=16)) then ImageDescription.ColorFormat := cfXBGR;
    End
    else  ImageDescription.ColorFormat := cfBGR;
 
    ImageDescription.HasAlpha := False;
  End
  else
  begin
    if ImageDescription.PixelFormat = pf32bits then
      if ((ImageDescription.BitFields.AlphaSize=0) and (ImageDescription.BitFields.Size=16)) then
      begin
        ImageDescription.ColorFormat := cfXBGR;
      End;
 
    if IsOpaque then ImageDescription.HasAlpha := False
    else ImageDescription.HasAlpha := True;
  End;
 
  FinishProgressSection(False);
  FinishProgressSection(True);
End;
 
function TBZBitmapBMPImage.ComputePaletteOrMaskSize : Integer;
begin
  Result := 0;
  if UsePalette and (ABitCount <= 8) then
  begin
    Result := ColorManager.ColorCount;
    if Result = 0 then Result := 1 shl ABitCount;
  end
  else
  begin
    Case AbitCount of
      15,16 : result := 3;  //GapSize1
      32 : if DataFormatDesc.Encoding = etBitfields then result := 4 else result:=0;
    End;
  End;
  Result := Result * 4;
End;
 
function TBZBitmapBMPImage.ComputeCompressionType : LongWord;
begin
  //BMP_COMPRESSION_HUF1D
  //BMP_COMPRESSION_JPEG
  //BMP_COMPRESSION_PNG
  //BMP_COMPRESSION_ALPHABITF
  Result  := BMP_COMPRESSION_NONE;
  if (ABitCount = 16) then Result  := BMP_COMPRESSION_BITF;
  Case DataFormatDesc.Encoding of
    etBitFields : if (ABitCount = 16) or (ABitCount>=32) then Result:=BMP_COMPRESSION_BITF;
    etRLE :
    begin
      Case ABitCount of
        4 : Result := BMP_COMPRESSION_RLE4;
        8 : Result := BMP_COMPRESSION_RLE8;
      end;
    End;
  end;
End;
 
function TBZBitmapBMPImage.getInfoHeaderSize(aVersion : TBZBMPHeaderType): Integer;
begin
  Result := 0;
  Case aVersion of
    bmpht_WindowsV1 : Result:= 36;
    bmpht_WindowsV4 : Result:= 108;
    bmpht_WindowsV5 : Result:= 124;
  End;
End;
 
procedure TBZBitmapBMPImage.InitBitFieldMasks;
begin
  RedMask   := $00000000;
  GreenMask := $00000000;
  BlueMask  := $00000000;
  AlphaMask := $00000000;
  if ABitCount >8 then
  begin
    Case ABitCount of
      15:
      begin
        //format XRGB 1555
        AlphaMask := $00008000;
        RedMask   := $00007C00;
        GreenMask := $000003E0;
        BlueMask  := $0000001F;
        ABitCount := 16;
      End;
      16:
      begin
        // format RGB 565
        RedMask   := $00007C00;
        GreenMask := $000003E0;
        BlueMask  := $0000001F;
        AlphaMask := $00000000;
      End;
      24: //BGR
      begin
        RedMask   := $00FF0000;
        GreenMask := $0000FF00;
        BlueMask  := $000000FF;
        AlphaMask := $00000000;
      End;
      32: //BGRA
      begin
        RedMask   := $00FF0000;
        GreenMask := $0000FF00;
        BlueMask  := $000000FF;
        AlphaMask := $FF000000;
      End;
      //64;
    End;
  End;
End;
 
procedure TBZBitmapBMPImage.InitSaving(aVersion : TBZBMPHeaderType);
var
  id:string;
begin
  // On initialise quelques variables et paramètres
  With ImageDescription do
  begin
    RowStrideType := bleDWordBoundary; //Alignement des lignes sur 32bits
    bmpWidth := Width;
    bmpHeight := Height;
    ABitCount := BitsPerPixel;
     //GlobalLogger.LogStatus('BitsPerPixel    : '+Inttostr(BitsPerPixel));
  End;
  //GlobalLogger.LogStatus('Width  : '+Inttostr(bmpWidth));
  //GlobalLogger.LogStatus('Height : '+Inttostr(bmpHeight));
  //GlobalLogger.LogStatus('Bpp    : '+Inttostr(ABitCount));
 
 // id:='MB';
  FBmpFileHeader.bfType:=BMP_MAGIC_WINBMP;
 
  If DataFormatDesc.Encoding = etRLE then
  begin
    FNeedAdjustBFH:=True;
    FBmpFileHeader.bfSize := 14 + 4+ getInfoHeaderSize(aVersion) + ComputePaletteOrMaskSize;      //Ce paramètre est à recalculer un peu plus tard si compression RLE
  End
  Else FBmpFileHeader.bfSize := 14 + 4+ getInfoHeaderSize(aVersion) + ComputePaletteOrMaskSize + ((bmpWidth*bmpHeight)*ImageDescription.PixelSize);
 
  With FBmpFileHeader do
  begin
    bfReserved1:=0;
    bfReserved2:=0;
    bfOffBits:= 14 + 4+getInfoHeaderSize(aVersion)+ComputePaletteOrMaskSize; //sizeof(TBZBmpFileHeader)
  End;
End;
 
Function TBZBitmapBMPImage.CreateInfoHeader(aVersion : TBZBMPHeaderType):TBZBitmapBMPInfoHeader;
begin
  Case aVersion of
    bmpht_unknown : raise EBZSaveImageException.Create('Erreur lors de la sauvegarde de l''image BMP : En-tête inconnue');
    bmpht_Os21x, bmpht_Os22x : raise EBZSaveImageException.Create('Erreur lors de la sauvegarde de l''image BMP : '+#13+#10+
                                                                   ' Type Os21x et Os22x non supportés');
    bmpht_WindowsV2, bmpht_WindowsV3 : EBZSaveImageException.Create('Erreur lors de la sauvegarde de l''image BMP : '+#13+#10+
                                                                       ' Type Windows Version 2 et 3 non supportés');
    bmpht_WindowsV1 :
    Begin
      With Result.WindowsV1 Do
      begin
        biWidth           := bmpWidth;
        biHeight          := bmpHeight;
        biPlanes          := 1;
        if ABitCount = 15 then biBitCount:=16 else   biBitCount:= ABitCount;
        biCompression     := ComputeCompressionType;
        biSizeImage:=(bmpWidth*bmpHeight)*(ABitCount Div 8);
        biXPixelsPerMeter:=100;
        biYPixelsPerMeter:=100;
        if ABitCount<=8 then biClrUsed:=ComputePaletteOrMAskSize else biClrUsed:=0;
        biClrImportant:=0;
      End;
    End;
    bmpht_WindowsV4 :
    Begin
      With Result.WindowsV4 Do
      begin
        biWidth           := bmpWidth;
        biHeight          := bmpHeight;
        biPlanes          := 1;
        biBitCount        := ABitCount;
 
        biCompression     := ComputeCompressionType;
        //biSizeImage:=0;          //Ce paramètre est calculer un peu plus tard
        biXPixelsPerMeter:=100;
        biYPixelsPerMeter:=100;
        if ABitCount<=8 then biClrUsed:=ComputePaletteOrMaskSize else biClrUsed:=0;
        biClrImportant:=0;
 
       (* biRedMask: Longword;             //< Masque Couleur Rouge
        biGreenMask: Longword;           //< Masque Couleur Vert
        biBlueMask: Longword;            //< Masque Couleur Bleu
        biAlphaMask: Longword;           //< Masque Couleur Alpha
 
        biCSType: Longword;              //< Type de l'espace de couleur CIE
        biEndpoints: TBZBMP_CIEXYZCoordTriple; //< "Color space endpoints"
 
        biGammaRed: Longword;            //< Correction Gamma Rouge
        biGammaGreen: Longword;          //< Correction Gamma Vert
        biGammaBlue: Longword;           //< Correction Gamma Bleu  *)
      End;
    End;
    bmpht_WindowsV5 :
    begin
      With Result.WindowsV5 Do
      begin
        biWidth           := bmpWidth;
        biHeight          := bmpHeight;
        biPlanes          := 1;
        biBitCount        := ABitCount;
 
        biCompression     := ComputeCompressionType;
        //biSizeImage:=0;          //Ce paramètre est calculer un peu plus tard
        biXPixelsPerMeter:=100;
        biYPixelsPerMeter:=100;
        if ABitCount<=8 then biClrUsed:=ComputePaletteOrMaskSize else biClrUsed:=0;
        biClrImportant:=0;
 
       (* biRedMask: Longword;             //< Masque Couleur Rouge
        biGreenMask: Longword;           //< Masque Couleur Vert
        biBlueMask: Longword;            //< Masque Couleur Bleu
        biAlphaMask: Longword;           //< Masque Couleur Alpha
 
        biCSType: Longword;              //< Type de l'espace de couleur CIE
        biEndpoints: TBZBMP_CIEXYZCoordTriple; //< "Color space endpoints"
 
        biGammaRed: Longword;            //< Correction Gamma Rouge
        biGammaGreen: Longword;          //< Correction Gamma Vert
        biGammaBlue: Longword;           //< Correction Gamma Bleu
 
        biIntent: Longword;              //< "rendering intent"
 
        biProfileData: Longword;         //< Position des données du profile de couleur
        biProfileSize: Longword;         //< Taille des données du profile de couleur
 
        biReserved: Longword;            //< Réservé *)
      End;
    End;
  end;
end;
 
procedure TBZBitmapBMPImage.SaveHeader;
var
  BIH : TBZBitmapBMPInfoHeader;
begin
  if not(DataFormatDesc.VersionAsInteger in [1,4,5]) then DataFormatDesc.VersionAsInteger:=1;
 
  Case DataFormatDesc.VersionAsInteger of
    1 :
    begin
      InitSaving(bmpht_WindowsV1);
      InitBitFieldMasks;
      BIH := CreateInfoHeader(bmpht_WindowsV1);
      //ShowMessage('ID = '+FBmpFileHeader.bfType);
      Memory.Write(FBmpFileHeader,14);
      FHeaderSize := 40;
      Memory.WriteLongWord(FHeaderSize);
      Memory.Write(BIH.WindowsV1,36);
      if (ABitCount>8) and (BIH.WindowsV1.biCompression = BMP_COMPRESSION_BITF) then
      begin
        Case ABitCOunt of
          15:
          begin
            With Memory do
            begin
              WriteLongWord(RedMask);
              WriteLongWord(GreenMask);
              WriteLongWord(BlueMask);
              WriteLongWord(AlphaMask);
            End;
          End;
          16:
          begin
            With Memory do
            begin
              WriteLongWord(RedMask);
              WriteLongWord(GreenMask);
              WriteLongWord(BlueMask);
            End;
          End;
          32:
          begin
            With Memory do
            begin
              WriteLongWord(RedMask);
              WriteLongWord(GreenMask);
              WriteLongWord(BlueMask);
              WriteLongWord(AlphaMask);
            End;
          End;
          //64;
        End;
      End;
    End;
    4 :
    begin
      InitSaving(bmpht_WindowsV4);
      InitBitFieldMasks;
      BIH := CreateInfoHeader(bmpht_WindowsV4);
      Memory.Write(FBmpFileHeader,14);
      Memory.WriteLongWord(FHeaderSize);
      Memory.Write(BIH.WindowsV4,108);
    End;
    5 :
    begin
      InitSaving(bmpht_WindowsV4);
      InitBitFieldMasks;
      BIH := CreateInfoHeader(bmpht_WindowsV4);
      Memory.Write(FBmpFileHeader,14);
      Memory.WriteLongWord(FHeaderSize);
      Memory.Write(BIH.WindowsV5,124);
    End;
  End;
End;
 
procedure TBZBitmapBMPImage.SavePalette;
begin
  if ImageDescription.UsePalette then
  begin
    if (ABitCount<=8) then
    begin
 
    End
    else
    begin
 
    End;
  End;
End;
 
procedure TBZBitmapBMPImage.SaveImageData;
var
  i,x,y : Integer;
  AColor : TBZColor;
  ColorBGR24 : TBZColorBGR_24;
  ColorBGRA32 : TBZColor;
begin
  Case ABitCount of
    1:
    begin
 
    End;
    2:
    begin
 
    End;
    4:
    begin
 
    End;
    8:
    begin
 
    End;
    15 :
    begin
 
    End;
    24 :
    begin
      For y:=MaxHeight downto 0 do
      begin
        For X:=0 to MaxWidth do
        begin
          AColor := GetPixel(X,Y);
          //Format BGR
          //ColorBGR24 :=AColor.SwapRBChannels.; SwapChannels(scmToBGR). .AsVector3b; //BZColorToBGR24(AColor);
          ColorBGR24.Blue := AColor.Blue;
          ColorBGR24.Green := AColor.Green;
          ColorBGR24.Red := AColor.Red;
          Memory.Write(ColorBGR24,3);
          //if ImageDescription.RowStrideLength>0 then  // padding de fin de ligne
          //for i:=1 to ImageDescription.RowStrideLength do Memory.WriteByte(0);
        End;
      End;
    End;
    32 :
    begin
      For y:=MaxHeight downto 0 do
      begin
        For X:=0 to MaxHeight do
        begin
          AColor := GetPixel(X,Y);
          //Format BGRA
          ColorBGRA32.Red := AColor.Blue;
          ColorBGRA32.Green := AColor.Green;
          ColorBGRA32.Blue := AColor.Red;
          ColorBGRA32.Alpha := AColor.Alpha;
          Memory.Write(ColorBGRA32,4);
        End;
      End;
    End;
    // 64 :
  End;
End;
 
Procedure TBZBitmapBMPImage.SaveToMemory();
begin
  SaveHeader;
  if ImageDescription.UsePalette then SavePalette;
  SaveImageData;
 
End;
 
{%endregion%}
 
Initialization
 
  RegisterRasterFormat('bmp', 'Windows OS2 Bitmap', TBZBitmapBMPImage);
  RegisterRasterFormat('dib', 'Windows DIB Bitmap', TBZBitmapBMPImage);
  //RegisterRasterFormat('ico', 'Windows OS2 Icon', TBZBitmapBMPImage);
  //RegisterRasterFormat('cur', 'Windows OS2 Cursor', TBZBitmapBMPImage);
  RegisterRasterFormat('rle', 'Windows OS2 Bitmap', TBZBitmapBMPImage);
 
Finalization
  UnregisterRasterFormat(TBZBitmapBMPImage);
End.

Juste par la différences de taille entre le code de FPC/Lazarus (FPReaderBMP, et TLazReaderDIB) et celui-ci y'a pas photo et on comprend vite pourquoi certaines spécifications du format BMP ne sont pas ou mal prises en compte

[EDIT]

Je te rajoutes ces quelques fonctions relatives au bitfields entre autres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Type
  { TGLZBitFields : Masques et décalage des bits pour extraire les composantes couleur.}
  TBZColorBitFields = packed record
    Size : Byte; //12 = 16/24bits, 16=32bits
    RedMask, GreenMask, BlueMask, AlphaMask : LongWord;
    RedShift, GreenShift, BlueShift, AlphaShift : Integer;
    RedDeltaShift, GreenDeltaShift, BlueDeltaShift, AlphaDeltaShift : Integer;
    RedSize, GreenSize, BlueSize, AlphaSize : Byte;
  end;
 
function Compute_BytesPerLine(AWidth: Cardinal; ABitsPerPixel: Byte; ALineEnd: TBZBitmapLineEnd): PtrUInt;
begin
  Result := (Compute_BitsPerLine(AWidth, ABitsPerPixel, ALineEnd) + 7) shr 3;
end;
 
function Compute_BitsPerLine(AWidth: Cardinal; ABitsPerPixel: Byte; ALineEnd: TBZBitmapLineEnd): PtrUInt;
begin
 
  Result := AWidth * ABitsPerPixel;
 
  case ALineEnd of
    bleNoBoundary: ;
    bleByteBoundary:   Result := (Result +  7) and not PtrUInt(7);
    bleWordBoundary:   Result := (Result + 15) and not PtrUInt(15);
    bleDWordBoundary:  Result := (Result + 31) and not PtrUInt(31);
    bleQWordBoundary:  Result := (Result + 63) and not PtrUInt(63);
    bleDQWordBoundary: Result := (Result +127) and not PtrUInt(127);
  end;
end;
 
function CreateBitFieldMask(AShift, APrec: Byte): Cardinal; inline;
begin
  Result := ($FFFFFFFF shr (32 - APrec)) shl AShift;
end;
 
function GetMaskShift(AMask: LongWord): ShortInt; inline;
begin
  Result := 0;
  while ((AMask and (1 shl Result)) = 0) and (Result < 32) do inc(Result);
  if result = 32 then result:=0;
end;
 
function GetMaskSize(AMask: LongWord; AShift:ShortInt): Byte; inline;
 
begin
  Result := 0;
  while (AShift + Result < 32) and ((AMask and (1 shl (AShift + Result))) <> 0) do Inc(Result);
end;
 
function GetMaskDeltaShift(ASize:Byte): Integer; inline;
begin
  result:=8-ASize;
end;
 
function ConvertBitFieldsToBZColor(Const aBitFields : TBZColorBitFields; SrcColor : Integer):TBZColor;
  function GetBitFieldValue(Const Value : LongWord; Mask:LongWord; BitShift, BitSize : Byte):Byte; inline;//; DeltaShift:Integer;const IsAlphaMask:Boolean=false): Byte; inline;
  var
    I,v,v2 : Integer;
  begin
      V:=(Value and Mask) Shr BitShift;
      V2:=0;
      I:=8-BitSize; //DeltaShift;
      While I>0 do
      begin
        V2 := V2 or (V Shl I);
        I:=I-BitSize;
      end;
      if I<0 then
        V2 := V2 or (V Shr (-I))
      else
        V2 := V2 or (V Shl I);
      V:= (V2 shl 8) + V2;
      Result:= V; //(V and  255); // ClampByte(V);
    end;
 
 
begin
  With aBitFields do
  begin
    if RedSize>0 then Result.Red:= GetBitFieldValue(SrcColor,RedMask, RedShift, RedSize) else Result.Red := 0;//, RedDeltaShift);
    if GreenSize>0 then Result.Green:= GetBitFieldValue(SrcColor,GreenMask, GreenShift, GreenSize) else Result.Green := 0;//, GreenDeltaShift);
    if BlueSize>0 then Result.Blue:= GetBitFieldValue(SrcColor,BlueMask, BlueShift, BlueSize) else Result.Blue := 0;//, BlueDeltaShift);
 
    if (AlphaSize=0) then Result.Alpha:=255
    else Result.Alpha:=GetBitFieldValue(SrcColor,AlphaMask, AlphaShift, AlphaSize);//, AlphaDeltaShift, true);
 
  end;
end;

**tourlourou** · 18/02/2019, 17h19

@Jean-Pierre : bonjour, tes 4 fichiers sont bien ouverts et copiés, mais avec quelques différences de profondeur, comme lors de tes tests. Ils en ressortent d'ailleurs amaigris d'1/4 ! Je pense que ce sont les mêmes que toi, avec un BIH en V4 (taille 108). Ils sont d'ailleurs tous enregistrés en V1 ( BITMAPINFOHEADER, taille 40).

192x128x32.bmp_CopyTest.bmp : InfoHeader 40 ; BitCount : 24
192x128x32.bmp : InfoHeader 108 ; BitCount : 32
250x250x32.bmp_CopyTest.bmp : InfoHeader 40 ; BitCount : 32
250x250x32.bmp : InfoHeader 40 ; BitCount : 32
32bitsKC.bmp_CopyTest.bmp : InfoHeader 40 ; BitCount : 32
32bitsKC.bmp : InfoHeader 40 ; BitCount : 32
397x299x32_72.bmp_CopyTest.bmp : InfoHeader 40 ; BitCount : 24
397x299x32_72.bmp : InfoHeader 108 ; BitCount : 32

**Jipété** · 18/02/2019, 17h26

Yop !

Envoyé par BeanzMaster

Je l'avais oublié cette discussion. Le truc c'est que ce genre de manips ne devraient pas être faites par nous.

C'est bien ce qu'il me semblait aussi.

Envoyé par BeanzMaster

"Only works with lines aligned to whole bytes" en gros ce que je comprends c'est que cela fonctionne uniquement avec un tampon dant les pixels sont codés sur 32bits

Et moi ce que je ne comprends pas c'est d'où tu sors cette notion de 32bits qui n'est absolument pas présente dans la phrase. Alors d'accord, on s'en doute, mais on ne fait pas une programmation sérieuse sur des suppositions, car c'est comme ça que les Ariane explosent en vol.

Sinon, concernant ton autre post, écoute, tu es gentil, mais je suis épuisé, et j'en ai marre...

ImageMagick est capable d'ouvrir un .png et de l'enregistrer en bmp 32 bits, mais si je lui fais ouvrir un bmp 32 bits alors il l'enregistre en bmp... 24 bits !
Et pour configurer IM non seulement c'est une abomination, mais en plus l'interface écrite en Lazarus utilise IntfGraphics et FPimage ! Au secours, j'ai déjà donné !

Quant à ton code,
1) il manque une accolade fermante de commentaire ligne 790, la ligne précédente se termine par une parenthèse fermante

2) ensuite il ne compile pas parce qu'il ne trouve pas beanzlib_options.inc ligne 97 ;
3) une fois cet include commenté il ne compile pas car il ne trouve pas les unités déclarées dessous.
Faudrait-il que j'enregistre mon projet dans le même bazar (chez moi) que le dossier des Gif's ? Vu comment tu l'as présentée dans le post, je pensais que c'était une petite unité stand-alone.
Ayant horreur de mélanger les torchons et les serviettes, je considère ça comme un signe qui me dit "laisse tomber".

De toute façon, je préférerais lire une explication sur la manière dont tu te dépatouilles du problème du byte Alpha à 0 pour afficher quand même l'image, plutôt que de me farcir les 2600 lignes de cette unité... Pas le courage.
Pi ça, ça fait un peu peur :

Envoyé par BeanzMaster

je crois que j'ai une erreur avec le 24bits si je me souviens bien que je n'ai pas encore corrigé) des fichiers au format BMP.

Allez, juste pour rire, la démo d'ImageMagick censée remplacer les pixels noirs d'une image PNG par des transparents se prend un râteau : elle en convertit beaucoup plus, et fait disparaître des bouts de l'image !

Vraiment la cata, le graphisme.
Dommage...

Envoyé par tourlourou

@Jean-Pierre : Ils en ressortent d'ailleurs amaigris d'1/4 !

Bonsoir Yves,
et merci pour tes tests.
Oui, c'est normal quand on perd 1 byte sur 4 (l'alpha).

Bah, va falloir que je me résigne à étudier en redémarrant ma vieille machine virtuelle Win2000 et son vieux D7 perso...

**tourlourou** · 18/02/2019, 17h45

@Jérôme : Bonjour, J'obtiens presque les mêmes résultats que toi sous Ubuntu 18.04 gtk2 et CT 6.4 64 Bits... Je constate comme seule différence que 32bitsKC.bmp passe au chargement (Image1 OK) mais pas en copie (Image2 KO), mais avec les mêmes données que toi dans le Memo... Pour les autres, tout pareil ! Il faudra que je teste avec CT sous Windows : suite au prochain épisode...

[EDIT = OK avec CT 6.5 64 Bits sous Windows 10]

**tourlourou** · 18/02/2019, 17h58

Only works with lines aligned to whole bytes

Ne peut-on le comprendre plutôt comme : ne fonctionne que si les lignes démarrent bien au Bit0 d'un octet (style, pour un pfxBit avec et x <8, une ligne démarrant au yéme bit d'un octet avec y > 0 ne pourrait être valablement renvoyée par les GetLineStart) ? Après, je n'ai pas vérifié si les spécifications du format Bitmap autorisent cette fantaisie...

**Jipété** · 18/02/2019, 19h33

Tiens, j'ai un drôle de truc à vous soumettre.

Il y a quelque temps j'avais récupéré un code D5 très simple, voilà le lien avec en haut un fichier .txt ultra court qui contient tout, si vous voulez jouer avec, vous mettez un bouton et deux mémos, un TImage et un TOpenPictureDialog, vous mettez le code du site et F9.

Moi, je ne vais vous parler que de la partie récupération des pixels, parce que quand on regarde le code ça a l'air très simple et quand on l'exécute avec un fichier 32 bits c'est la misère et je n'arrive pas à comprendre où et pourquoi et comment.

Mais d'abord une petite image :

Nom : gag_d5.png
Affichages : 882
Taille : 2,8 Ko

Nom : gag_d5.png
Affichages : 882
Taille : 2,8 Ko

à gauche l'image choisie et sa préview dans la boîte de dialogue, vous reconnaissez 192x128x32.bmp, et à droite ce qui s'affiche dans l'outil.

Grand Un, je ne m'explique pas ce décalage horizontal, car c'est comme si le pointeur du RawImage.GetLineStart ne pointait pas au bon endroit...

Et grand Deux, il y a aussi du décalage vertical, qu'on voit mieux sur une image zoomée à 400 % :

Nom : gag_zoomé_400pcent.png
Affichages : 903
Taille : 2,3 Ko

Nom : gag_zoomé_400pcent.png
Affichages : 903
Taille : 2,3 Ko

le rectangle bleu de gauche remonte d'un px en en oubliant un tout en bas à gauche, et les deux carrés bien colorés en haut ont chacun une sale bande au-dessus.

Sinon, globalement, les dimensions sont correctes à l'extérieur, mais à l'intérieur c'est le souk, le bazar, le waï...

J'ai essayé de rattraper l'inversion R<>B mais bernique, donc il y a une ligne en attente parce que l'idée c'était de voir s'il était facile de remplacer le 0 du canal Alpha par 255, dans le fichier qui pose souci.

Là je ne donne que le code de la partie remplissage avec mes petits ajouts :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
     BitMap.BeginUpdate(); // couple rajouté par moi
     {pixel data is stored upside down, so fill bitmap from bottom up} // ok
     for y := BitmapInfoHeader.biHeight - 1 downto 0 do begin
        //pb := BitMap.ScanLine[y];  {get ^ address of first byte on row}
        pb := BitMap.RawImage.GetLineStart(y); {get ^ address of first byte on row}
        BlockRead(f, pb^, RowLength, amt);
 {       if Bitmap.PixelFormat = pf24bit then
           for i := 0 to RowLength-1 do
              if ((i+1) mod 3) = 0 then begin
                b := byte(Bitmap.RawImage.Data[i+2]);
                byte(Bitmap.RawImage.Data[i+2]) := byte(Bitmap.RawImage.Data[i]);
                byte(Bitmap.RawImage.Data[i]) := b;
              end;    }
        if Bitmap.PixelFormat = pf32bit then
           for i := 0 to RowLength-1 do
              if ((i+1) mod 4) = 0 then begin
                b := byte(Bitmap.RawImage.Data[i+2]);
                byte(Bitmap.RawImage.Data[i+2]) := byte(Bitmap.RawImage.Data[i]);
                byte(Bitmap.RawImage.Data[i]) := b;
                if Bitmap.RawImage.Data[i+3] = 0 then Bitmap.RawImage.Data[i+3] := 255;
              end;
     end; // ligne suivante
     BitMap.EndUpdate(); // couple
     // R B inversés

En commentaire la correction si pf24, aussi inopérante que celle du pf32.

Et là, je n'ai pas d'idée, car le cœur de la boucle c'est ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

BlockRead(f, pb^, RowLength, amt);

et je ne comprends pas pourquoi ça donne des données comme on les voit.
Pourtant elle est sympa cette ligne de code : elle ~~récupère~~ devrait récupérer tous les bytes d'une scanline en un seul passage, sans boucle.

Détail à 800 % du centre de tout en haut :
Nom : détail_800pcent.png
Affichages : 860
Taille : 375 octets

Nom : détail_800pcent.png
Affichages : 860
Taille : 375 octets

Ah, si vous voulez jouer, pensez à rajouter b: byte; dans var du bouton.
Merci du retour.

**BeanzMaster** · 18/02/2019, 22h18

Envoyé par tourlourou

@Jérôme : Bonjour, J'obtiens presque les mêmes résultats que toi sous Ubuntu 18.04 gtk2 et CT 6.4 64 Bits... Je constate comme seule différence que 32bitsKC.bmp passe au chargement (Image1 OK) mais pas en copie (Image2 KO), mais avec les mêmes données que toi dans le Memo... Pour les autres, tout pareil ! Il faudra que je teste avec CT sous Windows : suite au prochain épisode...

Merci Yves il y aurais donc quelques corrections qui auraient été faite dans IntfGraphics avec TLazReaderDIB. Par contre le probleme de changement du RawImage a l'assignation n'est pas réglé vu que la copie ne fonctionne pas avec des BMP 32bits.

Envoyé par Jipété

Yop !

Et moi ce que je ne comprends pas c'est d'où tu sors cette notion de 32bits qui n'est absolument pas présente dans la phrase. Alors d'accord, on s'en doute, mais on ne fait pas une programmation sérieuse sur des suppositions, car c'est comme ça que les Ariane explosent en vol.

Le 32bits vient des infos dans la pauvre documentation donner farcifala sur le RawImage et que sous Linux le bitsperpixel est toujours initialisé à 32bits, donc ce que je comprend si le les pixels ne sont pas stockés en 32bits "getlinedatastart" ne fonctionne pas

Envoyé par Jipété

Quant à ton code,
1) il manque une accolade fermante de commentaire ligne 790, la ligne précédente se termine par une parenthèse fermante

2) ensuite il ne compile pas parce qu'il ne trouve pas beanzlib_options.inc ligne 97 ;
3) une fois cet include commenté il ne compile pas car il ne trouve pas les unités déclarées dessous.
Faudrait-il que j'enregistre mon projet dans le même bazar (chez moi) que le dossier des Gif's ? Vu comment tu l'as présentée dans le post, je pensais que c'était une petite unité stand-alone.
Ayant horreur de mélanger les torchons et les serviettes, je considère ça comme un signe qui me dit "laisse tomber".

Ok pas de soucis, je vais te faire une unit standalone d'ici la fin de semaine en prenant la base du TGIFViewer

Envoyé par Jipété

De toute façon, je préférerais lire une explication sur la manière dont tu te dépatouilles du problème du byte Alpha à 0 pour afficher quand même l'image, plutôt que de me farcir les 2600 lignes de cette unité... Pas le courage.
Pi ça, ça fait un peu peur :

Ok le truc avec "l'alpha=0" pour les bmp 32bits, c'est que j'utilise 2 variables de vérifications dans ma boucle de remplissage de mon buffer de pixel

pour chaque pixel je teste la valeur Alpha :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
FIgnoreAlpha := FIgnoreAlpha and (DstColor.alpha = 0);
IsOpaque := IsOpaque and (DstColor.alpha = 255);

Donc
Si FIgnoreAlpha est à true cela signifie que TOUS les pixels on une valeur Alpha à 0
Si IsOpaque est à true, on pourrait alors considéré pouvoir stocker les pixels en 24bits (comme le fait Lazarus dans certains cas, d'ou ce passage de 32 à 24)

Ensuite en fonction de ces 2 variables, et des infos du BMP (le bitfield) je rempli mes valeurs dispos dans ma description en fonction.
De plus cette technique permet de détecter efficacement si le BMP est au format XBGR

Comme tu peux le voir ci-dessous si FIgnoreAlpha := True je change les valeurs alpha à 255 (Procedure MakeOpaque) et je peux ainsi visualiser l'image

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
  If FIgnoreAlpha Then
  Begin
    //GlobalLogger.LogNotice('IgnoreAlpha');
    MakeOpaque;
    if (ImageDescription.PixelFormat = pf32bits) then
    begin
      if ((ImageDescription.BitFields.AlphaSize=0) and (ImageDescription.BitFields.Size=16)) then ImageDescription.ColorFormat := cfXBGR;
    End
    else  ImageDescription.ColorFormat := cfBGR;
 
    ImageDescription.HasAlpha := False;
  End
  else
  begin
    if ImageDescription.PixelFormat = pf32bits then
      if ((ImageDescription.BitFields.AlphaSize=0) and (ImageDescription.BitFields.Size=16)) then
      begin
        ImageDescription.ColorFormat := cfXBGR;
      End;
 
    if IsOpaque then ImageDescription.HasAlpha := False
    else ImageDescription.HasAlpha := True;
  End;

En ce qui concerne ton dernier post

Comment tu initialises ton Bitmap ? le depth et bitsperpixel de ton RawImage.Description sont-ils bien à 32 ?

Ensuite je n'aime pas trop cette façon de faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 for i := 0 to RowLength-1 do
              if ((i+1) mod 4) = 0 then begin
                b := byte(Bitmap.RawImage.Data[i+2]);
                byte(Bitmap.RawImage.Data[i+2]) := byte(Bitmap.RawImage.Data[i]);
                byte(Bitmap.RawImage.Data[i]) := b;
                if Bitmap.RawImage.Data[i+3] = 0 then Bitmap.RawImage.Data[i+3] := 255;
              end;

Je préfère

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
 for i := 0 to RowLength-1 do
 begin
     byte(Bitmap.RawImage.Data[i*4]) := byte(Bitmap.RawImage.Data[i*4 + 2];             // B > R
     //byte(Bitmap.RawImage.Data[i*4 + 1]) := byte(Bitmap.RawImage.Data[i*4 + 1];    // G = G
     byte(Bitmap.RawImage.Data[i*4 + 2]) := byte(Bitmap.RawImage.Data[i*4];            //  R > B
      if Bitmap.RawImage.Data[i*4 +3] = 0 then Bitmap.RawImage.Data[i*4 + 3] := 255 //  A 
end;

Pour tes boucles "for" penses à les englobés par Begin..End c'est plus sur

**Jipété** · 18/02/2019, 22h43

Envoyé par BeanzMaster

En ce qui concerne ton dernier post

Comment tu initialises ton Bitmap ? le depth et bitsperpixel de ton RawImage.Description sont-ils bien à 32 ?

Toi tu n'as pas regardé le lien et le fichier .txt

Donc on perd du temps...
Ces choses ne sont pas utilisées dans ce code, par contre, oui, le Bitmap.PixelFormat est bien positionné à la bonne valeur.

Envoyé par BeanzMaster

Ensuite je n'aime pas trop cette façon de faire

Pas grave, tu peux les enlever, le problème reste entier : j'ai bien écrit que c'était un ajout pour voir si je pouvais remettre les bonnes couleurs, mais ça ne change rien au problème du décalage des carrés/rectangles.

Envoyé par BeanzMaster

Je préfère

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
 for i := 0 to RowLength-1 do
 begin
     byte(Bitmap.RawImage.Data[i*4]) := byte(Bitmap.RawImage.Data[i*4 + 2];             // B > R
     //byte(Bitmap.RawImage.Data[i*4 + 1]) := byte(Bitmap.RawImage.Data[i*4 + 1];    // G = G
     byte(Bitmap.RawImage.Data[i*4 + 2]) := byte(Bitmap.RawImage.Data[i*4];            //  R > B
      if Bitmap.RawImage.Data[i*4 +3] = 0 then Bitmap.RawImage.Data[i*4 + 3] := 255 //  A 
end;

Attention, tu vas tout exploser avec tes i*4 ! La boucle n'est pas sur Bitmap.Width mais sur RowLength qui vaut, d'après le code,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
     Rowlength := (BitmapInfoHeader.biWidth
                 * BitmapInfoHeader.biBitCount) div 8;

Envoyé par BeanzMaster

Pour tes boucles "for" penses à les englobés par Begin..End c'est plus sûr

Pas nécessaire sur ce coup-là, c'est juste que j'aime bien la concision, et si ça peut te rassurer, les premiers jets ont été faits avec tous les begin...end qu'il fallait et le problème était là.

**Jipété** · 18/02/2019, 23h51

Tiens, je me suis amusé à un truc curieux : plutôt que de balayer toute la hauteur de l'image, j'ai d'abord cherché la première ligne en faisant ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
//     for y := BitmapInfoHeader.biHeight - 1 downto 0 do begin
        pb := BitMap.RawImage.GetLineStart(0); {get ^ address of first byte on row}
        BlockRead(f, pb^, RowLength, amt);
//      end; // ligne suivante

puis la dernière :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
//     for y := BitmapInfoHeader.biHeight - 1 downto 0 do begin
        pb := BitMap.RawImage.GetLineStart(BitmapInfoHeader.biHeight - 1); {get ^ address of first byte on row}
        BlockRead(f, pb^, RowLength, amt);
//      end; // ligne suivante

tout en virant la tentative de correction des couleurs, et que s'est-il passé ?
Le premier code a généré une ligne de 1 pixel de haut tout en haut du TImage, et le second code une ligne tout en bas du TImage.

Mais ce qui est très curieux, c'est que dans les deux cas les couleurs, fausses, étaient les mêmes, alors que ça n'aurait pas dû.

Voilà l'image, avec deux mots d'explication : j'ai agrandi la copie d'écran dans les deux sens mais deux fois plus vers le haut et l'ai posée sur un fond orange, histoire de faire apparaître le premier pixel gris à gauche.
Les rectangles mauve et blanc font 64 px chacun, et le total du bleu, du petit bout blanc à gauche et du premier gris 64 aussi, et 64 x 3 = 192, la largeur de l'image.

Nom : une_ligne.png
Affichages : 860
Taille : 498 octets

Nom : une_ligne.png
Affichages : 860
Taille : 498 octets

Si quelqu'un y comprend quelque chose...

**Jipété** · 19/02/2019, 09h37

Et bonjour !

Je me suis souvenu qu'il y a un exemple "officiel", puisque se trouvant dans (pour Linux) /usr/share/lazarus/version/examples/scanline, alors ce matin j'ai commenté la section récup des datas du code d'origine du projet en D5, de BitMap.BeginUpdate(); // couple rajouté par moi jusqu'à BitMap.EndUpdate(); // couple et l'ai remplacée par le code de l'exemple, à peine modifié.
J'ai gardé les commentaires, désolé pour le surpoids :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
    // create an image with a format similar to Delphi's pf32bit
    // keep in mind that you access it in bytes, not words or dwords
    // For example PowerPC uses another byte order (endian big)
    ScanLineImage := TLazIntfImage.Create(0,0);
//    ImgFormatDescription.Init_BPP32_B8G8R8_BIO_TTB(192, 128); // code d'origine force les valeurs, ici adaptées au fichier prévu
    ImgFormatDescription.Init_BPP32_B8G8R8A8_BIO_TTB(192, 128); // comme ça c'est strictement pareil sauf le trait noir à gauche qui disparaît
    ScanLineImage.DataDescription := ImgFormatDescription;
 
    // call the pf24bit specific drawing function
    for y := 0 to ScanLineImage.Height-1 do
      PaintToRGB32bitScanLine(y, ScanLineImage.Width,
                              ScanLineImage.GetDataLineStart(y));
    // jérôme, t'as vu, y a pas de begin...end ;-)
 
    Bitmap.Width  := ScanLineImage.Width;
    Bitmap.Height := ScanLineImage.Height;
    // create IntfImage with the format of the current LCL interface
    IntfImage := Bitmap.CreateIntfImage;
    // convert the content from the very specific to the current format
    IntfImage.CopyPixels(ScanLineImage);
    Bitmap.LoadFromIntfImage(IntfImage);
 
    ScanLineImage.Free;
    IntfImage.Free;

ensuite, la procédure d'affichage, avec 1 ligne de commentaire en + :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.PaintToRGB32bitScanLine(Row,ImgWidth: integer; LineStart: Pointer);
// LineStart is pointer to the start of a scanline with the following format:
// 4 bytes per pixel. First byte is blue, second green, third is red.
// et le 4e ? Valeur aléatoirement pifométrique ?
// Black is 0,0,0, white is 255,255,255
var
  i: Integer;
begin
  // fill line with gray -- black !, pas gray. Pas sérieux, ça...
  for i:=0 to (ImgWidth*4)-1 do
////jp    PByte(LineStart)[i]:=0; // set red, green and blue to 0 (i.e. black)
  // set one pixel to red (this creates a red line)
////jp  PByte(LineStart)[(Row mod ImgWidth)*4+2]:=255;
    BlockRead(f, PByte(LineStart)[i], 1, amt); // lit les datas du fichier
end;

N'oubliez pas ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
  private
    { Private declarations }
    f:file; // vient de la proc LoadBitMapButtonClick
    procedure PaintToRGB32bitScanLine(Row,ImgWidth: integer; LineStart: Pointer);

et ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
uses
  LCLIntf, LCLType,
  //LMessages, Messages,
  FPImage, GraphType, IntfGraphics,

Exécutez, choisissez un fichier 32 bits (192x128x32.bmp, au hasard, sinon faudra modifier les dimensions), et ça ne fonctionne pas :
Nom : scanexo+D5.gif
Affichages : 960
Taille : 13,8 Ko

Nom : scanexo+D5.gif
Affichages : 960
Taille : 13,8 Ko

ligne pour inverser le parcours

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    for y := ScanLineImage.Height - 1 downto 0 do begin
//    for y := 0 to ScanLineImage.Height-1 do begin

On n'est pas loin, mais...
C'est juste que la mise en place des datas du fichier dans la mémoire de l'image est en vrac,

**tourlourou** · 19/02/2019, 09h39

Est-ce que Amt vaut bien RowLength pour chaque ligne lue ?

**Jipété** · 19/02/2019, 10h24

Envoyé par tourlourou

Est-ce que Amt vaut bien RowLength pour chaque ligne lue ?

Impossible à savoir :

Au tout début je suis parti sur une simple comparaison if not (RowLength = amt) then et je me suis ramassé cette erreur, je me suis dit que c'était peut-être lié à une variable "tenue", j'ai essayé avec a et r, j'ai déporté r avant la boucle et maintenant ça coince sur a.

Et si je commente tous les ajouts, ça coince sur BlockRead, hallucinant !

Je ferme tout, je rouvre, toujours pareil.
Je vais repartir de la sauvegarde d'hier...

EDIT
Bon, on ne le dira jamais assez, les sauvegardes ça sauve la vie !

Je suis reparti de celle d'hier soir, j'ai rajouté 3 lignes en testant à chaque fois, plus de message d'erreur louche, et pas de ShowMessage non plus pour répondre à ta question.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
     r := RowLength; // 1er ajout, test = ras
     BitMap.BeginUpdate(); // couple rajouté par moi
     {pixel data is stored upside down, so fill bitmap from bottom up} // ok
     for y := BitmapInfoHeader.biHeight - 1 downto 0 do begin
        //pb := BitMap.ScanLine[y];  {get ^ address of first byte on row}
        pb := BitMap.RawImage.GetLineStart(y); {get ^ address of first byte on row}
        BlockRead(f, pb^, RowLength, amt);
        a := amt; // 2e ajout, test = ras
        if (a <> r) then 
          ShowMessage(IntToStr(r) + '<>' + IntToStr(a));// 3e ajout, test = ras

**tourlourou** · 19/02/2019, 13h48

Y a-t-il un format de bitmaps qui soit ouvert à coup sûr sous tous les OS et permette les copies vers le format que vous visez ?
S'il est identifiable, pourquoi ne pas lire le fichier et le transformer vers ce format ? Avec au besoin le réglage du canal Alpha.

**Jipété** · 19/02/2019, 14h16

Envoyé par tourlourou

Y a-t-il un format de bitmaps qui soit ouvert à coup sûr sous tous les OS et permette les copies vers le format que vous visez ?

Tu as dû rater le début,

J'ai parlé de programmes Delphi qui font du rééchantillonnage et autres interpolations, toutes choses qui se basent pour leurs calculs sur des TRGBQuad.

Mais tu me donnes une idée : ouvrir des PNG et les transformer en BMP pour en extraire les TRGBQuads, les travailler, et récrire tout ça...

Je creuserai (je te dis pas comment j'use les pelles en ce moment !)

**Jipété** · 20/02/2019, 10h22

Bonjour,

à force d'avoir le nez sur le guidon, on ne voit plus du tout le paysage, c'est bien connu...

Et là, à force de regarder un code D5 écrit donc à l'époque où il ne devait y avoir que des bmp en version 1, j'ai complètement zappé le fait que les datas des versions 4 et 5 sont... beaucoup plus loin que là où se trouve le pointeur dans le fichier une fois la lecture des headers faites.

Il m'a fallu refaire complètement un projet et soigner la présentation des datas "techniques" remontées pour enfin voir le problème (faut dire aussi que le rendu faux ne l'était pas trop puisque les couleurs y sont justes, mais bizarrement placées : si j'avais eu n'importe quoi j'aurais peut-être percuté plus vite) :
cherchez dans le mémo à droite la deuxième ligne, 'Data offset', bon sang, elle est à 122 et on n'y est pas une fois la fin du header atteinte !

Deux coups de seek et c'est bon !

Nom : soluce_décalages.png
Affichages : 975
Taille : 63,5 Ko

Pour ce fichier...
Car avec d'autres c'est toujours la cata, mais concernant le code D5 c'est réglé (enfin, presque parce que les couleurs ne sont pas bonnes, même en inversant R et B...)

Si vous regardez attentivement le mémo, vous y voyez une ligne Height x 2 (??): 128. Les deux points d'interrogation sont de mon fait car le "x 2" est d'origine et sans explications sur le site, et c'est la première fois que je vois ça depuis que je trafique avec les bmp.
Si quelqu'un a un éclair de lucidité, qu'il nous explique.

Envoyé par Jipété

Mais tu me donnes une idée : ouvrir des PNG et les transformer en BMP pour en extraire les TRGBQuads, les travailler, et récrire tout ça...

Quant à cette idée d'étudier le rééchantillonnage (la raison première de tout ce bazar) à partir de fichiers png convertis, elle est séduisante pour avancer mais pas pour la résolution du problème majeur qui est bien de ne pas pouvoir ouvrir certains fichiers bitmap, et ça, c'est très désagréable.
Entre les deux mon cœur balance...

EDIT 1 : s'il y en a qui veulent jouer : files4fofo.zip
EDIT 2 : dans la sous-procédure CodeDelphi5 de la procédure OpenFichier je me suis grave pris les pieds dans le tapis.
(ça c'est quand on est épuisé... -- rhôôô l'excuse bidon,

)

Remplacez donc les parties en commentaire concernant la tentative d'inversion de R et B par celles-là mais le drame, c'est que ça ne change rien et ça, c'est un brave mystère, lisez les commentaires tout en bas, où il est question d'un fichier 600x400 codé en RGBX ou BGRX, flemme de chercher la précision, de toute façon ça ne change rien, c'est la position du X qui compte.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
{       if Bitmap.PixelFormat = pf24bit then
          for i := 0 to RowLength-1 do
             if ((i+1) mod 3) = 0 then begin
               b := byte(Bitmap.RawImage.Data[i-2]);
               byte(Bitmap.RawImage.Data[i-2]) := byte(Bitmap.RawImage.Data[i]);
               byte(Bitmap.RawImage.Data[i]) := b;
             end;    }
       if Bitmap.PixelFormat = pf32bit then
          for i := 0 to RowLength-1 do
             if ((i+1) mod 4) = 0 then begin
               b := byte(Bitmap.RawImage.Data[i-3]);
               byte(Bitmap.RawImage.Data[i-3]) := byte(Bitmap.RawImage.Data[i-1]);
               byte(Bitmap.RawImage.Data[i-1]) := b;
               if Bitmap.RawImage.Data[i] = 0 then
                  Bitmap.RawImage.Data[i] := 25; // ça impacte, mais PAS la transparence
               // sauf pour le 600x400, que je récupère mais il n'affiche qu'1 ligne...
               // -- Confirmé par des runs avec les 2 lignes commentées ou pas --
             end;

Bon sang, j'aimerais bien savoir ce qui manque à ce code pour afficher correctement les images.

**BeanzMaster** · 21/02/2019, 12h03

Salut à tous

Voilà c'est fait ! comme je te l'avais dit JP, j'ai rendu mon "Loader de fichier au format BMP" indépendant

Je suis partie sur la même base que TGifViewer.

Par rapport au TGIFViewer voilà ce que j'ai fait

1) J'ai sortie la classe TFastMemoryStream dans une unité indépendante et l'ai mise à jour pour les besoins de lecture du format BMP
2) J'ai mis à jour l'unité de TFastBitmap en ajoutant les définitions nécessaire pour la lecture du format BMP
3) L'unité uBMPViewer le coeur de la bête

Comme pour TGIFViewer j'ai créé un composant visuel TBMPViewer, mais je n'ai pas créé pour le moment de package pour installer ce composant dans l'EDI. Il faudra donc le créé à la main comme dans le simple exemple que j'ai mis.

Dans l'unité uBMPViewer il y a la classe TBMPLoader qui peut être directement utilisée pour charger des fichiers BMP

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Var
  BMPLoader : TBMPLoader;
  BMP : TBitmap;
  Infos : String;
 
  BMPLoader := TBMPLoader.Create;
  BMPLoader.LoadFromFile(FileName):
  Infos := BMPLoader.GetImageDescriptionAsString; // Récupération des infos sur le fichier au format BMP 
  // Export de TFastBitmap vers TBitmap
  BMP := TBitmap.Create; 
  BMP := BMPLoader.FastBitmap.GetBitmap;
  // Passage à un TImage
  //Image1.Picture.Bitmap.Assign(BMP);
  FreeAndNil(BMP);

J'ai laissé quelques bout de code en commentaires. Il y a surement encore quelques corrections ou une meilleur façon de faire par moment. Mais en l'état ca fonctionne du feu de Dieu.
J'ai testé sous Windows 10 avec Lazarus 2.0 et sous Linux avec Lazarus 2.0 (he he he ! comme je l'avais dis mes dépots non pas été long à être mis à jour

)
Dans les 2 cas j'ai testé avec un bon nombre de BMP provenant de ma "BMP Image-TestSuite" pas noté de problèmes

J'ai même pu charger sans soucis mon BMP FireFoxLarge de 1,5 Go

Nom : 2019-02-21_120120.jpeg
Affichages : 913
Taille : 102,5 Ko

Bon te connaissant tu vas bien me pondre un fichier BMP tordu !

Bref voila tout est dans le zip :TBMPViewer.zip et bien sûre je suis ouvert à toutes suggestions. J'attend vos retours. Et si vous avez des questions pas de problèmes

A+

[EDIT] Petit rappel la classe TFastBitmap stock l'image en 32bits. Format BGRA pour Windows et RGBA pou Linux (cf TColor32)

**Jipété** · 21/02/2019, 12h54

Envoyé par BeanzMaster

Bon te connaissant tu vas bien me pondre un fichier BMP tordu !

2 !

Toutes mes félicitations !

Un microscopique problème de compilation, que tu devrais régler avec un {$IFDEF VERSIONxxx}, je l'avais déjà remarqué avec le GifViewer, pas que ça me gène mais s'il doit y avoir des corrections à venir, à force, à chaque coup de F9, bim !, juste pour ça c'est dommage :

dans le .lpr :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
begin
  RequireDerivedFormResource := True;
////  Application.Scaled := True;

et dans uBMPViewer.pas ligne 940 et 2 suivantes, .ToString je ne connais pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
//  S := S + #13 + #10 + 'Dimension      : ' + FImageDescription.Width.ToString+'x'+ FImageDescription.Height.ToString;
//  S := S + #13 + #10 + 'Bits par pixel : ' + FImageDescription.BitCount.ToString;
  S := S + #13 + #10 + 'Dimension      : ' + IntToStr(FImageDescription.Width)+'x'+ IntToStr(FImageDescription.Height);
  S := S + #13 + #10 + 'Bits par pixel : ' + IntToStr(FImageDescription.BitCount);
  S := S + #13 + #10;
  S := S + #13 + #10 + 'Transparent    : ' + cBoolStr[FImageDescription.HasAlpha];
  S := S + #13 + #10;
  S := S + #13 + #10 + 'Utilisation Palette de couleur : ' + cBoolStr[FImageDescription.UsePalette];
//  S := S + #13 + #10 + 'Nombre de couleur dans la palette : '+FImageDescription.PaletteCount.ToString
  S := S + #13 + #10 + 'Nombre de couleur dans la palette : '+IntToStr(FImageDescription.PaletteCount);

Sinon, on aurait un ch'tit problème de R et B inversés, on dirait, avec un fichier OS/2 (en arrière-plan ce que je vois dans un viewer) :
Nom : pb_os2_RBinversés.png
Affichages : 886
Taille : 688,9 Ko

Nom : pb_os2_RBinversés.png
Affichages : 886
Taille : 688,9 Ko

Et un qui n'est pas content, avec ses 256 couleurs :
Nom : erreur_redbrick256.png
Affichages : 906
Taille : 51,2 Ko

Les 2 fichiers sont dans le zip, et le zip est en 2 parties (l'OS/2 est gros) :
2fichiers.zip.001.zip
2fichiers.zip.002.zip
J'ai été obligé de rajouter '.zip' à la fin des 2 fichiers, à virer, et tu commences par le .001 pour décompacter.

Suis absent en début d'aprème.

Encore bravo !

Travailler avec TBitmap et des fichiers bmp sous Linux [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager