PCX Show by Richard Davey29th Aug 2003 23:36
|
|---|
|
Summary Now you can use PCX graphic files in your DarkBasic programs! Includes a fast function for displaying PCX header info and also rendering the images to a specified bitmap. Handle Description ========================================================== Code ` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
` PCX Show v1.0
` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
` By Rich Davey (rich@fatal-design.com)
` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
` Music listened to while coding this
` Gladiator Motion Picture Soundtrack
` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
` Note:
` Fed-up using BMP's? Well now you can
` use PCX files instead! You can only
` use 256 colour PCX files though, but
` the compression ratio is still far
` greater than BMP. This is a function
` for inclusion in your own programs.
`
` Simply call it with:
`
` PCXShow("filename.pcx","command",bitmap)
`
` Where filename.pcx is a valid 256 colour
` PCX file (of any dimension)
` Command can be either "info" or "show"
` info will print a PCX info screen and
` show will actually render the image
` Bitmap can be used to tell it to render
` the pcx to a different bitmap (default is 0)
sync rate 0
sync on
hide mouse
PCXShow("rich.pcx","info",0)
wait key
cls 0
PCXShow("rich.pcx","show",0)
wait key
end
` PCX Show Version 1.0 Function
` (C)opyright Richard Davey, DarkForge, 2000
function PCXShow(file$,command$,bmap)
filesize=file size(file$)
if filesize<0
print "PCXShow Error: File size is zero bytes! Does it exist?"
wait key
end
endif
dim pcx(filesize)
open to read 1,file$
for a=0 to filesize
read byte 1,pcx(a)
next a
close file 1
manufacturer=pcx(0)
version=pcx(1)
encoding=pcx(2)
bitsperpixel=pcx(3)
planes=pcx(65)
open to read 1,file$
for a=0 to 3
read byte 1,null
next a
read word 1,xmin
read word 1,ymin
read word 1,xmax
read word 1,ymax
read word 1,hres
read word 1,vres
for a=0 to 49
read byte 1,null
next a
read word 1,bytesperline
read word 1,paletteinfo
close file 1
dimensionx=xmax-xmin
dimensiony=ymax-ymin
inc dimensionx
inc dimensiony
totalbytes=planes*bytesperline
if manufacturer=10
manufacturer$="ZSoft"
else
manufacturer$="Unknown"
endif
if version=0 then version$="2.5"
if version=2 then version$="2.8 w/palette information"
if version=3 then version$="2.8 w/o palette information"
if version=5 then version$="3.0"
if version$="" then version$="Unknown"
if encoding=1
encoding$="Run Length Encoding"
else
encoding$="Unknown"
endif
if paletteinfo=1 then paletteinfo$="Color/BW"
if paletteinfo=2 then paletteinfo$="Greyscale"
if pcx(filesize-769)=12
dim vga_r(256)
dim vga_g(256)
dim vga_b(256)
vc=0 : a=filesize-768
repeat
vga_r(vc)=pcx(a)
vga_g(vc)=pcx(a+1)
vga_b(vc)=pcx(a+2)
inc vc
inc a,3
until vc=255
else
print "PCXShow Error : No support for < 256 colour PCXs"
wait key
end
endif
if command$="info"
for bgcol=50 to 150 step 5
ink rgb(0,0,bgcol),rgb(0,0,0)
line 0,by,639,by
inc by
next bgcol
for bgcol=150 to 50 step -5
ink rgb(0,0,bgcol),rgb(0,0,0)
line 0,by,639,by
inc by
next bgcol
by=420
for bgcol=50 to 150 step 5
ink rgb(0,0,bgcol),rgb(0,0,0)
line 0,by,639,by
inc by
next bgcol
for bgcol=150 to 50 step -5
ink rgb(0,0,bgcol),rgb(0,0,0)
line 0,by,639,by
inc by
next bgcol
ink rgb(255,255,255),rgb(0,0,0)
set text font "Courier"
set text size 10
center text 320,15,"PCX Show v1.0 - (C) DarkForge 2000"
center text 320,435,"www.darkforge.co.uk"
text 50,50,"Filename:"
text 300,50,file$
text 50,70,"Manufacturer:"
text 300,70,manufacturer$
text 50,90,"Version:"
text 300,90,version$
text 50,110,"Encoding:"
text 300,110,encoding$
text 50,130,"Bits per Pixel:"
text 300,130,str$(bitsperpixel)
text 50,150,"X Min:"
text 300,150,str$(xmin)
text 50,170,"Y Min:"
text 300,170,str$(ymin)
text 50,190,"X Max:"
text 300,190,str$(xmax)
text 50,210,"Y Max:"
text 300,210,str$(ymax)
text 50,230,"Colour planes:"
text 300,230,str$(planes)
text 50,250,"Bytes per Scanline:"
text 300,250,str$(bytesperline)
text 50,270,"Palette Info:"
text 300,270,paletteinfo$
center text 320,300,"16 Colour Palette"
ink rgb(255,255,255),rgb(0,0,0)
blx=320-65
box blx,320,blx+130,330
i=blx+1
for a=16 to 47 step 3
ink rgb(pcx(a),pcx(a+1),pcx(a+2)),rgb(0,0,0)
box i,321,i+6,329
inc i,8
next a
ink rgb(255,255,255),rgb(0,0,0)
blx=320-255
box blx,370,blx+513,380
center text 320,350,"256 Colour Palette"
i=blx+1
for a=0 to 255
ink rgb(vga_r(a),vga_g(a),vga_b(a)),rgb(0,0,0)
box i,371,i+1,379
inc i,2
next a
else
x=0 : y=0 : c=128
if bmap>0 then create bitmap bmap,dimensionx,dimensiony
repeat
repeat
istream=pcx(c)
dstream$=bin$(istream)
dstream$=right$(dstream$,8)
if val(left$(dstream$,1))=1 and val(mid$(dstream$,2))=1
rlecount=0
r=val(mid$(dstream$,3))
if r=1 then inc rlecount,32
r=val(mid$(dstream$,4))
if r=1 then inc rlecount,16
r=val(mid$(dstream$,5))
if r=1 then inc rlecount,8
r=val(mid$(dstream$,6))
if r=1 then inc rlecount,4
r=val(mid$(dstream$,7))
if r=1 then inc rlecount,2
r=val(mid$(dstream$,8))
if r=1 then inc rlecount
color=pcx(c+1)
ink rgb(vga_r(color),vga_g(color),vga_b(color)),rgb(0,0,0)
line x,y,x+rlecount,y
inc x,rlecount
inc c,2
else
color=pcx(c)
ink rgb(vga_r(color),vga_g(color),vga_b(color)),rgb(0,0,0)
if x<dimensionx
dot x,y
inc x
endif
inc c
endif
until x>=dimensionx
x=0
inc y
until y>=dimensiony
set current bitmap 0
endif
endfunction
|