38 lines
1.2 KiB
Text
38 lines
1.2 KiB
Text
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
|