visionmercer/qb64-include
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update savebinarypbm.bm

Browse source
This commit is contained in:
visionmercer 2022-06-13 13:04:47 +02:00 • committed by GitHub
commit 32e3ed4cb6
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 6 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

10
savebinarypbm.bm
View file

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