Discussion :

[Jipété]

Bonjour,

le retour de ce sujet (le retour parce qu'on en a déjà causé [pas de mon fait] mais comme le moteur de recherche du forum a coulé une bielle, ça ira plus vite d'en créer un nouveau).

Dans cette discussion il est question d'un maximum à 32768 x 32768 pixels, mais ce 32768 pour la hauteur m'étonne un peu car la valeur est signée, donc plutôt 32768 x (+ ou -)16384.

1^re question : j'ai trouvé une image énorme dans le sens où elle fait 30000 x 17078, c'est un jpeg qui pèse 234 Mo, et comment a-t-elle bien pu être créée si l'une de ses dimensions est en dehors des clous ?
Bien sûr aucun de mes outils Lazarus ne l'ouvre, pas plus que d'autres outils Linux, mais ImageMagick et The Gimp s'en sortent haut la main (en y passant 5 minutes quand même).

L'ayant ouverte dans The Gimp, je me suis dit que j'allais la ramener dans les supposés clous avec un redimensionnement à 28106 x 16000 et il aura fallu au Gimp environ 20 à 25 minutes pour enregistrer un fichier de 176 Mo (peut-être à cause de la compression que je n'ai pas eu l'idée de ramener à "aucune") :


Mais comme les outils qui foiraient avant le redimensionnement foirent encore après, la seconde question est simple : quelles sont les limites, au moins pour Lazarus/FreePascal, afin que je puisse vérifier avant que le système n'envoie un affreux message à l'utilisateur ?


Message abscons s'il en est car j'ai fait un test ce matin à la fraîche avec 3 gigas de mémoire dispos !

J'ai un peu farfouillé dans les sources mais n'ai rien trouvé.
Merci pour vos retours,

[anapurna]

Salut

Pas simple a répondre... sûrement un souci de ressource.
Il peut exister plusieurs cas :

1. tout dépend du type de variable que tu as prise pour faire tes boucles et de la taille de ton buffer de donnée ;
2. le buffer est de la taille de ton fichier... il vaut peut être mieux passer par un "file mapping" qui est une variante "bufferisée" de l’accès fichier.

Sinon j'attends les autres propositions.

[Jipété]

Yep !

Merci de ton retour, ça m'a donné une idée pour creuser plus.

1°) tout dépend du type de variable que tu as pris pour faire tes boucles et de la taille de ton buffer de donnée
2°)le buffer est de la taille de ton fichier .... il faut peut être mieux passer par un "file mapping" qui est une variante "bufferisé" de l’accès fichier

Ah mais moi je n'ai rien pris du tout : je m'appuie sur les propositions de Lazarus, en l'espèce TPicture : aPicture.LoadFromFile('chemin/fichier'); et j'ai remonté sa piste jusque là : include/Bitmap.inc ligne 121, raccourcie :

Code :

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

1
2
3
4
procedure TBitmap.LoadFromStream(AStream: TStream; ASize: Cardinal);
begin
  inherited LoadFromStream(AStream, ASize);
end;

OK, la taille est un cardinal, donc max 2^32 soit 4294967296 et la racine carrée c'est 65536


On peut donc avoir 65536 bits x 65536 bits au maximum (des word), et si on considère qu'un pixel c'est 24 ou 32 bits, ça va nous en offrir au mieux 2048 x 2048 pour 32 bpp ou 2730 x 2730 pour 24 bpp.

On notera que j'ai fait abstraction du fait que la hauteur est normalement signée et qu'on perd donc 1 bit sur cette affaire (le word [0..65535] devient un smallint [-32768..+32767]) et ce qui me parait bizarre, c'est qu'il me semble que des vieux tests (pour cette vieille discussion) autorisaient des valeurs plus élevées.

Faut que je la retrouve [EDIT : retrouvée ! La lirai + tard à tête reposée], car j'ai demandé à Gimp de me générer une image 2800 x 2800 x 24 bpp, je l'ai exportée en bmp et en jpg et les outils les ouvrent sans problème.
J'ai dû rater une marche quelque part.


EDIT : ch'suis un !
Les lignes horizontales sont constituées de pixels, donc 24 bpp ou 32 bpp soit 2730 ou 2048 pixels.
Mais la hauteur nous autorise 32768 lignes !

Nouveau test avec 2730x32700 : fichier bien ouvert avec l'outil (compter 30 secondes environ)
Dernier test avec 2730x32800 : l'outil a planté tellement violemment qu'il a disparu sans envoyer de message d'erreur !

Ce qui est bizarre, ce sont les infos de Gimp pour le 1^er fichier : 2730 x 32700 pixels avec un nombre de pixels qui s'élève à 89271000, ce qui correspond à 2730x32700, ce qui devient, avec les unités, à 2730 pixels_par_ligne x 32700 lignes.
Ouf !
(excusez-moi, je réfléchis à haute voix et par écrit, )

[BeanzMaster]

Salut

Pour ce qui est de la taille d'un tampon en mémoire théoriquement et si je ne me trompe pas, en 32bits tu es limité à 2Go et à 4Go pour les systèmes 64 bits. Au-delà il faut géré tous ça par un genre de "File Mapping" comme l'a dit Anapurna

Il ne faut pas que tu oublis dans tes calculs la taille d'un pixel;

Pixel 24 bits = 3 octets
Pixel 32 bits = 4 octets

Et vu que lazarus fait du padding il faut mieux se baser sur 4 octets par pixel

(32768 * 32768) * 4 = 4294967296 octets / 1024 = 4194304 ko / 1024 = 4096 Mo = 4Go

On a donc atteint la limite pour un système 64 bits

Prenons la taille maximum en largeur 32768 et la moitié en hauteur soit 16384

(32768 * 16384) * 4 = 2147483648 octets / 1024 = 2097152 Ko / 1024 = 2048 Mo = 2Go

La limite en 32 bits est atteinte

J'ai testé sous Win10 64 bits (+16go de Ram), The Big image avec FastOne image Viewer, XNView et Gimp tous les 3 arrivent à la lire et l'afficher sans problème.
Avec mon outils, je me suis pris un Runtime 203 (= "Plus de mémoire disponible" en gros)

Après quelques recherches ici même et chez les voisins

A la suite de quoi j'ai modifié mon lpr comme ceci. Solution valide seulement sous Windows. Je n'ai pas encore testé sous Linux, ni sous MacOS :

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
Program BeanzPictureViewer;
 
{$mode objfpc}{$H+}
 
Uses
  {$IFDEF UNIX}
    cLocal,  
    {$IFDEF UseCThreads}
      cthreads,
    {$ENDIF}
  {$ENDIF}
  Interfaces, LCLIntf,
  {$ifdef WINDOWS } //--> ajout
  Windows,// this includes the LCL widgetset
  {$ENDIF}
  Forms, Dialogs, uMainForm,uErrorBoxForm
  { you can add units after this };
 
{$R *.res}
Const  //--> ajout
  cHeapMinSize : ptruint = $FFFFFFFF;
  cHeapMaxSize : ptruint = $FFFFFFFF;
 
Begin
  RequireDerivedFormResource := True;
 
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TErrorBoxForm, ErrorBoxForm);
  Application.Run;
  if not(SetProcessWorkingSetSize(MainForm.Handle ,cHeapMinSize, cHeapMaxSize )) then //--> ajout
    ShowMessage('Impossible ( heap )');
End.

Plus de Runtime Error 203.

Puis, dans ma procédure de chargement d'une image vers mon "image". Pour info j'utilises les unités de FPC du paquet PASJPEG que l'on trouve ici : \fpcsrc\packages\pasjpeg\

puis maintenant je me prend un gros SIGSEGV dans le code ci-dessous :

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
  MemStream := nil;
 Memory.Seek(0,soBeginning);
  MemStream := TMemoryStream.Create;
  MemStream.SetSize(Memory.Size);
  Globallogger.LogStatus('MemStream Size = '+inttostr(MemStream.Size));
  Globallogger.LogStatus('Memory    Size = '+inttostr(Memory.Size));
               Move(Memory.GetBuffer^,MemStream.Memory^,Memory.Size); //------> gros SIGSEGV ICI
  MemStream.Position:=0;
 
  FillChar(FInfo,SizeOf(FInfo),0);
 
  FError:=jpeg_std_error;
  FInfo.err := @FError;
  jpeg_CreateDecompress(@FInfo, JPEG_LIB_VERSION, SizeOf(FInfo));
  FProgressMgr.pub.progress_monitor := @ProgressCallback;
  FProgressMgr.instance := Self;
  FInfo.progress := @FProgressMgr.pub;
 
  jpeg_stdio_src(@FInfo, @MemStream);
  jpeg_read_header(@FInfo, TRUE);
 
  bmpWidth := FInfo.image_width;
  bmpHeight := FInfo.image_height;
  FGrayscale := FInfo.jpeg_color_space = JCS_GRAYSCALE;
  FProgressiveEncoding := jpeg_has_multiple_scans(@FInfo);
 
  // On sauvegarde en local les dimensions de l'image
  MemStream.Position:=0;

Dans mon log :

Code :

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

1
2
  Globallogger.LogStatus('MemStream Size = '+inttostr(MemStream.Size));
  Globallogger.LogStatus('Memory    Size = '+inttostr(Memory.Size));

Ces 2 valeurs sont identiques

[STATUS] MemStream Size = 233682756
[STATUS] Memory Size = 233682756

Je me suis dis Jipete c'est un fou. Pourquoi tu infliges un tel truc à ton PC. ??? Les mesures de temps que tu donnes m'effraies. Franchement je te tire mon chapeau pour ta patience. J'ai converti avec Gimp cette superbe image en BMP 24bits pour un résultat de 1,5 Go environ.

Et là cette fois je prend un SIGSEGV dans une de mes procédures qui intervient à la fin du chargement des donnée de l'image. Ici j'utilse un composant genre TImage avec un "buffer" pour le traitement et l'affichage de l'image chargée :

donc en gros si mon image pèse 1Go j'en 2 Tampon de 1Go soit 2Go +


Et la je me dis que ce n'est pas un problème d'allocation et ou de fragmentation de la mémoire. la fonction Move est peut être limitée ??

Voici comment réagis mon application avec la mémoire



et la paf de nouveau ( à : 0% | 1960 mo ) , le Runtime Error 203 dans :

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
Procedure TBZCustomBitmap.PutImage(Const ASrcBmp: TBZCustomBitmap; SrcX, SrcY, cfWidth, cfHeight: Integer; DstX, DstY: Integer;
  Const ADrawMode: TBZBitmapDrawMode = dmSet; Const AAlphaMode: TBZBitmapAlphaMode = amNone;
  Const SrcFactor: TBZBlendingFactor = bfOne; Const DstFactor: TBZBlendingFactor = bfDstAlpha);
 
Var
  TotalSize, xx, yy, i, nextSrcLine, nextDstLine: Integer;
  LineSize: Longint;
  SrcPtr, DstPtr: PBZColor;
  DstPix, SrcCol, DstCol: TBZColor;
 
Begin
  if (cfWidth=0) and (cfHeight=0) then exit;
 
  {%H-}ClipCopyRect(SrcX, SrcY, cfWidth, cfHeight, DstX, DstY, ASrcBmp.Width, ASrcBmp.Height, Types.Rect(0, 0, Self.Width, Self.Height));
 
  SrcPtr := ASrcBmp.GetPixelPtr(SrcX, SrcY);
 
  DstPtr := self.GetPixelPtr(DstX, DstY);
 
  If (cfWidth <= ASrcBmp.Width) Then
    nextSrcLine := ASrcBmp.Width
  Else
    nextSrcLine := SrcX + (ASrcBmp.Width - (SrcX + cfWidth));
 
 
  If (ADrawMode = dmSet) And (AAlphamode = amNone) Then
  Begin
    if (((ASrcBmp.Width = FWidth) and (ASrcBmp.Height = FHeight)) and ((cfWidth = FWidth) and (cfHeight = FHeight))) then
      Move(SrcPtr^,DstPtr^,DWord(ASrcBmp.Size)) // ---->> SIGSEGV ICI ( Runtime Error 203 )
    else
    begin

Le log comme quoi mon BMP est chargé

[STATUS] ------------------- LOADING : H:\BeanzMaster\Downloads\The_Garden_of_Earthly_Delights_by_Bosch_High_Resolution.bmp
[NOTICE] [ 16:55:38 ] Version detected : Windows Bitmap 4.0
[NOTICE] [ 16:55:38 ] InternalReadSize : 122
[STATUS] Width : 30000
[STATUS] Height : 17078
[STATUS] Bpp : 24
[STATUS] Bmp Size : 1537020122
[STATUS] Offset : 122
[STATUS] File Size : 1537020122
[STATUS] gapSize1 = 0 Cols 24 = 0
[STATUS] gapSize1 = 0 Cols 32 = 0
[STATUS] Read ABitCount = 24

La suite plus tard.......

[anapurna]

Salut

Dis-moi, ton Fdata ne serait pas un peu sous-dimensionné dans ton TcustomBitmap ?

Tu l'utilises dans ta fonction self.GetPixelPtr(DstX, DstY); mais je ne vois pas où tu initialises la taille.

[mm_71]

As-tu assez de mémoire sur ton système ? Chez moi ( Mint 18.3 ) ImageMagic fonctionne sans souci en quelques secondes mais envoie brièvement la mémoire à plus de 6 Go mais pas un programme écrit avec Lazarus qui donne un résultat curieux.
1: Il met une éternité ( presque 10 minutes ) à charger l'image et générer un thumbnail en poussant la mémoire à 8Go mais au final l'image est noire même si correctement chargée ).
2: Ceci fait il tourne au ralenti ( Presque une minute pour pouvoir déplacer le curseur et entrer un nom de fichier ).
3: Sauvegarde et conversion en 800*600: L'apocalypse : Il me colle la mémoire au plafond ( 16 Go ) ainsi que le swap ( 3,3 / 4 Go ) pendant plusieurs minutes et monopolise tout le système. Pendant ce temps je surveille l'arrivée de l'image et je vois que la vignette de l'explorateur de fichier attachée au fichier en cours d'enregistrement montre bien l'image. Mais surprise ! Au bout de quelques temps elle vire au noir et c'est fini.
4: Il faut que je ferme mon programme pour récupérer la mémoire et l'usage normal de l'ordi.
Je n'utilise que les fonctions les plus basiques pour la gestion des images.
Il semble que ce soit un problème de taille et pas de poids, les images de mon APN sont bien plus lourdes et passent sans souci.

[Jipété]

As-tu assez de mémoire sur ton système ? Chez moi ( Mint 18.3 ) ImageMagic fonctionne sans souci en quelques secondes mais envoie brièvement la mémoire à plus de 6 Go mais pas un programme écrit avec Lazarus qui donne un résultat curieux.

Je n'ai que 4 Go et je peux dire que faire bosser Gimp sur ce fichier a réveillé mon fichier de swap !
Et fallait pas être pressé.
Mais il s'en est sorti.

Il semble que ce soit un problème de taille et pas de poids, les images de mon APN sont bien plus lourdes et passent sans souci.

Pas compris : les images de ton APN pèsent plus que 233 Mo ?

+++
De mon côté, j'en suis là :
J'ai écrit ça, ce matin :

LoadFromStream(AStream: TStream; ASize: Cardinal);

OK, la taille est un cardinal, donc max 2^32 soit 4294967296 et la racine carrée c'est 65536.

Cette histoire de racine carrée pour avoir un carré avec H = L c'est faux et complètement idiot (c'te chaleur c'est terrible ! )

On pourrait très bien avoir une image ayant une hauteur de 1 ligne (après tout, j'en ai généré tout plein pour faire avancer l'autre discussion).

1 ligne de pixel(s), le "s" entre parenthèses car au minimum 1 (j'ai fait des fichiers ainsi), 1 pixel de 32 bits d'accord (et tant pis pour le 24 bits) et donc un maximum de 4294967296 bits div 32 = 134217728 pixels.
134 millions de pixels ! Ouch ! (et presque 179 millions si on était en 24 bits).

Si je teste cette valeur démente avec Gimp dans la boîte de dialogue de création d'image, il refuse silencieusement et remet 640 : après plusieurs tests, je constate que la valeur maximum autorisée est de 262144 pixels de large, ce qui correspond à 65536 x 4. Pourquoi ce nombre ?

Faudra que je vérifie si c'est en rapport avec la taille max d'image définie dans les préférences --> non, je me suis autorisé 256 Mo et de toute façon, si j'essaye de créer plus grand, il m'en informe et me demande la permission. En attendant j'ai maintenant un fichier de 1 048 698 bytes, et ce que je ne comprends pas c'est que 262144x1x32 = 8388608, et 1048698 x 8 (pour avoir des bits) - 8388608 = 976 : ça me semble beaucoup pour un header, même v4...

Remarquez comme la boîte de dialogue est trompeuse an niveau de l'intitulé :


Je tente d'ouvrir ce fichier avec mon outil, --> "Invalid floating point operation", mais on sait qu'en fait (j'en ai parlé dans la vieille discussion sur les grandes tailles), c'est quand le déboggeur est + ou - en vrac, et qu'il ne sera pas capable de nous dire où ça coince.
En attendant, un showmessage(inttostr(bmpFic.Width)+ ' ' +inttostr(bmpFic.Height)); donne les bonnes valeurs, et si après je fais un exit pour ne rien afficher, ben j'ai quand même le message du déboggeur en vrille.
Idem avec 262144x2, alors que le viewer de Linux ouvre les deux.

Va-t-il falloir passer des heures d'essais et d'échecs pour tenter de trouver ces valeurs maximum cachées au fond de codes mal fichus ?

Nota : si je supprime tout ce qui est affichage (la conversion vers TLazinftImage, le TImage), je n'ai plus de plantage :


Jérome, génère la même image que moi (262144 x 1 x 32) et donne tes chiffres, qu'on compare, parce que je ne sais pas que faire avec ce 1048576 qu'on voit sur ma copie d'écran.
On dirait que c'est la limite : 1048576 div 32 = 32768, tiens donc !

[mm_71]

Pas compris : les images de ton APN pèsent plus que 233 Mo ?

Oups... Erreur de ma part.
A part ça j'ai fait un autre test. Réduction de l'image à 1200 Px. de large et retour dans mon programme et surprise: L'image s'affiche mais la vignette auto-générée pour la grille est toujours noire !
Je lance la réduction à 800 Px de large pensant que le résultat serait également noir, ben non, j'ai mon image ! Je relance le programme avec cette nouvelle image dans le répertoire de traitement et cette fois le thumbnail est généré correctement.

Si je teste cette valeur démente avec Gimp dans la boîte de dialogue de création d'image, il refuse silencieusement et remet 640 : après plusieurs tests, je constate que la valeur maximum autorisée est de 262144 pixels de large, ce qui correspond à 65536 x 4. Pourquoi ce nombre ?

Avec gimp 2.8.16 je n'ai pas ça, j'ai juste cette boîte de dialogue:



Et en cliquant sur valider sans modifier les préférences j'ai mon image vierge sur laquelle je fais un graffiti vite fait ( 7,5 Mo pour l'image ). Test avec mon programme = Images noires comme précédemment.
Dans les exifs j'ai "color space uncalibrated". Serait-ce une piste ?
Je n'en sais pas plus.

[mm_71]

@foetus.

Complètement HS mais tu devrais remettre un fichier index sur ton site avant que free ne le fasse valser pour stockage.

[BeanzMaster]

salut

dis moi ton Fdata ne serais pas un peu sous dimensionné dans ton TcustomBitmap

tu l'utilise dans ta fonction
mais je ne vois pas ou tu initialise la taille

Mon tampon est initialisé plus haut comme ceci

Code :

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

1
2
3
 // On initialise les dimensions de notre bitmap
  SetSize(bmpWidth, bmpHeight);
  Clear(clrTransparent);

Et voici le code de SetSize

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
Procedure TBZCustomBitmap.SetSize(NewWidth, NewHeight: Integer);
Begin
  If (FWidth = Abs(NewWidth)) And (FHeight = Abs(NewHeight)) Then exit;
  FWidth := Abs(NewWidth); // abs au cas ou cela serai négatif (lors d'un chargement de fichier incorrecte par exemple)
  FHeight := Abs(NewHeight);
 
  // Les dimension ne peuvent pas être égale à zero, on ajuste
  If FWidth = 0 Then FWidth := 1;
  If FHeight = 0 Then FHeight := 1;
 
  FSize := (Int64(FWidth) * Int64(FHeight))*4; //sizeof(TBZColor); //FImageDescription.Description.PixelSize;
 
  FMaxWidth := FWidth - 1;
  FMaxHeight := FHeight - 1;
  FMaxSize := (Int64(FWidth) * Int64(FHeight)) - 1;
  FCenterX := (FWidth Shr 1) - 1;
  FCenterY := (FHeight Shr 1) - 1;
  FClipRect.Create(0, 0, FMaxWidth, FMaxHeight);
  If FSurfaceBuffer <> nil Then
  Begin
    ReAllocMem(FSurfaceBuffer, 0);
    FreeMem(FSurfaceBuffer);
    FSurfaceBuffer := nil;
  End;
  ReallocMem(FSurfaceBuffer, FSize);
 
  setLength(FScanLineLUT, FHeight);
 
  ComputeScanLineLUT;
 
  If FUsePalette Then
  Begin
    ReAllocMem(FImageIndexBuffer, 0);
    FreeMem(FImageIndexBuffer);
    FImageIndexBuffer := nil;
    ReAllocMem(FImageIndexBuffer, (FWidth*FHeight)*Sizeof(DWord));
  End;
  //    updateProperties;
  NotifyChange(self);
End;

Jérome, génère la même image que moi (262144 x 1 x 32) et donne tes chiffres, qu'on compare, parce que je ne sais pas que faire avec ce 1048576 qu'on voit sur ma copie d'écran.
On dirait que c'est la limite : 1048576 div 32 = 32768, tiens donc !

C'est fait l'image ne fait que 1 mo elle s'affiche donc parfaitement dans mon outil



J'ai fais une petite modification dans le lpr par rapport à mon précédent message . SetProcessWorkingSetSize n'etait pas placé correctement

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
Const
  cHeapMinSize : ptruint = $FFFFFFFF;
  cHeapMaxSize : ptruint = $FFFFFFFF;
 
Begin
  RequireDerivedFormResource := True;
 
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TErrorBoxForm, ErrorBoxForm);
 
  if not(SetProcessWorkingSetSize(Application.MainFormHandle ,cHeapMinSize, cHeapMaxSize )) then
    ShowMessage('Impossible de locker la heap');
 
  Application.Run;
 
End.

Et là miracle mon outil affiche l'image au format BMP. Mais à l'affichage, elle est en vrac, seul la partie basse est correctement visible. Je dois avoir une erreur lors du transfert des donnée avec mon objet Memory. Et ce qui est bizarre c'est que le ShowMessage('Impossible de locker la heap'); apparait Notes FastOneImage viewer se vautre royalement en me renvoyant une dimension de 1x1 et XNView l'affiche bien.



Voici les infos extraites par mon outil



Voici la classe de mon objet Memory en l'état actuel

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
Const
  { DefaultBufferedStreamBlockSize : par défaut tampon de 64Mo }
  DefaultBufferedStreamBlockSize = 1024 * 1024 * 64;
  DefaultCharsDelims = #8#9#10#13#32;
 
Type
   { TBZCustomBufferedStream:  Classe d'aide à la lecture et ou ecriture de données dans un flux (TStream).@br
      L'acces se fait par le biais d'un tampon de taille définie.
 
      L'acces aux données est un acces directe en mémoire et se fait de façon séquentielle.@br
      TBZCustomBufferedStream contient de nombreuse procedures et fonctions optimisées
      pour la lecture et l'écriture de valeurs de différents types.@br
      Disponibles en 2 versions "Little-Endian" ( et "Big-Endian" non codé encore).
 
      Cette classe ameliore surtout les performances d'accès aux données de fichiers physique.@br
      Ne pas employer directement TBZCustomBufferedStream. Utilsez la classe TBZBufferedStream
      et les autres classes descendantes.
  }
  TBZCustomBufferedStream = Class(TStream)
  Private
    Procedure LoadBuffer; Virtual;//(var Buf; BufSize: integer) : integer; virtual;
    Procedure WriteBuffer; Virtual;
 
  Protected
    Stream:     TStream; // Les données que l'on veux exploiter
    StreamSize: Int64; // La taille des données du stream
    StreamPosition: Int64; // Position dans le stream
    AutoFreeStream: Boolean; //Indicateur si l'on doit libérer le stream ou pas
    StreamViewStart, StreamViewEnd, StreamViewLength: Int64; // position et longueur du tampon dans le stream
    //StreamViewStartPtr, FZStreamViewEndPtr : PByte; // pointe directement sur le debut ou la fin peut-être utile dans certain cas (lecture depuis la fin par ex)
    StreamBytesLeft: Int64; // Nombre d'octet qui reste à lire
    StreamBytesRead: Int64; // Nombre d'octet deja lu (égual à FZStreamPosition+1)
 
 
    Buffer:     Pointer; //PByte; // Tampon mémoire pour l'acces au donnée par bloque
    BufferDefaultSize: Int64; // Taille du tampon par defaut
    BufferSize: Int64; // Taille réelle du tampon
    BufferPosition: Int64;  // Position dans le tampon
    BufferBytesRead, BufferBytesWrite: Int64;  // Nombre d'octet deja lu ou écrit dans le tampon
    BufferBytesLeft: Int64; // Nombre d'octet qui reste à lire dans le tampon
 
    FUseAlignedCache: Boolean; // On aligne la taille du tampon sur 32bit (accélère les échanges mémoire dans certain cas)
    StrideSize: Byte; //Taille en octet à ajouté à la fin du tampon pour l'alignement des données
 
    NeedStreamWrite : Boolean;
    BytesInBuf : Integer;
    BytesWritten: Integer;
 
    Procedure SetSize(Const NewSize: Int64); Override;
    Function GetStreamPosition: Int64;
 
  Public
    { @name : Create new buffered stream with a define Block Size (default 64Mb) }
    Constructor Create(Const aBlockSize: Integer = DefaultBufferedStreamBlockSize);
    { @name : Create new buffered stream from a legacy TStream object with a define Block Size (default 64Mb) }
    Constructor Create(AStream: TStream; Const aBlockSize: Integer = DefaultBufferedStreamBlockSize); Overload;
    { @name :  Destroy the stream }
    Destructor Destroy; Override;
    { @name :  Assign raw buffer to data }
    Procedure AssignBuffer(aBuffer: Pointer; aSize: Longint);
    { @name :  Assign legacy TStream object }
    Procedure AssignStream(aStream: TStream);
    { @name : Empty cache buffer }
    Procedure Flush;
    { @name : Read data of size "Count" and stored values in "aBuffer" }
    Function Read(Var aBuffer; Count: Longint): Longint; Override;
    { @name :  Write a Buffer data of size "Count" in Buffered Stream }
    Function Write(Const aBuffer; Count: Longint): Longint; Override;
    { @name : Move at position "Offset" according to the "Origin" }
    Function Seek(Const Offset: Int64; Origin: TSeekOrigin): Int64; Override;
    Function SeekForward(Offset : Int64):Int64;
    Function SeekBackward(Offset : Int64):Int64;
 
    { Routines de lecture et de déplacement dans le tampon }
 
 
    { @name : Read a byte at the current position }
    Function ReadByte: Byte;
    { @name : Write a Byte value at the current position }
    procedure WriteByte(Const Value : Byte);
    { @name : Skip next byte from the current position }
    Procedure SkipNextByte(Const aCount: Integer = 1);
    { @name : Move to previous byte from the current position }
    Procedure GotoPreviousByte(Const aCount: Integer = 1);
    { @name : If data is text, move to the next string Line }
    Procedure GotoNextStringLine;
    { @name : Read a Word value at the current position }
    Function ReadWord: Word;
    procedure WriteWord(Const Value : Word);
    { @name : Read an Integer value at the current position }
    Function ReadInteger: Integer;
    { @name : Write an Integer value at the current position }
    procedure WriteInteger(Const Value : Integer);
    { @name : Read a LongWord value at the current position }
    Function ReadLongWord: Longword;
    { @name : Write a LongWord value at the current position }
    procedure WriteLongWord(Const Value : LongWord);
    { @name : Read a LongInt value at the current position }
    Function ReadLongint: Longint;
    { @name : Write a Longint value at the current position }
    procedure WriteLongint(Const Value : Longint);
    { @name : Read a Cardinal value at the current position }
    Function ReadCardinal: Cardinal;
    { @name : Write a Cardinal value at the current position }
    procedure WriteCardinal(Const Value : Cardinal);
    { @name : Read a Single value at the current position }
    Function ReadSingle: Single;
    { @name : Write a Single value at the current position }
    procedure WriteSingle(Const Value : Single);
    { @name : Read a Double value at the current position }
    Function ReadDouble: Double;
    { @name : Write a Double value at the current position }
    procedure WriteDouble(Const Value : Double);
    { @name : Read a Char value at the current position }
    Function ReadChar: Char;
    { @name : Write a Char value at the current position }
    procedure WriteChar(Const Value : Char);
    { @name : Read the next char without moving position }
    Function ReadNextChar: Char;
    { @name : Skip chars in CharsDelim. (By default Space, tab, EOL) }
    Procedure SkipChar(Const CharsDelim: String = DefaultCharsDelims);
    {@name : Read full line of text }
    Function ReadLnString: String;
    //procedure WriteLnString(Const Value : String);
    { @name : Read a string of undefined length }
    Function ReadString: String;
    //procedure WriteString(Const Value : String);
    { @name : Read a string of length "len" }
    Function ReadString(len: Integer): String; Overload;
    { @name : Read a token string delimited by "CharsDelim" }
    Function ReadStrToken(Const CharsDelim: String = DefaultCharsDelims): String;
    { @name : Read an Integer token from data string }
    Function ReadStrIntToken: Integer;
    { @name : Clear data and set to ZERO }
    Procedure Clear;
    { @name : Returns the raw datas }
    Function GetBuffer: Pointer;
    { @name : Save stream }
    procedure Save;
    { @name : Returns the buffer as a string. @br
         *****Warning: Max 64MB or the size you've defined when creating TBZBufferdStream }
    Function GetBufferAsString: String;
    { @name : Check if we are on the End of Stream }
    Function EOS: Boolean;
 
    //property UseAlignedCache: Boolean read FUseAlignedCache write FUseAlignedCache;
 
    { Get the total of stream }
    Property Size: Int64 read StreamSize;
    { Get current postion in the stream }
    Property position: Int64 read GetStreamPosition;
    property BytesLeft : Int64 read BufferBytesLeft;
  End;
 
  { @name : Descendant class type of TBZCustomBufferedStream }
  TBZCustomBufferedStreamClass = Class Of TBZCustomBufferedStream;
 
  { TBZBufferedStream : See @link(TBZCustomBufferedStream) for more informations }
  TBZBufferedStream = Class(TBZCustomBufferedStream);
 
Implementation
 
{%region%=====[ TBZCustomBufferedStream ]=====================================}
 
Constructor TBZCustomBufferedStream.Create(Const aBlockSize: Integer = DefaultBufferedStreamBlockSize);
Begin
  Inherited Create;
  Buffer := nil;
  BufferDefaultSize := aBlockSize;
  BufferSize := BufferDefaultSize;
  BufferBytesRead := 0;
  BufferBytesLeft := -1;
  BufferPosition := 0;
 
  Stream := nil;
  StreamSize := BufferSize;
  StreamPosition := 0;
  StreamViewStart := 0;
  StreamViewEnd := 0;
  StreamViewLength := 0;
  AutoFreeStream := False;
  StreamBytesLeft := 0;
  StreamBytesRead := 0;
 
  NeedStreamWrite := False;
  BytesInBuf := 0;
End;
 
Constructor TBZCustomBufferedStream.Create(AStream: TStream; Const aBlockSize: Integer = DefaultBufferedStreamBlockSize);
Begin
  Inherited Create;
  Buffer := nil;
  BufferDefaultSize := aBlockSize;
  BufferSize := BufferDefaultSize;
  BufferBytesRead := 0;
  BufferBytesLeft := -1;
  BufferPosition := 0;
 
  Stream := nil;
  StreamSize := BufferSize;
 
  NeedStreamWrite := False;
  BytesInBuf := 0;
 
  Stream := AStream;
  StreamSize := AStream.Size;
 
  StreamPosition := 0;
  StreamViewStart := 0;
  StreamViewEnd := 0;
  StreamViewLength := 0;
  AutoFreeStream := False;
  StreamBytesLeft := StreamSize;
  StreamBytesRead := 0;
End;
 
Destructor TBZCustomBufferedStream.Destroy;
Begin
 
  If AutoFreeStream Then FreeAndNil(Stream);
  //FreeAndNil(Buffer);
  ReAllocMem(Buffer, 0);
  FreeMem(Buffer);
  Buffer := nil;
  Inherited Destroy;
End;
 
Procedure TBZCustomBufferedStream.Flush;
Begin
 
  //Clear;
  StreamViewStart := BufferPosition;
  //StreamViewEnd :=
  // StreamViewLength :=StreamViewEnd - StreamViewStart + 1;
  StreamBytesLeft := StreamSize - BufferPosition;
  BufferSize := BufferDefaultSize;
 
  BufferBytesRead := 0;
  BufferBytesLeft := -1;//BufferSize;
  BufferPosition := 0;
  BytesInBuf := 0;
  NeedStreamWrite := False;
End;
 
Procedure TBZCustomBufferedStream.LoadBuffer;
Var
  SeekResult: Integer;
  RSize:      Longint;
Begin
  //GlobalLogger.LogNotice('Load Buffer from file');
  // C'est la 1er fois ? on initialise le tampon
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
 
  // Fin des données, plus rien à lire, on remet tout a zero et on s'en va
  If (StreamViewStart > StreamSize - 1) Or (StreamBytesLeft <= 0) Then
  Begin
 
    // BufferPosition:=0;
    BufferBytesRead := 0;
    BufferBytesLeft := 0;
    StreamViewLength := 0;
    StreamBytesLeft := 0;
    StreamViewStart := 0;
    StreamViewEnd := 0;
    //EndOFZStream := true;
    exit;
  End;
 
  // On se place sous la bonne fenètre
  SeekResult := Stream.Seek(StreamViewStart, soBeginning);
  If SeekResult = -1 Then
    Raise EStreamError.Create('TBZCustomBufferedStream.LoadBuffer: Erreur lors du positionnement dans le flux');
  If (StreamBytesLeft < BufferDefaultSize) Then
    Rsize := StreamBytesLeft
  Else
    RSize := BufferDefaultSize;
  // On lit les données, et on transfert dans le tampon
  BufferSize := Stream.Read(Buffer^, RSize);
  If BufferSize <= 0 Then
    Raise EStreamError.Create('TBZCustomBufferedStream.LoadBuffer: Erreur lors de la Lecture du flux');
 
  // On met à jour les marqueurs de la "fenêtre" de lecture du Stream pour le chargement
 
  StreamPosition := StreamViewStart;
  StreamViewLength := BufferSize;
  StreamViewEnd := StreamViewStart + StreamViewLength - 1;
  If StreamViewEnd >= StreamSize Then
    Raise EStreamError.Create('TBZCustomBufferedStream.LoadBuffer: Index StreamViewEnd hors limite');
  Dec(StreamBytesLeft, BufferSize);
  Inc(StreamBytesRead, BufferSize);
 
  // On reinitialise les marqueurs du Buffer
  BufferPosition := 0;
  BufferBytesRead := 0;
  BufferBytesLeft := BufferSize;
 
End;
 
Procedure TBZCustomBufferedStream.WriteBuffer;
var
  SeekResult: Integer;
begin
  {$IFDEF DEBUG}GlobalLogger.LogNotice('Ecriture du fichier sur le disque');{$ENDIF}
  If Not (Assigned(Buffer)) Then Exit; // rien à écrire
 // if Not(NeedStreamWrite) or (BytesInBuf<=0) then exit; // On n'a pas demandé l'ecriture ou il n'y a rien à écrire
 
  SeekResult := Stream.Seek(StreamViewStart, soBeginning);
  if SeekResult = -1 then
    raise EStreamError.Create('TBZCustomBufferedStream.WriteBuffer: Erreur lors du positionnement dans le flux');
 
  BytesWritten := Stream.Write(Buffer^, BytesInBuf);
  if BytesWritten <> BytesInBuf then
    raise EStreamError.Create('TBZCustomBufferedStream.LoadBuffer: Erreur lors de l''ecriture du flux');
 
  Dec(BytesInBuf,BytesWritten);
  if BytesinBuf<>0 then ShowMessage('TBZCustomBufferedStream.LoadBuffer: Erreur probable lors de l''ecriture du flux');
  NeedStreamWrite := False;
End;
 
Procedure TBZCustomBufferedStream.SetSize(Const NewSize: Int64);
Begin
  ReAllocMem(Buffer, NewSize);
  BufferSize := NewSize;
  BufferPosition := 0;
  BufferBytesRead := 0;
  BufferBytesWrite := 0;
  BufferBytesLeft := NewSize;
End;
 
Function TBZCustomBufferedStream.GetStreamPosition: Int64;
Begin
  Result := StreamViewStart + BufferPosition;
End;
 
Function TBZCustomBufferedStream.Read(Var aBuffer; Count: Longint): Longint;
Var
  NumOfBytesToCopy, NumOfBytesLeft: Longint;  //, NumOfBytesRead
  CachePtr, BufferPtr: PByte;
Begin
  {$IFDEF DEBUG}
    GlobalLogger.LogNotice('Read Data in Buffer : '+Inttostr(Count)+' Octets');
    GlobalLogger.LogStatus(' - Stream Position : '+Inttostr(Position));
    GlobalLogger.LogStatus(' - Buffer Position : '+Inttostr(BufferPosition));
    GlobalLogger.LogStatus(' - Buffer Bytes Left : '+Inttostr(BufferBytesLeft));
    GlobalLogger.LogStatus(' - Stream Bytes Left : '+Inttostr(StreamBytesLeft));
    GlobalLogger.LogStatus(' - Stream Size : '+Inttostr(StreamSize));
    GlobalLogger.LogStatus(' - Buffer Size : '+Inttostr(BufferSize));
  {$ENDIF}
  Result := 0;
  If (StreamBytesLeft > 0) then NumOfBytesLeft := Count
    else if (Count>BufferBytesLeft) then NumOfBytesLeft := BufferBytesLeft
    else NumOfBytesLeft := Count;
 
  BufferPtr := @aBuffer;
 
  While NumOfBytesLeft > 0 Do
  Begin
 
    If (BufferBytesLeft <= 0) Then
    Begin
      //StreamViewStart := StreamViewStart + BufferPosition;
      Flush;
      LoadBuffer; // On charge un nouveau tampon depuis le stream
    End;
    // On copie les données
    NumOfBytesToCopy := Min(BufferSize - BufferPosition, NumOfBytesLeft);
    CachePtr := Buffer;
    Inc(CachePtr, BufferPosition);
 
    Move(CachePtr^, BufferPtr^, NumOfBytesToCopy);
    Inc(Result, NumOfBytesToCopy);
    Inc(BufferPosition, NumOfBytesToCopy);
    Inc(BufferPtr, NumOfBytesToCopy);
    // On met à jour les marqueur de notre tampon
    Inc(BufferBytesRead, NumOfBytesToCopy);
    Dec(BufferBytesLeft, NumOfBytesToCopy);
    Dec(NumOfBytesLeft, NumOfBytesToCopy);
 
  End;
  {$IFDEF DEBUG}
    GlobalLogger.LogStatus(' - New Buffer Position : '+Inttostr(BufferPosition));
    GlobalLogger.LogStatus(' - New Stream Position : '+Inttostr(Position));
  {$ENDIF}
End;
 
Function TBZCustomBufferedStream.Write(Const aBuffer; Count: Longint): Longint;
Var
  NumOfBytesToCopy, NumOfBytesLeft, NumOfBytesWriteLeft: Longint;
  CachePtr, BufferPtr: PByte;
 // BytesWritten : Longint;
Begin
  {$IFDEF DEBUG}
    GlobalLogger.LogNotice('Write Data in Buffer : '+Inttostr(Count)+' Octets');
    GlobalLogger.LogStatus(' - Stream Position : '+Inttostr(Position));
    GlobalLogger.LogStatus(' - Buffer Position : '+Inttostr(BufferPosition));
    GlobalLogger.LogStatus(' - Bytes in buf  : '+Inttostr(BytesInBuf));
    GlobalLogger.LogStatus(' - Stream Bytes Left : '+Inttostr(StreamBytesLeft));
    GlobalLogger.LogStatus(' - Stream Size : '+Inttostr(StreamSize));
    GlobalLogger.LogStatus(' - Buffer Size : '+Inttostr(BufferSize));
  {$ENDIF}
  Result := 0;
  NumOfBytesLeft := Count;
 // If (BufferSize>0) and (BytesInBuf+1 > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  BufferPtr := @aBuffer;
 // NumOfBytesToCopy := 0;
  While NumOfBytesLeft > 0 Do
  Begin
    NumOfBytesToCopy := 0;
    If (BufferPosition + NumOfBytesLeft) >= pred(BufferSize) Then NumOfBytesToCopy := Pred(BufferSize) - BufferPosition;
    NumOfBytesWriteLeft := NumOfBytesLeft-NumOfBytesToCopy;
    //if NumOfBytesWriteLeft < 0 then NumOfBytesWriteLeft:=0;
 
    if NumOfBytesToCopy>0 then
    begin
      CachePtr := Buffer;
      Inc(CachePtr, BufferPosition);
      Move(BufferPtr^,CachePtr^, NumOfBytesToCopy);
 
      //Inc(BufferPosition, NumOfBytesToCopy-1);
      Inc(BufferPtr, NumOfBytesToCopy);
      Inc(BytesInBuf, NumOfBytesToCopy); //BytesInBuf:=BufferSize;
      BufferPosition := BytesInBuf-1; //-1 car on commence à la position 0
      NeedStreamWrite := True;
      WriteBuffer;
      Inc(Result, NumOfBytesToCopy);
      Dec(NumOfBytesLeft,NumOfBytesToCopy);
      Flush;
    end
    else
    begin
      CachePtr := Buffer;
      Inc(CachePtr, BufferPosition);
      Move(BufferPtr^, CachePtr^, NumOfBytesWriteLeft);
      //Inc(BufferPosition,NumOfBytesWriteLeft);
      Inc(BytesInBuf,NumOfBytesWriteLeft);
      BufferPosition := BytesInBuf;
 
      Dec(NumOfBytesLeft,NumOfBytesWriteLeft);
      Inc(Result,NumOfBytesWriteLeft);
    End;
  end;
end;
 
Function TBZCustomBufferedStream.Seek(Const Offset: Int64; Origin: TSeekOrigin): Int64;
Var
  //NewBufStart, 
  NewPos: Integer;
Begin
  // Calcul de la nouvelle position
  Case Origin Of
    soBeginning: NewPos := Offset;
    soCurrent: NewPos := StreamViewStart + BufferPosition + Offset;
    soEnd: NewPos := pred(StreamSize) - Offset;
    Else
      Raise Exception.Create('TBZCustomBufferedStream.Seek: Origine Invalide');
  End;
  Result :=NewPos;
 // if Offset = 0 then exit;
 
  // Calcul de la fenêtre du stream, alignement des données
//  NewBufStart := NewPos and not Pred(BufferSize);
  //NewBufStart := NewPos - (StreamViewStart mod BufferSize);
 (*  if NewBufStart <> StreamViewStart then
  begin
 
    StreamViewStart := NewBufStart;
    StreamPosition := NewBufStart;
    BufferBytesLeft:=0;
  end
  else StreamPosition := NewPos; //- NewBufStart;  *)
  if NeedStreamWrite then
  begin
    WriteBuffer;
    NeedStreamWrite := False;
    Flush;
  end;
 
  BufferPosition := NewPos;
  BufferBytesLeft := BufferSize - BufferPosition;
  Result := NewPos;
  {$IFDEF DEBUG}
    GlobalLogger.LogStatus(' - Seek New Buffer Position : '+Inttostr(BufferPosition));
    GlobalLogger.LogStatus(' - Seek New Stream Position : '+Inttostr(Position));
  {$ENDIF}
End;
 
Function TBZCustomBufferedStream.SeekForward(Offset: Int64): Int64;
Begin
  result := Seek(Abs(Offset),soCurrent);
  //SkipNextByte(Abs(Offset));
  //result := Position;
End;
 
Function TBZCustomBufferedStream.SeekBackward(Offset: Int64): Int64;
Begin
  if Offset>0 then Offset := -Offset;
  result := Seek(Offset,soCurrent);
  ////Offset := Position - Offset;
  ////result := Seek(Offset,soBeginning);
  //GotoPreviousByte(Abs(Offset));
  //result := Position;
End;
 
Procedure TBZCustomBufferedStream.AssignBuffer(aBuffer: Pointer; aSize: Longint);
Begin
  SetSize(aSize);
  Move(aBuffer^, Buffer, aSize);
End;
 
Procedure TBZCustomBufferedStream.Save;
begin
  if BytesInBuf>0 then
  begin
    NeedStreamWrite := True;
    WriteBuffer;
    Flush;
  End;
End;
 
Procedure TBZCustomBufferedStream.AssignStream(aStream: TStream);
Var
  ms: TMemoryStream;
Begin
  If (aStream Is TCustomMemoryStream) Then
  Begin
    //    AssignBuffer(TCustomMemoryStream(aStream).Memory,aStream.Size);
    Stream := TCustomMemoryStream(aStream);
    StreamSize := TCustomMemoryStream(aStream).Size;
    StreamPosition := 0;
    StreamViewStart := 0;
    StreamViewEnd := StreamSize - 1;
    StreamViewLength := StreamSize;
    StreamBytesLeft := StreamSize;
    StreamBytesRead := 0;
    AutoFreeStream := False;
  End
  Else
  Begin
    ms := TMemoryStream.Create;
    With ms Do
    Begin
      CopyFrom(aStream, 0);
      Position := 0;
    End;
    Stream := ms;
    StreamSize := ms.Size;
    StreamPosition := 0;
    StreamViewStart := 0;
    StreamViewEnd := StreamSize - 1;
    StreamViewLength := StreamSize;
    StreamBytesLeft := StreamSize;
    StreamBytesRead := 0;
    AutoFreeStream := True;
  End;
End;
 
Function TBZCustomBufferedStream.ReadByte: Byte;
Begin
  If (BufferBytesLeft < 1) Then
  Begin
    Flush;
    LoadBuffer;
  End;
  Result := PByte(Buffer + BufferPosition)^;
  Inc(BufferPosition);
  Inc(BufferBytesRead);
  Dec(BufferBytesLeft);
End;
 
Procedure TBZCustomBufferedStream.WriteByte(Const Value: Byte);
Begin
  If (BufferSize>0) and (BytesInBuf+1 > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PByte(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition);
  Inc(BytesInBuf);
End;
 
Procedure TBZCustomBufferedStream.SkipNextByte(Const aCount: Integer = 1);
Begin
  If (BufferBytesLeft <  aCount) Then
  Begin
    Flush;
    LoadBuffer;
  End;
 
  Inc(BufferPosition, aCount);
  Inc(BufferBytesRead, aCount);
  Dec(BufferBytesLeft, aCount);
End;
 
Procedure TBZCustomBufferedStream.GotoPreviousByte(Const aCount: Integer = 1);
Begin
  { TODO 0 -oBZStreamClasses -cTBZCustomBufferedStream : GotoPreviousByte. Gérer le rechargement en arriere du buffer }
  Dec(BufferPosition,aCount);
  Dec(BufferBytesRead,aCount);
  Inc(BufferBytesLeft,aCount);
End;
 
Function TBZCustomBufferedStream.ReadWord: Word;
Begin
  If (BufferBytesLeft < 2) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PWord(Buffer + BufferPosition)^;
  Inc(BufferPosition, 2);
  Inc(BufferBytesRead, 2);
  Dec(BufferBytesLeft, 2);
End;
 
Procedure TBZCustomBufferedStream.WriteWord(Const Value: Word);
Begin
  If (BufferSize>0) and ((BytesInBuf+2) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PWord(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition,2);
  Inc(BytesInBuf,2);
End;
 
Function TBZCustomBufferedStream.ReadInteger: Integer;
Begin
  If (BufferBytesLeft < 4) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PInteger(Buffer + BufferPosition)^;
  Inc(BufferPosition, 4);
  Inc(BufferBytesRead, 4);
  Dec(BufferBytesLeft, 4);
End;
 
Procedure TBZCustomBufferedStream.WriteInteger(Const Value: Integer);
Begin
  If (BufferSize>0) and ((BytesInBuf+4) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PInteger(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition,4);
  Inc(BytesInBuf,4);
End;
 
Function TBZCustomBufferedStream.ReadLongint: Longint;
Begin
  If (BufferBytesLeft < 4) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PLongint(Buffer + BufferPosition)^;
  Inc(BufferPosition, 4);
  Inc(BufferBytesRead, 4);
  Dec(BufferBytesLeft, 4);
End;
 
Procedure TBZCustomBufferedStream.WriteLongint(Const Value: Longint);
Begin
  If (BufferSize>0) and ((BytesInBuf+4) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PLongint(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition,4);
  Inc(BytesInBuf,4);
End;
 
Function TBZCustomBufferedStream.ReadLongWord: Longword;
Begin
  If (BufferBytesLeft < 4) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PLongWord(Buffer + BufferPosition)^;
  Inc(BufferPosition, 4);
  Inc(BufferBytesRead, 4);
  Dec(BufferBytesLeft, 4);
End;
 
Procedure TBZCustomBufferedStream.WriteLongWord(Const Value: LongWord);
Begin
  If (BufferSize>0) and ((BytesInBuf+4) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PLongWord(Buffer + BufferPosition)^ := value;
  Inc(BytesInBuf,4);
  BufferPosition := BytesInBuf;
End;
 
Function TBZCustomBufferedStream.ReadCardinal: Cardinal;
Begin
  If (BufferBytesLeft < 4) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PCardinal(Buffer + BufferPosition)^;
  Inc(BufferPosition, 4);
  Inc(BufferBytesRead, 4);
  Dec(BufferBytesLeft, 4);
End;
 
Procedure TBZCustomBufferedStream.WriteCardinal(Const Value: Cardinal);
Begin
  If (BufferSize>0) and ((BytesInBuf+4) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PCardinal(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition,4);
  Inc(BytesInBuf,4);
End;
 
Function TBZCustomBufferedStream.ReadSingle: Single;
Var
  ts: Byte;
Begin
  ts := SizeOf(Single);
  If (BufferBytesLeft < ts) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PSingle(Buffer + BufferPosition)^;
 
  Inc(BufferPosition, ts);
  Inc(BufferBytesRead, ts);
  Dec(BufferBytesLeft, ts);
End;
 
Procedure TBZCustomBufferedStream.WriteSingle(Const Value: Single);
Var
  ts: Byte;
Begin
  ts := SizeOf(Single);
  If (BufferSize>0) and ((BytesInBuf+ts) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PSingle(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition,ts);
  Inc(BytesInBuf,ts);
End;
 
Function TBZCustomBufferedStream.ReadDouble: Double;
Var
  ts: Byte;
Begin
  If (BufferBytesLeft < 8) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PDouble(Buffer + BufferPosition)^;
  ts := SizeOf(Double);
  Inc(BufferPosition, ts);
  Inc(BufferBytesRead, ts);
  Dec(BufferBytesLeft, ts);
End;
 
Procedure TBZCustomBufferedStream.WriteDouble(Const Value: Double);
Var
  ts: Byte;
Begin
  ts := SizeOf(Double);
  If (BufferSize>0) and ((BytesInBuf+ts) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PDouble(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition,ts);
  Inc(BytesInBuf,ts);
End;
 
Function TBZCustomBufferedStream.ReadChar: Char;
Begin
  If (BufferBytesLeft < 1) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PChar(Buffer + BufferPosition)^;
  Inc(BufferPosition);
  Inc(BufferBytesRead);
  Dec(BufferBytesLeft);
End;
 
Procedure TBZCustomBufferedStream.WriteChar(Const Value: Char);
Begin
  If (BufferSize>0) and ((BytesInBuf+1) > pred(BufferSize)) Then Save;
  If Not (Assigned(Buffer)) Then SetSize(BufferDefaultSize);
  PChar(Buffer + BufferPosition)^ := value;
  Inc(BufferPosition);
  Inc(BytesInBuf);
End;
 
Function TBZCustomBufferedStream.ReadNextChar: Char;
Begin
  If (BufferBytesLeft < 1) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := PChar(Buffer + BufferPosition)^;
End;
 
Procedure TBZCustomBufferedStream.GotoNextStringLine;
Var
  c: Char;
  sLineEnding: String;
Begin
  sLineEnding := #13#10;
  C := ReadChar;
  While ((BufferPosition < BufferSize) And Not (pos(C, sLineEnding) > 0)) Do
  Begin
    C := ReadChar;
  End;
  If (C = #13) Then ReadChar;      //or (C=#10)
End;
 
Function TBZCustomBufferedStream.ReadLnString: String;
Var
  C1, C2: Char;
  Stop:   Boolean;
  S:      String;
Begin
  If (BufferBytesLeft <= 0) Then
  Begin
    flush;
    loadbuffer;
  End;
  S := '';
  Stop := False;
  While Not (Stop) And (BufferPosition <= BufferSize - 1) Do
  Begin
    C1 := ReadChar;
    If (C1 = #13) Or (C1 = #10) Then
    Begin
      Stop := True;
      C2 := ReadChar;
      If (C2 In [#32..#255]) Then
      Begin
        Dec(BufferPosition);
        Dec(BufferBytesRead);
        Inc(BufferBytesLeft);
      End;
      // S:=S+C1;
    End
    Else
    Begin
      If (C1 = #9) Or (C1 = #32) Or (C1 In [#32..#255]) Then
        S := S + C1;
    End;
  End;
  Result := S;
End;
 
Function TBZCustomBufferedStream.ReadString(len: Integer): String;
Var
  S: String;
  TmpBuffer: PByte;
Begin
  //GlobalLogger.LogNotice('ReadString At : '+IntToStr(GetPosition));
  If (BufferBytesLeft < Len) Then
  Begin
    flush;
    loadbuffer;
  End;
  Result := '';
  S := '';
  SetLength(S, Len);
  Move(PChar(Buffer + BufferPosition)^, S[1], Len);
  TmpBuffer := Pointer(S) + Len;
  TmpBuffer^ := 0;
  Result := S;
  Len:=Len-1;
  Inc(BufferPosition, Len);
  Inc(BufferBytesRead, Len);
  Dec(BufferBytesLeft, Len);
 
End;
 
Function TBZCustomBufferedStream.ReadString: String;
Var
  Len: Integer;
  TmpBuffer: PByte;
Begin
  Len := ReadInteger;
  SetLength(Result, Len);
  Read(Pointer(Result), Len);
  TmpBuffer := Pointer(Result) + Len;
  TmpBuffer^ := 0;
End;
 
Procedure TBZCustomBufferedStream.SkipChar(Const CharsDelim: String = DefaultCharsDelims);
Var
  c: Char;
Begin
  C := ReadChar;
  While ((BufferPosition < BufferSize) And (pos(C, CharsDelim) > 0)) Do
  Begin
    C := ReadChar;
  End;
  Dec(BufferPosition);
  Dec(BufferBytesRead);
  Inc(BufferBytesLeft);
End;
 
Function TBZCustomBufferedStream.ReadStrToken(Const CharsDelim: String = DefaultCharsDelims): String;
Var
  LastC: Char;
Begin
  Result := '';
  SkipChar(CharsDelim);
  LastC := ReadChar;
  While ((BufferPosition < BufferSize) And Not (pos(LastC, CharsDelim) > 0)) Do
  Begin
    SetLength(Result, Length(Result) + 1);
    Result[Length(Result)] := LastC;
    LastC := ReadChar;
  End;
End;
 
Function TBZCustomBufferedStream.ReadStrIntToken: Integer;
Var
  LastC: Char;
  S:     String;
Begin
  Result := -1;
  S := '';
  SkipChar(DefaultCharsDelims);
  LastC := ReadChar;
  While ((BufferPosition < BufferSize) And (pos(LastC, '0123456789') > 0)) Do
  Begin
    SetLength(S, Length(S) + 1);
    S[Length(S)] := LastC;
    LastC := ReadChar;
  End;
  If s <> '' Then
  Begin
    Result := StrToInt(S);
    GotoPreviousByte;
  End;
End;
 
Procedure TBZCustomBufferedStream.Clear;
Begin
  FillByte(PByte(Buffer)^, BufferSize, 0);
End;
 
Function TBZCustomBufferedStream.GetBuffer: Pointer;
Begin
  Result := Buffer;
End;
 
Function TBZCustomBufferedStream.GetBufferAsString: String;
Var
  S: String;
Begin
  If (BufferBytesLeft <= 0) Then
  Begin
    flush;
    loadbuffer;
  End;
  SetLength(S, BufferSize);
  Move(PChar(Buffer)^, S[1], BufferSize);
  Result := S;
End;
 
Function TBZCustomBufferedStream.EOS: Boolean;
Begin
  Result := False;
  If ((StreamBytesLeft <= 0) And (BufferBytesLeft <= 0)) Then Result := True;
  //if result then GlobalLogger.LogWarning('EOS');
  //result:= GetStreamPosition>=StreamSize;
End;

J'ai eu autre classe qui utilise le FileMapping mais elle n'est pas finalisée j'ai encore quelques erreurs. va falloir que je me penche dessus. Car j'ai l'impression qu'en réalité toutes les données du fichier BMP ne sont pas lues, ce qui provoquerai cet erreur d'affichage.

Voic la boucle de lecture des données de l'image dans le fichier 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
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
  pf32Bits:  // Pas de compression, formats couleurs suivant "BitField" sinon format couleur par defaut BGRA
    Begin
      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);
          SrcPtr := PLongWord(LineBuffer);
          X:= Width;
          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;

Note : Avec le JPG j'obtiens la même erreur. Runtime 203

[Jipété]

Avec gimp 2.8.16 je n'ai pas ça, j'ai juste cette boîte de dialogue:

Ah, ma version est bien plus vieille, ici, où tout est vieux : la machine, moi, Gimp (2.8.2)...

On va dire un grand merci à foetus, j'ai tout bien récupéré mais il m'a fallu lancer une machine virtuelle Seven pour avoir accès au contenu du dossier compressé, ensuite Gimp a fait chauffer le swap je vous dis pas !, ça m'a pris un temps dément et je me retrouve avec un fichier de 1,2 Go.
Même pas j'essaye de l'ouvrir avec mes outils Lazarus. T'as essayé, toi ?


+++

Note : Avec le JPG j'obtiens la même erreur. Runtime 203

Test avec mon programme = Images noires comme précédemment.
Dans les exifs j'ai "color space uncalibrated". Serait-ce une piste ?

Me demande si on n'est pas en train de découvrir un nouveau gag...

[BeanzMaster]

Ah, ma version est bien plus vieille, ici, où tout est vieux : la machine, moi, Gimp (2.8.2)...

On va dire un grand merci à foetus, j'ai tout bien récupéré mais il m'a fallu lancer une machine virtuelle Seven pour avoir accès au contenu du dossier compressé, ensuite Gimp a fait chauffer le swap je vous dis pas !, ça m'a pris un temps dément et je me retrouve avec un fichier de 1,2 Go.
Même pas j'essaye de l'ouvrir avec mes outils Lazarus. T'as essayé, toi ?

Oui L'image est chargée mais s'affiche mal. Ce problème viens de chez moi de mon "memory" semblerait-il



J'ai aussi créé 2 images avec Gimp

La première de 16000x16000 *4 soit 1Go

Pas de soucis avec celle-la mon outil l'affiche sans broncher



La 2eme de 32000x16000 *4 soit 2Go

Idem que "FireFoxLarge" l'image est chargée mais ne s'affiche pas correctement



Ca me confirme que pour moi ici c'est dans mon code qu'il y a une erreur

J'essayerai de testé sous Linux demain

EDIT : J'ai placé un log dans ma fonction test Size voici le résultat avec le bmp en 32000x16000

[STATUS] ------------------- LOADING : H:\BeanzMaster\Documents\BigImage_32000x16000.bmp
[NOTICE] [ 00:54:31 ] Version detected : Windows Bitmap 1.0
[NOTICE] [ 00:54:31 ] InternalReadSize : 54
[STATUS] Width : 32000
[STATUS] Height : 16000
[STATUS] Bpp : 24
[STATUS] Bmp Size : 1536000054
[STATUS] Offset : 54
[STATUS] File Size : 1536000054
[STATUS] gapSize1 = 0 Cols 24 = 0
[STATUS] gapSize1 = 0 Cols 32 = 0
[STATUS] Read ABitCount = 24
[STATUS] BPP == 24
[NOTICE] [ 00:54:31 ] ------> Used Color : 0
[STATUS] GAPSIZE 1 = 0
[STATUS] *BitCount = 24
[STATUS] Red Shift = 16
[STATUS] Green Shift = 8
[STATUS] Blue Shift = 0
[STATUS] Alpha Shift = 0
[STATUS] Red Size = 8
[STATUS] Green Size = 8
[STATUS] Blue Size = 8
[STATUS] Alpha Size = 0
[STATUS] BitFields Size = 12
[NOTICE] [ 00:54:31 ] TBZCustomBitmap.SetSize : 32000x16000 ----------------------------> Création du bitmap en 32 bits qui reçois l'image
[NOTICE] [ 00:54:31 ] TBZCustomBitmap.SetSize Buffer size : 2048000000 ----> Taille 2Go OK
[NOTICE] [ 00:54:33 ] Load palette : 0
[NOTICE] [ 00:54:39 ] IgnoreAlpha
[NOTICE] [ 00:54:40 ] TBZCustomBitmap.SetSize : 32000x16000 ----------------------------> Création du bitmap en 32 bits temporaire dont j'ai parlé plutôt qui est utilisé dans mon composant
[NOTICE] [ 00:54:40 ] TBZCustomBitmap.SetSize Buffer size : 2048000000 ----> Taille 2Go OK

[BeanzMaster]

Avec gimp 2.8.16 je n'ai pas ça, j'ai juste cette boîte de dialogue:

Sous Gimp, il faut aller dans Edition ---> Préférences

Et en cliquant sur valider sans modifier les préférences j'ai mon image vierge sur laquelle je fais un graffiti vite fait ( 7,5 Mo pour l'image ). Test avec mon programme = Images noires comme précédemment.
Dans les exifs j'ai "color space uncalibrated". Serait-ce une piste ?
Je n'en sais pas plus.

C'est possible que le "color space" puisse jouer un rôle dans l'affichage

[Jipété]

Oui L'image est chargée mais s'affiche mal. Ce problème viens de chez moi de mon "memory" semblerait-il

De ton décodage du header, plutôt :



Moi je vois 6C en 0E₁₆ donc v4, 18 en 1C₁₆ donc pf24bit et 00 en 1E₁₆ donc rgba...

[BeanzMaster]

De ton décodage du header, plutôt :



Moi je vois 6C en 0E₁₆ donc v4, 18 en 1C₁₆ donc pf24bit et 00 en 1E₁₆ donc rgba...

Chez moi :



Nos paramètres ne semble pas être les mêmes

Options gimp :

[Jipété]

Nos paramètres ne semblent pas être les mêmes

Ah oui, lors de l'export du png en bmp ! Moi j'ai choisi rgb 24bits histoire d'avoir un fichier plus petit,

Allez, au pieu

[BeanzMaster]

J'ai testé sous Linux avec FireFoxLarge.bmp même combat mon affichage est foireux



J'essayerai demain sans l'utilisation mon composant TBZImage

[mm_71]

Sous Gimp, il faut aller dans Edition ---> Préférences

Oui, je sais mais j'ai voulu voir ce que ça donnait en cliquant direct sur valider et ça fonctionne quand même.
A part ça j'ai refait qualques essais avec une image gimp en .jpg ( Juste un grafitti sur fond blanc ) et mon programme. Les résultats:


16000 * 16000 OK
32000 * 1000 OK
1000 * 32000 Beaucoup plus long à traiter que 32000 * 1000 mais OK
32000 * 16000 Noir ( Pixel vu par GHex: 8A 28 A0 02 )
32000 * 10000 Bordel général ( Image jointe ) et sauvegarde noire.



Manifestement c'est une question de nombre de pixels dans l'image, au delà d'une certaine limite Tpicture ne gère plus rien. ( J'ai aussi essayé avec l'image d'origine convertie en gris ou en couleurs indexées et même résultat ) donc ce n'est pas un problème de poids en octets.

[Jipété]

Bonjour,

16 bits c'est un Word en Pascal, 0..65535, le SmallInt c'est 16 bits aussi mais signé, soit -32768..0..32767
1 cardinal c'est 2^32=4294967296 bits, le maximum autorisé pour un stream.
Si on regroupe ces bits par paquets de 32 (qu'on pourra appeler RGBQuad par ex., ou pixel [de 32 bpp]), le max autorisé de ces choses devient 134217728.
D'un autre côté, le max autorisé par Gimp c'est 262144, mais le max de quoi ? Note : 262144x512=134217728.
Tout ça je l'ai déjà dit hier, mais ça n'est pas plus clair ce matin...

Manip Gimp : création d'une image 4x1x24 remplie avec le bel orange pour bien repérer les pixels dans l'afficheur hexa et exportée sans "informations de couleur" pour aller à l'essentiel :


On voit bien les données cruciales de taille, en 12₁₆ pour la largeur et 16₁₆ pour la hauteur, et plus bas, les pixels de 3 bytes étant coloriés pour les voir vite, on en a bien 4, répartis sur 1 ligne.

Il est donc bien question de X lignes de Y pixels pour The Gimp (dit dans l'ordre de lecture : il y a tant de pixels par ligne, et tant de lignes), le nombre de lignes max étant là aussi de 262144 (testé tout-à-l'heure).
Si les pixels sont de 32 bpp, une ligne au max va "peser" 262144x32=8388608 bits. Si je mets hauteur et largeur au max, le message d'alerte m'informe que l'image serait de 640,5 Go ! Je n'ai pas confirmé la demande, on ne saura donc jamais comment l'engin se serait comporté.

Mais c'est très bizarre car si je fais showmessage(inttostr(8388608 * 262144)); ça m'affiche avec des espaces pour y voir clair 2 199 023 255 552, soit 2,2 Tera bits et donc, divisé par 8, 27 487 790 694 bytes : 27,5 Go. D'où Gimp sort son 640 Go ?
Quelqu'un pour vérifier/expliquer ça ? Merci.

+++
Par ailleurs, hier soir j'ai relu toute la discussion de l'année dernière (qui s'est terminée en eau de boudin, sans conclusion définitive), et j'ai refait des tests avec le moule donné par Yves, adapté au fur et à mesure des posts, je le remets ici (avec quelques commentaires et notes de l'autre discussion) car je m'en suis servi ce matin, pour reprendre les tests de mm_71 :

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
procedure TForm1.Button1Click(Sender: TObject);
var
  b: TBitmap;
  w,h: integer;
begin
// 24/07 : je reprends les tests de mm_71 (Linux 32 bits, vieux Gimp, vieux Laz 1.4) :
//  w := 16000;  h := 16000; // fichier de 0 byte créé + proc à bloc...
//  w := 32000;  h :=  1000; // image affichée noire (ok avec viewer, Gimp et ImageMagick, mais ImageJ n'affiche rien)
//  w :=  1000;  h := 32000; // parfaitement correct
//  w := 32000;  h := 16000; // fichier de 0 byte créé et c'est tout.
//  w := 32000;  h := 10000; // fichier de 0 byte créé + proc à bloc + message "out of mem" au bout d'un moment.
 
//w := 12000;  h := 8000; // long à venir mais ça a fonctionné (fic = 384 Mo)
//w := 12300;  h := 8200; // long à venir mais ça a fonctionné (fic = 302 Mo, bien plus petit que dessus !)
w := 16000;  h := 6000; // long à venir mais ça a fonctionné (fic = 384 Mo)
 
  b := TBitmap.Create;
  b.PixelFormat := pf32bit;
//  b.Width:=32768;  b.Height:=16384;
  // Ludelpho7 post 19 : j'ai lancé un gros 31000x16384 qui a pris du temps, mais qui marche,
  //b.Width:=31000;  b.Height:=16384; // plante comm' d'hab
  //b.Width:=32000;  b.Height:=16000; // BM : post 26 out of memory
                                    // BM : Lazarus 1.6.4 64bits sous windows 10 : max = 32767x16383
                                    // jpt : ça plante, mais 12287x8191 ça génère un fichier pf32bit de 402 Mo.
  b.Width:=w;  b.Height:=h;
  b.Canvas.Pen.Color:=clLime; // ligne à rajouter
  b.Canvas.Brush.Color:=clLime;
  b.Canvas.Rectangle(0, 0, w, h);
  b.Canvas.Changed; //--> BM Pour que l'enregistrement soit ok
  b.SaveToFile('/test.bmp');  // plante ici
  b.Free;  // on relache la mémoire avant le chargement de l'image
  Application.ProcessMessages;// jpt, pour que l'affichage redessine le bouton
  Image1.Picture.LoadFromFile('/test.bmp');
{  b.Width := 8000;  b.Height:= 8000;
génère un fichier de 256 Mo qui s'ouvre sans problème avec le visionneur de fichiers
de Linux tout comme avec The Gimp mais une tentative avec Lazarus
(TBitmap, TPicture, TImage) se solde par un délog/relog violent de la session, alors méfiance !}
 
{lien donné (http://www.fileformat.info/format/bmp/egff.htm) ne veut rien dire "Maximum Image Size : 32Kx32K and 2Gx2G pixels"}
 
{jpt : la limite serait basée sur des integer d'il y a 30 ans donc 16 bits donc 32768
mais pour la hauteur on se souvient que selon que la valeur est positive ou négative
l'image sera construite top2bottom ou bottom2top (ou l'inverse),
on n'a donc plus que 16384 valeurs disponibles pour la hauteur.}
end;

Les résultats àmha les plus hallucinants :

Code :

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

1
2
//  w := 32000;  h :=  1000; // image affichée noire (ok avec viewer, Gimp et ImageMagick, mais ImageJ n'affiche rien)
//  w :=  1000;  h := 32000; // parfaitement correct

et

Code :

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

1
2
//w := 12000;  h := 8000; // long à venir mais ça a fonctionné (fic = 384 Mo)
//w := 12300;  h := 8200; // long à venir mais ça a fonctionné (fic = 302 Mo, bien plus petit que dessus !)

Je ne sais pas ce qu'il faut aller chercher, ni où, une chose est sure, on a un brave problème sur les bras...

[mm_71]

Bon, ben accrochez vous j'ai du lourd ( Et vérifié à plusieurs reprises ) avec Lazarus 1.8 sous Mint 18.3 64 bits.
On obtient un résultat différent selon que b.width et b.height soient fixés par un variable ou directement par un nombre en dur.
Additif: Quand il n'y a pas de résultat terminal sous les variables c'est qu'il n'a rien renvoyé.

Avec w:=32768; h:=16384; Bmp= 0 Octets et ferme l'appli.

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
(project1:30178): Gdk-CRITICAL **: IA__gdk_draw_rectangle: assertion 'GDK_IS_DRAWABLE (drawable)' failed
ERROR in LCL: TGtk2WidgetSet.RawImage_FromDrawable
Creating gdb catchable error:
 
  $000000000061CE29 line 731 of lazloggerbase.pas
  $000000000054FA47 line 1446 of lclproc.pas
  $000000000054DE3F line 914 of lclproc.pas
  $000000000046E0EB line 3238 of gtk2/gtk2widgetset.inc
  $00000000004882A1 line 719 of gtk2/gtk2lclintf.inc
  $000000000055A619 line 167 of include/lclintf.inc
  $000000000056D266 line 210 of include/custombitmap.inc
  $000000000056DD7E line 496 of include/custombitmap.inc
  $0000000000580747 line 167 of include/fpimagebitmap.inc
The program 'project1' received an X Window System error.
This probably reflects a bug in the program.
The error was 'BadAlloc (insufficient resources for operation)'.
  (Details: serial 1042 error_code 11 request_code 53 minor_code 0)
  (Note to programmers: normally, X errors are reported asynchronously;
   that is, you will receive the error a while after causing it.
   To debug your program, run it with the --sync command line
   option to change this behavior. You can then get a meaningful
   backtrace from your debugger if you break on the gdk_x_error() function.)

Mais avec b.Width:=32768; b.Height:=16384; Bmp 0 octets, l'appli reste active jusqu'a ce qu'on la ferme.

Avec w := 32000; h := 16000 Bmp et rechargement dans tpicture correct mais recharge une image noire.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
ERROR in LCL: TGtk2WidgetSet.CreateBitmapFromRawImage Incompatible DataSize
Creating gdb catchable error:
 
  $000000000061CE29 line 731 of lazloggerbase.pas
  $000000000054FA47 line 1446 of lclproc.pas
  $000000000054DE3F line 914 of lclproc.pas
  $0000000000487A76 line 421 of gtk2/gtk2lclintf.inc
  $000000000055A519 line 152 of include/lclintf.inc
  $0000000000564A75 line 2338 of graphics.pp
  $000000000056A605 line 188 of include/rasterimage.inc
  $000000000056A7E6 line 234 of include/rasterimage.inc
  $0000000000574527 line 48 of include/canvas.inc
TRasterImage.BitmapHandleNeeded: Unable to create handles, using default

Mais avec b.Width:=32000; b.Height:=16000; Bmp=0 Octets. et RAS

Avec w := 16000; h := 16000; ( Et toutes valeurs inférieures à 32000*16000 ) 100% Fonctionnel.
Mais avec b.Width:=16000; b.Height:=16000;Message Out of Memory et aucun bmp enregistré même à 0 octets ??!!!!!!!!!????

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
TApplication.HandleException Out of memory
  Stack trace:
  $000000000043692C
  $000000000056D7A9 line 346 of include/custombitmap.inc
  $000000000056CA2A line 962 of include/rasterimage.inc
  $000000000045EC84 line 58 of unit1.pas
  $000000000053C1E8 line 2861 of include/control.inc
  $000000000059C17A line 55 of include/buttoncontrol.inc
  $000000000059C95F line 169 of include/buttons.inc
  $000000000059C062 line 21 of include/buttoncontrol.inc
  $0000000000430C7F
  $000000000052DECC line 5396 of include/wincontrol.inc
  $00000000006FA25C line 112 of lclmessageglue.pas
  $000000000070BBBB line 2415 of gtk2/gtk2wsstdctrls.pp

On dirait entre autre chose que le type de la variable pour w et h influence sérieusement le résultat mais j'arrête ici, j'ai le bocal qui perd de l'huile !

Pour Jipete: Ton système est trop ancien et limité en mémoire, j'arrive à en bouffer 10Gb + du swap avec mes tests.

Code :

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

1
2
3
4
5
//  w := 16000;  h := 16000; // fichier de 0 byte créé + proc à bloc...
//  w := 32000;  h :=  1000; // image affichée noire (ok avec viewer, Gimp et ImageMagick, mais ImageJ n'affiche rien)
//  w :=  1000;  h := 32000; // parfaitement correct
//  w := 32000;  h := 16000; // fichier de 0 byte créé et c'est tout.
//  w := 32000;  h := 10000; // fichier de 0 byte créé + proc à bloc + message "out of mem" au bout d'un moment.

Tout ce qui est ci-dessus fonctionne chez moi.