怎么把图片变灰？

Question

做了一个IM聊天的  
所有的头像都是QQ下面COPY的
怎么让彩色的头像变灰？（最小化的时候再最大化颜色不能变）
刚找了个VB的  效果有了  可是最小化后再最大化一下颜色就又变回原来的了 怎么解决呢？
Sub ChangetoGray(ByVal SrcDC&, _
                 ByVal nx&, _
                 ByVal ny&, _
                 Optional ByVal nMaskColor& = -1)
'-----------------------------------------------------------------
    Dim rgbColor&, Gray&
    Dim RValue&, GValue&, BValue&
    Dim dl&
    
    'get color.
    rgbColor = GetPixel(SrcDC, nx, ny)
    
    'if rgbColor=MaskColor, don't chang the color
    If rgbColor = nMaskColor Then GoTo Release:
    
    'get color rgb heft.
    RValue = GetRValue(rgbColor)
    GValue = GetGValue(rgbColor)
    BValue = GetBValue(rgbColor)
    
    'set new color
    Gray = (9798 * RValue + 19235 * GValue + 3735 * BValue) / 32768 'Change wffs
    
    rgbColor = RGB(Gray, Gray, Gray)
    
    dl& = SetPixelV(SrcDC, nx, ny, rgbColor)
    
Release:
    rgbColor = 0: Gray = 0
    RValue = 0: GValue = 0: BValue = 0
    dl = 0
'-----------------------------------------------------------------
End Sub

Answer 1

procedure Gray(bmp: TBitmap);
var
  p: PByteArray;
  w: Integer;
  i, j: Integer;
begin
  bmp.pixelformat := pf24bit;
  for i := 0 to bmp.height - 1 do
  begin
    p := bmp.scanline[i];
    j := 0;
    while j < (bmp.width-1) * 3 do
    begin
      w :=(p[j] * 28 + p[j+1] * 151 + p[j+2]*77);
      w := w shr 8;
      p[j] := byte(w);
      p[j+1] := byte(w);
      p[j+2] := byte(w);
      inc(j, 3)
    end;
  end;
end;