procedure TForm1.SetWallpaperPalette;
type
  RGBQUAD = Packed Record
    rgbBlue: Byte;
    rgbGreen: Byte;
    rgbRed: Byte;
    rgbReserved: Byte;
  end;
var
  NewColors : Array[1..4] of RGBQUAD;
begin
  FillChar(NewColors, SizeOf(NewColors), 0);
  with NewColors[1] do
  begin
    rgbBlue := 0;
    rgbGreen := $C6;
    rgbRed := $C6;
  end;
  with NewColors[2] do
  begin
    rgbBlue := 0;
    rgbGreen := $CE;
    rgbRed := $CE;
  end;
  with NewColors[3] do
  begin
    rgbBlue := 0;
    rgbGreen := $D6;
    rgbRed := $D6;
  end;
  with NewColors[4] do
  begin
    rgbBlue := 0;
    rgbGreen := $DE;
    rgbRed := $DE;
  end;
 SetDibColorTable(Image1.Picture.Bitmap.Canvas.Handle, 0, 4, NewColors);
end;