Autor Beitrag
FriFra
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 557

Win XP Prof, Win XP Home,Win Server 2003,Win 98SE,Win 2000,Win NT4,Win 3.11,Suse Linux 7.3 Prof,Suse Linux 8.0 Prof
D2k5 Prof, D7 Prof, D5 Standard, D3 Prof, K3 Prof
BeitragVerfasst: Sa 16.07.05 16:49 
Wenn man neben den normalen Images einer ImageList auch noch eine Inactive-ImageList mit schöne Graustufen Images haben will, bläht man die Resourcen seiner Programme leicht auf. Um dies unnötig zu machen, kann man nun eine 2. ImageList mit den "grayed" Versionen der ersten befüllen:
ausblenden volle Höhe Delphi-Quelltext
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:
  procedure CreateInactiveImageList(Source, Target: TImageList; brightness:
    integer; TranparentColor: TColor); overload;
    function ChangeBrightness(Farbe: TColor): TColor;
    var
      R, G, B: Byte;
    begin
      Farbe := ColorToRGB(Farbe);
      R := (Farbe and $000000FF);
      G := (Farbe and $0000FF00shr 8;
      B := (Farbe and $00FF0000shr 16;
      if brightness < 0 then
      begin
        R := Trunc(R + (R * brightness / 100));
        G := Trunc(G + (G * brightness / 100));
        B := Trunc(B + (B * brightness / 100));
      end
      else
      begin
        R := Ceil(R + ((255 - R) * brightness / 100));
        G := Ceil(G + ((255 - G) * brightness / 100));
        B := Ceil(B + ((255 - B) * brightness / 100));
      end;
      Result := RGB(R, G, B);
    end;
    function BitmapToGrayscale(const Bitmap: TBitmap): TBitmap;
    var
      i, j: Integer;
      Grayshade, Red, Green, Blue: Byte;
      PixelColor: Longint;
    begin
      try
        Result := Bitmap;
        with Result do
          for i := 0 to Width - 1 do
            for j := 0 to Height - 1 do
            begin
              PixelColor := ColorToRGB(Canvas.Pixels[i, j]);
              Red := PixelColor;
              Green := PixelColor shr 8;
              Blue := PixelColor shr 16;
              Grayshade := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
              Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade);
            end;
      except
        Result := Bitmap;
      end;
    end;
  var
    cBmp, gBmp: TBitmap;
    n, x, y: integer;
    OrigBK: TColor;
  begin
    Target.Clear;
    OrigBK := Source.BkColor;
    Source.BkColor := TranparentColor;
    for n := 0 to Source.Count - 1 do
    begin
      cBmp := TBitmap.Create;
      gBmp := TBitmap.Create;
      try
        Source.GetBitmap(n, cBmp);
        try
          gBmp.Assign(BitmapToGrayscale(cBmp));
          Source.GetBitmap(n, cBmp);
          for x := 0 to 15 do
            for y := 0 to 15 do
            begin
              if cBmp.Canvas.Pixels[x, y] = TranparentColor then
                gBmp.Canvas.Pixels[x, y] := TranparentColor
              else
                gBmp.Canvas.Pixels[x, y] :=
                  ChangeBrightness(gBmp.Canvas.Pixels[x, y]);
            end;
          Target.AddMasked(gBmp, TranparentColor);
        except
        end;
      finally
        FreeAndNil(cBmp);
        FreeAndNil(gBmp);
      end;
    end;
    Source.BkColor := OrigBK;
  end;
  procedure CreateInactiveImageList(Source, Target: TImageList); overload;
  begin
    CreateInactiveImageList(Source, Target, 30, clFuchsia);
  end;


Aufruf:  CreateInactiveImageList(ImageList1, ImageList2);

_________________
Michael
(principal certified lotus professional - developer)