// Our first DialogBox sample and statusbar
#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 - " + FWVERSION ;
ICON oIco SIZE 350, 440
oDlg:lHelpIcon := .F.
@ 30,24 IMAGE oBmp FILE cBmp OF oDlg size 128,128 pixel NOBORDER
oBmp:lTransparent := .t.
@ 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
@ 190, 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"
@ 190,130 BUTTON oSaida PROMPT "&Saida" SIZE 40, 12 pixel OF oDlg ;
FONT oFont ;
ACTION( LIBERA_TUDO( oDlg ) )
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 LIBERA_TUDO( oDlg )
/*
DbCommitAll()
DbUnLockAll()
DbCloseAll()
FreeResources()
*/
Release All
SysRefresh()
HB_GCALL( .T. )
CLEAR MEMORY
PostQuitMessage( 0 )
QUIT
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 ) } }
LOCAL cMsg := "STATUSBAR: SIMPLES GENERADOR DE QRCODE"
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
SET MESSAGE OF oDlg TO cMsg NOINSET CENTERED
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