home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / SAVEMOD.BAS < prev    next >
BASIC Source File  |  1989-08-27  |  5KB  |  120 lines
  1. REM $INCLUDE: 'os2def.bi'
  2. REM $INCLUDE: 'pmbase.bi'
  3. REM $INCLUDE: 'opendlg.bi'
  4. REM $INCLUDE: 'winmisc.bi'
  5. REM $INCLUDE: 'wintrack.bi'
  6. REM $INCLUDE: 'gpibit.bi'
  7.  
  8. REM $INCLUDE: 'CAPTURE.INC'
  9.  
  10. '|***************************************************************************
  11. '|
  12. '| SAVEMOD.BAS: Support module of CAPTURE.BAS to Save a bitmap to a disk file
  13. '|
  14. '|***************************************************************************
  15. '| Saves captured bitmap to a disk file.  The filename to which the bitmap
  16. '| is saved is obtained from the the routine "DlgFile" in OPENDLG.DLL.
  17. '| If "Dlgfile" returns an appropriate value, the bitmap is converted to
  18. '| file format and written out to disk.
  19. '|***************************************************************************
  20. SUB SaveBitmapToFile(hab&, hwndFrame&, hbm&) STATIC
  21. DIM bfh AS BITMAPFILEHEADER, bi AS MyBITMAPINFO
  22. DIM filename AS STRING * 80, vdlf AS DLF
  23. '|
  24. '| Initialize values to be used in in the Dialog box
  25. '|
  26.   szExtension$ = "\*.BMP" + CHR$(0)
  27.   szHelp$ = "Any extension may be given, but the default is "+_
  28.             ".BMP, and attached to the file name if an extension "+_
  29.             "is not given." + CHR$(0)
  30.   szSaveTitle$ = "SAVE BITMAP TO FILE" + CHR$(0)
  31. '|
  32. '| Initialize fields of "vdlf".  vdlf is of TYPE DLF, which is used
  33. '| by the Dialog box routine.
  34. '|
  35.   CALL SetupDLF(MakeLong(VARSEG(vdlf), VARPTR(vdlf)),_
  36.                 DLGSAVEDLG OR DLGNOOPEN,_
  37.                 MakeLong(VARSEG(filehandle%), VARPTR(filehandle%)),_
  38.                 MakeLong(VARSEG(szExtension$), SADD(szExtension$)),_
  39.                 0,_
  40.                 MakeLong(VARSEG(szSaveTitle$), SADD(szSaveTitle$)),_
  41.                 MakeLong(VARSEG(szHelp$), SADD(szHelp$)))
  42.                 vdlf.szOpenFile = filename
  43. '|
  44. '| Obtain file name to save bitmap to.  The routine "DlgFile" is contained
  45. '| within the DLL "OpenDlg.DLL".  It displays and manipulates the
  46. '| dialog box for saving files.  It returns only when a valid filename
  47. '| has been obtained, and the user selects "Save" or "Cancel.  It returns
  48. '| one of three values:
  49. '|
  50. '|               TDFNEWSAVE  saving to a new file
  51. '|               TDFOLDSAVE  write over an existing file
  52. '|               TDFNOSAVE   user selected "Cancel"
  53. '|
  54.   retn% = DlgFile(hwndFrame&, MakeLong(VARSEG(vdlf), VARPTR(vdlf)))
  55.   filename = vdlf.szFileName
  56.   IF retn% = TDFNEWSAVE OR retn% = TDFOLDSAVE THEN
  57.     CALL SetSystemPointerToWaitPointer
  58.     bool% = GpiQueryBitmapParameters(hbm&,_
  59.                                      MakeLong(VARSEG(bi), VARPTR(bi)))
  60.   '|
  61.   '| Initialize Bitmap file header information.
  62.   '|
  63.   '| PM requires each scanline to end on a 32 bit boundary, after
  64.   '| the number of bits per scan line is determined, it is rounded up
  65.   '| to the next 32 bit boundary.
  66.   '|
  67.     bits% = bi.cBitCount * bi.cx
  68.     ScanLineSize% = ((bits% \ 32) + SGN(bits% MOD 32)) * 4
  69.     BmpDataSize& = CLNG(ScanLineSize%) * bi.cy
  70.     bfh.usType = BFTBMAP
  71.     bfh.cbSize = LEN(bfh) + 48 + BmpDataSize&
  72.     bfh.xHotspot = 0
  73.     bfh.yHotspot = 0
  74.     bfh.offBits =  LEN(bfh) + 48&
  75.     bfh.bmp.cbFix = bi.cbFix
  76.     bfh.bmp.cx = bi.cx
  77.     bfh.bmp.cy = bi.cy
  78.     bfh.bmp.cPlanes = bi.cPlanes
  79.     bfh.bmp.cBitCount = bi.cBitCount
  80.   '|
  81.   '| Get file name and Delete file if it exists, then OPEN file for BINARY
  82.   '|
  83.     bmpfile$ = LEFT$(filename, INSTR(filename, CHR$(0)) - 1)
  84.     IF retn% = TDFOLDSAVE THEN KILL bmpfile$
  85.     OPEN bmpfile$ FOR BINARY AS #2
  86.   '|
  87.   '| Write Bitmap file header to file
  88.   '|
  89.     PUT #2,,bfh
  90.   '|
  91.   '| Set buffer to size that can hold one scanline
  92.   '|
  93.     outbuffer$ = SPACE$(ScanLineSize%)
  94.   '|
  95.   '| Convert one scanline of bitmap at a time to format which can be
  96.   '| written to file, the copy to output buffer and write buffer to file.
  97.   '| Write COLOR PALETTE to file returned by GpiQueryBitmapBits to file
  98.   '| prior to writing first scanline to file.  This must be within the
  99.   '| loop since the PALETTE information is obtained from the call to
  100.   '| GpiQueryBitmapBits
  101.   '|
  102.     CALL CreateBitmapPSandDC(hpsBitmap&, hdc&)
  103.     bool% = GpiSetBitmap(hpsBitmap&, hbm&)
  104.     FOR scanline% = 0 TO bi.cy - 1
  105.       bool% = GpiQueryBitmapBits(hpsBitmap&,_
  106.                                  scanline%,_
  107.                                  1,_
  108.                                  MakeLong(VARSEG(outbuffer$), SADD(outbuffer$)),_
  109.                                  MakeLong(VARSEG(bi), VARPTR(bi)))
  110.       IF scanline% = 0 THEN PUT #2,,bi.argbColor
  111.       PUT #2,,outbuffer$
  112.     NEXT scanline%
  113.     CLOSE #2
  114.     bool% = GpiDestroyPS(hpsBitmap&)
  115.     bool% = DevCloseDC(hdc&)
  116.     CALL SetSystemPointerToStandardArrow
  117.   END IF
  118. END SUB
  119.  
  120.