.PCX - Page 2 of 2

 BBS: Inland Empire Archive
Date: 02-15-94 (13:27)             Number: 135
From: HARRY F. HARRISON            Refer#: NONE
  To: JEFFREY ZAPATKA               Recvd: NO  
Subj: .PCX - Page 2 of 2             Conf: (2) Quik_Bas
'Continued from previous post
SUB ReadPCXLine (PCXFile, TotalBytes, ScanLine())
zero$ = CHR$(0)
index = LBOUND(ScanLine) + 2
count = 0
DO
   ReadPCXByte PCXFile, pixels
   ScanLine(index) = pixels
   IF count = TotalBytes THEN EXIT DO
   ReadPCXByte PCXFile, pixels
   ScanLine(index) = ScanLine(index) + CVI(zero$ + CHR$(pixels))
   count = count + 2
   index = index + 1
LOOP WHILE count < TotalBytes
END SUB

SUB SelectScreen
SELECT CASE ASC(PCXheader.BitsPerPixel)
   CASE 1
      IF ASC(PCXheader.NumPlanes) = 4 THEN
        IF MaxScrMode < 11 THEN
         ScrMode = 9
         ScrMaxX = 639
         ScrMaxY = 349
         ScrMaxColor = 15
         ScrBitsPerPixel = 1
        ELSE
         ScrMode = 12
         ScrMaxX = 639
         ScrMaxY = 479
         ScrMaxColor = 15
         ScrBitsPerPixel = 1
        END IF
      ELSE
         ScrMode = 11
         ScrMaxX = 639
         ScrMaxY = 479
         ScrMaxColor = 1
         ScrBitsPerPixel = 1
      END IF
   CASE 2
      ScrMode = 1
      ScrMaxX = 319
      ScrMaxY = 199
      ScrMaxColor = 3
      ScrBitsPerPixel = 2
   CASE 8
      ScrMode = 9
      ScrMaxX = 639
      ScrMaxY = 349
      ScrMaxColor = 15
      ScrBitsPerPixel = 8
END SELECT
END SUB

SUB SetPalette (pcxpal$)
Version = ASC(PCXheader.Version)
IF Version = 5 AND (ScrMode = 13 OR ScrMode = 12) THEN
   FOR I = 0 TO ScrMaxColor
      R = ASC(MID$(pcxpal$, I * 3 + 1, 1)) \ 4
      G = ASC(MID$(pcxpal$, I * 3 + 2, 1)) \ 4
      B = ASC(MID$(pcxpal$, I * 3 + 3, 1)) \ 4
      PALETTE I, B * 65536 + G * 256 + R
   NEXT I
ELSEIF Version = 5 AND ScrMode = 9 THEN
  FOR I = 0 TO ScrMaxColor
      R = ASC(MID$(pcxpal$, I * 3 + 1, 1)) \ 64
      G = ASC(MID$(pcxpal$, I * 3 + 2, 1)) \ 64
      B = ASC(MID$(pcxpal$, I * 3 + 3, 1)) \ 64
      PALETTE I, R * 4 + G * 16 + B * 1
  NEXT I
ELSE
   PALETTE
END IF
END SUB

SUB SHOWPCX (PCXName$) STATIC
MaxScrMode = 12
 ON ERROR GOTO NoVGA
 SCREEN MaxScrMode
 ON ERROR GOTO 0
   SCREEN 0
   WIDTH 80
   IF PCXName$ = "" THEN EXIT SUB
   IF 0 = LEN(DIR$(PCXName$)) THEN BEEP: EXIT SUB
   OpenPCXFile PCXName$, xsize, ysize, TotalBytes, pcxpal$
   SEEK #PCXFile, LEN(PCXheader) + 1
   SelectScreen
   SCREEN ScrMode
   SetPalette pcxpal$
   REDIM ScanLine(TotalBytes + 1)
   pbits = xsize * ASC(PCXheader.BitsPerPixel)
   sbits = ScrMaxX * ScrBitsPerPixel
   IF pbits > sbits THEN
      ScanLine(0) = sbits + 1
   ELSE
      ScanLine(0) = pbits
   END IF
   ScanLine(1) = 1
   Y = 0
   DO
      ReadPCXLine PCXFile, TotalBytes, ScanLine()
      PUT (0, Y), ScanLine
      Y = Y + 1
   LOOP WHILE Y < ysize OR Y < ScrMaxY
   CLOSE #PCXPile
   Y = TIMER \ 3
   'DO WHILE INT(TIMER \ 3) = Y: LOOP
   PALETTE
END SUB
$$54
---
 * Origin: Far Heap Corrupt - Abort, Retry, Ignore or Fail? (1:105/222.5)
Outer Court
Echo Basic Postings

Books at Amazon:

Back to BASIC: The History, Corruption, and Future of the Language

Hackers: Heroes of the Computer Revolution (including Tiny BASIC)

Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution

The Advent of the Algorithm: The Idea that Rules the World

Moths in the Machine: The Power and Perils of Programming

Mastering Visual Basic .NET