Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Error displaying 256 color PCX image program?
#1
Code: (Select All)
handle& = _NewImage(800, 600, 32)
Screen handle&
Dim palentry As String * 3
Dim rgbpalette(256) As Long
[Image: test.jpg]

Dim dat As String * 1
Open "c:\shu01.pcx" For Binary As #1
header$ = Space$(128)
Get #1, , header$: Cls
bitsper = Asc(Mid$(header$, 4, 1))
plane = Asc(Mid$(header$, 66, 1))

XRes$ = Mid$(header$, 9, 2)
XRes1$ = Left$(XRes$, 1): XRes2$ = Right$(XRes$, 1)
XRes = Asc(XRes1$) + Asc(XRes2$) * 256 + 1

YRes$ = Mid$(header$, 11, 2)
YRes1$ = Left$(YRes$, 1): YRes2$ = Right$(YRes$, 1)
YRes = Asc(YRes1$) + Asc(YRes2$) * 256 + 1
Dim mqh(800, 800) As Integer
scanline$ = Mid$(header$, 67, 2)
scanline1$ = Left$(scanline$, 1): scanline2$ = Right$(scanline$, 1)
scanline = Asc(scanline1$) + Asc(scanline2$) * 256
If plane = 1 And bitsper = 8 Then

Seek #1, LOF(1) - 767
For i% = 0 To 255
Get #1, , palentry$
R& = Asc(Mid$(palentry$, 1, 1))
G& = Asc(Mid$(palentry$, 2, 1))
B& = Asc(Mid$(palentry$, 3, 1))
rgbpalette&(i%) = _RGB(R&, G&, B&)

Next i%

Seek #1, &H81
c = 1: sum = 1: j% = 1
Do
Get #1, , dat
Select Case Asc(dat)
Case Is < 192
mqh(c, j) = Asc(dat)

c = c + 1
sum = sum + 1

If c = scanline + 1 Then
j% = j% + 1
If j% = YRes + 1 Then Exit Do
c = 1
End If
Case Is > 192 And Asc(dat) <= 255
lps = Asc(dat) - 192
Seek #1, 129 + sum
Get #1, , dat
For a = 1 To lps
mqh(c, j%) = Asc(dat)

c = c + 1

If c = scanline + 1 Then
j% = j% + 1
If j% = YRes + 1 Then Exit Do
c = 1
End If
Next a
sum = sum + 2
End Select
Loop

For i% = 1 To YRes
For j% = 1 To XRes

PSet (j%, i%), rgbpalette&(mqh(j%, i%))
Next j%, i%
Close #1
End If


Attached Files
.rar   SHU01.rar (Size: 32.78 KB / Downloads: 38)
Reply


Messages In This Thread
Error displaying 256 color PCX image program? - by macalwen - 07-04-2024, 12:53 PM



Users browsing this thread: 1 Guest(s)