home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / compiler / sample12.bas < prev    next >
BASIC Source File  |  1993-04-04  |  4KB  |  193 lines
  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.  
  193.