pascal格式，自己去翻译吧。
Function SaveAsWBmpFile (Bmp:TBitmap; Filename:String): Boolean;
{ $Define bmp_already_is_black_and_white}
const
BorderWhite= 220*3;
BorderLight= 195 *3;
BorderLightGray= 160*3;
BorderGray=125*3;
BorderDarkGray=90*3;
BorderDark=60*3;
BorderBlack=30*2;
var F:File; Col:TColor;
Buf: Array[0..256] of Byte; (* maximum bitmap width = 256*8 pixels *)
Gray,BufLen,BPos,A,B,X,Y:Longint;
procedure Write_To_Header(L:Longint); var extra:Longint; b:Byte;
begin
extra:=0; While L>=128 do begin Inc(extra); Dec(l,128); end;
if extra>0 then begin b:=128+extra; BlockWrite(F,b,1); end;
b:=l; BlockWrite(F,b,1);
end;
begin
SaveAsWBmpFile:=False;
if Bmp=NIL then EXIT; if Bmp.Empty then EXIT;
if Bmp.Width=0 then EXIT; if Bmp.Height=0 then EXIT;
AssignFile(F,FileName);
Rewrite(F,1); if IOResult<>0 then EXIT;
BufLen:=Bmp.Width shr 3 + Byte(Bmp.Width and 7>0);
Write_To_Header(0); Write_To_Header(0);
Write_To_Header(Bmp.Width); Write_To_Header(Bmp.Height);
for Y:=0 to Bmp.Height-1
do begin
FillChar(Buf,SizeOf(Buf),0); BPos:=0; B:=128;
for X:=0 to Bmp.Width-1
do begin
{$IfDef bmp_already_is_black_and_white}
if Bmp.Canvas.Pixels[X,Y]<>clBlack then Inc(Buf[BPos],B);
{$Else}
Col:=Bmp.Canvas.Pixels[X,Y];
Gray:= (Col and $ff) + ((Col shr 8) and $ff) + ((Col shr 16) and $ff);
if (Gray>BorderWhite) then Inc(Buf[BPos],B) else
if (Gray>BorderLight)
then begin if (X mod 3<>0)or(Y mod 3<>1) then Inc(Buf[BPos],B) end else
if (Gray>BorderLightGray)
then begin if (X and 1=1)or(Y and 1=1) then Inc(Buf[BPos],B) end else
if (Gray>BorderGray)
then begin if (X and 1=1)=(Y and 1<>1) then Inc(Buf[BPos],B) end else
if (Gray>BorderDarkGray)
then begin if (X mod 3=1)and(Y mod 3=2) then Inc(Buf[BPos],B) end else
if (Gray>BorderDark)
then begin if (X and 3=0) and (Y and 3=0) then Inc(Buf[BPos],B) end else
if (Gray>BorderBlack)
then begin if (X mod 5=1) and (Y mod 5=3) then Inc(Buf[BPos],B) end;
{$EndIf}
if B>1 then B:=B shr 1 else begin B:=128; Inc(BPos); end;
end;
BlockWrite(F,Buf,BufLen);
end;
CloseFile(F);
SaveAsWBmpFile:=True;
end;
