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