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 09:42:00 +02:00 • committed by GitHub
commit aa5ac9e761
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 13 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

27
savebinarypbm.bm
View file

@ -2,36 +2,35 @@ Sub saveBinaryPBM (handle As Long, filename As String)
Dim imgwidth As Long Dim imgwidth As Long
Dim imgheight As Long Dim imgheight As Long
Dim oldsource As Long Dim oldsource As Long
Dim fid As String Dim header As String
Dim imgdim 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 c As _Byte Dim c As _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 Open filename For Binary As #1
fid = "P4" + Chr$(10) header = "P4" + Chr$(10)
Put #1, , fid header = header + "# Created with QB64" + Chr$(10)
fid = "# Created with QB64" + Chr$(10) header = header + LTrim$(Str$(imgwidth) + Str$(imgheight)) + Chr$(10)
Put #1, , fid Put #1, , header
imgdim = LTrim$(Str$(imgwidth) + Str$(imgheight)) + Chr$(10)
Put #1, , imgdim
Dim o As _Unsigned _Byte
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) = _RGB(0, 0, 0))
If c <> 0 Then If c <> 0 Then
o = _SetBit(o, 7 - (x Mod 8)) outbyte = _SetBit(outbyte, 7 - (bytecount Mod 8))
Else Else
o = _ResetBit(o, 7 - (x Mod 8)) outbyte = _ResetBit(outbyte, 7 - (bytecount Mod 8))
End If End If
If x Mod 8 = 7 Then If bytecount Mod 8 = 7 Then
Put #1, , o Put #1, , outbyte
End If End If
bytecount = bytecount + 1
Next Next
Next Next
If (imgheight * imgwidth) Mod 8 <> 0 Then Put #1, , outbyte
Close #1 Close #1
End Sub End Sub