Sub saveBinaryPBM (handle As Long, filename As String) Dim imgwidth As Long Dim imgheight As Long Dim oldsource As Long Dim header As String Dim y As _Unsigned Long Dim x As _Unsigned Long Dim bytecount As _Unsigned Long Dim ff As Long Dim c As _Byte Dim outbyte As _Unsigned _Byte oldsource = _Source _Source handle imgwidth = _Width(handle) imgheight = _Height(handle) ff = FreeFile Open filename For Binary As #ff header = "P4" + Chr$(10) header = header + "# Created with QB64" + Chr$(10) header = header + LTrim$(Str$(imgwidth) + Str$(imgheight)) + Chr$(10) Put #1, , header For y = 0 To imgheight - 1 For x = 0 To imgwidth - 1 c = (Point(x, y) = _RGB(0, 0, 0)) If c <> 0 Then outbyte = _SetBit(outbyte, 7 - (bytecount Mod 8)) Else outbyte = _ResetBit(outbyte, 7 - (bytecount Mod 8)) End If If bytecount Mod 8 = 7 Then Put #ff, , outbyte End If bytecount = bytecount + 1 Next Next If (imgheight * imgwidth) Mod 8 <> 0 Then Put #1, , outbyte Close #ff End Sub