如何把图片变灰

怎么把图片变灰？
做了一个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

[解决办法]
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;