Gradient Colors

[Natter]

Hi,

There is a .png file - a gradient of some color (for example, red)
https://cloud.mail.ru/public/NipP/v5trqrynQ

Is it possible to get a list of colors from this file (from left to right) ?

[karinha]

Maybe,

https://encycolorpedia.pt/ff0000

Regards, saludos.

[Natter]

I've seen it all. But I haven't figured out how to use it. The only thing that comes to mind is to open bitmap's gradients in XImage and read the pixel colors from DC. Save the results to the database

[nageswaragunupudi]

Code: Select all  Expand view  RUN

function ImagePixels()

   local hBmp  := FW_ReadImage( nil, "https://thumb.cloud.mail.ru/weblink/thumb/xw1/NipP/v5trqrynQ" )[ 1 ]
   local aClrs

   aClrs := ReadBmpPixels( hBmp )
   DeleteObject( hBmp )

   XBROWSER aClrs SHOW SLNUM

return nil

static function ReadBmpPixels( hBmp )

   local hBmpOld, hDC0, hDC
   local nBmpWidth  := nBmpWidth( hBmp )
   local nBmpHeight := nBmpHeight( hBmp )
   local nRow, nCol, nClr, aCol
   local aClrs := {}

   hDC0     := GetDC(  0 )
   hDC      := CreateCompatibleDC( HDC0 )
   hBmpOld  := SelectObject( hDC, hBmp )

   nRow     := 3 // can be any
   AAdd( aClrs,  aCol := { 1, 1, nClr := GetPixel( hDC, 1, 1 ), cClrToCode( nClr ) } )
   for nCol := 2 to nBmpWidth - 1
      nClr     := GetPixel( hDC, nCol, nRow )
      if nClr == aCol[ 3 ]
         aCol[ 2 ] := nCol
      else
         aCol  := { nCol, nCol, nClr, cClrToCode( nClr ) }
         AAdd( aClrs, aCol )
      endif
   next nCol

   SelectObject( hDC, hBmpOld )
   Deletedc( hdc )
   ReleaseDC( 0, hDC0 )

return aClrs

[Natter]

Thank you, Rao!

[Jimmy]

hi,
i got this Error

Imgpixel.prg(9) Error E0030 Syntax error "syntax error at 'ACLRS'"

what i´m doing wrong

[karinha]

hi,
i got this Error

Imgpixel.prg(9) Error E0030 Syntax error "syntax error at 'ACLRS'"

what i´m doing wrong

Code: Select all  Expand view  RUN

#include "FiveWin.ch"
 

Regards, saludos.

[karinha]

Master Nages, how do I record in a .TXT or .DBF?

Maestro Nages, ¿cómo grabo en un .TXT o .DBF?

Gracias, tks.

Regards, saludos.

[nageswaragunupudi]

Are you asking how to store an array as text in a txt file or dbf?

Code: Select all  Expand view  RUN

MEMOWRIT( cFileTxt, FW_ValToExp( aAnyArrayData ) )
// later
cText := MEMOREAD( cFileTxt )
aArray := &c   // or &(c)

[karinha]

Thanks/Gracias Master Nages.

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

FUNCTION ImagePixels()

   LOCAL hBmp := FW_ReadImage( NIL, "https://thumb.cloud.mail.ru/weblink/thumb/xw1/NipP/v5trqrynQ" )[ 1 ]
   LOCAL aClrs, cFileTxt := "NAGES.TXT", cTxt, cText

   aClrs := ReadBmpPixels( hBmp )

   DeleteObject( hBmp )

   XBROWSER aClrs SHOW SLNUM

   cTxt := {aClrs}

   MEMOWRIT( cFileTxt, FW_ValToExp( cTxt ) )

   WinExec( "Notepad.exe " + cFileTxt )

RETURN NIL

STATIC FUNCTION ReadBmpPixels( hBmp )

   LOCAL hBmpOld, hDC0, hDC
   LOCAL nBmpWidth  := nBmpWidth( hBmp )
   LOCAL nBmpHeight := nBmpHeight( hBmp )
   LOCAL nRow, nCol, nClr, aCol
   LOCAL aClrs := {}

   hDC0    := GetDC(  0 )
   hDC     := CreateCompatibleDC( HDC0 )
   hBmpOld := SelectObject( hDC, hBmp )

   nRow    := 3 // can be any

   AAdd( aClrs,  aCol := { 1, 1, nClr := GetPixel( hDC, 1, 1 ), cClrToCode( nClr ) } )

   FOR nCol := 2 TO nBmpWidth - 1

      nClr     := GetPixel( hDC, nCol, nRow )

      IF nClr == aCol[ 3 ]

         aCol[ 2 ] := nCol

      ELSE

         aCol  := { nCol, nCol, nClr, cClrToCode( nClr ) }

         AAdd( aClrs, aCol )

      ENDIF

   NEXT nCol

   SelectObject( hDC, hBmpOld )

   Deletedc( hdc )
   ReleaseDC( 0, hDC0 )

RETURN aClrs

// FIN / END
 

Regards, saludos.

[nageswaragunupudi]

Code: Select all  Expand view  RUN

 cTxt := {aClrs}

   MEMOWRIT( cFileTxt, FW_ValToExp( cTxt ) )
 

is not correct:

This is correct:

Code: Select all  Expand view  RUN

MEMOWRIT( cFileTxt, FW_ValToExp( aClrs ) )