Guardar imagen desde la WEB

[acuellar]

Buenas Estimados

Como se hace para guardar a una carpeta especifica en el disco una imagen desde la WEB

Así la obtengo:

Code: Select all  Expand view

 oImagen:SetBmp("http://"+dominio+"/data/images/foto1.jpg")
 

Gracias por la ayuda.

[cnavarro]

viewtopic.php?f=3&t=25334&p=137982&hilit=download+image+from+url&sid=9b895fc7aefbf08ed81a762344e4e179#p137982

[acuellar]

Perfecto.

Muchas gracias estimado Cristobal por el Link

Gracias estimado Antonio por la función.

[karinha]

Very good.

Code: Select all  Expand view

// => \samples\GRABARIMG.PRG  - 15/11/2021

#Include "FiveWin.ch"

STATIC oWnd, hLib

FUNCTION Main()

   LOCAL oBar, cTitle, cUrl, cSaveAs

   SetBalloon( .T. )

   SkinButtons()

   // https://imgur.com/
   cUrl    := "https://i.imgur.com/UQxRdAp.png"
   cSaveAs := "GrabaImg.png"

   cTitle  := "FiveWin Brasil: Grabar Imagen Desde URL"

   DEFINE WINDOW oWnd TITLE cTitle

   DEFINE BUTTONBAR oBar BUTTONSIZE 60, 50 _3DLOOK TOP OF oWnd 2007

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\floppy.bmp" FLAT         ;
      ACTION( URLDownLoad( cUrl, cSaveAs ) ) TOOLTIP "Saves this Image"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\Exit.bmp" FLAT           ;
      ACTION oWnd:End() TOOLTIP "Exit this app" GROUP

   SET MESSAGE OF oWnd TO cTitle  NOINSET CLOCK DATE KEYBOARD 2007

   ACTIVATE WINDOW oWnd MAXIMIZED                                            ;
      ON INIT( CLRTEST( CLR_WHITE, CLR_HRED ) )                              ;
      ON PAINT(  DiagonalGradientFill( hDC,                                  ;
                 0, 0, oWnd:nHeight, oWnd:nWidth,                            ;
                 { { 0.16, CLR_WHITE, CLR_CYAN },                            ;
                 { 0.16, CLR_CYAN, nRGB( 181, 61, 29 ) },                    ;
                 { 0.16, nRGB( 181, 61, 29 ), nRGB( 250,157,52 ) },          ;
                 { 0.16, nRGB( 250,157,52 ), nRGB( 181, 61, 29 ) },          ;
                 { 0.16, nRGB( 181, 61, 29 ), CLR_CYAN },                    ;
                 { 0.20, CLR_CYAN, CLR_WHITE } },.T. ), PINTA( hDC ) )

RETURN NIL

FUNCTION URLDownLoad( cUrl, cSaveAs )

   hLib := LOADLIBRARY( "urlmon.dll" )

   CURSORWAIT()

   IF FILE( cSaveAs )

      ERASE cSaveAs

   ENDIF

   IF .NOT. URLDownloadToFile( 0, cUrl, cSaveAs, 0, 0 ) == 0

      MsgInfo( "Image Not Found in: https://imgur.com/", "Attention!" )

      RETURN( .F. )

   ENDIF

   FreeLibrary( hLib )

   CURSORARROW()

   ShellExecute(GetActiveWindow(),"open",'"'+cSaveAs+'"')

RETURN( .T. )

FUNCTION DiagonalGradientFill( hDC, nTop, nLeft, nBottom, nRight, aGradInfo, ;
                               lDirection )

   LOCAL nClr := 1, nClrs := Len( aGradInfo )
   LOCAL nSize, nStart, nEnd

   DEFAULT lDirection := .T.

   IF Empty( aGradInfo )

      RETURN NIL

   ENDIF

   nSize    = ( nBottom - nTop ) + ( nRight - nLeft )
   nStart   = 0
   nEnd     = 0

   FOR nClr := 1 to nClrs

      nStart = nEnd
      nEnd   += ( nSize * ( aGradInfo[ nClr ][ 1 ] ) )

      DiagonalGradient( hDC, ;
                        { nTop, nLeft, nBottom, nRight },;
                          aGradInfo[ nClr ][ 2 ], ;
                          aGradInfo[ nClr ][ 3 ], ;
                          lDirection, ;
                          nStart, ;
                          nEnd )

   NEXT

RETURN NIL

FUNCTION Pinta( hDC )

   LOCAL nColor
   LOCAL nLeft   := 80
   LOCAL nRight  := 220
   LOCAL cTexto  := "FIVEWIN BRASIL THE BEST"
   LOCAL cTexto2 := "No funciona...    "
   LOCAL oFont
   LOCAL hFont
   LOCAL nLen    := LEN( cTexto )
   LOCAL cLetra, n
   LOCAL nResHoriz, nResVert

   nResHoriz := oWnd:nHorzRes() // retorna a resolucao horizontal
   nResVert  := oWnd:nVertRes() // retorna a resolucao vertical

   // atencao: nResolution identifica em que resolucao foram inicialmente
   // desenhadas as telas, e DEVE ter um dos seguintes valores:
   //
   // 1 =  640 X 480
   // 2 =  800 X 600
   // 3 = 1024 X 768
   // 4 = 1152 X 864
   // 5 = 1280 X 800
   // 6 = 1280 X 1024
   // 7 = 1600 X 1200
   // 8 =  768 X 1024
   // 9 = 1440 X 900
   // 10 = 1280 X 768
   // 11 = 1280 X 720

   IF nResHoriz = 1366 .AND. nResVert = 768

      nLeft  := 260
      nRight := 230

   ELSEIF nResHoriz = 1360 .AND. nResVert = 768

      nLeft  := 210
      nRight := 250

   ELSEIF nResHoriz = 1280 .AND. nResVert = 1024

      nLeft  := 210
      nRight := 350

   ELSEIF nResHoriz = 1280 .AND. nResVert = 768

      nLeft  := 170 // 210  // my computer.
      nRight := 280

   ELSEIF nResHoriz = 1280 .AND. nResVert = 720

      nLeft  := 200
      nRight := 200

   ELSEIF nResHoriz = 1024 .AND. nResVert = 768

      nLeft  :=  80
      nRight := 220

   ELSE

      nLeft  :=  80
      nRight := 220

   ENDIF

   DEFINE FONT oFont NAME "Segoe UI Symbol" SIZE 0, -80 BOLD

   hFont := SelectObject( hDC, oFont:hFont )

   FOR n := 1 TO nLen

      cLetra := substr( cTexto, n, 1 )

      nColor := SetTextColor( hDC,  CLR_GREEN )

      // TextOut( hDC, 10, nLeft, cLetra )
      TextOut( hDC, nRight, nLeft, cLetra )

      SetTextColor( hDC, nColor )

      nLeft += GetTextWidth( hDC, cLetra, oFont )

   NEXT

   SelectObject( hDC, hFont )

RETURN NIL

#pragma BEGINDUMP

#include <hbapi.h>
#include <windows.h>

HB_FUNC( CLRTEST )
{
   int aElements[2] = { COLOR_CAPTIONTEXT, COLOR_ACTIVECAPTION };
   DWORD aColors[2];

   aColors[ 0 ] = hb_parnl( 1 );
   aColors[ 1 ] = hb_parnl( 2 );
   SetSysColors( 2, aElements, aColors );

}

#pragma ENDDUMP

DLL32 FUNCTION URLDownloadToFile( pCaller AS LONG, szURL AS STRING, szFileName ;
   AS STRING, dwReserved AS LONG, lpfnCB AS LONG ) AS LONG PASCAL              ;
   FROM "URLDownloadToFileA" LIB hlib

// fin /end
 

Regards, saludos.