Discussion :

[Charly910]

Bonjour,

j'ai un truc bizarre avec l'image Toto.bmp provenant de mon scanner.

Si je fais :

Code :

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

1
2
  Image1.Picture.LoadFromFile('Toto.bmp') ;
   Image1.Picture.SaveToFile('Titi.bmp') ;

L'image est correcte dans Image1.

Mais si maintenant je charge Titi.bmp dans Image1, elle est inversée ; tête en bas et gauche vers droite ?

Voici les 2 images zippées : Images.zip

Comment faire pour la sauvegarder à l'endroit ?

Merci
A+
Charly

[Andnotor]

Un bitmap peut être tête en bas (habituellement) ou tête en haut (plus rarement) et le sens de lecture est donné par TBitmapInfoHeader.biHeight (valeur positive ou négative).

Mais il y a manifestement un oubli (encore présent dans Delphi 11) à la création d'un TBitmap (indépendamment de l'utilisation d'un TImage).

Un certain nombre d'éléments de l'entête ne sont pas préservés lors de l'utilisation de CreateDIBSection\GetObject et sont recopiés manuellement après ces appels. biHeight devrait manifestement également en faire partie. Il faudrait ajouter DIB.dsBmih.biHeight := bmiHeader.biHeight à la fin de la méthode TBitmap.ReadDIB.

Mais sans modifier les sources, je ne vois pas trop comment faire (pas de procédure SetDIB) si ce n'est tester le fichier avant ouverture :

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
function IsBitmapTopToBottom(const aFileName :TFileName) :boolean;
var
  Info :TBitmapInfoHeader;
Begin
  with TFileStream.Create(aFileName, fmOpenRead) do
  try
    Seek(SizeOf(BitmapFileHeader), soFromBeginning);
    Read(Info, SizeOf(Info));
 
    Result := Info.biHeight < 0;
 
  finally
    Free;
  end;
end;

et le cas échéant le remettre en ordre après écriture.

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
procedure SetBitmapTopToBottom(const aFileName :TFileName);
var
  Info :TBitmapInfoHeader;
Begin
  with TFileStream.Create(aFileName, fmOpenReadWrite) do
  try
    Seek(SizeOf(BitmapFileHeader), soFromBeginning);
    Read(Info, SizeOf(Info));
 
    if Info.biHeight > 0 then
    begin
      Info.biHeight := -Info.biHeight;
 
      Seek(SizeOf(BitmapFileHeader), soFromBeginning);
      Write(Info, SizeOf(Info));
    end;
 
  finally
    Free;
  end;
end;

[Cirec]

en fait Delphi gère très bien ce genre de bitmap inversé
sauf qu'au moment d'enregistrer le fichier Delphi converti
biHeight en valeur positive mais les données sont copiées dans l'ordre initial.

Quand tu charges un bitmap tête en bas il s'affiche correctement sans rien faire
tu peux même en faire des copies avec Assign() tout est bon, les accès avec
Scanline sont ok et quand tu le sauvegardes c'est la cata.

ce petit code, à utiliser juste avant la sauvegarde d'un bitmap tête en bas,
règle le problème et il ne change rien à un bitmap "normal".

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
procedure FixUpDownBitmap(aSource, aDest: TBitmap);
var
  Y, LineSize, BitCount: Integer;
begin
  case aSource.PixelFormat of
    pf1Bit: BitCount := 1;
    pf4Bit: BitCount := 4;
    pf8Bit: BitCount := 8;
    pf15Bit: BitCount := 15;
    pf16Bit: BitCount := 16;
    pf24Bit: BitCount := 24;
    pf32Bit: BitCount := 32;
  end;
  aDest.Assign(aSource);
    // calcul la longeur d'une ligne du Bmp Destination
  LineSize := BytesPerScanline(aSource.Width, BitCount, 32);
  for Y := 0 to aSource.Height - 1 do
    MoveMemory(aDest.ScanLine[Y], aSource.ScanLine[Y], LineSize);
end;

Cordialement,

@+

[Charly910]

Merci à tous les 2,

C'est bien la faute à biHeight.

J'ai adopté la fonction de Cirec qui fonctionne bien.

A+
Charly

[wheel]

La boucle dans le code de Cirec est superflue au premier changement une nouvelle copie sera créée ..

Code :

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

1
2
aDest.Assign(aSource);
aDest.Scaneline[0]; // juste pour déclencher change

[Andnotor]

en fait Delphi gère très bien ce genre de bitmap inversé
sauf qu'au moment d'enregistrer le fichier Delphi converti
biHeight en valeur positive mais les données sont copiées dans l'ordre initial.

Delphi ne gère pas grand chose ici

CreateDIBSection crée le bitmap tête en bas et les fonctions GDI en tiennent compte. Pour illustrer cela, ta fonction pourrait se résumer à :

Code :

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

1
2
3
aDest.PixelFormat := aSource.PixelFormat;
aDest.SetSize(aSource.Width, aSource.Height);
aDest.Canvas.Draw(0, 0, aSource);

Le problème est que Delphi, à la place de mémoriser le BitmapInfoHeader du fichier, préfère récupérer des informations fragmentaires par GetObject sur le HBitmap. Il en force bien certaines manquantes mais pas suffisamment, il manque biHeight. Résultat à la sauvegarde, l'image est inversée puisque le BitmapInfoHeader créé n'est plus conforme à l'original et ne correspond donc plus à la représentation du HBitmap.

La boucle dans le code de Cirec est superflue au premier changement une nouvelle copie sera créée ..

Une copie conforme à la source ; avec le même problème

[wheel]

Une copie conforme à la source ; avec le même problème

La copie est dans le bon ordre générée par le GDI qui affiche correctement l'image; l'inversement de l'ordre ne concerne que le stockage et GDI l'ignore comme vous l'avez constater avec GetObject.

SetSize n'est pas Disponible dans D7

[cincap]

Bonjour à toutes et à tous,

Excellent Cirec comme d'habitude ton statut devrai être repris dans les pointures de se site.

Je confirme sous Windows 11 - 64bits et D6 cela fonctionne correctement.

@+,

cincap

[cincap]

@ tous,

Par contre j'avais remarqué que sans procédure rien qu'avec le nombre de bits par couleur simplifiait la sauvegarde avec la photo de Charly910.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
procedure TForm1.BtestSauveClick(Sender: TObject);
begin
 with Image1.Picture.Bitmap do
        begin
          { on travail en couleurs pf24bit ou pf32bit }
          pixelformat := pf24bit;
 savetofile('Tititest.bmp');
 end;
 
end;

A tester pour d'autres formats !

@+,

cincap

[Andnotor]

@wheel : Au temps pour moi, Scanline lance bien un CopyImage.


Mais si c'était pour mon propre usage, je m'arrangerais quant même pour éviter cette copie.

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
type
  TBitmap = class(Vcl.Graphics.TBitmap)
  private
    InfoHeader :TBitmapInfoHeader;
  public
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  end;
 
procedure TBitmap.LoadFromStream(Stream: TStream);
Begin
  inherited;
 
  Stream.Seek(SizeOf(TBitmapFileHeader), soFromBeginning);
  Stream.Read(InfoHeader, SizeOf(TBitmapInfoHeader));
end;
 
procedure TBitmap.SaveToStream(Stream: TStream);
var
  BIH :TBitmapInfoHeader;
Begin
  inherited;
 
  if InfoHeader.biHeight >= 0 then Exit;
 
  Stream.Seek(SizeOf(TBitmapFileHeader), soFromBeginning);
  Stream.Read(BIH, SizeOf(TBitmapInfoHeader));
 
  BIH.biHeight := InfoHeader.biHeight;
 
  // S'assure qu'il n'y a pas eu de modification de taille, PixelFormat ou autre
  if not CompareMem(@BIH, @InfoHeader, SizeOf(TBitmapInfoHeader)) then Exit;
 
  Stream.Seek(SizeOf(TBitmapFileHeader), soFromBeginning);
  Stream.Write(InfoHeader, SizeOf(TBitmapInfoHeader));
end;

Mais bref, ça reste un emplâtre pour (à mon sens) un petit oubli

[Charly910]

Bonjour,

merci à tous pour ces précisions.

J'avais testé ce code expérimental (!) qui fonctionne et me redresse bien 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
24
25
26
27
28
29
{ ==================================================================== }
procedure TF_Princ.FlipImage;
Var
  Bmp, Bmp2  : TBitmap ;
  X,Y : Integer;
  SrcRect,DstRect : TRect;
begin
  Bmp := TBitmap.Create ;
  Bmp2 := TBitmap.Create;
  Try
    Bmp.PixelFormat := pf32bit ;
    Bmp.Assign(Image1.Picture.Bitmap) ;
    X := Bmp.Width;
    Y := Bmp.Height;
    Bmp2.Width := X;
    Bmp2.Height := Y;
    Bmp2.PixelFormat := pf32bit ;
    SrcRect := Rect(0,0,X,Y);
    DstRect := Rect(X,0,0,Y);
    Bmp2.Canvas.CopyRect(DstRect,Bmp.Canvas,SrcRect);
    Bmp.Assign(Bmp2) ;
    Bmp2.Canvas.CopyRect(DstRect,Bmp.Canvas,SrcRect);
    Image1.Picture.Bitmap.Assign(Bmp2) ;
  Finally
    Bmp.Free ;
    Bmp2.Free ;
  End;
End ;
{ ==================================================================== }

Il y a surement des choses qui ne servent à rien là dedans. Mon idée était au départ de retourner l'image et en le faisant 2 fois de suite, ça marchait !

AndNotOr pourra peut être me dire pourquoi ça marche et me simplifier ce code (ou me dire qu'il est idiot )

A+
Charly

[Andnotor]

Au plus simple, c'est l'exemple de cincap.

Lorsque tu modifies PixelFormat, l'image est copiée dans un nouveau TBitmapImage (interne au TBitmap) aux nouvelles caractéristiques, et puisque Delphi ne crée que des bitmaps tête en haut (GDI faisant le reste), la sauvegarde est maintenant correct.

Mais avec ton image d'exemple, passer de pf1bit à pf32bit, je te laisse imaginer la différence de taille du fichier !

Pour être plus général, une copie est générée dès que tu touches au BitmapInfoHeader. On pourrait dès lors simplement jouer sur la taille :

Code :

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

1
2
3
Bmp.LoadFromFile(...);
Bmp.Width := Bmp.Width -1;
Bmp.SaveToFile(...);

Un pixel sur tes images scannées ; tu ne verras pas la différence et l'image restera en 1 bit

[Cirec]

La boucle dans le code de Cirec est superflue au premier changement une nouvelle copie sera créée ..

Code :

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

1
2
aDest.Assign(aSource);
aDest.Scaneline[0]; // juste pour déclencher change

En d'autres mots,
chaque appel à Scanline provoque une nouvelle copie !!!
J'avais solutionné un problème similaire en réaffectant sa propre valeur au premier Pixel

Code :

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

Bitmap.Canvas.Pixels[0,0] := Bitmap.Canvas.Pixels[0,0]

Mais je ne savais pas pourquoi ça fonctionnait après cette manip.
Merci @Wheel pour cette info

Heureusement, quand c'est possible, je ne fais qu'un appel à Scanline quand je manipule les données.

Au final la procédure fond comme neige au soleil

Code :

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

1
2
3
4
5
procedure FixUpDownBitmap(aSource, aDest: TBitmap);
begin
  aDest.Assign(aSource);
  aDest.ScanLine[0];
end;

Cordialement,

@+

[Charly910]

L'image monochrome, c'était pour l'exemple. Je scanne des images en couleur.

Finalement la solution de Andnotor est très simple et fonctionne bien :

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
{ ==================================================================== }
procedure TF_Princ.FlipImage(aSource, aDest: String);
Var
  Bmp : TBitmap ;
begin
  Bmp := TBitmap.Create ;
  Try
    Bmp.PixelFormat := pf24bit ;
    Bmp.LoadFromFile(aSource);
    Bmp.Width := Bmp.Width -1;
    Bmp.SaveToFile(aDest);
  Finally
    Bmp.Free ;
  End ;
End ;
{ ==================================================================== }

Merci aussi à Cirec.

A+
Charly

[Andnotor]

En d'autres mots,
chaque appel à Scanline provoque une nouvelle copie !!!

Non, il y a un compteur de référence. Plusieurs TBitmap peuvent partager le même HBitmap et la copie ne survient normalement qu'à la modification par l'un d'eux.

[wheel]

Heureusement, quand c'est possible, je ne fais qu'un appel à Scanline quand je manipule les données.

La copie ne se produit qu'une seule fois comme disait Andnotor; ne pas utiliser Scanline dans vous manipulations implique l'utilisation d'un autre moyen à la fin afin de lancer OnChange dans le Bitmap pour afficher les changements effectués.

Andnotor
On peut utiliser le code dans le poste #10 pour gérer le format bmp dans TPicture c'est plus propre.

Code :

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

 TPicture.RegisterFileFormat('bmp','Fichier bitmap',TBitmapBis);