Inactive-ImageList zur Laufzeit erstellen

[FriFra]

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:

Delphi-Quellcode:

  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 $0000FF00) shr 8;
      B := (Farbe and $00FF0000) shr 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:

Delphi-Quellcode:

  CreateInactiveImageList(ImageList1, ImageList2);