Gerador de Qrcode

por **Kapiaba** » 06 Ago 2015 11:30

Melhorando...

// Our first DialogBox sample
// Testado com FWHX15.05 Show de bola.
 
#include "FiveWin.ch"
#include "ttitle.ch"
 
# define HTTPREQUEST_PROXYSETTING_PROXY  2

#IFDEF __XHARBOUR__
  #xtranslate hb_DateTime([<x,...>])          => DateTime(<x>)
  #xtranslate hb_tstostr([<x>])               => TToS(<x>)
  #xtranslate hb_stot([<x>])                  => SToT(<x>)
  #xtranslate hb_ttod([<x>])                  => TToD(<x>)
  #xtranslate hb_hour([<x>])                  => Hour(<x>)
  #xtranslate hb_minute([<x>])                => Minute(<x>)
  #xtranslate hb_sec([<x>])                   => Secs(<x>)
  #xtranslate hb_NumToHex([<x>])              => NumToHex(<x>)
  #xtranslate hb_StrFormat([<x,...>])         => StrFormat(<x>)
  #xtranslate <x>:__EnumIndex                 => hb_EnumIndex
#ENDIF
 
function Main()
 
   local obmp ,cBmp
   local oDlg, oIco
   local ofont
   local cCode:= space(180)
   local oGerar, oSaida
 
   DEFINE Font ofont NAME "Verdana" SIZE 0,14 
    
   DEFINE ICON oIco FILE "fivewin.ico"
 
   DEFINE DIALOG oDlg TITLE "Gerador de Qrcode - FWHX15.05" ;
      ICON oIco SIZE 350, 440

   oDlg:lHelpIcon := .F.
 
   @ 30,24  IMAGE oBmp FILE cBmp OF oDlg size 128,128 pixel NOBORDER 
     
   oBmp:lTransparent := .t.
     
   //  cargaBmp( "hola",oBmp )
       
   @ 160, 10 SAY OemToAnsi( "Digite o C¢digo Para Gerar: " ) ;
             size 100, 12 FONT oFont pixel OF oDlg
     
   @ 170, 10 GET cCode size 120, 12 FONT oFont pixel OF oDlg
 
   @ 205, 85 BUTTON oGerar PROMPT "&Gerar" SIZE 40, 12 OF oDlg pixel ;
             WHEN( .NOT. EMPTY( cCode ) )  FONT oFont                ;
             ACTION cargaBmp( alltrim( cCode) ,oBmp )

   oGerar:cToolTip := "Busca e Gera o Qrcode"
 
   @ 205,130 BUTTON oSaida PROMPT "&Saida" SIZE 40, 12 pixel OF oDlg ;
             FONT oFont                                              ;
             ACTION oDlg:End()

   oSaida:cTooltip := "Saida - Exit - Cancelar"
 
   ACTIVATE DIALOG oDlg CENTERED ;
            ON INIT  DlgBarTitle( oDlg, "  Gerador de Qrcode","" ,44 )  ;
            ON PAINT DlgStatusBar(oDlg, 68,, .t. )

   oFont:End()
   
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( "Deseja Gravar QRCODE.PNG no 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

// FIM DO PROGRAMA

Gerador de Qrcode

Gerador de Qrcode

Quem está online