5748370 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n bmpshow2.bas
   1: DECLARE SUB PalUpDate (Colrs!)
   2: DECLARE SUB ChangePal (Red%, Blue%, Green%, syscolor%)
   3: DECLARE SUB ShowBitmap (f$, mde!)
   4: DECLARE FUNCTION FillIn$ (t$, num!)
   5: CLEAR , , 15000
   6: '==== All code above the line above this one is ignored ====
   7: q = 2
   8: 10 ShowBitmap "C:\PSP\CLOUD2.BMP", q: q = 1
   9: SLEEP 5
  10: ShowBitmap "C:\PSP\DEATH1.BMP", q
  11: SLEEP 5
  12: ShowBitmap "C:\WIN95\Win95.BMP", q
  13: SLEEP 5
  14: ShowBitmap "C:\PSP\BUMBY3.BMP", q
  15: SLEEP 5
  16: ShowBitmap "C:\PSP\WIZARD.BMP", q
  17: SLEEP 5
  18: ShowBitmap "C:\PSP\NEUTON.BMP", q
  19: SLEEP 5
  20: ShowBitmap "C:\PSP\EARTH.BMP", q
  21: SLEEP 5
  22: GOTO 10
  23: 
  24: SUB ChangePal (Red%, Green%, Blue%, syscolor%)
  25: palmask = &H3C6
  26: palregrd = &H3CF
  27: palregwr = &H3C8
  28: paldata = &H3C9
  29: OUT palmask, &HFF
  30: OUT palregwr, syscolor%
  31: OUT paldata, Red%
  32: OUT paldata, Green%
  33: OUT paldata, Blue%
  34: END SUB
  35: 
  36: FUNCTION FillIn$ (t$, num)
  37: FillIn$ = STRING$(num - LEN(t$), ASC("0")) + t$
  38: END FUNCTION
  39: 
  40: SUB ShowBitmap (f$, mde)
  41: DIM Red AS STRING * 1
  42: DIM Green AS STRING * 1
  43: DIM Blue AS STRING * 1
  44: DIM PicType AS STRING * 1
  45: OPEN f$ FOR BINARY AS #1
  46:   GET #1, 29, PicType
  47: mxcol = ASC(PicType)
  48: SCREEN 13
  49: IF mde = 2 THEN
  50:         FOR i% = 0 TO 255
  51:         GET #1, 55 + (i% * 4), Red
  52:         GET #1, 55 + (i% * 4) + 1, Green
  53:         GET #1, 55 + (i% * 4) + 2, Blue
  54:         CCHex1% = INT(ASC(Red)) / 8
  55:         CCHex2% = INT(ASC(Green)) / 8
  56:         CCHex3% = INT(ASC(Blue)) / 8
  57:         ChangePal CCHex3%, CCHex2%, CCHex1%, i%
  58:         NEXT i%
  59: END IF
  60: DEF SEG = &HA000
  61: DIM v AS STRING * 10000
  62: Inc = 10000
  63: pt1$ = CHR$(253) + CHR$(0) + CHR$(160)
  64: pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2)))
  65: FOR q = 1079 TO LOF(1) STEP Inc
  66: GET #1, q, v
  67: OPEN "1.TMP" FOR BINARY AS #3
  68: pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2)))
  69: PUT #3, , pt1$
  70: PUT #3, , pt3$
  71: PUT #3, , pt2$
  72: PUT #3, , v
  73: CLOSE 3
  74: BLOAD "1.TMP", x1
  75: KILL "1.TMP"
  76: x1 = x1 + Inc
  77: NEXT q
  78: IF mde = 1 THEN
  79:         FOR i% = 0 TO 255
  80:         GET #1, 55 + (i% * 4), Red
  81:         GET #1, 55 + (i% * 4) + 1, Green
  82:         GET #1, 55 + (i% * 4) + 2, Blue
  83:         CCHex1% = INT(ASC(Red)) / 8
  84:         CCHex2% = INT(ASC(Green)) / 8
  85:         CCHex3% = INT(ASC(Blue)) / 8
  86:         ChangePal CCHex3%, CCHex2%, CCHex1%, i%
  87:         NEXT i%
  88: END IF
  89: CLOSE 1, 2, 3
  90: END SUB
  91: 
5748371 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:00:18