Class XbpBitmap() Foundation

// This example demonstrates the basic process of creating 
// bitmaps and displaying them in a window. The bitmap is 
// loaded and displayed using the resource ID 2000. At the 
// end of the example code, an example of a resource file 
// containing the bitmap as a resource is shown. 
PROCEDURE Main 
   LOCAL oBMP, oPS 

   SetColor( "N/W" ) 
   CLS 

   oPS := SetAppWindow():presSpace() 
   oBMP:= XbpBitmap():new():create( oPS ) 

   oBMP:load( NIL, 2000 ) 
   oBMP:draw( oPS, {50,50} ) 

   WAIT 

RETURN 

/* Resource file containing the bitmap declaration 
   TEST.ARC 
*/ 
   ICON     1     =  "XPPPMT.ICO" 
   POINTER  2     =  "XPPPOINT.PTR" 

   BITMAP   2000  =  "SHARK.BMP" 

// This example demonstrates the process of how bitmaps can 
// be output to a printer. A presentation space that is linked 
// to a printer device context is created in the user defined 
// function PrinterPS(). The bitmap is scaled to fill the 
// entire paper size during printing. This means that the 
// printing takes some time. The bitmap is loaded and printed 
// using the resource ID 2000. 

#include "Gra.ch" 

PROCEDURE Main 
   LOCAL oPrinterPS, oBitmap, aRect, aSize 

   oPrinterPS := PrinterPS() 
   oBitmap    := XbpBitmap():new():create( oPrinterPS ) 

                                      // Determine paper size 
   aSize      := oPrinterPS:device():paperSize() 
   aRect      := { 0, 0, aSize[1], aSize[2] } 

   oBitmap:load( NIL, 2000 )          // Load bitmap 

   oPrinterPS:device():startDoc()     // Activate spooler 

   oBitmap:draw( oPrinterPS, aRect )  // Spool print job 

   oPrinterPS:device():endDoc()       // Close spooler 

   DestroyDevice( oPrinterPS )        // Release resources 
   oBitmap:destroy() 

RETURN 

// Create the presentation space for a printer 
FUNCTION PrinterPS() 
   LOCAL oPS, oDC := XbpPrinter():new():create() 

   oPS:=XbpPresSpace():new() 
   oPS:create( oDC, oDC:paperSize(), GRA_PU_LOMETRIC ) 
RETURN oPS 

// Release printer device context 
PROCEDURE DestroyDevice( oPS ) 
   LOCAL oDC := oPS:device() 

   IF .NOT. oDC == NIL 
      oPS:configure()          // Configure to release 
      oDC:destroy()            // device context from PS 
   ENDIF 
RETURN 

// In the example, the two user defined functions 
// GraSaveScreen() and GraRestScreen() are programmed 
// that allow graphic displays in a window to be saved. 
// This is similar to the functions SaveScreen() and 
// RestScreen(). The Main procedure demonstrates the use 
// of these two functions by drawing a box, saving it, 
// and redisplaying it at 10 different places. 

PROCEDURE Main 
   LOCAL oBitmap, oPS 

   SetColor( "N/W" ) 
   CLS 
   oPS := SetAppWindow():presSpace() 

   GraBox( oPS, {10,10}, {100,100} ) 
   oBitmap := GraSaveScreen( oPS, {10,10}, {91,91} ) 

   WAIT "Box was saved in bitmap. Press any key..." 
   CLS 
   WAIT "Box will be redisplayed 10 times. Press any key..." 

   FOR i:=0 TO 9 
      GraRestScreen( oPS, {10+20*i,10+10*i}, oBitmap ) 
   NEXT 
   oBitmap:destroy() 

   WAIT "Done. Press any key..." 
RETURN 

// The function GraSaveScreen() creates a bitmap in memory 
// where the specified section of a window is copied. The 
// area to be saved is defined by the parameter aPos {nX,nY} 
// and aSize {nXsize, nYsize}. The presentation space 
// oSourcePS is the PS of a window and contains the screen 
// information to be saved. It is copied into oTargetPS using 
// GraBitBlt(). oTargetPS is the presentation space for the 
// bitmap and must be assigned to the XbpBitmap object before 
// the memory space for the raster image is requested using 
// :make(). 

FUNCTION GraSaveScreen( oSourcePS, aPos, aSize ) 
   LOCAL oBitmap   := XbpBitmap():new():create( oSourcePS ) 
   LOCAL oTargetPS := XbpPresSpace():new():create() 
   LOCAL aSourceRect[4], aTargetRect 

   aSourceRect[1] := aSourceRect[3] := aPos[1] 
   aSourceRect[2] := aSourceRect[4] := aPos[2] 
   aSourceRect[3] += aSize[1] 
   aSourceRect[4] += aSize[2] 

   aTargetRect    := {0, 0, aSize[1], aSize[2]} 

   oBitmap:presSpace( oTargetPS ) 
   oBitmap:make( aSize[1], aSize[2] ) 

   GraBitBlt( oTargetPS, oSourcePS, aTargetRect, aSourceRect ) 
RETURN oBitmap 

// The function GraRestScreen() redisplays a saved 
// section of screen. It just uses the :draw() method 

FUNCTION GraRestScreen( oTargetPS, aPos, oBitmap ) 
   oBitmap:draw( oTargetPS, aPos ) 
RETURN NIL 

// This example loads a JPEG file from disk and displays 
// some properties such as the author and copyright information 
// from the image's meta data. 
#include "gra.ch" 

PROCEDURE Main 
   LOCAL oBitmap 
   LOCAL cFile 
   LOCAL cAuthor 
   LOCAL cTitle 
   LOCAL cSubject 
   LOCAL cCopyright 
   LOCAL oBmp 

   SetColor( "N/W" ) 
   CLS 

   // The JPEG file used in the example is loaded from 
   // the image collection installed with Xbase++. The 
   // corresponding directory is located using the 
   // XPPRESOURCE environment variable normally set by 
   // the installer. 
   cFile := GetImageDir() 
   IF Empty(cFile) 
      ? "Error - XPPRESOURCE env. variable must point to installed images!" 
      WAIT 
      QUIT 
   ENDIF 
   cFile += "\asky_fhd.jpg" 

   oBmp  := XbpBitmap():new():create() 
   IF !oBmp:loadFile(cFile) 
      WAIT "Error loading image. Please press a key." 
      QUIT 
   ENDIF 

   // Display a preview of the image for reference 
   oBmp:draw( , {300,20,600,280},,, GRA_BLT_BBO_IGNORE ) 

   // Read exemplary properties from the image and 
   // display them for demonstration purposes 
   cTitle     := Coalesce( oBmp:getProperty("System.Title"),     "(empty)" ) 
   cSubject   := Coalesce( oBmp:getProperty("System.Subject"),   "(empty)" ) 
   cAuthor    := Coalesce( oBmp:getProperty("System.Author"),    "(empty)" ) 
   cCopyright := Coalesce( oBmp:getProperty("System.Copyright"), "(empty)" ) 

   ? 
   ? "Title:     ", cTitle 
   ? "Subject:   ", cSubject 
   ? 
   ? "Author:    ", cAuthor 
   ? "Copyright: ", cCopyright 
   ? 

   WAIT "Done. Press any key..." 
RETURN 

// Get the directory containing the images installed with 
// Xbase++. 
FUNCTION GetImageDir() 
   LOCAL cEnv 
   LOCAL nIdx 
   LOCAL cTmp 
   LOCAL cRet := "" 

   cEnv := GetEnv( "XPPRESOURCE" ) 
   IF Empty(cEnv) 
      RETURN "" 
   ENDIF 

   // Extract the image directory from the list 
   // of semicolon-separated directories 
   DO WHILE Len(cEnv) > 0 
      nIdx := At( ";", cEnv ) 
      IF nIdx != 0 
         cTmp := Left( cEnv, nIdx -1 ) 
         cEnv := SubStr( cEnv, nIdx + 1) 
      ELSE 
         cTmp := cEnv 
         cEnv := "" 
      ENDIF 

      IF At("BITMAP", Upper(cTmp)) != 0 
         cRet := cTmp 
         EXIT 
      ENDIF 

      IF nIdx == 0 
         EXIT 
      ENDIF 
   ENDDO 
RETURN cRet