Создать неактивные пиктограммы для TSpeedButton и TBitBtn во время выполнения

Материал из DRKB

Создать неактивные пиктограммы для TSpeedButton и TBitBtn во время выполнения[править | править код]

procedure AddDisableBMP(SB : array of TObject);
var
  BM, SBM : TBitmap;
  w, x, y, NewColor, i : integer;
  PixelColor : TColor;
begin
  BM := TBitmap.Create;
  SBM := TBitmap.Create;
  try
    for i := 0 to High(SB) do
    begin
      if (SB[i] is TSpeedButton) then
        BM.Assign((SB[i] as TSpeedButton).Glyph)
      else if (SB[i] is TBitBtn) then
        BM.Assign((SB[i] as TBitBtn).Glyph)
      else
        Exit;

      if not Assigned(BM) or (BM.Width <> BM.Height) then Exit;

      w := BM.Width;
      SBM.Width := w * 2;
      SBM.Height := w;
      SBM.Canvas.Draw(0, 0, BM);

      for x := 0 to w - 1 do
        for y := 0 to w - 1 do
        begin
          PixelColor := ColorToRGB(BM.Canvas.Pixels[x, y]);
          NewColor := Round((((PixelColor shr 16) + ((PixelColor shr 8) and $00FF) +
            (PixelColor and $0000FF)) div 3)) div 2 + 96;
          BM.Canvas.Pixels[x, y] := RGB(NewColor, NewColor, NewColor);
        end;


      SBM.Canvas.Draw(w, 0, BM);

      if (SB[i] is TSpeedButton) then
        with (SB[i] as TSpeedButton) do
        begin
          Glyph.Assign(SBM);
          NumGlyphs := 2;
        end
      else
        with (SB[i] as TBitBtn) do
        begin
          Glyph.Assign(SBM);
          NumGlyphs := 2;
        end;
      BM := TBitmap.Create;
      SBM := TBitmap.Create;
    end;
  finally
    BM.Free;
    SBM.Free;
  end;
end;


Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01251