HotSpot with colored images

[Rochinha]

For all,

Code sample illustrating this feature.



Download in http://www.5volution.com/forum/hotspot.zip

[Ruben Fernandez]

Rochinha:

Se ve impresionante, pero no lo pude probar
el prg del zip no es un prg es el bmp.

Saludos y gracias.

Ruben Fernandez.

[James Bott]

Rochinha,

The file in the zip, hotspot.prg seems to be a binary file not ASCII.

James

[Rochinha]

Friends,

Excuse-me for the mistake

This is the code sample:

Code: Select all

#include "fivewin.ch"

// Ver exemplo TESTGRAF.PRG tambem

Function main() 
   Local oSay, oCursor
   Local aMunicipios := {}
   Local oDlg, oBmpColor , oBmpBlackWhite 
   Local cTitle := "Testing" 
   Local cDataDict := "dentes.bmp" // "e:\fontes\nfw\harbour\recursos\mapas\mapazn.bmp"
   Local cBmp := "", cTitulo := "Showing Map Color"

   DEFINE CURSOR oCursor HAND

   cBmp := alltrim( cGetFile( "*.bmp", "Please select a BMP file" ) )
   if .not. "." $ cBmp
      cBmp += ".BMP"
   endif

   if file( cBmp )
      if ! file("ESTADOS.DBF")
         ESTRU_DBF := { { "IDMUNICIPI", "N",10, 0 } , ;
                        { "MUNICIPIO" , "C",30, 0 } }
                        DBCREATE( "ESTADOS", ESTRU_DBF )
      else
         USE estados SHARED NEW
      endif

      DEFINE BITMAP oBmp FILE cBmp
      DEFINE DIALOG oDlg TITLE cTitulo SIZE oBmp:nWidth(), oBmp:nHeight PIXEL
                                               //Size 276,185 
             @ 0,000 Bitmap oBmp Filename cBmp Of oDlg Pixel // Adjust  // 100 High 
             oBmp:bLClicked := {|nRow,nCol|GetZone(nRow,nCol,oBmp,aMunicipios,.f.)} 
             oBmp:bRClicked := {|nRow,nCol|GetZone(nRow,nCol,oBmp,aMunicipios,.t.)} 
   
      ACTIVATE DIALOG oDlg CENTERED //;
         //ON PAINT PalBmpDraw( hDC, 0, 0, oBmp:hBitmap )

      oBmp:End()
   endif
   Return Nil

Function GetZone(nRow,nCol,oBmpColor,aMunicipios,lModifica) 
   Local nColor  := GetPixel( oBmpColor:GetDC(), nCol,nRow)

   locate for estados->idmunicipi = ncolor
   if lModifica = .t.
      cName := estados->municipio
      if MsgGet( "Informe o Continente",; // Title
                 "Continente:",;          // Label
                 @cName )                // A variable by reference
         rlock()
         estados->idmunicipi := nColor
         estados->municipio  := cName
         commit
      endif
   else
      if ! found()
         cName := space(30)
         if MsgGet( "Informe o Continente",; // Title
                    "Continente:",;          // Label
                    @cName )                // A variable by reference
            append blank
            estados->idmunicipi := nColor
            estados->municipio  := cName
            commit
         endif
      else
         ? estados->municipio, "Cor : " + dec2rgb( nColor ) , "Col : " + AllTrim(Str(nCol)) , "Row : " + AllTrim(Str(nRow)) 
      endif
   endif
   oBmpColor:ReleaseDC()
   Return Nil 

***********************************************************************
*
* Dec2RGB function: returns separate RGB values from object color value
*
* Usage:
*         nColor = RGB2Dec(<Red>, <Green>, <Blue>)
*          ? nColor = 12345678
*
FUNCTION rgb2dec( nRed, nGreen, nBlue )
   RETURN ( nRed + ( nGreen * 256 ) + ( nBlue * 65536 ) )

***********************************************************************
*
* Translate: VB Code to xBase for Rochinha
*
* Dec2RGB function: returns separate RGB values from object color value
*
* Usage:
*         RGB = Dec2RGB(<Decimal Color>) && such as 10079487
*          ? RGB = "255, 204, 153"       && color result
*
FUNCTION dec2rgb( tnDec )
   IF tnDec < 0
      ? 'Must be a positive value'
      RETURN ""
   ENDIF

   * Determine the hexadecimal equivalent of the decimal parameter passed
   lcHex    := ""
   lnFactor := 24 // set up factor value one exponent greater than used

   FOR lnPos = 6 TO 1 STEP -1
       lnFactor = lnFactor - 4     && decrement factorial
       lnExp = 2 ^ lnFactor        && extrapolate next least power of two
       FOR lnOrd = 15 TO 1 STEP -1
           IF tnDec < lnExp            && no value greater than current one,
              lcHex = lcHex + "0"    && so store a zero in this position
              EXIT                   && go back for the next value
           ENDIF
           IF tnDec >= lnExp * lnOrd  && is value greater than or equal to?
              * find the matching hex value from its ordinal position
              lcHex = lcHex + SUBSTR('123456789ABCDEF', lnOrd, 1)
              EXIT
           ENDIF
       NEXT
       tnDec = tnDec % lnExp     && leave remainder of exponential division
   NEXT

   * reverse the order of the individual color indicators
   lcHex = RIGHT(lcHex, 2) + SUBSTR(lcHex, 3, 2) + LEFT(lcHex, 2)

   * convert the pairs into decimal values
   lnPick = 2          && offset to determine which pair to convert
   lcRGB = ["]     && start of string delineator

   * parse each color indicator and convert to decimal
   FOR lnColor = 1 TO 3
       lcHue = SUBSTR(lcHex, (lnPick * lnColor) - 1, 2) && pull out color
       lnMSB = ASC(LEFT(lcHue, 1))     && "Most Significant Bit"
       lnLSB = ASC(RIGHT(lcHue, 1))     && "Least Significant Bit"

       * subtract appropriate value from each to get decimal equivalent
       lnMSB = lnMSB - IIF(lnMSB > 57, 55, 48)
       lnLSB = lnLSB - IIF(lnLSB > 57, 55, 48)

       * then add decimals together
       lcRGB = lcRGB + TRANSFORM( lnMSB * 16 + lnLSB, '999') + ", "
   NEXT
   lcRGB = LEFT(lcRGB, LEN(lcRGB) - 2) + ["]  && replace last comma with quote
   RETURN lcRGB