View Issue Details

IDProjectCategoryView StatusLast Update
0017900LazarusLCLpublic2011-02-10 16:06
ReporterAnton KavalenkaAssigned ToPaul Ishenin 
PrioritynormalSeverityfeatureReproducibilityalways
Status closedResolutionfixed 
PlatformallOSallOS Version
Product Version0.9.29 (SVN)Product Build28174 
Target VersionFixed in Version0.9.31 (SVN) 
Summary0017900: LCL: TImageList.AddIcon() quick and dirty implementation
DescriptionCurrently TImageList.AddIcon(Image:TIcon) is not implemented
Attached the patch and test application.
TagsNo tags attached.
Fixed in Revision28955,28956
LazTarget0.99.0
WidgetsetGTK 2, Win32/Win64
Attached Files
  • imglist.patch (1,409 bytes)
    Index: imglist.inc
    ===================================================================
    --- imglist.inc	(revision 28174)
    +++ imglist.inc	(working copy)
    @@ -74,14 +74,44 @@
       Adds an icon to the list.
      ------------------------------------------------------------------------------}
     function TCustomImageList.AddIcon(Image: TIcon): Integer;
    -begin 
    -  //!!! check one or more
    +var
    +  Dst,Src:TRect;
    +  bmp:TBitmap;
    +  is32:boolean;
    +  clr:TColor;
    +begin
    +  Result:=-1;
    +  bmp:=TBitmap.Create;
    +  {$ifdef MSWINDOWS}
    +  bmp.PixelFormat:=Image.PixelFormat;
    +  {$else}
    +  bmp.PixelFormat:=pf24bit;
    +  {$endif}
    +  bmp.SetSize(Width,Height);
    +  is32:=bmp.PixelFormat=pf32bit;
    +  try
    +    bmp.Canvas.Brush.Style:=bsSolid;
     
    -  //No Icon Support yet
    +    if is32 then
    +      clr:=clNone
    +    else
    +      clr:=clFuchsia;
     
    -  Result := -1;
    +    bmp.Canvas.Brush.Color:=clr;
    +    Dst:=Rect(0,0,bmp.width,bmp.height);
    +    Src:=Rect(0,0,image.Width,image.Height);
    +    bmp.Canvas.FillRect(Dst);
    +
    +    if is32 then
    +      bmp.Canvas.CopyRect(Dst,Image.Canvas,Src)
    +    else
    +      bmp.Canvas.StretchDraw(dst,Image);
    +
    +    Result:=AddMasked(bmp,bmp.Canvas.Pixels[bmp.width-1,bmp.height-1]);
    +  finally
    +    bmp.Free;
    +  end;
     end;
    -
     {------------------------------------------------------------------------------
       Method:  TCustomImageList.AddImages
       Params:  Value: An imagelist containing images to be added
    
    imglist.patch (1,409 bytes)
  • laztest70.zip (129,223 bytes)
  • imglist1.patch (2,083 bytes)
    Index: imglist.inc
    ===================================================================
    --- imglist.inc	(revision 28174)
    +++ imglist.inc	(working copy)
    @@ -74,14 +74,69 @@
       Adds an icon to the list.
      ------------------------------------------------------------------------------}
     function TCustomImageList.AddIcon(Image: TIcon): Integer;
    -begin 
    -  //!!! check one or more
    +var
    +  Dst,Src:TRect;
    +  bmp:TBitmap;
    +  is32:boolean;
    +  i,ndx:integer;
    +  clr:TColor;
    +  cnt:array[0..3] of integer;
    +  corners:array[0..3] of TColor;
    +begin
    +  Result:=-1;
    +  bmp:=TBitmap.Create;
    +  {$ifdef MSWINDOWS}
    +  bmp.PixelFormat:=Image.PixelFormat;
    +  {$else}
    +  bmp.PixelFormat:=pf24bit;
    +  {$endif}
    +  bmp.SetSize(Width,Height);
    +  is32:=bmp.PixelFormat=pf32bit;
    +  try
    +    bmp.Canvas.Brush.Style:=bsSolid;
     
    -  //No Icon Support yet
    +    if is32 then
    +      clr:=clNone
    +    else
    +      clr:=clFuchsia;
     
    -  Result := -1;
    +    bmp.Canvas.Brush.Color:=clr;
    +    Dst:=Rect(0,0,bmp.width,bmp.height);
    +    Src:=Rect(0,0,image.Width,image.Height);
    +    bmp.Canvas.FillRect(Dst);
    +
    +    if is32 then
    +      bmp.Canvas.CopyRect(Dst,Image.Canvas,Src)
    +    else
    +      bmp.Canvas.StretchDraw(dst,Image);
    +
    +    // image corners colors
    +    corners[0]:=bmp.Canvas.Pixels[0,0];
    +    corners[1]:=bmp.Canvas.Pixels[bmp.width-1,0];
    +    corners[2]:=bmp.Canvas.Pixels[0,bmp.height-1];
    +    corners[3]:=bmp.Canvas.Pixels[bmp.width-1,bmp.height-1];
    +
    +    FillChar(cnt,sizeof(cnt),0);
    +    for i:=0 to 3 do
    +    begin
    +      if corners[i]=corners[0] then inc(cnt[0]);
    +      if corners[i]=corners[1] then inc(cnt[1]);
    +      if corners[i]=corners[2] then inc(cnt[2]);
    +      if corners[i]=corners[3] then inc(cnt[3]);
    +    end;
    +
    +    ndx:=0;
    +    for i:=1 to 3 do
    +    begin
    +      if cnt[i]>cnt[ndx] then
    +        ndx:=i;
    +    end;
    +
    +    Result:=AddMasked(bmp,corners[ndx]);
    +  finally
    +    bmp.Free;
    +  end;
     end;
    -
     {------------------------------------------------------------------------------
       Method:  TCustomImageList.AddImages
       Params:  Value: An imagelist containing images to be added
    
    imglist1.patch (2,083 bytes)

Activities

2010-11-10 18:47

 

imglist.patch (1,409 bytes)
Index: imglist.inc
===================================================================
--- imglist.inc	(revision 28174)
+++ imglist.inc	(working copy)
@@ -74,14 +74,44 @@
   Adds an icon to the list.
  ------------------------------------------------------------------------------}
 function TCustomImageList.AddIcon(Image: TIcon): Integer;
-begin 
-  //!!! check one or more
+var
+  Dst,Src:TRect;
+  bmp:TBitmap;
+  is32:boolean;
+  clr:TColor;
+begin
+  Result:=-1;
+  bmp:=TBitmap.Create;
+  {$ifdef MSWINDOWS}
+  bmp.PixelFormat:=Image.PixelFormat;
+  {$else}
+  bmp.PixelFormat:=pf24bit;
+  {$endif}
+  bmp.SetSize(Width,Height);
+  is32:=bmp.PixelFormat=pf32bit;
+  try
+    bmp.Canvas.Brush.Style:=bsSolid;
 
-  //No Icon Support yet
+    if is32 then
+      clr:=clNone
+    else
+      clr:=clFuchsia;
 
-  Result := -1;
+    bmp.Canvas.Brush.Color:=clr;
+    Dst:=Rect(0,0,bmp.width,bmp.height);
+    Src:=Rect(0,0,image.Width,image.Height);
+    bmp.Canvas.FillRect(Dst);
+
+    if is32 then
+      bmp.Canvas.CopyRect(Dst,Image.Canvas,Src)
+    else
+      bmp.Canvas.StretchDraw(dst,Image);
+
+    Result:=AddMasked(bmp,bmp.Canvas.Pixels[bmp.width-1,bmp.height-1]);
+  finally
+    bmp.Free;
+  end;
 end;
-
 {------------------------------------------------------------------------------
   Method:  TCustomImageList.AddImages
   Params:  Value: An imagelist containing images to be added
imglist.patch (1,409 bytes)

2010-11-10 18:47

 

laztest70.zip (129,223 bytes)

2010-11-10 20:35

 

imglist1.patch (2,083 bytes)
Index: imglist.inc
===================================================================
--- imglist.inc	(revision 28174)
+++ imglist.inc	(working copy)
@@ -74,14 +74,69 @@
   Adds an icon to the list.
  ------------------------------------------------------------------------------}
 function TCustomImageList.AddIcon(Image: TIcon): Integer;
-begin 
-  //!!! check one or more
+var
+  Dst,Src:TRect;
+  bmp:TBitmap;
+  is32:boolean;
+  i,ndx:integer;
+  clr:TColor;
+  cnt:array[0..3] of integer;
+  corners:array[0..3] of TColor;
+begin
+  Result:=-1;
+  bmp:=TBitmap.Create;
+  {$ifdef MSWINDOWS}
+  bmp.PixelFormat:=Image.PixelFormat;
+  {$else}
+  bmp.PixelFormat:=pf24bit;
+  {$endif}
+  bmp.SetSize(Width,Height);
+  is32:=bmp.PixelFormat=pf32bit;
+  try
+    bmp.Canvas.Brush.Style:=bsSolid;
 
-  //No Icon Support yet
+    if is32 then
+      clr:=clNone
+    else
+      clr:=clFuchsia;
 
-  Result := -1;
+    bmp.Canvas.Brush.Color:=clr;
+    Dst:=Rect(0,0,bmp.width,bmp.height);
+    Src:=Rect(0,0,image.Width,image.Height);
+    bmp.Canvas.FillRect(Dst);
+
+    if is32 then
+      bmp.Canvas.CopyRect(Dst,Image.Canvas,Src)
+    else
+      bmp.Canvas.StretchDraw(dst,Image);
+
+    // image corners colors
+    corners[0]:=bmp.Canvas.Pixels[0,0];
+    corners[1]:=bmp.Canvas.Pixels[bmp.width-1,0];
+    corners[2]:=bmp.Canvas.Pixels[0,bmp.height-1];
+    corners[3]:=bmp.Canvas.Pixels[bmp.width-1,bmp.height-1];
+
+    FillChar(cnt,sizeof(cnt),0);
+    for i:=0 to 3 do
+    begin
+      if corners[i]=corners[0] then inc(cnt[0]);
+      if corners[i]=corners[1] then inc(cnt[1]);
+      if corners[i]=corners[2] then inc(cnt[2]);
+      if corners[i]=corners[3] then inc(cnt[3]);
+    end;
+
+    ndx:=0;
+    for i:=1 to 3 do
+    begin
+      if cnt[i]>cnt[ndx] then
+        ndx:=i;
+    end;
+
+    Result:=AddMasked(bmp,corners[ndx]);
+  finally
+    bmp.Free;
+  end;
 end;
-
 {------------------------------------------------------------------------------
   Method:  TCustomImageList.AddImages
   Params:  Value: An imagelist containing images to be added
imglist1.patch (2,083 bytes)

Anton Kavalenka

2010-11-10 20:36

reporter   ~0042951

imglist1.patch tries to guess which color is most frequent on image corners to choose it as transparent.

Vincent Snijders

2010-11-16 12:46

manager   ~0043090

Target 0.9.30 to give timely feedback on the patch. May be postponed if the patch is rejected or needs extra work.

Paul Ishenin

2011-01-11 09:59

manager   ~0045087

Please test and close if ok.

Anton Kavalenka

2011-01-19 17:38

reporter   ~0045310

Behavior of AddIcon is slightly different than Delphi.
Delphi stretches icon but not adds more than one Icon.
The typical scenario is adding 32x32 icon to 16x16 ImageList.
It just adds two new icons instead of stretched one.

Issue History

Date Modified Username Field Change
2010-11-10 18:47 Anton Kavalenka New Issue
2010-11-10 18:47 Anton Kavalenka File Added: imglist.patch
2010-11-10 18:47 Anton Kavalenka Widgetset => GTK 2, Win32/Win64
2010-11-10 18:47 Anton Kavalenka File Added: laztest70.zip
2010-11-10 20:35 Anton Kavalenka File Added: imglist1.patch
2010-11-10 20:36 Anton Kavalenka Note Added: 0042951
2010-11-16 12:46 Vincent Snijders LazTarget => 0.9.30
2010-11-16 12:46 Vincent Snijders Note Added: 0043090
2010-11-16 12:46 Vincent Snijders Status new => acknowledged
2010-11-16 12:46 Vincent Snijders Target Version => 0.9.30
2010-11-19 10:30 Vincent Snijders LazTarget 0.9.30 => 0.99.0
2010-11-19 10:30 Vincent Snijders Target Version 0.9.30 => 0.99.0
2011-01-11 09:59 Paul Ishenin Fixed in Revision => 28955
2011-01-11 09:59 Paul Ishenin Status acknowledged => resolved
2011-01-11 09:59 Paul Ishenin Fixed in Version => 0.9.31 (SVN)
2011-01-11 09:59 Paul Ishenin Resolution open => fixed
2011-01-11 09:59 Paul Ishenin Assigned To => Paul Ishenin
2011-01-11 09:59 Paul Ishenin Note Added: 0045087
2011-01-11 10:16 Paul Ishenin Fixed in Revision 28955 => 28955,28956
2011-01-19 17:38 Anton Kavalenka Note Added: 0045310
2011-02-10 16:06 Anton Kavalenka Status resolved => closed