Сменить рисунок на кнопке "Пуск"

ОГЛАВЛЕНИЕ    HOME  MAIL

var
  StartButton: hWnd;
  bmOld: THandle;
  bm: TBitMap;

procedure TForm1.FormCreate(Sender: TObject);
const
  text = 'Ура!!!';
var
  r: TRect;
  i: integer;
begin
  StartButton := FindWindowEx(
    FindWindow('Shell_TrayWnd',nil),
    0, 'Button', nil);
  bm := TBitMap.Create;
  bmOld := SendMessage(StartButton, BM_GETIMAGE, 0, 0);
  GetWindowRect(StartButton, r);
  bm.Width := r.Right - r.Left - 8;
  bm.Height := r.Bottom - r.Top - 6;
  with bm.Canvas do begin
    Brush.Color := clBtnFace;
    FillRect(ClipRect);
    for i := 0 to bm.Width + 4 do begin
      Pen.Color := RGB(i * 4, 255, 0);
      MoveTo(i - 5, 0);
      LineTo(i, bm.Height);
    end;

    Brush.Style := bsClear;
    Font.Style := [fsBold];
    Font.Name := 'Arial';
    Font.Size := 9;
    Font.Color := clBlue;

    TextOut((bm.Width - TextWidth(text)) div 2,
      (bm.Height - TextHeight(text)) div 2, text);
  end;
  SendMessage(StartButton, BM_SETIMAGE, 0, bm.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SendMessage(StartButton, BM_SetImage, 0, bmOld);
  bm.Destroy;
end;