harbour-core/contrib/gtwvw/tests/drawimg.prg

/*
   compile and link this file together with wutil.prg

   This is a sample of how to display an image file (.bmp,.gif,.jpg)
   in four ways:
   1. Image stretched to fit a region
      (all four coordinates are defined)
   2. Height is defined, width is proportional to height
      (right coordinate is passed as NIL)
   3. Width is defined, height is proportional to width
      (bottom coordinate is passed as NIL)
   4. Actual image size
      (bottom and right coordinate are NIL)

   Also shown in this sample:
   1. Image Caching
      Image is read from file only once, and then cached.
      Test: After image is displayed, delete the image file.
            Image should be still displayed with no problem,
            since gtwvw already store it in memory.
   2. Transparency
      If this option is used, topleft pixel is used as the transparent mask
      of the image.

   Remarks:
   Image drawing and wvw_paint management are performed by wutil.prg.
   wutil.prg is a simple "middle module" interfacing an application with
   gtwvw.
 */

#require "gtwvw"

#include "inkey.ch"
#include "setcurs.ch"
#include "hbclass.ch"

// WPAINTOBJ types
#define WPAINTOBJ_LABEL                  1
#define WPAINTOBJ_SHADEDRECT             2
#define WPAINTOBJ_TEXTBOX                3
#define WPAINTOBJ_PROGRESSBAR            4
#define WPAINTOBJ_BOXGET                 5
#define WPAINTOBJ_BOXRAISED              6
#define WPAINTOBJ_BOXRECESSED            7
#define WPAINTOBJ_BOXGROUP               8
#define WPAINTOBJ_BOXGROUPRAISED         9
#define WPAINTOBJ_IMAGE                 10
#define WPAINTOBJ_OUTLINE               11
#define WPAINTOBJ_LINE                  12
#define WPAINTOBJ_ELLIPSE               13
#define WPAINTOBJ_RECTANGLE             14
#define WPAINTOBJ_FILLRECTANGLE         15
#define WPAINTOBJ_ROUNDRECT             16
#define WPAINTOBJ_FOCUSRECT             17
#define WPAINTOBJ_GRIDHORZ              18
#define WPAINTOBJ_GRIDVERT              19
#define WPAINTOBJ_PICTURE               20
#define WPAINTOBJ_LABELEX               21
#define WPAINTOBJ_LINEEX                22
#define WPAINTOBJ_OUTLINEEX             23

// WCTRLOBJ types
#define WCTRLOBJ_PUSHBUTTON             1001
#define WCTRLOBJ_VSCROLLBAR             1002
#define WCTRLOBJ_HSCROLLBAR             1003
#define WCTRLOBJ_COMBOBOX               1004

// OBJECT OPERATION
#define WOBJ_ADD_OVERWRITE      1   // overwrite if exists
#define WOBJ_ADD_APPEND         2   // append even if exists (the same id can coexist)
#define WOBJ_ADD_NEWONLY        3   // cancel if exists

STATIC s_aPObjList := {}

PROCEDURE Main()

   LOCAL ntop := 7, ;
      nleft := 3, ;
      nbot := MaxRow() - 2, ;
      nrig := MaxCol() - 2, ;
      nmidver := Int( ( ntop + nbot ) / 2 ), ;
      nmidhor := Int( ( nleft + nrig ) / 2 )
   LOCAL cpict := "vouch1.gif"
   LOCAL ltransp := .F.
   LOCAL nMaxCache
   LOCAL i, j, oWPaint
   LOCAL getlist := {}

#if defined( __HBSCRIPT__HBSHELL ) .AND. defined( __PLATFORM__WINDOWS )
   hbshell_gtSelect( "GTWVW" )
#endif

   nMaxCache := wvw_SetMaxBMCache()

   SetColor( "N/W,N/GR*,,,N/W*" )
   wvw_SetCodepage( , 255 )
   wg_ResetWPaintObj( 0 )
   DO WHILE .T.
      CLS
      SetCursor( SC_NORMAL )
      cpict := PadR( cpict, 40 )
      @ 0, 0 SAY "FileName  :" GET cpict PICT "@K" VALID hb_FileExists( AllTrim( cpict ) )
      @ 1, 0 SAY "Transpar? :" GET ltransp PICT "Y"
      @ 2, 0 SAY "Max Cache :" GET nMaxCache PICT "999"
      @ 3, 0 SAY "NumOfCache=" + Transform( wvw_NumBMCache(), "999" ) + ;
         ", Max NumOfCache=" + Transform( wvw_SetMaxBMCache(), "999" )
      READ
      IF LastKey() == K_ESC
         EXIT
      ENDIF
      wvw_SetMaxBMCache( nMaxCache )
      @ 3, 0 SAY "NumOfCache=" + Transform( wvw_NumBMCache(), "999" ) + ;
         ", Max NumOfCache=" + Transform( wvw_SetMaxBMCache(), "999" )

      @ 5, 0 SAY "TOPLEFT: stretched image                 TOPRIGHT: fit vertically (proportional)"
      @ 6, 0 SAY "BOTLEFT: fit horizontally (proportional) BOTRIGHT: actual image size"

      cpict := AllTrim( cpict )

      // wvw_LoadPicture( 1, cpict ) //20060707

      SetCursor( SC_NONE )
      DispBegin()
      FOR i := ntop TO nbot
         FOR j := nleft TO nrig
            @ i, j SAY "X"
         NEXT
      NEXT
      @ ntop, nmidhor TO nbot, nmidhor
      @ nmidver, nleft TO nmidver, nrig
      @ ntop, nleft TO nbot, nrig
      DispEnd()

      // topleft panel, stretch/fit to panel
      oWPaint := wPaintObj():New( 0, WPAINTOBJ_IMAGE, "TOPLEFT", ntop + 1, nleft + 1, nmidver - 1, nmidhor - 1, NIL, ltransp )
      oWPaint:cImage := cpict
      wg_AddWPaintObj( 0, oWPaint )

      // topright panel, fit vertically
      oWPaint := wPaintObj():New( 0, WPAINTOBJ_IMAGE, "TOPRIGHT", ntop + 1, nmidhor + 1, nmidver - 1, NIL, NIL, ltransp )
      oWPaint:cImage := cpict
      wg_AddWPaintObj( 0, oWPaint )

      // botleft panel, fit horizontally
      oWPaint := wPaintObj():New( 0, WPAINTOBJ_IMAGE, "BOTLEFT", nmidver + 1, nleft + 1, NIL, nmidhor - 1, NIL, ltransp )
      oWPaint:cImage := cpict
      wg_AddWPaintObj( 0, oWPaint )

      // botright panel, actual image size
      oWPaint := wPaintObj():New( 0, WPAINTOBJ_IMAGE, "BOTRIGHT", nmidver + 1, nmidhor + 1, NIL, NIL, NIL, ltransp )
      oWPaint:cImage := cpict
      wg_AddWPaintObj( 0, oWPaint )

      Inkey( 0 )

      // delete all image objects
      wg_DelWPaintObj( 0, WPAINTOBJ_IMAGE, NIL )
   ENDDO // WHILE .T.
   SetCursor( SC_NORMAL )

   RETURN

// ************** simple wpaint organizer *******

/*********************************************************/

CREATE CLASS wGUIObj

   VAR nWinNum                      // parent window's number
   VAR lVisible                     // is the object visible
   VAR nType                        // Type
   VAR cId                          // Id
   VAR nRow1, nCol1, nRow2, nCol2   // mouse object region
   VAR aOffTLBR                     // offset in pixels

ENDCLASS

/*********************************************************/

CREATE CLASS wPaintObj FROM wGUIObj

   // image like wvtimage
   VAR cImage
   VAR lTransp

   METHOD New( nWinNum, nType, cId, nRow1, nCol1, nRow2, nCol2, aOffTLBR, lTransp )
   METHOD Draw()
   METHOD Undraw()
   METHOD Hide()
   METHOD Show()

ENDCLASS

METHOD New( nWinNum, nType, cId, nRow1, nCol1, nRow2, nCol2, aOffTLBR, lTransp ) CLASS wPaintObj

   hb_default( @aOffTLBR, { 0, 0, 0, 0 } )
   hb_default( @lTransp, .F. )

   ::nWinNum := nWinNum
   ::lVisible := .T.

   ::nType := nType
   ::cId := cId
   ::nRow1 := nRow1
   ::nCol1 := nCol1
   ::nRow2 := nRow2
   ::nCol2 := nCol2

   ::aOffTLBR := AClone( aOffTLBR )

   ::lTransp := lTransp

   RETURN Self

METHOD Draw() CLASS wPaintObj

   IF ! ::lVisible
      RETURN NIL
   ENDIF

   DO CASE
   case ::nType == WPAINTOBJ_IMAGE
      IF ! Empty( ::cImage )
         wvw_DrawImage( ::nWinNum, ::nRow1, ::nCol1, ::nRow2, ::nCol2, ;
            ::cImage, ::aOffTLBR, ::lTransp )
      ENDIF

   OTHERWISE
      // lBoxErrMessage()
   ENDCASE

   RETURN NIL  // DRAW()

// undraw the object
// normally this is called with ::lVisible == .F.,
// otherwise the object will be redrawn by WVW_PAINT
METHOD Undraw() CLASS wPaintObj

   LOCAL cScreen
   LOCAL nRow1, nCol1, nRow2, nCol2, nMaxRow, nMaxCol

   // to be safer, the area can be enlarged first
   nMaxRow := MaxRow()
   nMaxCol := MaxCol()

   DO CASE
   case ::nType == WPAINTOBJ_LABEL
      nRow1 := ::nRow1
      nCol1 := ::nCol1
      nRow2 := ::nRow2
      nCol2 := ::nCol2
   OTHERWISE
      nRow1 := Max( ::nRow1 - 1, 0 )
      nCol1 := Max( ::nCol1 - 1, 0 )
      nRow2 := Min( ::nRow2 + 1, nMaxRow )
      nCol2 := Min( ::nCol2 + 1, nMaxCol )
   ENDCASE

   cScreen := SaveScreen( nRow1, nCol1, nRow2, nCol2 )
   DispBegin()
   RestScreen( nRow1, nCol1, nRow2, nCol2, cScreen )
   DispEnd()

   RETURN NIL // undraw()

METHOD Hide() CLASS wPaintObj

   // temporarily hides the object
   ::lVisible := .F.
   ::Undraw()

   RETURN NIL

METHOD Show() CLASS wPaintObj

   // show the object
   ::lVisible := .T.
   ::draw()

   RETURN NIL

/*********************************************************/

// clears all wPaint objects from window nWinNum
// if nObjNum specified, clears object >= nObjNum
FUNCTION wg_ResetWPaintObj( nWinNum, nObjNum, lStrict )

   hb_default( @nObjNum, 0 )
   hb_default( @lStrict, .F. )

   DO WHILE Len( s_aPObjList ) < nWinNum + 1
      AAdd( s_aPObjList, {} )
   ENDDO

   ASize( s_aPObjList[ nWinNum + 1 ], nObjNum )

   RETURN .T.

// adds a WPaint object oWPaint into window nWinNum
// returns ::cId if successful. "" if failed.
FUNCTION wg_AddWPaintObj( nWinNum, oWPaint, lStrict, nOperation )

   LOCAL i

   hb_default( @lStrict, .F. )
   hb_default( @nOperation, WOBJ_ADD_OVERWRITE )

   // simplified:
   nOperation := WOBJ_ADD_OVERWRITE

   // parameter checking...
   // ...

   // exist nType + cId ?
   i := AScan( s_aPObjList[ nWinNum + 1 ], {| x | x:nType == oWPaint:nType .AND. x:cId == oWPaint:cId } )

   IF i > 0
      // so we are about to overwrite now...
      // ::Hide() is ideal, but it can be slow
      // let's do it only of user want strict/perfect operation
      IF lStrict
         s_aPObjList[ nWinNum + 1 ][ i ]:Hide()
      ELSE
         s_aPObjList[ nWinNum + 1 ][ i ]:lVisible := .F.
      ENDIF
      s_aPObjList[ nWinNum + 1 ][ i ] := oWPaint

   ELSE
      AAdd( s_aPObjList[ nWinNum + 1 ], oWPaint )
   ENDIF

   // if it is visible, draw it now!
   IF oWPaint:lVisible
      oWPaint:draw()
   ENDIF

   RETURN oWPaint:cId // 20040811 was .T.

// deletes a WPaint object oWPaint from window nWinNum
// returns number of object deleted.
//
// NOTE: if cId is NIL, delete all object of type nType
FUNCTION wg_DelWPaintObj( nWinNum, nType, cId, lStrict )

   LOCAL i
   LOCAL lDelAll := ( cId == NIL )
   LOCAL nDeleted := 0
   LOCAL nLen

   hb_default( @lStrict, .F. )

   // is nType set?
   IF nType < 1
      RETURN nDeleted
   ENDIF

   // exist nType + cId ?
   i := 1
   nLen := Len( s_aPObjList[ nWinNum + 1 ] )
   DO WHILE i <= nLen
      IF s_aPObjList[ nWinNum + 1 ][ i ]:nType == nType .AND. ;
         ( lDelAll .OR. s_aPObjList[ nWinNum + 1 ][ i ]:cId == cId )
         IF lStrict
            s_aPObjList[ nWinNum + 1 ][ i ]:Hide()
         ELSE
            s_aPObjList[ nWinNum + 1 ][ i ]:lVisible := .F.
         ENDIF
         ADel( s_aPObjList[ nWinNum + 1 ], i )
         ASize( s_aPObjList[ nWinNum + 1 ], --nLen )
         nDeleted++
      ELSE
         i++
      ENDIF
   ENDDO

   RETURN nDeleted