Keskustelu: Koodit: PCX-tallenusta QB:llä

SUB savepcx (f AS STRING)
   DIM a AS INTEGER, b AS INTEGER, c AS LONG, d AS LONG, e AS STRING * 1
   DIM h AS STRING

   DEF SEG = &HA000
   b = FREEFILE

   h = CHR$(&HA) + CHR$(&H5) + CHR$(&H1) + CHR$(&H8) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H3F) + CHR$(&H1) + CHR$(&HC7) + CHR$(&H0) + CHR$(&H48) + CHR$(&H0) + CHR$(&H48) + CHR$(&H0) + CHR$(&H0) + CHR$(&H1) + CHR$(&H4) + CHR$(&H0)  _
+ CHR$(&H4) + CHR$(&HB) + CHR$(&H0)
   h = h + CHR$(&H6) + CHR$(&H10) + CHR$(&H0) + CHR$(&H8) + CHR$(&H14) + CHR$(&H0) + CHR$(&HB) + CHR$(&H1B) + CHR$(&H0) + CHR$(&HE) + CHR$(&H22) + CHR$(&H0) + CHR$(&H10) + CHR$(&H26) + CHR$(&H0) + CHR$(&H12) + CHR$(&H2B) + CHR$(&H0) + CHR$(&H15) +  _
CHR$(&H33) + CHR$(&H0)
   h = h + CHR$(&H17) + CHR$(&H38) + CHR$(&H0) + CHR$(&H18) + CHR$(&H37) + CHR$(&H0) + CHR$(&H19) + CHR$(&H3B) + CHR$(&HB) + CHR$(&H21) + CHR$(&H3F) + CHR$(&H0) + CHR$(&H1C) + CHR$(&H43) + CHR$(&H0) + CHR$(&H1E) + CHR$(&H48) + CHR$(&H3) + CHR$(&H20) _
 + CHR$(&H47) + CHR$(&H0)
   h = h + CHR$(&H1) + CHR$(&H40) + CHR$(&H1) + CHR$(&H1) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&HD) + CHR$(&HA) + CHR$(&HD) + CHR$(&HA) + CHR$(&H53) + CHR$(&H61) + CHR$(&H76) + CHR$(&H65) + CHR$( _
&H64) + CHR$(&H20) + CHR$(&H77)
   h = h + CHR$(&H69) + CHR$(&H74) + CHR$(&H68) + CHR$(&H20) + CHR$(&H73) + CHR$(&H61) + CHR$(&H76) + CHR$(&H65) + CHR$(&H70) + CHR$(&H63) + CHR$(&H78) + CHR$(&H20) + CHR$(&H62) + CHR$(&H79) + CHR$(&H20) + CHR$(&H66) + CHR$(&H61) + CHR$(&H77) + CHR$ _
(&H6B) + CHR$(&H7A) + CHR$(&H20)
   h = h + CHR$(&H32) + CHR$(&H30) + CHR$(&H30) + CHR$(&H32) + CHR$(&HD) + CHR$(&HA) + CHR$(&HD) + CHR$(&HA) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$( _
&H0)

   IF DIR$(f) <> "" THEN KILL f

   OPEN f FOR BINARY AS b
   PUT #1, , h         ' PCX-headeri (128 tavua)
   c = 0

   DO UNTIL c = 64000       ' loopataan 320x200 pikselille
      a = PEEK(c)
      d = 1

      DO
         IF c = 64000 THEN EXIT DO
         IF PEEK(c + 1) = a THEN
            d = d + 1: c = c + 1
         ELSE
            EXIT DO
         END IF
      LOOP

      IF d = 1 THEN
         IF a >= 192 THEN
            e = CHR$(1 + 192)
            PUT b, , e
            e = CHR$(a)
            PUT b, , e
         ELSE
            e = CHR$(a)
            PUT b, , e
         END IF
      ELSE
         IF d > (255 - 192) THEN
            c = c - d + (255 - 192)
            d = 255 - 192
         END IF
         e = CHR$(d + 192)
         PUT b, , e
         e = CHR$(a)
         PUT b, , e
      END IF

      c = c + 1
   LOOP
   DEF SEG

   e = CHR$(&HC)      ' magic-tavu
   PUT b, , e

   OUT &H3C7, 0       ' tallennetaan paletti
   FOR c = 1 TO 768
      a = INP(&H3C9) * 4
      e = CHR$(a)
      PUT b, , e
   NEXT c

   CLOSE b
END SUB