5748088 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n sample12.bas
   1: 
   2: rem
   3: rem This program works under either DOS or Windows.
   4: rem
   5: rem It uses a standard file input dialog box to get the name of a file
   6: rem to load and display on the screen.  It also allows the picture displayed
   7: rem to be stored back to disk; either in regular or compressed format
   8: rem
   9: 
  10: 
  11: 
  12:    REM windows name "Picture Loader"
  13: 
  14:      cls
  15: 
  16:       scolor=0
  17:       screen 1000,scolor
  18: 
  19: 
  20:   rem
  21:   rem make array to hold bitmap info
  22:   rem
  23:       dim a&(256)
  24: 
  25: 
  26:   rem
  27:   rem enable mouse
  28:   rem
  29:      y=mouseon
  30: 
  31:   rem
  32:   rem define my menu bar at top of screen
  33:   rem
  34:   mainmenu "File","","","","",""
  35: 
  36:   rem
  37:   rem define menu items
  38:   rem
  39:   rem  the '&' symbol tells windows what keyboard shortcut will select this
  40:   addsubmenu 1,"&Read",1059
  41:   addsubmenu 1,"&Write",1060
  42:   addsubmenu 1,"&Compressed Write",1061
  43:   addsubmenu 1,"&Quit",1062
  44:   menuitemgray 1060             : rem gray this item until something read
  45:   menuitemgray 1061
  46: 
  47: 100
  48: 
  49:    a$=inkey$
  50:    if a$="" or len(a$)=1 then goto 100
  51:    if a$=chr$(0)+chr$(62) then
  52:      stop
  53: 
  54:    elseif a$=chr$(0)+chr$(59) then
  55:      rem come here to read a file
  56:      a$="text"+chr$(0)+"*.bmp"+chr$(0)+chr$(0)
  57:      openfileread a$,"","","Load a Picture"
  58: 
  59: 
  60:      rem
  61:      rem dialog$(102) will be "1" if legal file name found
  62:      rem
  63: 
  64:      if dialog$(102)="1" then
  65: 
  66: 
  67: 
  68:        rem
  69:        rem Get File Name user has selected
  70:        rem
  71: 
  72:        ffname$=dialog$(100)
  73: 
  74:        rem
  75:        rem read bitmap header and get info on it
  76:        rem
  77:        a=bitmaph(ffname$,a&(0))
  78:        x=0
  79:        y=0
  80:        pxsize=a&(1)
  81:        pysize=a&(2)
  82:        colors=a&(4)
  83:        if colors=1 or colors=2 then
  84: 	 colors=1
  85:        elseif colors=4 then
  86: 	 colors=16
  87:        else
  88: 	 colors=256
  89:        end if
  90: 
  91:        rem
  92:        rem Now select palette resolution required to reproduce bitmap
  93:        rem
  94:        rem If you are going to do a STOREBITMAP after loading the bitmap
  95:        rem you should usually define a palette the same as the resolution
  96:        rem of the picture you are loading.  This is expecially true if you
  97:        rem tell BasicBasic to convert colors on loading.  BasicBasic may
  98:        rem use all palette entries available, thereby increasing the number
  99:        rem of palette entries required to show the picture.
 100:        rem
 101:        rem Also, note, that Windows in standard VGA (16 color) does not allow
 102:        rem palette changes.
 103:        rem
 104: 
 105:        maxcolor=system(17)
 106:        if colors>maxcolor then colors=maxcolor
 107:        screen 1000,colors
 108: 
 109: 
 110:        rem
 111:        rem only if in Windows load colors from bitmap
 112:        rem
 113: 
 114:        if ostype=2 and maxcolor>16 then
 115: 	 a=bitmapc(ffname$,a&(0))
 116: 	 if colors>236 then
 117: 	  for i=10 to 246
 118: 	    palette i,a&(i)
 119: 	  next i
 120: 	 else
 121: 	  for i=0 to colors
 122: 	   palette i,a&(i)
 123: 	  next i
 124: 	 end if
 125:        end if
 126: 
 127:        rem
 128:        rem if a small picture blow it up
 129:        rem
 130:        if pxsize<25 then
 131: 	 xmult=4
 132:        elseif pxsize<50 then
 133: 	 xmult=2
 134:        else
 135: 	 xmult=1
 136:        end if
 137: 
 138:        if pysize<25 then
 139: 	 ymult=4
 140:        elseif pysize<50 then
 141: 	 ymult=2
 142:        else
 143: 	 ymult=1
 144:        end if
 145: 
 146:        rem
 147:        rem Set to always convert to closest color possible
 148:        rem
 149:        convert=0
 150: 
 151:        loadbitmap ffname$,0,x,y,0,0,pxsize,pysize,convert,xmult,ymult
 152: 
 153: 
 154:        menuitemon 1060
 155:        menuitemon 1061
 156: 
 157:      end if
 158: 
 159:    else if a$=chr$(0)+chr$(60) or a$=chr$(0)+chr$(61)
 160: 
 161:      if a$=chr$(0)+chr$(60) then
 162:        smes$="Save Picture"
 163:        compress=0
 164:      else
 165:        smes$="Save Picture Compressed"
 166:        compress=1
 167:      end if
 168: 
 169:      rem
 170:      rem get name of file to save to
 171:      rem
 172:      a$="text"+chr$(0)+"*.bmp"+chr$(0)+chr$(0)
 173:      openfilesave a$,"","",smes$
 174: 
 175: 
 176:      if dialog$(102)="1" then
 177: 
 178:        rem
 179:        rem if ok button "1" then store bitmap
 180:        rem
 181: 
 182:        ffname$=dialog$(100)
 183:        storebitmap 0,ffname$,0,0,pxsize,pysize,compress,0
 184: 
 185:      end if
 186:    end if
 187: 
 188:    goto 100
 189: 
 190: 
 191: 
 192: 
5748089 [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:08:52