Create savebinarypbm.bm

savebinarypbm.bm

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