Saludos
Hace años recibà este codigo fuente para codigo QR, lo compile y funciona bien, la incidencia es "no genera el archivo de la imagen
oGBmp:save(".\qrcode.png" ) // FORMATO INVALIDO ?, el archivo se genera con tamaño cero,
// 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
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" ) // FORMATO INVALIDO ?
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
