space saving.
This commit is contained in:
visionmercer
parent
73e1655b80
commit
576726e6be
4 changed files with 626 additions and 626 deletions
|
|
@ -1,203 +1,203 @@
|
|||
|
||||
Sub SaveBinaryPPM (imageHandle As Long, fileName As String)
|
||||
Dim r As _Unsigned _Byte
|
||||
Dim g As _Unsigned _Byte
|
||||
Dim b As _Unsigned _Byte
|
||||
Dim fileHandle As Integer
|
||||
Dim w As _Unsigned Long
|
||||
Dim h As _Unsigned Long
|
||||
Dim head As String
|
||||
Dim fileout As String
|
||||
Dim image As _MEM
|
||||
Dim filebuffer As _MEM
|
||||
Dim inPosition As _Offset
|
||||
Dim outPosition As _Offset
|
||||
Dim length As _Offset
|
||||
image = _MemImage(imageHandle)
|
||||
inPosition = image.OFFSET
|
||||
w = _Width(imageHandle)
|
||||
h = _Height(imageHandle)
|
||||
length = inPosition + w * h * 4
|
||||
head = "P6" + Chr$(10)
|
||||
head = head + "# Created with Pixler" + Chr$(10)
|
||||
head = head + LTrim$(str$(w) + str$(h)) + Chr$(10)
|
||||
head = head + "255" + Chr$(10)
|
||||
filebuffer = _MemNew(w * h * 3)
|
||||
outPosition = filebuffer.OFFSET
|
||||
Do
|
||||
b = _MemGet(image, inPosition, _Unsigned _Byte)
|
||||
g = _MemGet(image, inPosition + 1, _Unsigned _Byte)
|
||||
r = _MemGet(image, inPosition + 2, _Unsigned _Byte)
|
||||
_MemPut filebuffer, outPosition, r As _UNSIGNED _BYTE
|
||||
_MemPut filebuffer, outPosition + 1, g As _UNSIGNED _BYTE
|
||||
_MemPut filebuffer, outPosition + 2, b As _UNSIGNED _BYTE
|
||||
inPosition = inPosition + 4
|
||||
outPosition = outPosition + 3
|
||||
Loop Until inPosition = length
|
||||
fileout = Space$(w * h * 3)
|
||||
_MemGet filebuffer, filebuffer.OFFSET, fileout
|
||||
fileHandle = FreeFile
|
||||
Open fileName For Binary As fileHandle
|
||||
Put fileHandle, , head
|
||||
Put fileHandle, , fileout
|
||||
Close fileHandle
|
||||
_MemFree image
|
||||
_MemFree filebuffer
|
||||
End Sub
|
||||
sub savebinaryppm (imagehandle as long,filename as string)
|
||||
dim r as _unsigned _byte
|
||||
dim g as _unsigned _byte
|
||||
dim b as _unsigned _byte
|
||||
dim filehandle as integer
|
||||
dim w as _unsigned long
|
||||
dim h as _unsigned long
|
||||
dim head as string
|
||||
dim fileout as string
|
||||
dim image as _mem
|
||||
dim filebuffer as _mem
|
||||
dim inposition as _offset
|
||||
dim outposition as _offset
|
||||
dim length as _offset
|
||||
image=_memimage(imagehandle)
|
||||
inposition=image.offset
|
||||
w=_width(imagehandle)
|
||||
h=_height(imagehandle)
|
||||
length=inposition+w*h*4
|
||||
head="P6"+chr$(10)
|
||||
head=head+"# Created with Pixler"+chr$(10)
|
||||
head=head+ltrim$(str$(w)+str$(h))+chr$(10)
|
||||
head=head+"255"+chr$(10)
|
||||
filebuffer=_memnew(w*h*3)
|
||||
outposition=filebuffer.offset
|
||||
do
|
||||
b=_memget(image,inposition,_unsigned _byte)
|
||||
g=_memget(image,inposition+1,_unsigned _byte)
|
||||
r=_memget(image,inposition+2,_unsigned _byte)
|
||||
_memput filebuffer,outposition,r as _unsigned _byte
|
||||
_memput filebuffer,outposition+1,g as _unsigned _byte
|
||||
_memput filebuffer,outposition+2,b as _unsigned _byte
|
||||
inposition=inposition+4
|
||||
outposition=outposition+3
|
||||
loop until inposition=length
|
||||
fileout=space$(w*h*3)
|
||||
_memget filebuffer,filebuffer.offset,fileout
|
||||
filehandle=freefile
|
||||
open filename for binary as filehandle
|
||||
put filehandle,,head
|
||||
put filehandle,,fileout
|
||||
close filehandle
|
||||
_memfree image
|
||||
_memfree filebuffer
|
||||
end sub
|
||||
|
||||
Sub save24bitBmp (imageHandle As Long, fileName As String)
|
||||
Dim oSource As Long
|
||||
Dim ff As Long
|
||||
Dim x As Long, y As Long
|
||||
Dim header As String * 54
|
||||
Dim outBytes As String * 3
|
||||
Dim padding As String
|
||||
oSource = _Source
|
||||
_Source imageHandle
|
||||
sub save24bitbmp (imagehandle as long,filename as string)
|
||||
dim osource as long
|
||||
dim ff as long
|
||||
dim x as long,y as long
|
||||
dim header as string*54
|
||||
dim outbytes as string*3
|
||||
dim padding as string
|
||||
osource=_source
|
||||
_source imagehandle
|
||||
|
||||
header = "BM" + MKL$(_Width * _Height * 3 + 54) +_
|
||||
String$(4, 0) + MKL$(54) + MKL$(40) +_
|
||||
MKL$(_Width) + MKL$(_Height) +_
|
||||
MKI$(1) + MKI$(24) + MKL$(0) + MKL$(0) +_
|
||||
MKL$(11811) + MKL$(11811) + MKL$(0) + MKL$(0)
|
||||
header="BM"+mkl$(_width*_height*3+54)+_
|
||||
string$(4,0)+mkl$(54)+mkl$(40)+_
|
||||
mkl$(_width)+mkl$(_height)+_
|
||||
mki$(1)+mki$(24)+mkl$(0)+mkl$(0)+_
|
||||
mkl$(11811)+mkl$(11811)+mkl$(0)+mkl$(0)
|
||||
|
||||
If ((_Width * 3) Mod 4) Then padding$ = String$(4 - ((_width * 3) Mod 4), 0)
|
||||
if ((_width*3) mod 4) then padding$=string$(4-((_width*3) mod 4),0)
|
||||
|
||||
ff = FreeFile
|
||||
Open fileName For Binary As ff
|
||||
Put ff, , header
|
||||
For y = _Height - 1 To 0 Step -1
|
||||
For x = 0 To _Width - 1
|
||||
outBytes = Left$(MKL$(Point(x, y)), 3)
|
||||
Put #ff, , outBytes
|
||||
Next
|
||||
put #ff, , padding
|
||||
Next
|
||||
Close ff
|
||||
_Source oSource
|
||||
End Sub
|
||||
ff=freefile
|
||||
open filename for binary as ff
|
||||
put ff,,header
|
||||
for y=_height-1 to 0 step -1
|
||||
for x=0 to _width-1
|
||||
outbytes=left$(mkl$(point(x,y)),3)
|
||||
put #ff,,outbytes
|
||||
next
|
||||
put #ff,,padding
|
||||
next
|
||||
close ff
|
||||
_source osource
|
||||
end sub
|
||||
|
||||
Sub save8bitPNG (imagehandle As Long, filename As String)
|
||||
Dim PngHeader As String
|
||||
Dim IHDR As String
|
||||
Dim IDAT As String
|
||||
Dim IEND As String
|
||||
Dim PLTE As String
|
||||
Dim x As _Unsigned Long, y As _Unsigned Long
|
||||
Dim colorvalue As _Unsigned Long
|
||||
Dim chunksize As String
|
||||
Dim ff As Long
|
||||
Dim imageData As String
|
||||
dim sourceMem as _mem
|
||||
dim c As _Unsigned _byte
|
||||
sourceMem = _memimage(imagehandle)
|
||||
PngHeader = chr$(137) + "PNG" + Chr$(13) + Chr$(10) + Chr$(26) + Chr$(10)
|
||||
IHDR = "IHDR" + MKL$(FlipBytes(_Width(imagehandle))) + MKL$(FlipBytes(_Height(imagehandle))) + Chr$(8) + Chr$(3) + String$(3, 0)
|
||||
IHDR = MKL$(FlipBytes(&H0D)) + IHDR + MKL$(FlipBytes(crc32(IHDR)))
|
||||
IEND = MKL$(0) + "IEND" + MKL$(FlipBytes(&HAE426082))
|
||||
PLTE = "PLTE"
|
||||
for c = 0 to 255
|
||||
PLTE = PLTE + chr$(_Red32(_PaletteColor(c)))
|
||||
PLTE = PLTE + chr$(_Green32(_PaletteColor(c)))
|
||||
PLTE = PLTE + chr$(_Blue32(_PaletteColor(c)))
|
||||
Next
|
||||
PLTE = mkl$(FlipBytes(256 * 3)) + PLTE + MKL$(FlipBytes(crc32(PLTE)))
|
||||
sub save8bitpng (imagehandle as long,filename as string)
|
||||
dim pngheader as string
|
||||
dim ihdr as string
|
||||
dim idat as string
|
||||
dim iend as string
|
||||
dim plte as string
|
||||
dim x as _unsigned long,y as _unsigned long
|
||||
dim colorvalue as _unsigned long
|
||||
dim chunksize as string
|
||||
dim ff as long
|
||||
dim imagedata as string
|
||||
dim sourcemem as _mem
|
||||
dim c as _unsigned _byte
|
||||
sourcemem=_memimage(imagehandle)
|
||||
pngheader=chr$(137)+"PNG"+chr$(13)+chr$(10)+chr$(26)+chr$(10)
|
||||
ihdr="IHDR"+mkl$(flipbytes(_width(imagehandle)))+mkl$(flipbytes(_height(imagehandle)))+chr$(8)+chr$(3)+string$(3,0)
|
||||
ihdr=mkl$(flipbytes(&h0d))+ihdr+mkl$(flipbytes(crc32(ihdr)))
|
||||
iend=mkl$(0)+"IEND"+mkl$(flipbytes(&hae426082))
|
||||
plte="PLTE"
|
||||
for c=0 to 255
|
||||
plte=plte+chr$(_red32(_palettecolor(c)))
|
||||
plte=plte+chr$(_green32(_palettecolor(c)))
|
||||
plte=plte+chr$(_blue32(_palettecolor(c)))
|
||||
next
|
||||
plte=mkl$(flipbytes(256*3))+plte+mkl$(flipbytes(crc32(plte)))
|
||||
|
||||
imageData = string$(_Height(imagehandle) * _Width(imagehandle) + _Height(imagehandle), 0)
|
||||
imagedata=string$(_height(imagehandle)*_width(imagehandle)+_height(imagehandle),0)
|
||||
|
||||
For y = 0 To _Height(imagehandle) - 1
|
||||
For x = 0 To _Width(imagehandle) - 1
|
||||
c = _memget(sourceMem, sourceMem.OFFSET + bytecount + 0, _Unsigned _byte)
|
||||
asc(imageData,bytecount + y + 2) = c
|
||||
bytecount = bytecount + 1
|
||||
Next x
|
||||
Next y
|
||||
_memfree sourceMem
|
||||
IDAT = _Deflate$(imageData)
|
||||
chunksize = MKL$(FlipBytes(Len(IDAT)))
|
||||
IDAT = "IDAT" + IDAT
|
||||
IDAT = IDAT + MKL$(FlipBytes(crc32(IDAT)))
|
||||
IDAT = chunksize + IDAT
|
||||
ff = FreeFile
|
||||
Open filename For Output As ff: Close ff
|
||||
Open filename For Binary As ff
|
||||
Put ff, , PngHeader
|
||||
Put ff, , IHDR
|
||||
put ff, , PLTE
|
||||
Put ff, , IDAT
|
||||
Put ff, , IEND
|
||||
Close ff
|
||||
End Sub
|
||||
for y=0 to _height(imagehandle)-1
|
||||
for x=0 to _width(imagehandle)-1
|
||||
c=_memget(sourcemem,sourcemem.offset+bytecount+0,_unsigned _byte)
|
||||
asc(imagedata,bytecount+y+2)=c
|
||||
bytecount=bytecount+1
|
||||
next x
|
||||
next y
|
||||
_memfree sourcemem
|
||||
idat=_deflate$(imagedata)
|
||||
chunksize=mkl$(flipbytes(len(idat)))
|
||||
idat="IDAT"+idat
|
||||
idat=idat+mkl$(flipbytes(crc32(idat)))
|
||||
idat=chunksize+idat
|
||||
ff=freefile
|
||||
open filename for output as ff:close ff
|
||||
open filename for binary as ff
|
||||
put ff,,pngheader
|
||||
put ff,,ihdr
|
||||
put ff,,plte
|
||||
put ff,,idat
|
||||
put ff,,iend
|
||||
close ff
|
||||
end sub
|
||||
|
||||
Sub save32bitPNG (imagehandle As Long, filename As String)
|
||||
Dim PngHeader As String
|
||||
Dim IHDR As String
|
||||
Dim IDAT As String
|
||||
Dim IEND As String
|
||||
Dim x As _Unsigned Long, y As _Unsigned Long
|
||||
Dim colorvalue As _Unsigned Long
|
||||
Dim chunksize As String
|
||||
Dim ff As Long
|
||||
Dim imageData As String
|
||||
dim sourceMem as _mem
|
||||
dim as _Unsigned _byte r, g, b
|
||||
sourceMem = _memimage(imagehandle)
|
||||
PngHeader = chr$(137) + "PNG" + Chr$(13) + Chr$(10) + Chr$(26) + Chr$(10)
|
||||
IHDR = "IHDR" + MKL$(FlipBytes(_Width(imagehandle))) + MKL$(FlipBytes(_Height(imagehandle))) + Chr$(8) + Chr$(6) + String$(3, 0)
|
||||
IHDR = MKL$(FlipBytes(&H0D)) + IHDR + MKL$(FlipBytes(crc32(IHDR)))
|
||||
IEND = MKL$(0) + "IEND" + MKL$(FlipBytes(&HAE426082))
|
||||
imageData = string$(_Height(imagehandle) * _Width(imagehandle) * 4 + _Height(imagehandle), 0)
|
||||
sub save32bitpng (imagehandle as long,filename as string)
|
||||
dim pngheader as string
|
||||
dim ihdr as string
|
||||
dim idat as string
|
||||
dim iend as string
|
||||
dim x as _unsigned long,y as _unsigned long
|
||||
dim colorvalue as _unsigned long
|
||||
dim chunksize as string
|
||||
dim ff as long
|
||||
dim imagedata as string
|
||||
dim sourcemem as _mem
|
||||
dim as _unsigned _byte r,g,b
|
||||
sourcemem=_memimage(imagehandle)
|
||||
pngheader=chr$(137)+"PNG"+chr$(13)+chr$(10)+chr$(26)+chr$(10)
|
||||
ihdr="IHDR"+mkl$(flipbytes(_width(imagehandle)))+mkl$(flipbytes(_height(imagehandle)))+chr$(8)+chr$(6)+string$(3,0)
|
||||
ihdr=mkl$(flipbytes(&h0d))+ihdr+mkl$(flipbytes(crc32(ihdr)))
|
||||
iend=mkl$(0)+"IEND"+mkl$(flipbytes(&hae426082))
|
||||
imagedata=string$(_height(imagehandle)*_width(imagehandle)*4+_height(imagehandle),0)
|
||||
|
||||
For y = 0 To _Height(imagehandle) - 1
|
||||
For x = 0 To _Width(imagehandle) - 1
|
||||
b = _memget(sourceMem, sourceMem.OFFSET + bytecount + 0, _Unsigned _byte)
|
||||
g = _memget(sourceMem, sourceMem.OFFSET + bytecount + 1, _Unsigned _byte)
|
||||
r = _memget(sourceMem, sourceMem.OFFSET + bytecount + 2, _Unsigned _byte)
|
||||
a = _memget(sourceMem, sourceMem.OFFSET + bytecount + 3, _Unsigned _byte)
|
||||
for y=0 to _height(imagehandle)-1
|
||||
for x=0 to _width(imagehandle)-1
|
||||
b=_memget(sourcemem,sourcemem.offset+bytecount+0,_unsigned _byte)
|
||||
g=_memget(sourcemem,sourcemem.offset+bytecount+1,_unsigned _byte)
|
||||
r=_memget(sourcemem,sourcemem.offset+bytecount+2,_unsigned _byte)
|
||||
a=_memget(sourcemem,sourcemem.offset+bytecount+3,_unsigned _byte)
|
||||
|
||||
asc(imageData,bytecount + y + 2) = r
|
||||
asc(imageData,bytecount + y + 3) = g
|
||||
asc(imageData,bytecount + y + 4) = b
|
||||
asc(imageData,bytecount + y + 5) = a
|
||||
bytecount = bytecount + 4
|
||||
Next x
|
||||
Next y
|
||||
_memfree sourceMem
|
||||
IDAT = _Deflate$(imageData)
|
||||
chunksize = MKL$(FlipBytes(Len(IDAT)))
|
||||
IDAT = "IDAT" + IDAT
|
||||
IDAT = IDAT + MKL$(FlipBytes(crc32(IDAT)))
|
||||
IDAT = chunksize + IDAT
|
||||
ff = FreeFile
|
||||
Open filename For Output As ff: Close ff
|
||||
Open filename For Binary As ff
|
||||
Put ff, , PngHeader
|
||||
Put ff, , IHDR
|
||||
Put ff, , IDAT
|
||||
Put ff, , IEND
|
||||
Close ff
|
||||
End Sub
|
||||
asc(imagedata,bytecount+y+2)=r
|
||||
asc(imagedata,bytecount+y+3)=g
|
||||
asc(imagedata,bytecount+y+4)=b
|
||||
asc(imagedata,bytecount+y+5)=a
|
||||
bytecount=bytecount+4
|
||||
next x
|
||||
next y
|
||||
_memfree sourcemem
|
||||
idat=_deflate$(imagedata)
|
||||
chunksize=mkl$(flipbytes(len(idat)))
|
||||
idat="IDAT"+idat
|
||||
idat=idat+mkl$(flipbytes(crc32(idat)))
|
||||
idat=chunksize+idat
|
||||
ff=freefile
|
||||
open filename for output as ff:close ff
|
||||
open filename for binary as ff
|
||||
put ff,,pngheader
|
||||
put ff,,ihdr
|
||||
put ff,,idat
|
||||
put ff,,iend
|
||||
close ff
|
||||
end sub
|
||||
|
||||
Function FlipBytes~& (value As _Unsigned Long)
|
||||
FlipBytes~& = (value \ 16777216)_
|
||||
Or (value * 16777216)_
|
||||
Or ((value And 16711680) \ 256)_
|
||||
Or ((value And 65280) * 256)
|
||||
End Function
|
||||
function flipbytes~& (value as _unsigned long)
|
||||
flipbytes~&=(value \ 16777216)_
|
||||
or (value*16777216)_
|
||||
or ((value and 16711680) \ 256)_
|
||||
or ((value and 65280)*256)
|
||||
end function
|
||||
|
||||
Function crc32~& (IN$)
|
||||
Dim As _Unsigned Long CRC32_POLY, CRC
|
||||
CRC32_POLY = &HEDB88320
|
||||
CRC = &HFFFFFFFF
|
||||
For I = 1 To Len(IN$)
|
||||
CRC = CRC Xor Asc(IN$, I)
|
||||
For J = 1 To 8
|
||||
If CRC And 1 Then
|
||||
CRC = (CRC \ 2) Xor CRC32_POLY
|
||||
Else
|
||||
CRC = CRC \ 2
|
||||
End If
|
||||
Next J
|
||||
Next I
|
||||
crc32~& = Not CRC
|
||||
End Function
|
||||
function crc32~& (in$)
|
||||
dim as _unsigned long crc32_poly,crc
|
||||
crc32_poly=&hedb88320
|
||||
crc=&hffffffff
|
||||
for i=1 to len(in$)
|
||||
crc=crc xor asc(in$,i)
|
||||
for j=1 to 8
|
||||
if crc and 1 then
|
||||
crc=(crc \ 2) xor crc32_poly
|
||||
else
|
||||
crc=crc \ 2
|
||||
end if
|
||||
next j
|
||||
next i
|
||||
crc32~&=not crc
|
||||
end function
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue