QRCODE

[jnavas]

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

[jnavas]

Saludos y buen dia
Solucionado

oImage:SaveImage( cFileB, 0, nQuality )



// 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="
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

[cnavarro]

Juan, he intentado enviarte un par de mails sobre este tema, pero me han venido con un mensaje de que no ha sido posible enviarte el mail ( bandeja de entrada llena?.... o .... )

[jnavas]

Navarro
Gracias,
Puedes escribirme a adaptaprodrive@gmail.com
tengo mi cuenta con espacio lleno y lo estoy vaciando.

[karinha]

Un más simples:

http://www.pctoledo.com.br/forum/viewtopic.php?f=2&t=19679

Saludos.

[Antonio Linares]

https://bitbucket.org/fivetech/fivewin-contributions/downloads/QRCODE.rar

[jnavas]

Saludos,
Necesito utilizar esta funcion en una version antigua de FW que no tiene la funcion CALLDLL
Similar a

DLL32 Function Apagar (uFlags As LONG, dwReserved AS LONG) ;
AS LONG PASCAL FROM "ExitWindowsEx" LIB "USER32.DLL"

nResp := DllCall(qrDLL,DC_CALL_STD,"FastQRCode",cStr,cFile)


#Define DC_CALL_STD 0x0020

FUNCTION Generar_QR(cStr,cFile)

LOCAL nResp
LOCAL qrDLL

qrDLL := LoadLibrary("QRCodelib.Dll" )

nResp := DllCall(qrDLL,DC_CALL_STD,"FastQRCode",cStr,cFile)

FreeLibrary(qrDLL)

RETURN (NIL)

[Antonio Linares]

Juan,

Si no tiene CallDll() prueba con FWCallDll()

[jnavas]

Antonio
Gracias,
Tengo una version con FW24 y otra con FWH17, necesito implementarlo en FW24 tambien-

[karinha]

Con FWH2.7 funciona perfecto, usando la DLL del link de www.pctoledo.com.br



Saludos.

[karinha]

Se el FWH2.4 no funcionar, use este. És grátis.

http://forums.fivetechsupport.com/viewtopic.php?f=3&t=16841&p=164565&hilit=fwh+free#p164565

Saludos.

[jnavas]

Saludos y Gracias,
necesito la sentencia DLL32 ..... , el sistema lo ejecuta en modo SCRIPT no requiere compilación

[jnavas]

Code: Select all  Expand view

Saludos y gracias ,
Logré implementarlo mediante esta instrucción
DLL32 FUNCTION  FastQRCode(cStr AS  LPSTR, cFile AS LPSTR) AS BOOL PASCAL LIB "QRCodelib.Dll"