Discussion :

[Jipété]

Bonjour,

car pour une raison que j'ignore encore, au début d'une recopie de pixels par ScanLine (plus exactement par bmp.RawImage.GetLineStart), si le PixelFormat (pas celui de RawImage, celui du BitmapInfoHeader) est à pf32 juste avant le bmp.BeginUpdate, il est à pf24 après le EndUpdate, avec tous les effets indésirables qu'on peut supposer (SIGSEGV...)
Et impossible de l'examiner entre ces deux bornes, je me fais insulter et ça avorte.

Voilà la vie (p4src et p4dst sont des pRGBQuad, jpb c'est mon BitmapInfoHeader) :

Code :

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

1
2
3
4
5
6
7
8
9
      jpb := GetHeaderDatas(bmpDst); memo.Lines.Add(inttostr(jpb.PixelFormat)); // 32 dans le mémo
      bmpDst.BeginUpdate;
      for h := 0 to bmpSrc.Height-1 do begin
        p4dst := pRGBQuad(bmpDst.RawImage.GetLineStart(h));
        p4src := pRGBQuad(bmpSrc.RawImage.GetLineStart(h));
        for w := 0 to bmpSrc.Width-1 do p4dst[w] := tagRGBQuad(AppliquerCorrections32(p4src[w]));
      end;
      bmpDst.EndUpdate;
      jpb := GetHeaderDatas(bmpDst); memo.Lines.Add(inttostr(jpb.PixelFormat)); // 24 dans le mémo

et je suis vraiment dégouté...
Car des fois la proc arrive à recopier tous les pixels d'une image et des fois ça part en SIGSEGV sans que je comprenne pourquoi.

Je n'ai pas réussi à trouver ce qui se cachait sous EndUpdate, je n'arrive pas à "remonter" plus haut que

Code :

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

1
2
3
4
5
procedure TGraphic.Changed(Sender: TObject);
begin
  FModified := True;
  if Assigned(FOnChange) then FOnChange(Self);
end;

dans graphic.inc.

PS : la fonction AppliquerCorrections32 trafique juste les valeurs des pixels et a été testée en 24 bits où elle fonctionne très très très bien (normich, là, tout le monde est en pf24 du début à la fin et avec du tagRGBTriple) :

Code :

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

1
2
3
4
5
6
7
8
9
10
  function AppliquerCorrections32(p4: tagRGBQuad): tagRGBQuad; inline;
  var
    i,j,k: integer;
  begin
//  Result := tagRGBQuad(RGBAtoRGBAQuad(255,0,0,255)); exit; // pour test --  SIGSEGV
    i := integer(p4.rgbRed)  + rp - rm; if i > 255 then i := 255; if i < 0 then i := 0;
    // j et k c'est pareil avec rgbGreen et rgbBlue, enlevés ici pour alléger la lecture
//  Result := tagRGBQuad(RGBAtoRGBAQuad(byte(i),byte(j),byte(k),255)); // la vraie vie --  SIGSEGV
    Result := tagRGBQuad(p4); // pour test -- OK, image bien dupliquée à l'identique
  end;

Si quelqu'un avait une idée...

[anapurna]

salut

les deux images sont de la même taille ?
pourquoi ne pas passer par un tableau de bytes que tu maîtrise plutôt que d'utiliser les bitmap qui a priori font ce qu'il veulent

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
function AppliquerCorrections32(p4: tagRGBQuad): tagRGBQuad; inline;
  var
    i,j,k: integer;
  begin
   //  Result := tagRGBQuad(RGBAtoRGBAQuad(255,0,0,255)); exit; // pour test --  SIGSEGV
   // RGB <> RGBA ou RGBAtoRGBAQuad
    i := integer(p4.rgbRed)  + rp - rm; if i > 255 then i := 255; if i < 0 then i := 0;
 
    // j et k c'est pareil avec rgbGreen et rgbBlue, enlevés ici pour alléger la lecture
    // j et k quel valeur ? 
 
    //  Result := tagRGBQuad(RGBAtoRGBAQuad(byte(i),byte(j),byte(k),255)); // la vraie vie --  SIGSEGV
    // j et k ne sont pas initialisé ... plantage assuré 
 
    Result := tagRGBQuad(p4); // pour test -- OK, image bien dupliquée à l'identique
  end;

[Jipété]

salut

les deux images sont de la même taille ?
pourquoi ne pas passer par un tableau de bytes que tu maîtrise plutôt que d'utiliser les bitmap qui a priori font ce qu'il veulent

Oui, même taille : je pars d'un fichier bmp que je charge dans un TBitmap puis recopie dans un TImage (pour le voir) et recopie aussi dans un autre TBitmap en apportant des corrections aux pixels.
Je rappelle que cette manip fonctionne impeccablement avec un fichier 24 bits.

Oui, tableau de bytes, j'y avais vaguement songé, il y a les streams aussi, je vais peut-être me tourner vers cette options...

Ton problème de changement de pixelformat viens du fait que toutes tes valeurs Alpha sont à 255 c'est à dire image entièrement opaque.

Non mais c'est quoi ce délire ?
On n'a pas le droit d'avoir une image 32 bits opaque ?

Et attends, regarde ce que j'ai trouvé quand j'ai commencé à attaquer TLazIntfImage (car je m'étais rendu compte, il y a qq temps, que ça améliorait les choses -- pas toujours, on dirait ) :
Quelque part dans mon code, j'utilise donc bmpDst.LoadFromIntfImage(liiDst) et pour essayer de comprendre pourquoi mon bmpDst se retrouvait en pf24bit après cette ligne alors qu'il était en 32 avant l'instruction, j'ai pisté les choses :
Ctrl-clic sur LoadFromIntfImage envoie dans Graphics :

Code :

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

1
2
3
4
5
6
7
procedure TRasterImage.LoadFromIntfImage(IntfImage: TLazIntfImage);
var
  ImgHandle, ImgMaskHandle: HBitmap;
begin
  IntfImage.CreateBitmaps(ImgHandle, ImgMaskHandle, not IntfImage.HasMask);
  SetHandles(ImgHandle, ImgMaskHandle);
end;

CreateBitmaps envoie dans IntfGraphics :

Code :

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

1
2
3
4
5
procedure TLazIntfImage.CreateBitmaps(out ABitmap, AMask: HBitmap; ASkipMask: boolean);
begin
  if not RawImage_CreateBitmaps(FRawImage, ABitmap, AMask, ASkipMask)
  then raise FPImageException.Create('Failed to create handles');
end;

RawImage_CreateBitmaps envoie dans lclintfh.inc et la procédure est dans intfbaselcl.inc et là, on rigole :

Code :

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

1
2
3
4
function TWidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean = False): Boolean;
begin
  Result := False;
end;

Terminé -- Ça c'est du lourd de chez lourd, hein ! Plus qu'à tout jeter par la fenêtre...

[BeanzMaster]

.
Non mais c'est quoi ce délire ?
On n'a pas le droit d'avoir une image 32 bits opaque ?

Si bien sur mais c'est comme quand tu charge un un quand tu charges un bmp 32bit dont TOUS les pixels ont leur valeur Alpha à 255, le RawImage.BitCount te renvoi 24bits.

Et attends, regarde ce que j'ai trouvé quand j'ai commencé à attaquer TLazIntfImage (car je m'étais rendu compte, il y a qq temps, que ça améliorait les choses -- pas toujours, on dirait ) :
Quelque part dans mon code, j'utilise donc bmpDst.LoadFromIntfImage(liiDst) et pour essayer de comprendre pourquoi mon bmpDst se retrouvait en pf24bit après cette ligne alors qu'il était en 32 avant l'instruction, j'ai pisté les choses :
Ctrl-clic sur LoadFromIntfImage envoie dans Graphics :

Code :

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

1
2
3
4
5
6
7
procedure TRasterImage.LoadFromIntfImage(IntfImage: TLazIntfImage);
var
  ImgHandle, ImgMaskHandle: HBitmap;
begin
  IntfImage.CreateBitmaps(ImgHandle, ImgMaskHandle, not IntfImage.HasMask);
  SetHandles(ImgHandle, ImgMaskHandle);
end;

CreateBitmaps envoie dans IntfGraphics :

Code :

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

1
2
3
4
5
procedure TLazIntfImage.CreateBitmaps(out ABitmap, AMask: HBitmap; ASkipMask: boolean);
begin
  if not RawImage_CreateBitmaps(FRawImage, ABitmap, AMask, ASkipMask)
  then raise FPImageException.Create('Failed to create handles');
end;

RawImage_CreateBitmaps envoie dans lclintfh.inc et la procédure est dans intfbaselcl.inc et là, on rigole :

Code :

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

1
2
3
4
function TWidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean = False): Boolean;
begin
  Result := False;
end;

Terminé -- Ça c'est du lourd de chez lourd, hein ! Plus qu'à tout jeter par la fenêtre...

Pour la reference il faut voir a quoi est rattaché ton Widget chez toi sous linux cela devrai être GTK/Carbon
Donc chez toi, dans GTKLclIntf.inc tu devrai trouver ça

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
 
{------------------------------------------------------------------------------
  function TGtkWidgetSet.GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP;
    const SrcRect: TRect; var NewRawImage: TRawImage): boolean; override;
 ------------------------------------------------------------------------------}
function TGtkWidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect): Boolean;
var
  GdiBitmap: PGDIObject absolute ABitmap;
  GdiMask: PGDIObject absolute AMask;
  Drawable: PGdkDrawable;
  Bitmap: PGdkBitmap;
begin
  Result := false;
  {$IFDEF VerboseRawImage}
  DebugLn('TGtkWidgetSet.GetRawImageFromBitmap A');
  {$ENDIF}
  ARawImage.Init;
 
  if not IsValidGDIObject(ABitmap)
  then begin
    DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] invalid Bitmap!');
    exit;
  end;
  if (AMask <> 0) and not IsValidGDIObject(AMask)
  then begin
    DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] invalid Mask');
    exit;
  end;
 
  try
    // get rawimage for Bitmap
    case GdiBitmap^.GDIBitmapType of
      gbBitmap: begin
        Drawable := GdiBitmap^.GDIBitmapObject;
        Bitmap := nil;
      end;
      gbPixmap: begin
        Drawable := GdiBitmap^.GDIPixmapObject.Image;
        Bitmap := GdiBitmap^.GDIPixmapObject.Mask;
      end;
      gbPixbuf: begin
        Result := RawImage_FromPixbuf(ARawImage, GdiBitmap^.GDIPixbufObject, ARect);
        Exit;
      end;
    else
      DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] Unknown GDIBitmapType');
      Exit;
    end;
    {$IFDEF VerboseRawImage}
    DebugLn('TGtkWidgetSet.RawImage_FromBitmap A GdkPixmap=',DbgS(Drawable),' SrcMaskBitmap=',DbgS(Bitmap));
    {$ENDIF}
 
    //DbgDumpPixmap(Drawable, 'RawImage_FromBitmap - drawable');
    //DbgDumpBitmap(Bitmap, 'RawImage_FromBitmap - alpha');
 
    Result := RawImage_FromDrawable(ARawImage, Drawable, Bitmap, ARect);
    if Result and (AMask <> 0)
    then begin
      if GdiMask^.GDIBitmapType <> gbBitmap
      then begin
        DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] Unsupported GDIBitmapType for mask');
        Exit;
      end;
 
      Bitmap := GdiMask^.GDIBitmapObject;
      RawImage_AddMask(ARawImage, Bitmap, ARect);
      //DbgDumpBitmap(Bitmap, 'RawImage_FromBitmap - mask');
    end
    else
      ARawImage.Description.MaskBitsPerPixel := 0;
 
    if not Result
    then DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] unable to GetRawImageFromGdkWindow Image');
 
  except
    ARawImage.FreeData;
  end;
end;

et il ya aussi pour GTK2 et 3

et voilà ce que j'ai pour Win

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
 
function TWin32WidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect = nil): Boolean;
var
  WinDIB: Windows.TDIBSection;
  WinBmp: Windows.TBitmap absolute WinDIB.dsBm;
  ASize: Integer;
  R: TRect;
begin
  ARawImage.Init;
  FillChar(WinDIB, SizeOf(WinDIB), 0);
  ASize := Windows.GetObject(ABitmap, SizeOf(WinDIB), @WinDIB);
  if ASize = 0
  then Exit(False);
 
  //DbgDumpBitmap(ABitmap, 'FromBitmap - Image');
  //DbgDumpBitmap(AMask, 'FromMask - Mask');
 
  FillRawImageDescription(WinBmp, ARawImage.Description);
  // if it is not DIB then alpha in bitmaps is not supported => use 0 alpha prec
  if ASize < SizeOf(WinDIB) then
    ARawImage.Description.AlphaPrec := 0;
 
  if ARect = nil
  then begin
    R := Rect(0, 0, WinBmp.bmWidth, WinBmp.bmHeight);
  end
  else begin
    R := ARect^;
    if R.Top > WinBmp.bmHeight then
      R.Top := WinBmp.bmHeight;
    if R.Bottom > WinBmp.bmHeight then
      R.Bottom := WinBmp.bmHeight;
    if R.Left > WinBmp.bmWidth then
      R.Left := WinBmp.bmWidth;
    if R.Right > WinBmp.bmWidth then
      R.Right := WinBmp.bmWidth;
  end;
 
  ARawImage.Description.Width := R.Right - R.Left;
  ARawImage.Description.Height := R.Bottom - R.Top;
 
  // copy bitmap
  Result := GetBitmapBytes(WinBmp, ABitmap, R, ARawImage.Description.LineEnd, ARawImage.Description.LineOrder, ARawImage.Data, ARawImage.DataSize);
 
  // check mask
  if AMask <> 0 then
  begin
    if Windows.GetObject(AMask, SizeOf(WinBmp), @WinBmp) = 0
    then Exit(False);
 
    Result := GetBitmapBytes(WinBmp, AMask, R, ARawImage.Description.MaskLineEnd, ARawImage.Description.LineOrder, ARawImage.Mask, ARawImage.MaskSize);
  end
  else begin
    ARawImage.Description.MaskBitsPerPixel := 0;
  end;
end;

[BeanzMaster]

Bonjour,

car pour une raison que j'ignore encore, au début d'une recopie de pixels par ScanLine (plus exactement par bmp.RawImage.GetLineStart), si le PixelFormat (pas celui de RawImage, celui du BitmapInfoHeader) est à pf32 juste avant le bmp.BeginUpdate, il est à pf24 après le EndUpdate, avec tous les effets indésirables qu'on peut supposer (SIGSEGV...)
Et impossible de l'examiner entre ces deux bornes, je me fais insulter et ça avorte.
...
Je n'ai pas réussi à trouver ce qui se cachait sous EndUpdate, je n'arrive pas à "remonter" plus haut que

Code :

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

1
2
3
4
5
procedure TGraphic.Changed(Sender: TObject);
begin
  FModified := True;
  if Assigned(FOnChange) then FOnChange(Self);
end;

dans graphic.inc.

Salut, ici je pense qu'il ne faut pas descendre aussi bas. Il faudrait savoir quellle classe TBitmap, TLazIntf, ou TRawImage assigne ce FChange
Ton probleme de changement de pixelformat viens du fait que toutes tes valeurs Alpha sont à 255 c'est à dire image entièrement opaque.
A un moment donné lors de l'appel de EndUpdate BeginUpdate qui nous renvoi ici

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
 
procedure TCustomBitmap.UnshareImage(CopyContent: boolean);
var
  NewImage: TSharedCustomBitmap;
  OldImage: TSharedCustomBitmap;
begin
  if FSharedImage.RefCount <= 1 then Exit;
 
  // release old FImage and create a new one
  OldImage := FSharedImage as TSharedCustomBitmap;
  NewImage := GetSharedImageClass.Create as TSharedCustomBitmap;
  try
    NewImage.Reference;
    if CopyContent and OldImage.ImageAllocated //----> On passe par là
    then begin
      // force a complete rawimage, so we can copy it
      RawimageNeeded(False);
      OldImage.FImage.ExtractRect(Rect(0, 0, Width, Height), NewImage.FImage);
    end
    else begin
      // keep width, height and bpp
      NewImage.FImage.Description := OldImage.FImage.Description;
    end;
 
    FreeCanvasContext;
    FSharedImage := NewImage;
    NewImage := nil; // transaction sucessful
    OldImage.Release;
  finally
    // in case something goes wrong, keep old and free new
    NewImage.Free;
  end;
end;

Qui nous renvois vers cette fonction ou il y a un jolie commentaire

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
 
procedure TCustomBitmap.RawimageNeeded(ADescOnly: Boolean);
var
  OldChangeEvent: TNotifyEvent;
  ImagePtr: PRawImage;
  Flags: TRawImageQueryFlags;
begin
  ImagePtr := @TSharedCustomBitmap(FSharedImage).FImage;
  if ImagePtr^.Description.Format <> ricfNone
  then begin
    // description valid
    if ADescOnly then Exit;
    if (ImagePtr^.Data <> nil) and (ImagePtr^.DataSize > 0) then Exit;
    if ImagePtr^.Description.Width = 0 then Exit;  // no data
    if ImagePtr^.Description.Height = 0 then Exit; // no data
  end;
 
  .....
 
  // setup ImagePtr, fill description if not set
  if ImagePtr^.Description.Format = ricfNone
  then begin
    // use query to get a default description without alpha, since alpha drawing 
    // is not yet supported (unless asked for) ------> CA C'EST TROP FORT ! Et bien c'est fait  ON DEMANDE !!!!
    // use var and not pixelformat property since it requires a rawimagedescription (which we are creating)
    case FPixelFormat of
      pf1bit: Flags := [riqfMono, riqfMask];
      pf4bit,
      pf8bit: Flags := [riqfRGB, riqfMask, riqfPalette];
      pf32bit: Flags := [riqfRGB, riqfMask, riqfAlpha];
    else
      Flags := [riqfRGB, riqfMask];
    end;
    ImagePtr^.Description := QueryDescription(Flags, ImagePtr^.Description.Width, ImagePtr^.Description.Height);
    // atleast for now let pixelformat reflect the created description
    FPixelFormatNeedsUpdate := True;
  end;
 
....

Tiens bon j'arrive avec ma solution, hé hé hé !, Tu n'auras plus a te préoccupé du pixelformat et de tout le reste qui ne fonctionne pas avec le TBitmap ., Et c'est fournit avec tous les trucs que t'aime bien (Convolution, Resample, Blur ect...),un acces aux "Pixel" via Scanline "alla Delphi", un support des formats BMP, PixMap, TGA, PNG... bien meilleur. Taille image maximum 4Go (theoriquement on devrait pouvoir monter jusqu'à 16Go, mais j'ai pas testé) en 64bit et 2GO max en 32bit, et en plus c'est de 5 à 100x plus performant. Et c'est bourré de commentaires et d'un tas d'autres choses. Et j'ai même générer une aide avec PasDoc C'est pour bientôt car je vais avoir besoins de vous pour valider un peu tout ça.

A+

[Jipété]

Si bien sûr, mais c'est comme quand tu charges un bmp 32bit dont TOUS les pixels ont leur valeur Alpha à 255, le RawImage.BitCount te renvoie 24bits.

T'es sûr de ton coup, là ? Si oui, c'est vraiment du grand n'importe quoi !

Tiens bon j'arrive avec ma solution, hé hé hé !, Tu n'auras plus à te préoccuper du pixelformat et de tout le reste qui ne fonctionne pas avec le TBitmap ., Et c'est fourni avec tous les trucs que t'aime bien (Convolution, Resample, Blur, etc.),un accès aux "Pixel" via Scanline "ala Delphi", un support des formats BMP, PixMap, TGA, PNG... bien meilleur. Taille image maximum 4Go (théoriquement on devrait pouvoir monter jusqu'à 16Go, mais j'ai pas testé) en 64bit et 2GO max en 32bit, et en plus c'est de 5 à 100x plus performant. Et c'est bourré de commentaires et d'un tas d'autres choses. Et j'ai même générer une aide avec PasDoc C'est pour bientôt car je vais avoir besoin de vous pour valider un peu tout ça.

Tu me fais peur !
J'appréhende de me retrouver face à une usine à gaz pleine de fichiers de tous les côtés.
Moi, les trucs que j'aime, c'est une unité ou deux, pas d'installation, le uses qui va bien et roule ma poule.

Sinon,

Donc chez toi, dans GTKLclIntf.inc tu devrais trouver ça

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
function TGtkWidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect): Boolean;
var
  GdiBitmap: PGDIObject absolute ABitmap;
  GdiMask: PGDIObject absolute AMask;
  Drawable: PGdkDrawable;
  Bitmap: PGdkBitmap;
begin
  Result := false;
  {$IFDEF VerboseRawImage}
  DebugLn('TGtkWidgetSet.GetRawImageFromBitmap A');
  {$ENDIF}
  ARawImage.Init;
 
  if not IsValidGDIObject(ABitmap)
  then begin
    DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] invalid Bitmap!');
    exit;
  end;
  if (AMask <> 0) and not IsValidGDIObject(AMask)
  then begin
    DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] invalid Mask');
    exit;
  end;
 
  try
    // get rawimage for Bitmap
    case GdiBitmap^.GDIBitmapType of
      gbBitmap: begin
        Drawable := GdiBitmap^.GDIBitmapObject;
        Bitmap := nil;
      end;
      gbPixmap: begin
        Drawable := GdiBitmap^.GDIPixmapObject.Image;
        Bitmap := GdiBitmap^.GDIPixmapObject.Mask;
      end;
      gbPixbuf: begin
        Result := RawImage_FromPixbuf(ARawImage, GdiBitmap^.GDIPixbufObject, ARect);
        Exit;
      end;
    else
      DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] Unknown GDIBitmapType');
      Exit;
    end;
    {$IFDEF VerboseRawImage}
    DebugLn('TGtkWidgetSet.RawImage_FromBitmap A GdkPixmap=',DbgS(Drawable),' SrcMaskBitmap=',DbgS(Bitmap));
    {$ENDIF}
 
    //DbgDumpPixmap(Drawable, 'RawImage_FromBitmap - drawable');
    //DbgDumpBitmap(Bitmap, 'RawImage_FromBitmap - alpha');
 
    Result := RawImage_FromDrawable(ARawImage, Drawable, Bitmap, ARect);
    if Result and (AMask <> 0)
    then begin
      if GdiMask^.GDIBitmapType <> gbBitmap
      then begin
        DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] Unsupported GDIBitmapType for mask');
        Exit;
      end;
 
      Bitmap := GdiMask^.GDIBitmapObject;
      RawImage_AddMask(ARawImage, Bitmap, ARect);
      //DbgDumpBitmap(Bitmap, 'RawImage_FromBitmap - mask');
    end
    else
      ARawImage.Description.MaskBitsPerPixel := 0;
 
    if not Result
    then DebugLn('WARNING: [TGtkWidgetSet.RawImage_FromBitmap] unable to GetRawImageFromGdkWindow Image');
 
  except
    ARawImage.FreeData;
  end;
end;

il faudrait peut-être creuser ça, Result := RawImage_FromDrawable(ARawImage, Drawable, Bitmap, ARect);, mais, bonne nouvelle !, je vais sans doute m'en sortir avec TLazIntfImage, à condition de penser à l'initialiser correctement !

Les premiers tests sont positifs, le TBitmap conserve son pf32 et réussit à le transmettre au TImage d'affichage.
À suivre demain...

[Jipété]

[...] bonne nouvelle !, je vais sans doute m'en sortir avec TLazIntfImage, à condition de penser à l'initialiser correctement !

Les premiers tests sont positifs, le TBitmap conserve son pf32 et réussit à le transmettre au TImage d'affichage.
À suivre demain...

Salut, c'est "demain" et les choses ne sont pas toujours aussi simples :

Quand on lit ça, là :

Code :

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

1
2
3
4
  // create a TLazIntfImage with 32 bits per pixel, alpha 8bit, red 8 bit, green 8bit, blue 8bit,
  // Bits In Order: bit 0 is pixel 0, Top To Bottom: line 0 is top
  lRawImage.Init;
  lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);

qu'on le met en œuvre et que ça fonctionne très bien avec un fichier 32 bits, on se dit que pour un fichier 24 bits il suffirait de remplacer le .Init_BPP32 par le .Init_BPP24 qui va bien et hop !, non ?
Vous ne vous diriez pas ça, vous ?
J'ai testé, bienvenue dans la section des "messages d'erreur incompréhensibles"...

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 RaiseGDBException(const Msg: string);
 
  Raises an exception.
  Normally gdb does not catch fpc Exception objects, therefore this procedure
  raises a standard "division by zero" exception which is catched by gdb.
  This allows one to stop a program, without extra gdb configuration.
 ------------------------------------------------------------------------------}
procedure RaiseGDBException(const Msg: string);
begin
  debugln(rsERRORInLCL, Msg);
  // creates an exception, that gdb catches:
  debugln(rsCreatingGdbCatchableError);
  DumpStack;
  if (length(Msg) div (length(Msg) div 10000))=0 then ;
end;

Pour ouvrir correctement un fichier 24 bits il faut rester avec le .Init_BPP32, allez comprendre.

De plus, utiliser pour un fichier 32 bits l'initialisation avec BPP32_A8R8G8B8 ou _B8G8R8A8 ou _R8G8B8A8 ne montre aucune différence à l'affichage : ça fait peur pour la suite...


Par ailleurs, pour convertir un fichier 32 bits en fichier 24 bits j'ai découvert à mes dépens qu'il suffisait d'utiliser un dérivé du code trouvé ici, toujours dans ce foutu tuto (foutu tuto car on peut lire, au début de cette section, "Since Lazarus has no TBitmap.ScanLines property" !
Ah bon ! Et TBitmap.RawImage.GetLineStart(); c'est quoi ? Pour les chiens ? Pourtant ça fonctionne très bien [quand on arrive à maîtriser les pRGBTriple et autres pRGBQuad, mais ceci est une autre histoire...]).
Ce code m'a permis d'écrire ça, pour enregistrer un fichier :

Code :

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

1
2
3
4
5
6
7
8
9
  procedure Enregistre(b: TBitmap; f: string);
  var
    lii: TLazIntfImage;
  begin
    //b.SaveToFile(f); // rajouté pour test -- sortie 32 si source=32, ouf !
    lii := b.CreateIntfImage;
    lii.SaveToFile(f); // sortie 24 si source=32, aïe !
    lii.Free;
  end;

Ok ok, il doit falloir jouer avec les .Init foireux dont j'ai causé au-dessus, en attendant il n'y a rien dans le tuto qui le laisse supposer !
Au contraire, une telle simplicité incite à penser que tout est intégré dans les couches inférieures mais on dirait bien que non et qu'il n'y a rien dedans, ou juste le strict minimum .

Le temps que j'ai perdu avec ça, je vous raconte pas.
Le temps que je vais encore perdre à tester dans tous les sens, ça va être terrible.

Sans compter que j'ai bien l'impression que je vais me retrouver avec deux codes complètement différents, selon que le fichier d'entrée sera en 24 ou 32 bits : avec du Scanline (qui n'existe pas ! Boulets !) pour le 24 et du TLazIntfImage pour le 32, bonjour la maintenance !

Et pendant ce temps, le reste n'avance pas...

EDIT
Ah, j'allais oublier ça :

Ton problème de changement de pixelformat vient du fait que toutes tes valeurs Alpha sont à 255 c'est à dire image entièrement opaque.

Parce que hier soir en fouinant je suis tombé sur ça :

alpha is transparent when 0 in some widgetsets and in others when it is 255, just for your information.

et ça calme, hein !
source

EDIT2
Du coup, j'ai fait un test et

Ton problème de changement de pixelformat vient du fait que toutes tes valeurs Alpha sont à 255 c'est à dire image entièrement opaque.

même avec Alpha à 127 c'est SIGSEGV.
C'est lié au 24/32, certes, mais rien à voir avec le canal Alpha, ou alors, montre le code concerné.

[Jipété]

Les premiers tests sont positifs, le TBitmap conserve son pf32 et réussit à le transmettre au TImage d'affichage.

Ne jamais vendre la peau de l'ours avant de l'avoir tué, c'est bien connu. Je me suis réjoui trop vite, beaucoup trop vite...

Je me suis inspiré d'un taf de l'ami JurassicPork (tout en bas de la page), qui a juste oublié de préciser que c'était du 24 bits -- et moi qui croyais que le TLazIntfImage était un machin évolué...
Quelle déception... Un truc de pieds nickelés, pour rester poli.
Je vous laisse regarder les commentaires à la fin de mon bout de code sensé recopier les pixels (avec intervention ou pas sur leur valeur) d'un fichier 32 bits :

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
    if pf1 = 32 then begin // détecté en analysant le BitmapInfoHeader du fichier bmpFic, l'original
      try
        lRawImage.Init;
        lRawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(bmpFic.Width, bmpFic.Height);
        lRawImage.CreateData(False);
        liiDst := bmpFic.CreateIntfImage;
ShowMessage(StringReplace(liiDst.DataDescription.AsString, ' ', LineEnding, [rfReplaceAll]));
// depth 24 -- bpp 32
        jpb2 := GetHeaderDatas('', bmpFic); // pour vérif
        ShowMessage(IntToStr(jpb2.PixelFormat)); // ok 32
 
        for h := 0 to bmpFic.Height-1 do begin
          p4src := pRGBQuad(bmpFic.RawImage.GetLineStart(h));
          for w := 0 to bmpFic.Width-1 do liiDst.Colors[w,h] := CorrigeCouleurs32(p4src[w]);
        end;
 
ShowMessage(StringReplace(liiDst.DataDescription.AsString, ' ', LineEnding, [rfReplaceAll]));
// depth 24 -- bpp 32
        bmpDst.Assign(bmpFic); // forcer le pf32
        jpb2 := GetHeaderDatas('', bmpDst);
        ShowMessage('a '+IntToStr(jpb2.PixelFormat)); // ok pf32
 
        bmpDst.LoadFromIntfImage(liiDst); // >>>  LoadFromIntfImage fout tout en l'air  <<<
 
        jpb2 := GetHeaderDatas('', bmpDst);
        ShowMessage('b '+IntToStr(jpb2.PixelFormat)); // paf ! pf24
      finally
        liiDst.Free
      end;
    end;

En haut la source en 32 bits, en bas sa copie...


Bon, ben ça sent le chemin des array of bytes, heureusement j'avais regardé ça il y a quelques mois, j'ai gardé des notes,

Encore un truc qui aurait dû prendre une demi-journée et qui va durer 15 jours...

[BeanzMaster]

Ne jamais vendre la peau de l'ours avant de l'avoir tué, c'est bien connu. Je me suis réjoui trop vite, beaucoup trop vite...

Je me suis inspiré d'un taf de l'ami JurassicPork (tout en bas de la page), qui a juste oublié de préciser que c'était du 24 bits -- et moi qui croyais que le TLazIntfImage était un machin évolué...
Quelle déception... Un truc de pieds nickelés, pour rester poli.
Je vous laisse regarder les commentaires à la fin de mon bout de code sensé recopier les pixels (avec intervention ou pas sur leur valeur) d'un fichier 32 bits :

Code :

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

1
2
3
4
5
6
7
8
9
10
    if pf1 = 32 then begin // détecté en analysant le BitmapInfoHeader du fichier bmpFic, l'original
      try
        lRawImage.Init;
        lRawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(bmpFic.Width, bmpFic.Height);
        lRawImage.CreateData(False);
        liiDst := bmpFic.CreateIntfImage;
ShowMessage(StringReplace(liiDst.DataDescription.AsString, ' ', LineEnding, [rfReplaceAll]));
// depth 24 -- bpp 32
        jpb2 := GetHeaderDatas('', bmpFic); // pour vérif
        ShowMessage(IntToStr(jpb2.PixelFormat)); // ok 32

Essayes juste de changer la valeur alpha d'un seul pixel de ton image dans Gimp(par exemple le tout 1er en haut à gauche) par autre chose que 255 et refais ton test pour vérifier les pixelformats
Normalement le "Depth" devrait être à 32

[Jipété]

Essayes juste de changer la valeur alpha d'un seul pixel de ton image dans Gimp (par exemple le tout 1er en haut à gauche) par autre chose que 255 et refais ton test pour vérifier les pixelformats.

Pas trouvé où se cachait cette possibilité, alors j'ai changé toute une couleur, le bleu clair, on le voit bien en haut à gauche (ciel du paysage), en lui demandant de l'utiliser comme couleur transparente :
en haut dans The Gimp, dessous le fichier résultant ouvert dans mon outil, en tant que fichier source (j'ai fait sauter la copie foirée et ses raies verticales), je ne sais pas du tout si c'est bien ou pas, en tout état de cause, le visionneur rapide de ma distrib' l'affiche comme mon outil, donc je peux penser que c'est bon, de ce côté-là.


Par contre, de ce côté,

Normalement le "Depth" devrait être à 32.

Et non, il reste à 24 .
Bah, ça fait un joli ciel psychédélique, on se croirait dans un poster des années '70,

Allez, perds pas ton temps avec cette catastrophe, je vais tenter à l'ancienne, array of bytes ça devrait le faire, quand même ! Mais ça va prendre du temps, et demain j'ai vraiment autre chose à faire.

[Jipété]

Qui nous renvoie vers cette fonction où il y a un joli commentaire

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TCustomBitmap.RawimageNeeded(ADescOnly: Boolean);
var
  OldChangeEvent: TNotifyEvent;
  ImagePtr: PRawImage;
  Flags: TRawImageQueryFlags;
begin
  //...
  // setup ImagePtr, fill description if not set
  if ImagePtr^.Description.Format = ricfNone // <<<<<---------- jp ! ! !
  then begin
    // use query to get a default description without alpha, since alpha drawing 
    // is not yet supported (unless asked for) ------> CA C'EST TROP FORT ! Et bien c'est fait  ON DEMANDE !!!!
    //...

Sauf qu'on s'en fout un peu, tout au moins chez moi, car Format=ricfRGBA !

J'ai fait ce test :

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
ShowMessage(StringReplace(bmpSrc.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
ShowMessage(StringReplace(bmpDst.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
//bmpSrc -> Format=ricfRGBA Depth=24 BitsPerPixel=32
//bmpDst -> Format=ricfRGBA Depth=24 BitsPerPixel=32
 
  if UseOriginal then bmpSrc.Assign(bmpFic) else bmpSrc.Assign(bmpDst);
  // à garder pour scénario "origine-modifiée-origine", ok en pf24
 
  bmpDst.Assign(bmpSrc); // nécessaire pour tout faire en pf24-pRGBTriple ou pf32-pRGBQuad
  bmpDst.Width  := bmpSrc.Width;
  bmpDst.Height := bmpSrc.Height;
 
ShowMessage(StringReplace(bmpSrc.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
ShowMessage(StringReplace(bmpDst.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
//bmpSrc -> Format=ricfRGBA Depth=24 BitsPerPixel=24
//bmpDst -> Format=ricfRGBA Depth=24 BitsPerPixel=24

À cause du test if UseOriginal (simple booléen), Assign est utilisé pour affecter l'un ou l'autre bitmap à bmpSrc, et plus bas Assign est encore utilisé pour affecter bmpSrc à bmpDst.

Résultat, le BitsPerPixel des deux bitmaps et passé de 32 à 24, et je ne le voyais pas car j'utilise BitmapInfoHeader où cette propriété reste à 32.
Quelle pagaille, quelle misère, quelle souffrance...

[BeanzMaster]

Tu me fais peur !
J'appréhende de me retrouver face à une usine à gaz pleine de fichiers de tous les côtés.
Moi, les trucs que j'aime, c'est une unité ou deux, pas d'installation, le uses qui va bien et roule ma poule.

T'inquietes, certe il y a plus d'un fichier, mais c'est la même chose pour le TBitmap tout ne tiens pas dans une seule unité.
Tu n'aura rien à installer (pour le moment) même si il y a 4/5 compos non-visuel, et 2 compos visuel (1 TImage amélioré pour afficher l'image simplement, et 1 compo pour faire des graphiques simples genre TChart)
Du coté des uses juste 3/4 unités de bases (suivant si tu veux le support des format de fichiers) à placer dans le uses principal de ton application et c'est tout.
Coté utilisation c'est comme le TBitmap , mais en mieux voila un petit exemple d'utilisation vite fait :

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
 
Uses GLZTypes, GLZGraphic, GLZBitmap, GLZBitmapIO;
 
procedure JustDoIt;
Var 
  Bmp : TGLZBitmap;
  PixelPtr : PGLZColor;
  AColor : TGLZColor;
begin
  Try
    Bmp:=nil; // FPC il aime bien quand on initialise ces variables
  Try
    bmp := TGLZBitmap.Create(0,0);
    bmp.Loadfromfile(NomDeFichier); //bmp, tga, pcx, ppm ect.... 
 
    bmp.ColorFilter.GrayScale(GCM_CIEObserverRef709, gcmLightness); 
    bmp.DeformationFilter.Twirl(25);
    bmp.BlurFilter.GaussianBlur(5);
 
    With Bmp.Canvas do
    begin
      Pen.Style := psSolid;
      Pen.Color := clrRed; 
      Brush.Style := bsSolid;
      Brush.Color := clrGray;
      Rectangle(ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom);
      With Font do
      begin
         Name := Arial;
         Size := 16;
         Color := clrWhite;
         Align := taCenter;     
         Quality := fqClearType;
      end;
      TextOut(Bmp.CenterX, Bmp.CenterY,'Mon Texte');
   end;
 
   PixelPtr := Bmp.GetScanLine(25);
   For i=0 to Bmp.MaxWidth do 
   begin
      AColor := PixelPtr^;
      if PxelPtr^.Alpha>0 then
      begin
         AColor.Red := ClamByte(Round(AColor.Red*Coef));
         AColor.Green := ClamByte(Round(AColor.Green*Coef));
         AColor.Blue := ClamByte(Round(AColor.Blue*Coef));
         PixelPtr^:= AColor;
         Inc(PixelPtr);
      end;
    end;
    KeepRatio := True;
    Bmp.Transformation.Resample(200,100,rfmBlackmanWindowed, KeepRatio);   
    Bmp.SaveToFile('NomFichier.bmp');
  Except
    On E: EGLZBaseException Do
    Begin
      MessageDlg(E.Message, mtWarning, [mbOK], 0);
      Exit;
    End
    Else
    Begin
      MessageDlg('Erreur Inconnue : ' +//E.Message+
        #13 + #10 + 'Ok pour continuer' + #13 + #10 + 'Abandonner pour quitter l''application', mtError, [mbOK, mbAbort], 0);
    End;
  End;
  Finally
    if Assigned(Bmp) then FreeAndNil(Bmp);
  end;
end;

Peux pas faire plus simple.

Sinon, il faudrait peut-être creuser ça, Result := RawImage_FromDrawable(ARawImage, Drawable, Bitmap, ARect);, mais, bonne nouvelle !, je vais sans doute m'en sortir avec TLazIntfImage, à condition de penser à l'initialiser correctement !

Les premiers tests sont positifs, le TBitmap conserve son pf32 et réussit à le transmettre au TImage d'affichage.
À suivre demain...

En ce qui concerte tous les "Drawable" avec GTK c'est compliqué, j'y ai jeté un oeil récemment. Un utilisateur de GLScene, dans son projet un TabControl avec 2 Pages et le compo visuel de glscene pour afficher le context sur chaque Page. Sous Window pas de problemes, sous Linux les pages sont vides.

EDIT
Ah, j'allais oublier ça :
Parce que hier soir en fouinant je suis tombé sur ça :
et ça calme, hein !
source

Oui je viens lire surtout le commentaire de Taaz

taazz
1) alpha is transparent when 0 in some widgetsets and in other when it is 255, just for your information.

Le 2eme point est devenu naturel, pour moi maintenant.

EDIT2
Du coup, j'ai fait un test et

même avec Alpha à 127 c'est SIGSEGV.
C'est lié au 24/32, certes, mais rien à voir avec le canal Alpha, ou alors, montre le code concerné.

J'ai fait ce test :
//bmpSrc -> Format=ricfRGBA Depth=24 BitsPerPixel=32
//bmpDst -> Format=ricfRGBA Depth=24 BitsPerPixel=32

C'est de ça que je te parlais
Pour le code dans IntfGraphics

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
 
function AddAlphaToDescription(var ADesc: TRawImageDescription; APrec: Byte): Boolean;
  function CreateBitMask(AShift, APrec: Byte): Cardinal; inline;
  begin
    Result := ($FFFFFFFF shr (32 - APrec)) shl AShift;
  end;
var
  Mask: Cardinal;
begin
  Result:=false;
  if ADesc.AlphaPrec >= APrec then Exit;
  if ADesc.BitsPerPixel <> 32 then Exit;
  if ADesc.Depth <> 24 then Exit;
 
  Mask := CreateBitMask(ADesc.RedShift, ADesc.RedPrec)
       or CreateBitMask(ADesc.GreenShift, ADesc.GreenPrec)
       or CreateBitMask(ADesc.BlueShift, ADesc.BluePrec);
 
  if (Mask and $FF = 0)
  then begin
    ADesc.AlphaShift := 0;
    Result := True;
  end
  else
    if (Mask and $FF000000 = 0)
    then begin
      ADesc.AlphaShift := 24;
      Result := True;
    end;
  if Result
  then begin
    ADesc.AlphaPrec := APrec;
    ADesc.Depth := 32;
  end;
end;
 
procedure CheckAlphaDescription(AImage: TFPCustomImage);
var
  Desc: TRawImageDescription;
begin
  if not (AImage is TLazIntfImage) then Exit;
 
  Desc := TLazIntfImage(AImage).DataDescription;
  if Desc.AlphaPrec >= 8 then Exit;
 
  if not AddAlphaToDescription(Desc, 8)
  then begin
    Desc.Init_BPP32_B8G8R8A8_BIO_TTB(Desc.Width, Desc.Height);
    // copy mask description
    with TLazIntfImage(AImage).DataDescription do
    begin
      Desc.MaskBitsPerPixel := MaskBitsPerPixel;
      Desc.MaskShift := MaskShift;
      Desc.MaskLineEnd := MaskLineEnd;
      Desc.MaskBitOrder := MaskBitOrder;
    end;
  end;
 
  TLazIntfImage(AImage).DataDescription := Desc;
end;
 
procedure DefaultReaderDescription(AWidth, AHeight: Integer; ADepth: Byte; out ADesc: TRawImageDescription);
begin
  // Default description, assume 24bit for palettebased
  // Maybe when RawImage palette is supported, other descriptions need to be adjusted.
 
  ADesc.Init_BPP24_B8G8R8_M1_BIO_TTB(AWidth, AHeight);
 
  case ADepth of
    1: begin
      ADesc.Depth := 1;
      ADesc.BitsPerPixel := 1;
      ADesc.Format := ricfGray;
      ADesc.LineEnd := rileWordBoundary;
      ADesc.RedPrec := 1;
      ADesc.RedShift := 0;
      ADesc.GreenPrec := 1;
      ADesc.GreenShift := 0;
      ADesc.BluePrec := 1;
      ADesc.BlueShift := 0;
    end;
    2..4: begin
//      ADesc.Depth := 4;
//      ADesc.BitsPerPixel := 4;
    end;
    5..8: begin
//      ADesc.Depth := 8;
//      ADesc.BitsPerPixel := 8;
    end;
    9..15: begin
      ADesc.Depth := 15;
      ADesc.BitsPerPixel := 16;
      ADesc.RedPrec := 5;
      ADesc.RedShift := 10;
      ADesc.GreenPrec := 5;
      ADesc.GreenShift := 5;
      ADesc.BluePrec := 5;
      ADesc.BlueShift := 0;
    end;
    16: begin
      ADesc.Depth := 16;
      ADesc.BitsPerPixel := 16;
      ADesc.RedPrec := 5;
      ADesc.RedShift := 10;
      ADesc.GreenPrec := 6;
      ADesc.GreenShift := 5;
      ADesc.BluePrec := 5;
      ADesc.BlueShift := 0;
    end;
    17..24: begin
      // already default
    end;
  else
    ADesc.Depth := 32;
    ADesc.BitsPerPixel := 32;
    ADesc.AlphaPrec := 8;
    ADesc.AlphaShift := 24;
  end;
end;

et plus bas tu trouve çà pour le chargement des bmp 32 bits

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
procedure TLazReaderDIB.WriteScanLine(Row: Cardinal); 
begin
  // J'ai tronqué la procédure
          32:
            for Column := 0 to TheImage.Width - 1 do
            begin
              Color := RGBToFPColor(PColorRGBA(LineBuf)[Column]);
              TheImage.colors[Column,Row] := Color;
              FIgnoreAlpha := FIgnoreAlpha and (Color.alpha = alphaTransparent); //------> Il est là le HIC et dans les 2 procs CheckAlpha et AddAlpha
            end;