How to save a TBitmap to a WBMP file.

Title: How to save a TBitmap to a WBMP file.

Question: I needed to save WBMP files for WAP applications. Here is the way I found to do it...

Answer:
Note that the bitmap contained in the TBitmap must be black and white.

Function BitmapToWBMP( Bmp : TBitmap; Filename : String ) : Boolean;
Var
    F       : File;
    Buf     : Array[ 0..256 ] Of Byte;
    BufLen  : LongInt;
    BPos    : LongInt;
    B       : LongInt;
    X       : LongInt;
    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
    Result := 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
            If Bmp.Canvas.Pixels[ X, Y ]  clBlack Then Inc( Buf[ BPos ], B );
            If B  1 Then
                B := B Shr 1
            Else Begin
                B := 128;
                Inc( BPos );
            End;
        End;
        BlockWrite( F, Buf, BufLen );
    End;
    CloseFile( F );
    Result := True;
End;

Enjoy!

from: http://delphi.xcjc.net//viewthread.php?tid=46488



More Tips:

• get an inverse color value to a color?


• Work by WordApplication Component


• Pressing and releasing keys by software


• Surmounting MS Visual FoxPro 8.0 Database Corruption


• How to send files across the internet using FTP


• get the transparency color?


• print a TImage?

Torry's Delphi Pages

ImageDraw can render an image file (*.wbmp, *.gif, *.jpg, *.png, *.bmp, *.ico, and *.tiff) to the image format preferred by client mobile device. ImageDraw doesn't ...