'Program : BMP Load/Save
'Programer : FARZAD BADILI (FDB@bigfoot.com)
'http://www.inernettrash.com/users/fdb/
'Last Change : 1376\1\6

 DECLARE SUB loading (fln$)
 DECLARE SUB saving (fln$, sx, sy, ex, ey)
 '$INCLUDE: 'qbx.bi'

REM ************* This program will save or load the pictures ***************

  SCREEN 13
   DIM SHARED A%(32002), rgb%(768)
    DIM SHARED regs AS RegType

  LINE INPUT "Enter File Name :"; fln$
   IF fln$ = "" THEN END

 PRINT
  LINE INPUT "Enter your choice (L :load - S :save):"; ans$
   CLS

 IF UCASE$(ans$) = "L" THEN GOSUB part2 ELSE GOSUB part1
  SOUND 1000, 1: SOUND 500, 1: SOUND 1000, 1
   END

part1:
REM ******************************* saving **********************************

    CALL saving(fln$, 0, 0, 199, 199)
     RETURN

part2:
REM ****************************** loading **********************************
   CLS
    CALL loading(fln$)
     SLEEP 10
      RETURN

SUB loading (fln$)

 GET (0, 0)-(319, 199), A%

REM ************************** read R.G.B ***********************************
 OPEN fln$ FOR RANDOM AS #1 LEN = 1078
  fls = LOF(1)
   FIELD #1, 2 AS bftype$, 4 AS bfsize$, 2 AS bfres1$, 2 AS bfres2$, 4 AS bfoffbits$, 4 AS bisize$, 4 AS biwidth$, 4 AS biheight$, 2 AS biplanes$, 2 AS bbitcount$, 4 AS bicomp$, 4 AS bisi$, 4 AS bixp$, 4 AS biyp$, 4 AS biclru$, 4 AS biclri$, 1024 AS _
 B$
    GET #1, 1

 PRINT bftype$, CVL(bfsize$), CVI(bfres1$), CVI(bfres2$), CVL(bfoffbits$), CVL(bisize$), CVL(biwidth$), CVL(biheight$), CVI(biplanes$), CVI(bbitcount$), CVL(bicomp$), CVL(bisi$), CVL(bixp$), CVL(biyp$), CVL(biclru$), CVL(biclri$)
  k = CVL(biwidth$) / 2
   s = (CVL(biheight$) * 160) + 2
    m = k
     p = 160 - k
      f = 1

 IF CVI(bbitcount$) <> 8 THEN er = 1: GOTO p1
   count = CVL(biwidth$) * CVL(biheight$)
    x = 1
     FOR t = 1 TO 1024 STEP 1
      A$ = MID$(B$, t, 1)
       pltrgb = ASC(A$)
        B = pltrgb / 4
         rgb%(x) = B
          t = t + 1

      A$ = MID$(B$, t, 1)
       pltrgb = ASC(A$)
        g = pltrgb / 4
         rgb%(x + 1) = g
          t = t + 1

      A$ = MID$(B$, t, 1)
       pltrgb = ASC(A$)
        r = pltrgb / 4
         rgb%(x + 2) = r
          t = t + 1

      PALETTE CLR, 65536 * FIX(B) + 256 * FIX(g) + FIX(r)
       CLR = CLR + 1: x = x + 3
     NEXT

p1:
 CLOSE #1

 IF er = 1 THEN GOTO p2
  IF count > 20000 THEN GOTO p5

REM ************************** Loading The Picture **************************
p4:
REM  Image size is lower than 20000 bytes

 OPEN fln$ FOR BINARY AS #1
  SEEK #1, 1079
   A$ = INPUT$(count, #1)
 
 FOR t = 1 TO count STEP 2
  f$ = MID$(A$, t, 2)
   A%(s - p - m) = CVI(f$)
    m = m - 1
     IF m = k * (f - 1) THEN f = f + 1: m = k * f: p = p + 160 - k
 NEXT

 CLOSE #1
  GOTO p3

p5:
REM Image size is higher than 20000 bytes

 OPEN fln$ FOR BINARY AS #1
  SEEK #1, 1079
   FOR n = 1 TO FIX(count / 20000)
    A$ = INPUT$(20000, 1)

REM  Input the image data in array

    FOR t = 1 TO 20000 STEP 2
     f$ = MID$(A$, t, 2)
      A%(s - p - m) = CVI(f$)
       m = m - 1
        IF m = k * (f - 1) THEN f = f + 1: m = k * f: p = p + 160 - k
    NEXT t
   NEXT n
     
      n = fls - (FIX(count / 20000) * 20000) - 1078
       A$ = INPUT$(n, #1)
REM  Input the image data in array
  
  FOR t = 1 TO n STEP 2
   f$ = MID$(A$, t, 2)
    A%(s - p - m) = CVI(f$)
     m = m - 1
      IF m = k * (f - 1) THEN f = f + 1: m = k * f: p = p + 160 - k
  NEXT t
 CLOSE #1

p3:
 CLS
  PUT (0, 0), A%
p2:

 END SUB

SUB saving (fln$, sx, sy, ex, ey)

 LINE (sx, sy)-(ex, ey), 4, B
  GET (0, 0)-(319, 199), A%

REM ************************* Filling the RGB array *************************

 FOR n = 1 TO 768 STEP 3
   regs.ax = &H1015
    regs.bx = col
     CALL Interrupt(&H10, regs, regs)
      rgb%(n) = INT(regs.cx MOD 256) * 4         'b
       rgb%(n + 1) = INT(regs.cx / 256) * 4      'g
        rgb%(n + 2) = INT(regs.dx / 256) * 4     'r
         col = col + 1
 NEXT
  
REM ************************** Write R.G.B **********************************

 IF ex < sx THEN SWAP ex, sx
 IF ey < sy THEN SWAP ey, sy
 IF (ex - sx + 1) MOD 2 <> 0 THEN ex = ex + 1
 ix = ex - sx + 1
  iy = ey - sy + 1
   k = ix / 2
    s = ((ey + 1) * 160) + 2
     m = k
      p = 160 - k - (sx / 2)
       f = 1
        nq = sx / 2
         q = 0

 OPEN fln$ FOR RANDOM AS #1 LEN = 1078
  FIELD #1, 2 AS bftype$, 4 AS bfsize$, 2 AS bfres1$, 2 AS bfres2$, 4 AS bfoffbits$, 4 AS bisize$, 4 AS biwidth$, 4 AS biheight$, 2 AS biplanes$, 2 AS bbitcount$, 4 AS bicomp$, 4 AS bisi$, 4 AS bixp$, 4 AS biyp$, 4 AS biclru$, 4 AS biclri$, 1024 AS  _
B$
   LSET bftype$ = "BM"
    LSET bfsize$ = MKL$(1078 + (ix * iy))
     LSET bfres1$ = CHR$(0) + CHR$(0)
      LSET bfres2$ = CHR$(0) + CHR$(0)
       LSET bfoffbits$ = MKL$(1078)
        LSET bisize$ = MKL$(40)
         LSET biwidth$ = MKL$(ix)
          LSET biheight$ = MKL$(iy)
           LSET biplanes$ = MKI$(1)
            LSET bbitcount$ = MKI$(8)
             LSET bicomp$ = MKL$(0)
              LSET bisi$ = MKL$(ix * iy)
               LSET bixp$ = MKL$(0)
                LSET biyp$ = MKL$(0)
                 LSET biclru$ = MKL$(256)
                  LSET biclri$ = MKL$(0)
 FOR n = 1 TO 768 STEP 3
    n$ = n$ + CHR$(rgb%(n)) + CHR$(rgb%(n + 1)) + CHR$(rgb%(n + 2)) + CHR$(0)
 NEXT
    LSET B$ = n$
     PUT #1, 1
 CLOSE #1

REM ************************** Write picture ********************************
 count = ix * iy
  IF count > 20000 GOTO sp5
   A$ = ""

REM  Image size is lower than 20000 bytes

 OPEN fln$ FOR BINARY AS #1
  SEEK #1, 1079
   FOR t = 1 TO count STEP 2
    A$ = A$ + MKI$(A%(s - p - m - q))
     m = m - 1
      IF m = k * (f - 1) THEN f = f + 1: m = k * f: q = q + nq: p = p + 160 - k - nq: ' CLS : PUT (0, 0), A%, PSET
   NEXT
       PUT #1, , A$
 CLOSE #1
      GOTO sp2

sp5:
REM Image size is higher than 20000 bytes

 A$ = ""
 OPEN fln$ FOR BINARY AS #1
  SEEK #1, 1079
   FOR n = 1 TO FIX(count / 20000)
    
REM  Input the image data in file

    FOR t = 1 TO 20000 STEP 2
       A$ = A$ + MKI$(A%(s - p - m - q))
        m = m - 1
         IF m = k * (f - 1) THEN f = f + 1: m = k * f: q = q + nq: p = p + 160 - k - nq
    NEXT t
     PUT #1, , A$
      A$ = ""
   NEXT n

      n = (count + 1078) - (FIX(count / 20000) * 20000) - 1078
       A$ = ""
REM  Input the image data in file

 FOR t = 1 TO n STEP 2
  A$ = A$ + MKI$(A%(s - p - m - q))
    m = m - 1
     IF m = k * (f - 1) THEN f = f + 1: m = k * f: q = q + nq: p = p + 160 - k - nq
 NEXT t
     PUT #1, , A$
      CLOSE #1

sp2:

END SUB