Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/userdetect2/trunk/vcl/VTSCompat.pas
(Generate patch)

Comparing trunk/vcl/VTSCompat.pas (file contents):
Revision 95 by daniel-marschall, Thu Oct 13 21:59:51 2016 UTC vs.
Revision 96 by daniel-marschall, Tue Jan 3 13:13:18 2017 UTC

# Line 9 | Line 9 | interface
9   uses
10    Dialogs, Windows, Controls, Graphics, SysUtils, CommDlg, Classes;
11  
12 < function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon): integer;
12 > function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon; DoGreyscale: boolean=False): integer;
13   function CompatOpenDialogExecute(OpenDialog: TOpenDialog): boolean;
14   function CompatSaveDialogExecute(SaveDialog: TSaveDialog): boolean;
15  
16 + function ToGray(PixelColor: Longint): Longint;
17 +
18   implementation
19  
20   uses
# Line 153 | Line 155 | begin
155    end;
156   end;
157  
158 < function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon): integer;
158 > function ToGray(PixelColor: Longint): Longint;
159 > var
160 >  Red, Green, Blue, Gray: Byte;
161 > begin
162 >  Red    := PixelColor;
163 >  Green  := PixelColor shr 8;
164 >  Blue   := PixelColor shr 16;
165 >  Gray   := Round(0.299 * Red + 0.587 * Green + 0.114 * Blue);
166 >  result := Gray + Gray shl 8 + Gray shl 16;
167 > end;
168 >
169 > function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon; DoGreyscale: boolean=False): integer;
170   // http://www.delphipages.com/forum/showthread.php?t=183999
171   var
172    buffer, mask: TBitmap;
173    p: TPoint;
174 +  x, y: integer;
175   begin
176    // result := ImageList.AddIcon(ico);
177    // --> In Delphi 6, Icons with half-transparency have a black border (e.g. in ListView)
# Line 176 | Line 190 | begin
190      buffer.Transparent := true;
191      buffer.TransparentColor := buffer.Canvas.Pixels[0,0];
192  
193 <    if (ImageList.Width <> p.X) or (ImageLIst.Height <> p.Y) then
193 >    if (ImageList.Width <> p.X) or (ImageList.Height <> p.Y) then
194      begin
195        ImageList.Width := p.X;
196        ImageList.Height := p.Y;
# Line 187 | Line 201 | begin
201      mask.Canvas.Brush.Color := buffer.Canvas.Pixels[0, buffer.Height -1];
202      mask.Monochrome := true;
203  
204 +    if DoGreyscale then
205 +    begin
206 +      for x := 0 to buffer.Width - 1 do
207 +      begin
208 +        for y := 0 to buffer.Height - 1 do
209 +        begin
210 +          buffer.Canvas.Pixels[x, y] := ToGray(buffer.Canvas.Pixels[x, y]);
211 +        end;
212 +      end;
213 +    end;
214 +
215      result := ImageList.Add(buffer, mask);
216    finally
217      mask.Free;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines