Copy between two imagelists in Lazarus = bitmaps gets corrupt

[MISV]

I have tried quite a few things to solve his.

I have some bitmaps stoed in my imagelist ilPublicPM (images 16wx16h) that I want to copy to ilPublicTV (images 16wx18h)

When ilPublicPM is used o render images (e.g. a toolbar or menu), the bitmap have (corectly) the background color of the toolbar/menu.

The problem is this... The copied over bitmaps get black background no matter what.


helper function:

Code: [Select]

function myCreateBitmap(AWidth, AHeight: Integer; ABGColor: TColor; APixelFormat: TPixelFormat): TBitMap;
var
  BitMap: TBitMap;
begin
   BitMap := TBitMap.Create;
   with BitMap do
     begin
       if APixelFormat <> pfCustom then
         PixelFormat := APixelFormat
       ;
       Width := AWidth;
       Height := AHeight;
       Canvas.Brush.Style := bsSolid;
       Canvas.Brush.Color := ABGColor;
       Canvas.FillRect(Rect(0, 0, Width, Height));
     end
   ;
   Result := BitMap;
end;


Code not working:

Code: [Select]

var
  C: TColor;


Code: [Select]

// ilPublicPM.DrawingStyle := dsTransparent; // no difference
  TmpColor = clWindow;
  // TmpColor = clNone; // no difference
  //--
  B1 := msCreateBitmap(16, 16, TmpColor, pf32bit);
  B2 := msCreateBitmap(16, 18, TmpColor, pf32bit);
  E := ilPublicPM.Count - 1;
  for I := 0 to E do
  begin
    ilPublicPM.GetBitmap(I, B1);
    R := True;
    //--
    if R then
      begin
        for BX := 0 to 15 do
        begin
          for BY := 0 to 15 do
          begin
            C := B1.Canvas.Pixels[BX, BY];
            B2.Canvas.Pixels[BX, BY + 1] := C;
          end;
        end;
        //--
        ilPublicTV.Add(B2, nil)
      end;
  end;


[User137]

So problem is that copying transparent pixels doesn't copy their transparency? What is the type of C, perhaps the number range is not enough to cover the alpha? I'd use Cardinal. $FFFFFFFF equals 4294967295

[MISV]

Hi,

I would rather explain it as: The behavior appears to be that the background color of B2 is black where it should be transparent. I have also tried o fill with different colors before using, but that has not made any diffeence.

C = TColor

[derek.john.evans]

Try this code. Should run a lot faster, plus you can apply some TGraphicsDrawEffect's to the new imagelist. I've implement stretching/centering, but you may want something else.

Anyway, the function is just ImageListCopy(ImageListDst, ImageListSrc); 

Code: Pascal  [Select][+][-]

1. uses Graphics, GraphType;
2.  
3. procedure BitmapCopy(const ADst, ASrc: TBitmap; const AStretch: Boolean; const ABkColor: TColor);
4. begin
5.   ADst.Canvas.Brush.Color := ABkColor;
6.   ADst.Canvas.FillRect(0, 0, ADst.Width, ADst.Height);
7.   if AStretch then
8.   begin
9.     ADst.Canvas.StretchDraw(Bounds(0, 0, ADst.Width, ADst.Height), ASrc);
10.   end else begin
11.     ADst.Canvas.Draw((ADst.Width - ASrc.Width) div 2, (ADst.Height - ASrc.Height) div 2, ASrc);
12.   end;
13. end;
14.  
15. procedure ImageListCopy(const ADst, ASrc: TImageList; const AStretch: Boolean = True; const AEffect: TGraphicsDrawEffect = gdeNormal);
16. var
17.   LIdx: Integer;
18.   LBitmapSrc, LBitmapDst: TBitmap;
19. begin
20.   ADst.Clear;
21.   LBitmapSrc := TBitmap.Create;
22.   try
23.     LBitmapDst := TBitmap.Create;
24.     try
25.       LBitmapDst.SetSize(ADst.Width, ADst.Height);
26.       for LIdx := 0 to ASrc.Count - 1 do
27.       begin
28.         ASrc.GetBitmap(LIdx, LBitmapSrc, AEffect);
29.         BitmapCopy(LBitmapDst, LBitmapSrc, AStretch, clNone);
30.         ADst.AddMasked(LBitmapDst, clNone);      
31.       end;
32.     finally
33.       FreeAndNil(LBitmapDst);
34.     end;
35.   finally
36.     FreeAndNil(LBitmapSrc);
37.   end;
38. end;  
39.  

[MISV]

Hi,

It appears your code solves the problem although it makes me think there must be a bug somewhere.


This code (based on your code) works:

Code: [Select]

        B2.Canvas.Brush.Color := inv_LM_WindowColor;
        B2.Canvas.FillRect(0, 0, B2.Width, B2.Height);
        B2.Canvas.StretchDraw(Bounds(0, 1, B2.Width, 17), B1);


This (my original) code paints with black background;

Code: [Select]

        for BX := 0 to 15 do
        begin
          for BY := 0 to 15 do
          begin
            C := B1.Canvas.Pixels[BX, BY];
            B2.Canvas.Pixels[BX, BY + 1] := C
          end;
        end;

I am very happy I can replace it with something that does work and is faster. Thanks! (But I am still curious why my original code did not work.)