Espero que os guste .
- Code: Select all Expand view
// 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
