QRCODE

Post Reply
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

QRCODE

Post by 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
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: QRCODE

Post by 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
User avatar
cnavarro
Posts: 5792
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: QRCODE

Post by 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 .... )
C. Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
Si alguien te dice que algo no se puede hacer, recuerda que esta hablando de sus limitaciones, no de las tuyas.
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: QRCODE

Post by jnavas »

Navarro
Gracias,
Puedes escribirme a adaptaprodrive@gmail.com
tengo mi cuenta con espacio lleno y lo estoy vaciando.
User avatar
karinha
Posts: 4882
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: QRCODE

Post by karinha »

João Santos - São Paulo - Brasil
User avatar
Antonio Linares
Site Admin
Posts: 37485
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: QRCODE

Post by Antonio Linares »

regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: QRCODE

Post by 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)
User avatar
Antonio Linares
Site Admin
Posts: 37485
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: QRCODE

Post by Antonio Linares »

Juan,

Si no tiene CallDll() prueba con FWCallDll()
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: QRCODE

Post by jnavas »

Antonio
Gracias,
Tengo una version con FW24 y otra con FWH17, necesito implementarlo en FW24 tambien-
User avatar
karinha
Posts: 4882
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: QRCODE

Post by karinha »

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

Image

Saludos.
João Santos - São Paulo - Brasil
User avatar
karinha
Posts: 4882
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: QRCODE

Post by karinha »

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

http://forums.fivetechsupport.com/viewt ... ee#p164565

Saludos.
João Santos - São Paulo - Brasil
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: QRCODE

Post by jnavas »

Saludos y Gracias,
necesito la sentencia DLL32 ..... , el sistema lo ejecuta en modo SCRIPT no requiere compilación
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: QRCODE

Post by jnavas »

Code: Select all

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