FiveTech Software tech support forums

Code: Select all  Expand view

#include "fivewin.ch"
 #define MERGEPAINT 12255782    // 0xBB0226
 #define SRCAND      8913094


static oWnd, hBmp1, hBmp2
Function test()
   hBmp1 = LoadBitmap( GetResources(), "AZZURRO" )
   hBmp2 = LoadBitmap( GetResources(), "ROSSO" )







   DEFINE WINDOW oWnd
   ACTIVATE WINDOW oWnd ;
         ON PAINT ( SayBitmaps() )
       DeleteObject( hBmp1 )
       DeleteObject( hBmp2 )

return nil




  function SayBitmaps()
    local hDC := oWnd:GetDC()
    lOCAL nRow:=20
    Local nCol:=24


   TOTY := 20
   TOTX := 20

     aBmps := ARRAY( TOTY, TOTX )
     aData := ARRAY( TOTY, TOTX )
       n=1

     For nY := 1 to TOTY
        For nX := 1 To TOTX

           aData[nY,nX] := "X"

           DrawBitmap( hDC, hBmp1, nrow, ncol, 0, 0, SRCAND )

           // write the number
                 SetBkMode( hDC, 1 )
                SetTextColor( hDC, CLR_RED )
                TextOut( hDC, nrow, ncol,str(n)  )


                n:=n+1

        ncol:=ncol+48
     Next nX

   nRow += 24
  nCol := 48
Next nY


   oWnd:ReleaseDC()
return nil



 

Code: Select all  Expand view

CLASS Umbrella
DATA nTop, nLeft, nWidth, nHeight
DATA nStatus
DATA cBitmap
DATA oWnd
DATA   hBitmap, hPalette
METHOD IsOver( nRow, nCol ) // to detect a mouse click

METHOD New ( cBitmap, oWnd,nTop, nLeft,nWidth, nHeight) CONSTRUCTOR
METHOD Paint( )
METHOD LoadImage(cBmpFile )

ENDCLASS


 METHOD New( cBitmap, oWnd,nTop, nLeft,nWidth, nHeight)  CLASS Umbrella

      DEFAULT cBitmap := ""

       ::nTop     := nTop
       ::nLeft    := nLeft
       ::nWidth   := nWidth
       ::nHeight  := nHeight
       ::oWnd     := oWnd

     ::LoadImage(cBmpFile )


Return self



METHOD     LoadImage(cBmpFile )  CLASS Umbrella
   local lChanged := .f.
   local hBmpOld  := ::hBitmap
   local hPalOld  := ::hPalette
   local aBmpPal


         if ! Empty( cBmpFile )

       aBmpPal = PalBmpRead( ::GetDC(), AllTrim( cBmpFile ) )
       ::hBitmap = aBmpPal[ 1 ]
       ::hPalette = aBmpPal[ 2 ]
       ::ReleaseDC()
         endif

       if lChanged

         ::cBmpFile = cBmpFile

         if ! Empty( hBmpOld )
         PalBmpFree( hBmpOld, hPalOld )
      endif

      PalBmpNew( ::hWnd, ::hBitmap, ::hPalette )

   endif

  return lChanged

METHOD paint()


    if Empty( ::hBitmap ) .and. ! Empty( ::cBmpFile )
      ::LoadImage( ::cBmpFile )
   endif


     return nil


METHOD IsOver( nRow, nCol )  CLASS Umbrella
 return nil

Code: Select all  Expand view

function Click( nRow, nCol )

   local nMyRow := Int( nRow / 20 )
   local nMyCol := Int( nCol / 20 )
   
   MsgInfo( nMyRow * 20 + nMyCol )
   
return nil

Code: Select all  Expand view

#include "fivewin.ch"
#include "constant.ch"




Function Main()
   Local ownd
   Local umbrella

   DEFINE WINDOW oWnd

    umbrella:=Umbrella():New(10,10,oWnd,"azzurro.bmp",,.t.)



    ACTIVATE WINDOW oWnd



  RETURN NIL












CLASS Umbrella

   DATA nTop, nLeft, nWidth, nHeight

   DATA nStatus

   DATA cBmpFile, cResName, lBorder

   DATA hBmp, hBmpPal

   DATA oParent

   DATA nPen, nStylePen, nClrPen


   DATA hDCMem

   DATA hOldBmp


CLASSDATA hOld

METHOD New (nTop, nLeft, oParent,;
                  cBmpFile, cResName, lBorder )  CONSTRUCTOR

METHOD Paint( hDC, nTop, nLeft )
//METHOD IsOver( nRow, nCol ) // to detect a mouse click

METHOD EndPaint()

METHOD BeginPaint( hDC )

  METHOD Click( nRow, nCol )

METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
ENDCLASS


//-----------------------------------------------------------------------/

 METHOD New (nTop, nLeft, oParent,;
                  cBmpFile, cResName, lBorder ) CLASS Umbrella



DEFAULT lBorder := .t.

  ::oParent     := oParent

  ::nTop        := nTop
  ::nLeft       := nLeft
  // ::nHeight     := nBottom
  // ::nWidth     := nRight

  ::cBmpFile    := cBmpFile
  ::cResName    := cResName
  ::lBorder     := lBorder


 if File( ::cBmpFile )

     ::hBmp    := ReadBitmap (0, cBmpFile )
     ::hBmpPal := PalBmpRead( ::oParent:GetDC(), AllTrim( cBmpFile ) )
     ::oParent:ReleaseDC()

     if ! Empty( ::hOld )
        PalBmpFree( ::hOld )
     endif

     ::hOld := ::hBmpPal

     PalBmpNew( ::oParent:hWnd, ::hBmpPal )

     ::nHeight := nBmpHeight( ::hBmp )
     ::nWidth  := nBmpWidth( ::hBmp )

     ::nHeight  := ::nTop  + ::nHeight
     ::nWidth  := ::nLeft + ::nWidth



  endif
    ::Display()
   * ::Paint( ::oParent:GetDC() )

Return Self

//-----------------------------------------------------------------------/

METHOD Paint (hDC) CLASS Umbrella

Local hPen, hOldPen

DEFAULT hDC := ::oParent:hDC

  hPen      := CreatePen    (::nStylePen, ::nPen, ::nClrPen)
  hOldPen   := SelectObject (hDC, hPen)

  DrawBitmap (hDC, ::hBmp, ::nTop, ::nLeft, ::nWidth, ::nHeight)
  * PALBMPDraw( hDC, ::nTop, ::nLeft, ::hBmpPal, ::nWidth, ::nHeight)

  If ::lBorder

     Moveto (hDC, ::nLeft, ::nTop)

     LineTo( hDC, ::nWidth, ::nTop    )
     LineTo( hDC, ::nWidth, ::nHeight )
     LineTo( hDC, ::nLeft , ::nHeight )
     LineTo( hDC, ::nLeft , ::nTop    )


  endif


  SelectObject( hDC, hOldPen )
  DeleteObject( hPen )

Return nil




METHOD BeginPaint( hDC )
::hDCMem  := CompatDC( hDC )
::hOldBmp := SelectObject( ::hDCMem, ::hBmp )

Return nil



METHOD EndPaint()


SelectObject( ::hDCMem, ::hOldBmp )
DeleteDC( ::hDCMem )

::hDCMem  := nil


Return nil




METHOD Click( nRow, nCol )

   local nMyRow := Int( nRow / 20 )
   local nMyCol := Int( nCol / 20 )
   
   MsgInfo( nMyRow * 20 + nMyCol )
   
return nil






 

ukoenig wrote:How do You want to display the text ?
Working on a sample, I have to know :
Solution 1 : a centered transparent text
Solution 2 : a text centered, on bottom or top
and with a extra background-color.

Best regards
Uwe

Code: Select all  Expand view

   :aCols[1]:aBitmaps       := aBitmaps1
   :aCols[1]:bStrData       := {|| Nil }
   //:aCols[1]:lBmpStretch    := .T.                     // Rellenar toda la celda con el BitMap
   :aCols[1]:bBmpData       := { | oB | oXBrw:nArrayAt }
   //:aCols[1]:cHeader      := "Nombre de Grupo"
   :aCols[1]:nDataStrAlign  := 1
   :aCols[1]:lAllowSizing   := .F.
   :aCols[1]:nEditType      := 0