FiveTech Support Forums

// Our first DialogBox sample

#include "FiveWin.ch"
#include "ttitle.ch"

# define HTTPREQUEST_PROXYSETTING_PROXY  2

function Main()



  local obmp ,cBmp 
  local oDlg, oIco 
  local ofont
   local cCode:= space(180)

   DEFINE Font ofont NAME "Verdana" SIZE 0,14 
    
   DEFINE ICON oIco FILE "..\icons\fivewin.ico"

   DEFINE DIALOG oDlg TITLE "Qrcode Generator" ;
      ICON oIco SIZE 350, 440

   @ 30,24  IMAGE oBmp FILE cBmp OF oDlg size 128,128 pixel NOBORDER 
     
     oBmp:lTransparent := .t.
     
   //  cargaBmp( "hola",oBmp )
       
 
     @ 160, 10 SAY "Introduce el codigo a generar :" size 100, 12 ;
                        FONT oFont pixel OF oDlg
     
     @ 170, 10 GET cCode size 120, 12 FONT oFont pixel OF oDlg 

     @ 205, 85 BUTTON "&Buscar" SIZE 40, 12 OF oDlg pixel ;
              FONT oFont ; 
              ACTION cargaBmp( alltrim( cCode) ,oBmp )

     @ 205,130 BUTTON "&Salir" SIZE 40, 12 pixel OF oDlg;
               FONT oFont ; 
               ACTION oDlg:End()

   ACTIVATE DIALOG oDlg CENTERED ;
    ON INIT  DlgBarTitle( oDlg, "  Generador de Qrcode","" ,44 )  ;
    ON PAINT DlgStatusBar(oDlg, 68,, .t. ) 
   
return nil

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

Function cargaBmp( cCode, oImage )
 local cResp
 local nZeroZeroClr
 local ogbmp := GdiBmp():new()
 local nHeight := 248
 local nWidth  := 248
 local cUrl  := "http://api.qrserver.com/v1/create-qr-code/?data="
 
  cUrl += GetSafeURL(hb_strtoutf8( cCode ) )
  cUrl += "&size=" + alltrim( str( nWidth ) )  + "x" + alltrim( str( nHeight ) )
   
 cResp := loadBmp(cUrl)

 if !Empty( cResp ) 
 
    oGbmp:hbmp := GDIPLUSIMAGELOADPNGFROMSTR( cResp,len(cResp) ) 
   
    oImage:hBitmap := oGBmp:GetGDIHbitmap()
    oImage:HasAlpha()
    oImage:Refresh()
    if msgYesNo( " ¨ quiere grabar el codigo QR a Disco ?")
       oGBmp:save(".\qrcode.png" )
    endif  
    oGbmp:End()
 endif
 
Return nil

Static Function GetSafeURL(  cUrl ) 
   local cAsc
   local nChr
   local sHex
   local i
   local cGetSafeURL := ""
       
    For i = 1 To Len( cUrl )
        cASC := substr( cUrl, i, 1)
        nChr := Asc( cASC )
        
        If ( nChr > 47 .and. nChr < 58 ) .Or. ( nChr > 64 .And. nChr < 91 ) .Or. ( nChr > 96 .And. nChr < 123 ) 
            cGetSafeURL += cASC
        Else
            sHex :=  hb_NumtoHex( nChr )
            If Len( sHex ) = 1 
                cGetSafeURL += "%0" + sHex
            Else
                cGetSafeURL += "%"  + sHex
            End If
        End If
    Next

Return cGetSafeURL 

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

Function loadBmp(cUrl)
local oHttp
local cResp := nil

   Try
      oHttp := CreateObject( "winhttp.winhttprequest.5.1" )
         
      oHttp:Open("GET", cUrl, .f. )
      oHttp:Send()
      cResp := oHttp:ResponseBody()
          
   Catch
      MsgStop( "Error" )
      Return cResp
   End Try
  
Return cResp

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

Function DlgStatusBar(oDlg, nHeight, nCorrec , lColor )
Local nDlgHeight := oDlg:nHeight
Local aColor     := { { 0.40, nRGB( 200, 200, 200 ), nRGB( 184, 184, 184 ) },;
                    { 0.60, nRGB( 184, 184, 184 ), nRGB( 150, 150, 150 ) } }

DEFAULT nHeight  := 72
DEFAULT nCorrec  := 0
DEFAULT lColor   := .F.

nDlgHeight:= nDlgHeight+ncorrec
IF lColor
   GradienTfill(oDlg:hDC,nDlgHeight-( nHeight-2 ),0,nDlgHeight-20,oDlg:nWidth, aColor ,.t.)
   WndBoxIn( oDlg:hDc,nDlgHeight-( nHeight-1 ),0,nDlgHeight-( nHeight ),oDlg:nWidth )
ELSE
   WndBoxIn( oDlg:hDc,nDlgHeight -( nHeight-1 ),4,nDlgHeight-( nHeight ),oDlg:nWidth - 10 )
endif

Return Nil

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

FUNCTION DlgBarTitle( oWnd, cTitle, cBmp ,nHeight )
   LOCAL oFont
   LOCAL oTitle
   LOCAL nColText := 180
   LOCAL nRowImg  := 0
   

   DEFAULT cTitle  := ""
   DEFAULT nHeight := 48

   IF nHeight < 48
      nColText := 60
      nRowImg  := 12
      DEFINE FONT oFont NAME "Arial" size 10, 30
   ELSE
      DEFINE FONT oFont NAME "Arial" size 12, 30
   endif

    @ -1, -1  TITLE oTitle size oWnd:nWidth+1, nHeight+1 of oWnd SHADOWSIZE 0
   
   @  nRowImg,  10  TITLEIMG  OF oTitle BITMAP cBmp  SIZE 48, 48 REFLEX ;
          TRANSPARENT
   
    @  nRowImg-2 ,  nColText TITLETEXT OF oTitle TEXT cTitle COLOR CLR_BLACK FONT oFont

    oTitle:aGrdBack := { { 1, RGB( 255, 255, 255 ), RGB( 229, 233, 238 )  } }
    oTitle:nShadowIntensity = 0
    oTitle:nShadow = 0
    oTitle:nClrLine1 := nrgb(0,0,0)
    oTitle:nClrLine2 := RGB( 229, 233, 238 )
    oWnd:oTop:= oTitle
    
      

RETURN oTitle

HB_FUNC( GDIPLUSIMAGELOADPNGFROMSTR )
{
 void const *lpData = hb_parc(1) ;
 DWORD dwSize   =  hb_parni(2) ;
 HGLOBAL hgImage;
 IStream *isImage  = NULL;
 Bitmap  *pbmImage = NULL;

 HBITMAP hbmpImage;
                 hgImage = GlobalAlloc(GMEM_FIXED, dwSize);
                 if(hgImage)
                    {
                        CopyMemory(GlobalLock(hgImage), lpData, dwSize);
                        GlobalUnlock(hgImage);
                        CreateStreamOnHGlobal(hgImage, FALSE, &isImage );
                        if(isImage)
                            {
                               pbmImage = new  Bitmap(isImage);
                                isImage->Release();
                           }
                       GlobalFree(hgImage);
                   }

         hb_retnl( ( HB_LONG ) pbmImage );

}