Code: Select all | Expand
// Our first DialogBox sample
#include "FiveWin.ch"
#include "ttitle.ch"
#define HTTPREQUEST_PROXYSETTING_PROXY 2
// Para xHarbour
#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
MEMVAR SEQUENC
FUNCTION Main()
LOCAL obmp , cBmp
LOCAL oDlg, oIco
LOCAL ofont
LOCAL cCode := space( 440 ) // maximo de 440 caracteres por qrcode.
// Master Mastintin: con 431 caracteres el formato es invalido, porque?
// Que me falta? Prueba porfa
SEQUENC := "35141146377222003730599000004630001158179941|20141105134922|10.00|61694805808|m+4o8FY1lig1zcy6VU3t7INVwE6kiA/ykLXKDFZfb9gu0g4wl3Fk2HYaRhSt8G+yk9mP/R65m3R7V2IO8CxnmO1oVtlamB6UKA+UZZqDNEqtYlhQzLySNzMG0thaNMZsq5RxmQ3eQLPw8LLez3MqWvUveFXNSSq6AGEX2+KOdavteo3K2L06SQoVIjwkmcgRzqhfHP3y8t2wfr1nw/WAnaCF9ZY/K4dTykk3hsXcan/MKCTBlcSOhNgSh3sdsQHpl2w2tmbLBsYBLFkuvKlwzHarNJQ1RfRznGdojHglQH1KVtbAUXKke54pdRt3JL7nJlR+Lbmtd2tjcT2vRyTepw=="
cCode := ALLTRIM( SEQUENC )
DEFINE Font ofont NAME "Verdana" SIZE 0, 14
DEFINE ICON oIco FILE "..\icons\fivewin.ico"
DEFINE DIALOG oDlg TITLE "AdaptaPro 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 MEMO
@ 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, hDib
LOCAL nZeroZeroClr
LOCAL ogbmp := GdiBmp():new()
LOCAL nHeight := 248
LOCAL nWidth := 248
LOCAL cUrl := "http://api.qrserver.com/v1/create-qr-code/?data="
LOCAL nQuality := 1
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" ) // FORMATO INVALIDO ?
oImage:SaveImage( "qrcode.bmp", 0, nQuality )
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
Regards, saludos.