Subversion Repositories userdetect2

Rev

Rev 93 | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 93 Rev 96
Line 7... Line 7...
7 
interface
 7 
interface
8 
 
 8 
 
9 
uses
 9 
uses
10 
  Dialogs, Windows, Controls, Graphics, SysUtils, CommDlg, Classes;
 10 
  Dialogs, Windows, Controls, Graphics, SysUtils, CommDlg, Classes;
11 
 
 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;
 13 
function CompatOpenDialogExecute(OpenDialog: TOpenDialog): boolean;
14 
function CompatSaveDialogExecute(SaveDialog: TSaveDialog): boolean;
 14 
function CompatSaveDialogExecute(SaveDialog: TSaveDialog): boolean;
15 
 
 15 
 
- 
 
 16 
function ToGray(PixelColor: Longint): Longint;
- 
 
 17 
 
16 
implementation
 18 
implementation
17 
 
 19 
 
18 
uses
 20 
uses
19 
  PatchU, ShlObj, ShellAPI;
 21 
  PatchU, ShlObj, ShellAPI;
20 
 
 22 
 
Line 151... Line 153...
151 
      bmpmask.Free;
 153 
      bmpmask.Free;
152 
    end;
 154 
    end;
153 
  end;
 155 
  end;
154 
end;
 156 
end;
155 
 
 157 
 
- 
 
 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 
 
156 
function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon): integer;
 169 
function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon; DoGreyscale: boolean=False): integer;
157 
// http://www.delphipages.com/forum/showthread.php?t=183999
 170 
// http://www.delphipages.com/forum/showthread.php?t=183999
158 
var
 171 
var
159 
  buffer, mask: TBitmap;
 172 
  buffer, mask: TBitmap;
160 
  p: TPoint;
 173 
  p: TPoint;
- 
 
 174 
  x, y: integer;
161 
begin
 175 
begin
162 
  // result := ImageList.AddIcon(ico);
 176 
  // result := ImageList.AddIcon(ico);
163 
  // --> In Delphi 6, Icons with half-transparency have a black border (e.g. in ListView)
 177 
  // --> In Delphi 6, Icons with half-transparency have a black border (e.g. in ListView)
164 
 
 178 
 
165 
  p := RealIconSize(icon.handle);
 179 
  p := RealIconSize(icon.handle);
Line 174... Line 188...
174 
    buffer.Height := p.Y;
 188 
    buffer.Height := p.Y;
175 
    buffer.Canvas.Draw(0, 0, icon);
 189 
    buffer.Canvas.Draw(0, 0, icon);
176 
    buffer.Transparent := true;
 190 
    buffer.Transparent := true;
177 
    buffer.TransparentColor := buffer.Canvas.Pixels[0,0];
 191 
    buffer.TransparentColor := buffer.Canvas.Pixels[0,0];
178 
 
 192 
 
179 
    if (ImageList.Width <> p.X) or (ImageLIst.Height <> p.Y) then
 193 
    if (ImageList.Width <> p.X) or (ImageList.Height <> p.Y) then
180 
    begin
 194 
    begin
181 
      ImageList.Width := p.X;
 195 
      ImageList.Width := p.X;
182 
      ImageList.Height := p.Y;
 196 
      ImageList.Height := p.Y;
183 
    end;
 197 
    end;
184 
 
 198 
 
185 
    // create a mask for the icon.
 199 
    // create a mask for the icon.
186 
    mask.Assign(buffer);
 200 
    mask.Assign(buffer);
187 
    mask.Canvas.Brush.Color := buffer.Canvas.Pixels[0, buffer.Height -1];
 201 
    mask.Canvas.Brush.Color := buffer.Canvas.Pixels[0, buffer.Height -1];
188 
    mask.Monochrome := true;
 202 
    mask.Monochrome := true;
189 
 
 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 
 
190 
    result := ImageList.Add(buffer, mask);
 215 
    result := ImageList.Add(buffer, mask);
191 
  finally
 216 
  finally
192 
    mask.Free;
 217 
    mask.Free;
193 
    buffer.Free;
 218 
    buffer.Free;
194 
  end;
 219 
  end;