From 74c7113329f3489001ebbfe2ea3e9b70aabc2486 Mon Sep 17 00:00:00 2001 From: Jose Alberto Guerra Ugalde Date: Tue, 4 Feb 2025 21:52:10 -0600 Subject: [PATCH] - VERSION 5.01.25 - Cambios para envio de mensaje por WhatsApp (incompletos) --- B4A/B4XMainPage.bas | 49 ++++ B4A/C_Cliente.bas | 286 +++++++++++++++++++++- B4A/C_Principal.bas | 29 ++- B4A/Files/cliente.bal | Bin 18350 -> 30453 bytes B4A/GUNA_Reparto.b4a | 63 ++--- B4A/GUNA_Reparto.b4a.meta | 9 +- B4A/QRGenerator.bas | 491 ++++++++++++++++++++++++++++++++++++++ B4A/Subs.bas | 3 +- 8 files changed, 886 insertions(+), 44 deletions(-) create mode 100644 B4A/QRGenerator.bas diff --git a/B4A/B4XMainPage.bas b/B4A/B4XMainPage.bas index 9d370b4..e58e076 100644 --- a/B4A/B4XMainPage.bas +++ b/B4A/B4XMainPage.bas @@ -90,6 +90,8 @@ Sub Class_Globals ' Private lv_matriz As ListView Private s_algoritmo As Spinner Private s_matriz As Spinner + Dim in As Intent + Dim intentUsado As Boolean = False End Sub Public Sub Initialize @@ -144,9 +146,12 @@ Private Sub B4XPage_Created (Root1 As B4XView) ' Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS VENTAS (V_FECHA TEXT, V_CLIENTE TEXT, V_CLIENTE_ORIG TEXT, V_PRODNOMBRE TEXT, V_PRODID TEXT, V_CANTIDAD TEXT, V_PRECIO TEXT, V_TOTAL TEXT, V_PRODREGISTRO TEXT)") Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS RECHAZOS (R_FECHA TEXT, R_CLIENTE TEXT, R_CLI_ORIG TEXT, R_PRODID TEXT, R_CANT TEXT, R_RECHAZO INT)") Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS VENTAS (V_FECHA TEXT, V_CLIENTE TEXT, V_CLI_ORIG TEXT, V_PRODID TEXT, V_CANT TEXT, V_RECHAZO INT)") + Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS PAGARES (NOTA TEXT, CLIENTE TEXT, ALMACEN TEXT, SALDO_PENDIENTE TEXT, RUTA_PREVENTA TEXT, REPARTO TEXT)") + Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS PAGARES_NUEVOS (NOTA TEXT, CLIENTE TEXT, ALMACEN TEXT, MONTO TEXT, RUTA_PREVENTA TEXT, REPARTO TEXT, FECHA TEXT)") Subs.agregaColumna("REPARTO", "REP_PRODREGISTRO", "TEXT") Subs.agregaColumna("PICKING_REPARTO", "FECHA", "TEXT") Subs.agregaColumna("kmt_info", "SECUENCIA", "INT") + Subs.agregaColumna("kmt_info", "CAT_CL_LIMITECREDITO", "TEXT") Subs.agregaColumna("REPARTO", "REP_PRODID", "TEXT") Subs.agregaColumna("REPARTO", "REP_CLI_ORIG", "TEXT") Subs.agregaColumna("REPARTO", "REP_PRECIO", "TEXT") @@ -196,6 +201,7 @@ Private Sub B4XPage_Created (Root1 As B4XView) End Sub Sub B4XPage_Appear + importaBDDesdeWhatsApp If Starter.muestraProgreso = 1 Then muestraProgreso("Descargando actualización") Starter.muestraProgreso = 0 @@ -448,4 +454,47 @@ Private Sub s_matriz_ItemClick (Position As Int, Value As Object) Starter.skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("MATRIZ_RUTEO")) Starter.skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("MATRIZ_RUTEO",Value)) Log(Value) +End Sub + + +' Se revisa si hay una intención (intent) de abrir una base de datos y si es así, entonces se importa esa base de datos. +Sub importaBDDesdeWhatsApp + Log("importams bdwa") +' Private tmpBDWA As Boolean = traeUsarIntentBDWA + If Not(in.IsInitialized) Then in = B4XPages.GetNativeParent(B4XPages.MainPage).GetStartingIntent ' Si se usa esta funcion en Mainpage, se pone "Me" en lugar de B4XPages.MainPage. + If Not(intentUsado) And in <> Null Then +' Log(in) + Log(7654) + intentUsado = True +' Log(in.As(String)) + If in.GetData <> Null Then + Log(98765) + Dim XmlData As String + XmlData = in.GetData + Try + Dim OutStr As OutputStream = File.OpenOutput(File.DirInternal,"kmt.db",False) + Dim InStr As InputStream = File.OpenInput("ContentDir",XmlData) + File.Copy2(InStr,OutStr) + LogColor("BD copiada a interna.", Colors.Blue) + OutStr.Close + If in.As(String).Contains("whatsapp") Then ToastMessageShow("BD cargada desde Whatsapp", False) + Catch + Log(LastException) + End Try +' ExitApplication +' Starter.skmt.ExecNonQuery("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = 'IMPORTAR_BD_WA'") +' Starter.skmt.ExecNonQuery($"insert into CAT_VARIABLES (CAT_VA_DESCRIPCION, CAT_VA_VALOR) values ('IMPORTAR_BD_WA', '${tmpBDWA}')"$) + Private a As Cursor = Starter.skmt.ExecQuery($"select CAT_VA_VALOR from CAT_VARIABLES where CAT_VA_DESCRIPCION = 'APP_NAME'"$) + If a.RowCount > 0 Then + a.Position = 0 + ToastMessageShow($"BD de "${a.GetString("CAT_VA_VALOR")}" cargada."$, True) + End If + a = Starter.skmt.ExecQuery($"select * from usuarioa"$) + If a.RowCount > 0 Then + a.Position = 0 + B4XPages.MainPage.user.Text = a.GetString("USUARIO") + B4XPages.MainPage.pass.Text = a.GetString("PASS") + End If + End If + End If End Sub \ No newline at end of file diff --git a/B4A/C_Cliente.bas b/B4A/C_Cliente.bas index 0ff1979..5b5a337 100644 --- a/B4A/C_Cliente.bas +++ b/B4A/C_Cliente.bas @@ -59,16 +59,47 @@ Sub Class_Globals Dim l_atiende2 As Label Dim DATOS As Button Dim Guardar As Button - Dim NUEVO As Button + Dim b_mapa As Button Private l_total As Label Private HIST As Button Dim PASA_IMP As String Private B_IMP As Button Dim total_cliente As String Dim CREDITO As String + Dim limiteDeCredito As String = "0" + Dim pagarePendiente As Boolean = False Private p_principal As Panel Private B_PASO2 As Button Private L_CANT As Label + Private b_aceptaCredito As Button + Private b_cancelaCredito As Button + Private et_montoacredito As EditText + Private l_limite As Label + Private p_transPagares As Panel + Private p_pagares As Panel + Private total As String + Private l_montoEfectivo As Label + Private i_qr As B4XImageView + Private p_qr As Panel + Private b_cerrarqr As Button + Private qr As QRGenerator + Private l_numeroRegistrado As Label + Private b_confirmar As Button + Private NOTA As String = "" + Private l_estaVenta As Label + Private p_transPagare2 As Panel + Private b_abonar As Button + Private p_abonoPagare As Panel + Private b_aceptaAbono As Button + Private b_cancelaAbono As Button + Private l_montoRestante As Label + Private et_montoAbono As EditText + Private Label15 As Label + Private l_totalPagare As Label + Private l_numRegistradoAbono As Label + Private p_transAbonoPagare As Panel + Private saldoPendiente As String + Private l_tituloAbono As Label End Sub 'You can add more parameters here. @@ -83,6 +114,17 @@ Private Sub B4XPage_Created (Root1 As B4XView) g.Initialize("GPS") ' Activity.LoadLayout("info_gral") Root.LoadLayout("cliente") + p_transPagares.left = 0 : p_transPagares.Top = 0 + p_transPagares.Width = Root.Width : p_transPagares.Height = Root.Height + p_transPagare2.left = 0 : p_transPagare2.Top = 0 + p_transPagare2.Width = Root.Width : p_transPagare2.Height = Root.Height + p_transAbonoPagare.left = 0 : p_transAbonoPagare.Top = 0 + p_transAbonoPagare.Width = Root.Width : p_transAbonoPagare.Height = Root.Height + Subs.centraPanel(p_pagares, Root.Width) + Subs.centraPanel(p_qr, p_transPagare2.Width) + Subs.centraPanel(p_abonoPagare, p_transAbonoPagare.Width) + Subs.centraEtiqueta(l_tituloAbono, p_abonoPagare.Width) + qr.Initialize(i_qr.mBase.Width) c=Starter.skmt.ExecQuery("select CAT_CL_CODIGO, CAT_CL_RUTA, CAT_CL_NOMBRE, CAT_CL_ATIENDE1, CAT_CL_ATIENTE2, CAT_CL_TELEFONO, CAT_CL_EMAIL, CAT_CL_CALLE, CAT_CL_NOEXT,CAT_CL_NOINT,CAT_CL_CALLE1,CAT_CL_CALLE2,CAT_CL_COLONIA,CAT_CL_MUNI,CAT_CL_EDO,CAT_CL_CP,CAT_CL_LONG,CAT_CL_LAT from kmt_info where CAT_CL_CODIGO In (Select cuenta from cuentaa)") s=Starter.skmt.ExecQuery("select sum(pe_costo_tot) as TOTAL_CLIE, SUM(PE_CANT) AS CANT_CLIE FROM PEDIDO WHERE PE_CLIENTE IN (Select CUENTA from cuentaa)") s.Position=0 @@ -117,6 +159,8 @@ End Sub 'You can see the list of page related events in the B4XPagesManager object. The event name is B4XPage. Sub B4XPage_Appear + total = "0" + et_montoacredito.Text = "" Subs.centraPanel(p_principal, Root.Width) Starter.skmt.Initialize(Starter.ruta,"kmt.db", True) reqManager.Initialize(Me, B4XPages.MainPage.SERVER) @@ -124,6 +168,8 @@ Sub B4XPage_Appear s=Starter.skmt.ExecQuery("select sum(pe_costo_tot) as TOTAL_CLIE, SUM(PE_CANT) AS CANT_CLIE FROM PEDIDO WHERE PE_CLIENTE IN (Select CUENTA from cuentaa)") s.Position=0 c.Position=0 + l_montoEfectivo.Text = "" + et_montoacredito.Text = "" la_cuenta.Text = c.GetString("CAT_CL_CODIGO") La_nombre.Text = c.GetString("CAT_CL_NOMBRE") NOMBRE = c.GetString("CAT_CL_NOMBRE") @@ -135,6 +181,8 @@ Sub B4XPage_Appear la_cp.Text = c.GetString("CAT_CL_CP") l_entre1.Text = c.GetString("CAT_CL_CALLE1") l_entre2.Text = c.GetString("CAT_CL_CALLE2") + l_numeroRegistrado.Text = "Num. Registrado: " & c.GetString("CAT_CL_TELEFONO") + l_numRegistradoAbono.Text = "Num. Registrado: " & c.GetString("CAT_CL_TELEFONO") B4XPages.MainPage.almacen = c.GetString("CAT_CL_IDALMACEN") If c.GetString("CAT_CL_ATIENDE1") <> Null And c.GetString("CAT_CL_ATIENDE1") <> "null" Then l_atiende.Text = c.GetString("CAT_CL_ATIENDE1") @@ -157,16 +205,40 @@ Sub B4XPage_Appear C.Close If Existe <> 0 Then c = Starter.skmt.ExecQuery("select SUM(HVD_CANT) AS PC_NOART, SUM(HVD_COSTO_TOT) AS PC_MONTO from HIST_VENTAS where HVD_CLIENTE in (Select CUENTA from cuentaa) and HVD_RECHAZO = 0 and hvd_codpromo <> HVD_PROID ") - C.Position=0 + C.Position = 0 L_CANT.Text = c.GetString("PC_NOART") l_total.Text = Round2(c.GetString("PC_MONTO"), 2) + total = Round2(c.GetString("PC_MONTO"), 2) End If ' Private cym As Map = Subs.traeCantYMonto2(Subs.traeCliente) ' L_CANT.Text = cym.Get("cantidad") ' l_total.Text = Round2(cym.Get("monto"), 2) - + p_transPagares.Visible = False If CREDITO = "1" Then - Msgbox("AVISO","SE TIENE QUE IMPRIMIR PAGARÉ") 'ignore +' Msgbox("AVISO","SE TIENE QUE IMPRIMIR PAGARÉ") 'ignore + Dim pa As ResultSet = Starter.skmt.ExecQuery($"select * from pagares where cliente = '${Subs.traeCliente}' and ruta_preventa = (select cat_cl_ruta from kmt_info where cat_cl_codigo = '${Subs.traeCliente}') order by nota desc limit 1"$) + Log("-------------->> " & pa.RowCount) + pagarePendiente = False 'Valor por default + Do While pa.NextRow + Log(pa.GetString("NOTA")) + pagarePendiente = True + saldoPendiente = pa.GetString("SALDO_PENDIENTE") + l_totalPagare.Text = $"Total del pagaré: $${NumberFormat2(saldoPendiente, 1, 2, 2, True)}"$ + Loop + If pagarePendiente Then + Msgbox2Async("El cliente tiene un pagare pendiente, y es NECESARIO liquidarlo para realizar la entrega, ¿desea liquidarlo?", "PAGARÉ PENDIENTE", "SI", "", "NO", Null, True) + Wait For Msgbox_Result (result As Int) + If result=DialogResponse.POSITIVE Then + liquidarPagare + End If + b_abonar.Visible = True + Else + b_abonar.Visible = False + End If + Private lc As ResultSet = Starter.skmt.ExecQuery($"select cat_cl_limitecredito from kmt_info where cat_cl_codigo = '${Subs.traeCliente}'"$) + Do While lc.NextRow + limiteDeCredito = lc.GetString("CAT_CL_LIMITECREDITO") + Loop End If ' Private cym As Map = Subs.traemosCantYMonto(clv_pedido) ' L_CANT.Text = cym.Get("cantidad") @@ -189,10 +261,36 @@ Sub GPS_LocationChanged (Location1 As Location) End Sub Sub ListView1_ItemLongClick (Position As Int, Value As Object) - + End Sub Sub gest_Click + Log($"${CREDITO}, ${pagarePendiente}"$) + Msgbox2Async("¿La venta va a ser a credito?", "AVISO", "SI", "CANCELAR", "NO", Null, True) + Wait For Msgbox_Result (result As Int) + If result=DialogResponse.POSITIVE Then + If CREDITO = 1 And Not(pagarePendiente) Then + p_transPagares.BringToFront + p_transPagares.Visible = True + l_limite.Text = $"Límite de crédito: $${NumberFormat2(limiteDeCredito, 1,2,2,True)}"$ + l_estaVenta.Text = $"Esta venta: $${NumberFormat2(l_total.text, 1,2,2,True)}"$ + Else + Msgbox2Async("El cliente no es sujeto a crédito o tiene pagares pendientes", "AVISO", "OK", "", "", Null, False) + Wait For Msgbox_Result (result As Int) + Log(result) + If result=DialogResponse.POSITIVE Then +' guardaVenta + End If + End If + else if result=DialogResponse.NEGATIVE Then + guardaVenta + else if result=DialogResponse.CANCEL Then + + End If + +End Sub + +Sub guardaVenta DateTime.DateFormat = "MM/dd/yyyy" sDate=DateTime.Date(DateTime.Now) sTime=DateTime.Time(DateTime.Now) @@ -215,7 +313,6 @@ Sub gest_Click d.Position = 0 Dim fechaprev As String = d.GetString("HVD_FECHA") d.Close - Starter.skmt.ExecNonQuery("DELETE FROM NOVENTA WHERE NV_CLIENTE IN (select cuenta from cuentaa)") Starter.skmt.ExecNonQuery2("INSERT INTO NOVENTA (NV_CLIENTE, NV_FECHA, NV_USER, NV_MOTIVO, NV_COMM, NV_LAT, NV_LON, NV_IDALMACEN) VALUES (?,?,?,?,?,?,?,?) ", Array As Object (cuenta,sDate &" "& sTime, usuario, "ENTREGA","ENTREGA COMPLETA", B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps, B4XPages.MainPage.almacen)) Starter.skmt.ExecNonQuery2("INSERT INTO REPARTO_GEO (CLIENTE, USUARIO, FECHA_PUNTEO, LATITUD, LONGITUD, ALMACEN, RUTA_REPARTO, RUTA_PREV, FECHA_PREVENTA, TIPO,ENVIO) VALUES(?,?,?,?,?,?,?,?,?,?,0)",Array As String (la_cuenta.Text, usuario, sDate &" "&sTime, B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps, B4XPages.MainPage.almacen, ruta, rutapre, fechaprev, "ENTREGADO")) @@ -250,7 +347,7 @@ Sub Guardar_Click B4XPages.ShowPage("Principal") End Sub -Sub NUEVO_Click +Sub b_mapa_Click StartActivity(MAPA_CLIENTE) End Sub @@ -450,8 +547,7 @@ Sub B_PASO2_Click usuario = c.GetString("USUARIO") c.Close Starter.skmt.ExecNonQuery("DELETE FROM NOVENTA WHERE NV_CLIENTE IN (select cuenta from cuentaa)") - Starter.skmt.ExecNonQuery2("INSERT INTO NOVENTA (NV_CLIENTE,NV_FECHA,NV_USER,NV_MOTIVO,NV_COMM,NV_LAT,NV_LON) VALUES(?,?,?,?,?,?,?) ", Array As Object (cuenta,sDate & sTime, usuario, "PASO","PASO ESPERA", B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps)) - + Starter.skmt.ExecNonQuery2("INSERT INTO NOVENTA (NV_CLIENTE,NV_FECHA,NV_USER,NV_MOTIVO,NV_COMM,NV_LAT,NV_LON) VALUES(?,?,?,?,?,?,?) ", Array As Object (cuenta,sDate & sTime, usuario, "PASO","PASO ESPERA", B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps)) B4XPages.ShowPage("Principal") End Sub @@ -493,8 +589,180 @@ Sub JobDone(Job As HttpJob) Next Next End If + If resultado.Tag.As(String).IndexOf("insertaPagare_") > -1 Then + Private NOTA As String= resultado.Tag + NOTA = NOTA.SubString(NOTA.IndexOf("_")+1) + Log(NOTA) + p_transPagare2.Visible = True + CrearQR(NOTA) + End If + If resultado.Tag.As(String).IndexOf("pagareConfirmado_") > -1 Then + Private NOTA As String= resultado.Tag + NOTA = NOTA.SubString(NOTA.IndexOf("_")+1) + Log(NOTA) +' Log(resultado.Rows.Size) + If resultado.Rows.Size > 0 Then + p_transPagare2.Visible = False + guardaVenta + Msgbox("¡Pagare confirmado!", "AVISO") 'ignore + Else + ToastMessageShow("El pagare NO ha sido confirmado por el cliente!", True) + End If + End If End If Job.Release End If +End Sub + +Private Sub b_cancelaCredito_Click + p_transPagares.Visible = False +End Sub + +Private Sub b_aceptaCredito_Click + +' almacen, RUTA, ruta_reparto, clienteid, monto, fecha (yyyy/mm/dd HH:mm:ss) +' almacen, RUTA, ruta_reparto, clienteid, monto, nota, fecha + + p_transPagares.Visible = False + Private cliente As String = Subs.traeCliente + c = Starter.skmt.ExecQuery($"select CAT_CL_RUTA from kmt_info where cat_cl_codigo = '${cliente}'"$) + If c.RowCount > 0 Then + c.Position = 0 + Private RUTA_PREVENTA = c.GetString("CAT_CL_RUTA") + End If + c = Starter.skmt.ExecQuery($"select hvd_num_ticket from hist_ventas where hvd_cliente = '${cliente}'"$) + If c.RowCount > 0 Then + c.Position = 0 + NOTA = c.GetString("HVD_NUM_TICKET") + End If + DateTime.DateFormat = "MM/dd/yyyy" + sDate=DateTime.Date(DateTime.Now) + sTime=DateTime.Time(DateTime.Now) + Starter.skmt.ExecNonQuery($"insert into PAGARES_NUEVOS (NOTA, CLIENTE, ALMACEN, MONTO, RUTA_PREVENTA, REPARTO, FECHA) values ('${NOTA}', '${cliente}', '${Subs.traeAlmacen}', '${et_montoacredito.text}', '${RUTA_PREVENTA}', '${Subs.traeRutaReparto}', '${sDate & " " & sTime}')"$) + + Dim cmd As DBCommand + cmd.Initialize + cmd.Name = "insertaPagareGunaRep" + cmd.Parameters = Array As Object(Subs.traeAlmacen, RUTA_PREVENTA, Subs.traeRutaReparto, cliente, et_montoacredito.Text, NOTA, sDate & " " & sTime) + reqManager.ExecuteCommand(cmd, $"insertaPagare_${NOTA}"$) + +' guardaVenta +End Sub + +Private Sub p_transPagares_Click + +End Sub + +Private Sub et_montoacredito_TextChanged (Old As String, New As String) + If New.Length > 0 And et_montoacredito.Text > limiteDeCredito Then ' Si el credito que quieren es mayor al autorizado, solo se permite el autorizado. + et_montoacredito.Text = limiteDeCredito + Else If New.Length > 0 And et_montoacredito.Text > total Then ' Si el credito que quieren es mayor al monto de venta, solo se permite el monto de venta. + et_montoacredito.Text = total + End If + If et_montoacredito.Text <> "" And New.Length > 0 Then + l_montoEfectivo.Text = $"Efectivo: $${NumberFormat2((total - et_montoacredito.text), 1, 2, 2, True)}"$ + End If +End Sub + +Private Sub CrearQR(NOTA2 As String) + Private texto As String = $"https://wa.me/5215637241894?text=PAGARE ${NOTA2}"$ + i_qr.Clear + If texto.Length>0 Then + i_qr.SetBitmap(qr.Create(texto)) + Log("QR Creado ->"&texto) + End If +End Sub + +Private Sub b_cerrarqr_Click + i_qr.Clear +' If y = 1 Then + p_transPagare2.Visible = False +' p_gestion.Visible = True +' p_gestion.BringToFront +' Else +' p_qr.Visible = False +' End If +End Sub + +Private Sub b_confirmar_Click + Dim cmd As DBCommand + cmd.Initialize + cmd.Name = "selectPagareConfirmado_Demo" +' cmd.Parameters = Array As Object(Subs.traeCliente, NOTA) + cmd.Parameters = Array As Object(NOTA) + reqManager.ExecuteQuery(cmd, 0, $"pagareConfirmado_${NOTA}"$) +End Sub + +Private Sub p_transPagare2_Click + +End Sub + +Private Sub b_abonar_Click + liquidarPagare +End Sub + +Sub liquidarPagare + p_transAbonoPagare.Visible = True + p_transAbonoPagare.BringToFront +End Sub + +Private Sub p_transAbonoPagare_Click + p_transAbonoPagare.Visible = False +End Sub + +Private Sub b_cancelaAbono_Click + p_transAbonoPagare.Visible = False +End Sub + +Private Sub b_aceptaAbono_Click + p_transAbonoPagare.Visible = False + Private sn As Map + sn.Initialize + sn.Put("number","5215545815654") + sn.Put("message","Hola") + Dim jg As JSONGenerator + jg.Initialize(sn) + Log(jg) + Dim HTTPTask As HttpJob + HTTPTask.Initialize("HTTPTask", Me) + HTTPTask.PostString("http://192.168.0.190:3018/v1/messages", jg.ToString) + HTTPTask.GetRequest.SetContentType("application/json") + HTTPTask.GetRequest.SetHeader("Accept","application/json") + wait for (HTTPTask) JobDone(HTTPTask As HttpJob) + If HTTPTask.Success Then + 'Json.Initialize(HTTPTask.GetString) + Log("1:" & HTTPTask.GetString) + Log("2:" & HTTPTask.ErrorMessage) + End If + HTTPTask.Release +End Sub + +Private Sub et_montoAbono_TextChanged (Old As String, New As String) + Private cs As CSBuilder + cs.Initialize + If New.Length > 0 And et_montoAbono.Text > saldoPendiente Then ' Si el credito que quieren es mayor al autorizado, solo se permite el autorizado. + et_montoAbono.Text = saldoPendiente + End If + If et_montoAbono.Text <> "" And New.Length > 0 Then + Private msg As String = "" + If (saldoPendiente - et_montoAbono.text) > 0 Then + b_aceptaAbono.Text = "Abonar" + Private cd1 As ColorDrawable + cd1.Initialize(Colors.RGB(223, 163, 0), 10dip) + b_aceptaAbono.Background = cd1 + l_montoRestante.Text = cs.Color(Colors.black).Size(12).append($"Restan: $${NumberFormat2((saldoPendiente - et_montoAbono.text), 1, 2, 2, True)} ${msg} "$).pop.color(Colors.red).Append(CRLF & "¡No se puede realizar la entrega!").PopAll + Else + Private cd1 As ColorDrawable + cd1.Initialize(Colors.RGB(0, 174, 0), 10dip) + b_aceptaAbono.Background = cd1 + b_aceptaAbono.Text = "Liquidar" + l_montoRestante.Text = cs.color(Colors.green).Append("¡Listo para liquiar!").PopAll + End If + +' l_montoRestante.Text = $"Restan: $${NumberFormat2((saldoPendiente - et_montoAbono.text), 1, 2, 2, True)} ${msg}"$ + End If +End Sub + +Private Sub p_abonoPagare_Click End Sub \ No newline at end of file diff --git a/B4A/C_Principal.bas b/B4A/C_Principal.bas index 536b592..fc0cf00 100644 --- a/B4A/C_Principal.bas +++ b/B4A/C_Principal.bas @@ -856,6 +856,13 @@ Sub cargaGeneral reqManager.ExecuteQuery(cmd , 0, $"hist_datos_${ALMACEN}"$) LogColor($"Pedimos hist_datos - ${ALMACEN}, ${e_ruta.text}"$, Colors.red) reqs.Add("hist_datos") + + cmd.Initialize + cmd.Name = "select_abonosp_GUNA" + cmd.Parameters = Array As Object(e_ruta.text, ALMACEN) + reqManager.ExecuteQuery(cmd , 0, $"pagares"$) + LogColor($"Pedimos pagares - ${e_ruta.text}, ${ALMACEN}"$, Colors.red) + reqs.Add("pagares") End Sub Sub JobDone(Job As HttpJob) @@ -895,12 +902,13 @@ Sub JobDone(Job As HttpJob) Dim CAT_CL_LONG As String = records(result.Columns.Get("CAT_CL_LONG")) Dim CAT_CL_LAT As String = records(result.Columns.Get("CAT_CL_LAT")) Dim CAT_CL_BCREDITO As String = records(result.Columns.Get("CAT_CL_BCREDITO")) + Dim CAT_CL_LIMITECREDITO As String = records(result.Columns.Get("CAT_CL_LIMITECREDITO")) Dim CAT_CL_IDALMACEN As String = records(result.Columns.Get("CAT_CL_IDALMACEN")) ' Log(" ++ insert into kmt_info: "&CAT_CL_RUTA&","&CAT_CL_CODIGO&","&CAT_CL_RUTA&","&CAT_CL_NOMBRE) ' Log(records(result.Columns.Get("CAT_CL_IDALMACEN"))) If Not(CAT_CL_CODIGO.StartsWith("N")) Then ' Log($"INSERT ${CAT_CL_CODIGO}"$) - Starter.skmt.ExecNonQuery2("INSERT INTO kmt_info(CAT_CL_CODIGO,CAT_CL_RUTA,CAT_CL_NOMBRE,CAT_CL_ATIENDE1,CAT_CL_ATIENTE2,CAT_CL_TELEFONO,CAT_CL_EMAIL,CAT_CL_CALLE,CAT_CL_NOEXT,CAT_CL_NOINT,CAT_CL_CALLE1,CAT_CL_CALLE2,CAT_CL_COLONIA,CAT_CL_MUNI,CAT_CL_EDO,CAT_CL_CP,CAT_CL_LONG,CAT_CL_LAT,CAT_CL_BCREDITO, gestion, SECUENCIA, CAT_CL_IDALMACEN) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,0,?,?)", Array As Object (CAT_CL_CODIGO,CAT_CL_RUTA,CAT_CL_NOMBRE,CAT_CL_ATIENDE1,CAT_CL_ATIENTE2,CAT_CL_TELEFONO,CAT_CL_EMAIL,CAT_CL_CALLE,CAT_CL_NOEXT,CAT_CL_NOINT,CAT_CL_CALLE1,CAT_CL_CALLE2,CAT_CL_COLONIA,CAT_CL_MUNI,CAT_CL_EDO,CAT_CL_CP,CAT_CL_LONG,CAT_CL_LAT,CAT_CL_BCREDITO,"0",CAT_CL_IDALMACEN)) + Starter.skmt.ExecNonQuery2("INSERT INTO kmt_info(CAT_CL_CODIGO,CAT_CL_RUTA,CAT_CL_NOMBRE,CAT_CL_ATIENDE1,CAT_CL_ATIENTE2,CAT_CL_TELEFONO,CAT_CL_EMAIL,CAT_CL_CALLE,CAT_CL_NOEXT,CAT_CL_NOINT,CAT_CL_CALLE1,CAT_CL_CALLE2,CAT_CL_COLONIA,CAT_CL_MUNI,CAT_CL_EDO,CAT_CL_CP,CAT_CL_LONG,CAT_CL_LAT,CAT_CL_BCREDITO, gestion, SECUENCIA, CAT_CL_IDALMACEN, CAT_CL_LIMITECREDITO) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,0,?,?,?)", Array As Object (CAT_CL_CODIGO,CAT_CL_RUTA,CAT_CL_NOMBRE,CAT_CL_ATIENDE1,CAT_CL_ATIENTE2,CAT_CL_TELEFONO,CAT_CL_EMAIL,CAT_CL_CALLE,CAT_CL_NOEXT,CAT_CL_NOINT,CAT_CL_CALLE1,CAT_CL_CALLE2,CAT_CL_COLONIA,CAT_CL_MUNI,CAT_CL_EDO,CAT_CL_CP,CAT_CL_LONG,CAT_CL_LAT,CAT_CL_BCREDITO,"0",CAT_CL_IDALMACEN,CAT_CL_LIMITECREDITO)) End If Next Starter.skmt.TransactionSuccessful @@ -1339,6 +1347,24 @@ Sub JobDone(Job As HttpJob) Next Next End If + + Dim result As DBResult = reqManager.HandleJob(Job) + If result.Tag = "pagares" Then 'query tag +' For Each records() As Object In result.Rows +' For Each k As String In result.Columns.Keys +' Log(k & ": " & records(result.Columns.Get(k))) +' Next +' Next + For Each records() As Object In result.Rows + Private NOTA As String = records(result.Columns.Get("NOTA")) + Private CLIENTE As String = records(result.Columns.Get("CLIENTE")) + Private ALMACEN As String = records(result.Columns.Get("ALMACEN")) + Private SALDO_PENDIENTE As String = records(result.Columns.Get("SALDO_PENDIENTE")) + Private RUTA_PREVENTA As String = records(result.Columns.Get("RUTA_PREVENTA")) + Private REPARTO As String = records(result.Columns.Get("REPARTO")) + Starter.skmt.ExecNonQuery2("INSERT INTO PAGARES(NOTA, CLIENTE, ALMACEN, SALDO_PENDIENTE, RUTA_PREVENTA, REPARTO) VALUES (?,?,?,?,?,?)", Array As Object (NOTA, CLIENTE, ALMACEN, SALDO_PENDIENTE, RUTA_PREVENTA, REPARTO)) + Next + End If If result.Tag = "agrupaAlmacen" Then 'query tag If result.Rows.Size > 1 Then @@ -1464,6 +1490,7 @@ Sub e_ruta_EnterPressed Starter.skmt.ExecNonQuery("DELETE FROM TABULADOR_MONEDAS") Starter.skmt.ExecNonQuery("DELETE FROM TABULADOR_BILLETES") Starter.skmt.ExecNonQuery("DELETE FROM RUTAA") + Starter.skmt.ExecNonQuery("DELETE FROM PAGARES") B4XPage_Appear End If ' Starter.waypointsOrdered.Clear diff --git a/B4A/Files/cliente.bal b/B4A/Files/cliente.bal index 8806a17508b7b59464ed3a433dd60f6b2204ada3..c6d2a92add1fc9fc0a13592d3016b82f9a0f6e67 100644 GIT binary patch literal 30453 zcmeHPdypK(dEb@pgjUFy1Q1}r%pD-GL1*do77uA}ZzUa^?#`#>5gfdl+a2Al+1p)a z_w=w$EN~nr#t$HdfC<4#h-2)$Y?GHAoH!&vzz#N!;U6dERHc%XQxsI?QKpJ2<@ft~ zre|h%M>})7=e;Wmzy7-Wdw1X7^d}ODqo*VitMEOBvJxd-Xp|0>8b?nDJmgkx zw9Q)0ve`eAH)pC9(>{&;BMXg2wc_-yK#OX4o5CwtwT77ncJ=MPhKy|$ON}bW&*Tec zrC^m65@*yc4i;C2Hp{k6`!@SjRjXDGmh5@c?niYbKelg*GtcDb&6=q&D%EVIVOz5% z_6Cfp^!~|VB9EqXll!?itC63tRvJ}Voa{7?} zSupLQX|rkX*!~>9OZnUEpU3x5W})7w&fie74m*UoA+IroS~+hvN>-(4abZK_=8RQ# zaJgiubC5H;pwm=c<PlVS@D>B8qen@ zbLnxXui7xnQ|7E`Te3VepE1j2i+d}Z`9ihK%@e8#j{q!iD^9;vtg?CB%vY-OGq$x_ zA=k}vv08xpF_FuE@~}xeBGy>TeWP%>g>Xm`Fn0jk3RMENZyV+-}1#{2c93h{QIllF*$ejeJ`#~7G8Sq)OR1a=lqYZ z%a3op`%^q z<-ikPdgY<{tB>FOf6x7R`M+Fr^uIoj6}^N)ODoiKM{5>!b#%t8mkL9pR=qS^vFxFJ z7DA{Kl4+w2;7P!88=Y7|n=vb;dBl=xWpu%oZ*IG2n}^MrvPH#gCO+!)4P~n3s_oWj zMnmqfU>7ZWrfL^0TSj=*8%xE;9Q_A8ch#oR7pgYaKW!FE3*yYGHiBG3mPKDNp52|x zPmk@{o1=HJDqLcb4#heIvFJW=y zSY6^qiYH;$^LW@2)BUwT|D z7+EIAIB6qS-9VG*8>L&S-Xb`ug!4=^oO{;+C9c-H@Hmjb+l~)Ta&PTyy?R zf*F-#+e8`;^D+KpcgU?czJ-LF6JRbI_EWG%s}*7PT&dDvBfn)YtduIXg$B)%YaY#J z#=wL8#P$0|veWyyw3=D3ABI06Uk>Ap!6j}CvkOUu#V-6wGPN<7(30=sS;)4u;biPP zNP80}E$3A#%=BVhl47H1X*7d)o4MYmq?kihHoQY{wzN-)xs{R0@llf5N>%eE;#`?o zuFc6Y1<9?OpK=TxA|0FC%rurNAbZ`gp0nq&K$@JG^qM!2Vs>A8Y@C1`Z-}_BS}Ywb z6=WJ;5=n{Zl$pLOH#x;NOsTSK;Z86UN2X1$MigI8&IR-MLl*AAH)4)y8)ef_bVxL- zPGD-d+5`#Z#JpllL0nG(_DEM*|= zwu@Ei+${WZ&R^29#n&<{En7WdZKHUFxRK#mr!ENFL;~&^P@1-LA>Mh9ZNuy3DO*%0 zU5a2IPQ21S%o-1$G}TdfYLKT=%aR3SBNapr%Ut5vJWdw#C0n{Saf!|;nTwgiVU)4j zl3wqmGtADk-6$1ss*}YJtHY0+MFrVA0&V7eIUe$)W1Fx+9RQ_aJD1_!B~WlY&Zt|3 z;7Nu%5Jv@Ta1#8C4&n(n$Td<1ekwW><(9EVINYrMn zL%0^;D0mgb9vH2JjA>3mR@ad{i1Vc0jBL7TjAM9}K$h@^fn&YP5i&6&7bQxq5u4OC z329~A3YpY;faGRcPN{C#l!GSStPU>H!ZB`CkOpmjqS9%@6p8L29_|9X^FE!1Xa+R2 zY{+@{$;WmWK9{T9Y(qkz<8mY4G%#p$Iq*kj*^uM#laJA-BofDV?gH>5RY|1yOGH_Xqaw-K+Nw{6ybncyK_%xA%9Us+VG* zl6(da;Q*)9I}uh8`Q0e1g&$;_=7-*?-j47iAsZ)2k1=!DwxFX`^|Qr5B}q4`SEDHr zuY1N|4!KG7l!C(Nr!8YHM~7aDfl3?3P{)KZMD`d%HU$|&M7)H*yojTv&A-veMhiqfwrigbKoVL=p$yWppfhn*PX zU;o%u!STHHh%x>f*+g)>EMg;`sZDtJw3$~Wydn`3-3kEeejv@ukrZ!5GzSe-#2iJ@ z$th8EZjd)7GF${pf}UV0<||S96IaQTHz%oU@X*rU$(CJsq)|lEM4%)*f|APMF-jnd zhnAyHBj`0eQ+Wh6A@DK)(TFJk21=5~toNfSp;7J%6Mee@DIUM6HDV9g&{K^d!PpwH z7lV4E5mcZ>YQz|ZDvh`nkobt}0Qk&j9Mx84?L%vSBE*Pj2ooq`GLrx#7E()7@5Mvx zi?f8-7iSD|a~ds)CWM=Q$#N%8c0 zK*G}-0C;{kl7mI|a4Kg*kxySc-*zLqT7@HGxd~kZC_=y>K<^;D=W0TDPl7?-pU|uQ z0?^Yal4ix^deE!UsS1II00_Tt24J8h*{pZc#;XzWB=MU;IE3G=u_Ow=NiYV#e-Y@t z;WxEW_|4cR{2ok3)bCp`;w16={g|q!{3gK|{LTYi@f+qS>{^AE5tO)5o9T@Zcmja% z`xyWRN=JWk07xf^-zKJN=65YDSBj$FBpAx?8FU7-q%~;i4ZoSG3BP%I7Jm07Bl5d| z5hsb?^nuO%4$V!Y@S6lf`F#yKgZzF2{0W5`&!1p`lb?E!m#IdHp%w;0x{1U}ly*mc ze=uDQ9Ph~AE~*{`Mzd55Wd*b78bFcR3<6ZNU{t*yEx{8533^iD8To`!)w2R%iV}Yt zz+$}4u~QrZ4AdeODu{t1>()CNWDAOX`uObgGQ%a1z#LZ4Qwfk@R}%PF5a>z*6%dFg zfp~djk8Ob2ZnFe-MYjQrZn6Oqj3I#!06mSe;&}1Cm&FFYgIY8R&;ZXzQFm@XUg6jP z^F)yV`wf(iHV`kf?6CxH#R_{W0TPTMfilp85{PaCArjCw5Lp6Vu6YHPvkYYscUU5r z;~3j1JoE!67#?EYYQ0c;rySZ^3B|nLx+|fsw^|8diHWvn!FhBv>r3ZcVjV`wS&%aY zqZSDU_2o*mbhziDh?Um38T0#-o$c21jGo>8k88J#utCpx8CnKVK-qU=#)^tv2LP!I z?h-(vHERKIi>f)&3Ecm80*q{bC0s>^UW$QAn=4_)Ty7#oGd-LLfwt>gd98UrVFha5Vts@3l;pWioeCA>F zHtUNMy-x7w4}HXV3B!XK90>;XCH#m%@3s>qbrg>@iub4Vjfe|Dt;wQ)5JdupFOOq} z?P<;bq9&g6QQ(Qzu-`!Gcqv~1(vrol4`T8VIYfzF7~LcX5)8_L=GC9L8qYRAX7~`A z(`+^dMW`Dj3I$v0(wvat@&Ft8_*Kq zp;{zB7iyq%l)y)Tv}6)EhRK^H5F>xX=q4K=!59*_1L#2s>_SV>3x#FSAvU1%Hv$Gq zM+w{sq$QKUM=^O%B|w5PB=E~X4@w|<{uUyE`$1A{AhHBLh7n69fnUMoJ(U0n#*o0r zfgY4V^!zPE0y=+-EP-ELN(ua0uO&c&F(mMb772U-EkQ37GY*`VjB5k9tafbR&6Poa zb#O4`wjT^>e@XvIbTnIRj0~E$>%k0~1cUk#o6k%(8c51>zPYq!5r5j@j}g1j8m4$bts%kKT5~rB^+s!S&KdvQbq^M?WbyW1 zOx`Sq7&+%b3=hhI1cP!o;kk)OkYH@B`633z*P3>DjrKJ+b=$lQZ1)T>v1t3XkB4kOYHrxC$+yzX$j-I+X+xiM!-pYB_xJ z2wJ^g)@D%~L_vpoouu>I=G~}zc6%0TLf~59iMPKQEe1-*%<>O_r0jMHB=CorybB5N zM-M>>kYEf6tO0r&WyNtkx{`pt(bp2-;tZ6I68Iw^Etv%V7?XD)f%`E$C;<|TA%Q;u zx+{V1Y~Zg!DQE-Npv6GxD1om4X~`t;RZQN61n6pm5+K1C66nSTsN|rH{h$W{0BvG7~6y15}o%#=sY>oTU9sj>4$@pPB)oL#VBvI=W0Acg{53w>{ z9_>yc{4;*DE`*+4nYu|tS_dE`B9UNF7s78ms0cezQh$nvvPt*GV-;FD#ie%nWEJB? zBjV?i80nlx3V;;1F99UnUJHO(M|2@Xdxh7Zf#v{;D33wl89ao^oKl!fwx5ZTBC^NZ z(^1ohIoUH2gP~ioh$KCu`8RAx(9x>;cVTt|mE>A<>D6dT#B2Vyr1*^C4k^`$ukiYF zpz5Ui~_!dfk;%`}f5)Xd* zG*&!K#6%HZQS*10VGBx|*Kf7vrrHy5m!hNuf>D74J)uxUdN*WnXp%|}rBUQ%L?Vxe zQ5!+&oTPGHo~B=fnh>Bf7J>dd00SlYDjov_P(0OOrB5Ea@l=xQ;`%epJ^SBsAhT`I zvqf_6#}BNP@WQCTPhZUN&@#UeX%`;;9z7vSLF3aLG*D^tPPQXpZ%`>nFsKv}!oyP- zlt%G>NdC_tycmt3?Tbd73qUl2cNzvtlFBkb07YqpK&U8<7z6Z%X~f*zoJf>w<0o#y zkodxd!SOLQB5}*9!SS+)b{g?CdU~o6Bp6#G7}3%w-D|`Hpt4Afz(_|oJm|v!m6pVh zkfg#Gv?5yS@DD)M3TvR!CPLC5N`xe`$K}PQ4%=V~!Yoiz=JV6|_RnXrxK4~ApM^0* z_83Dp1ycti4x)%N2u&Tx6k*K!00dKqL5$R^(UgGJk~+Krk>+RT?VrzqAzk_=()_RrhVAy!rbV4!rog3AF(Md~Qm(2-O5b~)2OVyaf*Y(s16 zCOigEk|^G~&p<`~y;zP`WKqz!kzkPbCp=L-5A-yOcj+9R>&zg$6V+zaL~I`iApE`= zfPvES=cq(HN&NmUrV8PA>#5~3Aa~+73C7^}_ki9Te)FI&{MLEJVA7{21L#KGm!Ytt z&MUV7I!XL~0aNvq-y|4=-`@wi;G;B!13)@S{Qf6Q z)y(g%-u_8~q5Pgfr_PCYq9Qj$z2WznASe9Z1VH%x)A;t!A7F9K{Jy)Jx2=+341T`| c^xp8Bb|L&GApAZj8PT6$K+9=2*p^8AKa>?NfB*mh literal 18350 zcmeHOeQaCR6@Mm4sUZUfYYU8z*Oo$|5Spav2VbpgyRE^oL*lkuH*jCKw|5Dzw`XQoVb23 zj^=44(tSSn+JAo~gX}wnG z*xotKENUiM`%)9RC_YPht#0V$qW%$d2GZK3Uh*g)eQNAX8{+2ad_0!P@dTy3&aDSM z^bmJS=X2RyEG=v;AJdZjMvQ0qb2R;bM`>EUj7rdns<)M1CW#i2$VYO6zSbEq9uKC?f0AWKE6 z`KoD@3r1BdiT%d3vd@0f@4>{JW?qI5{zR+~--o=0R+lwzO$l$fgO8 zO;aZtjLOh&Z2D{uO=q+DANA1Zdg${!^v68(Di6KdL$C4B=X>Z2JoJSg`r{t@A`gAB zhrYx^U+SS%553kyuk+CBJv8lZpLc_Yz8th|w<|zzM7t90Di0r|@)X*o$7y|Hb7P%#Dw|)*mUne(Tt8pLqD9`>)BTx7~Mqm3dCj%q?%u6ffKN zc6@tH{ouLe$TN=~z4*cR@A~sIPyRi-@{yJA|LVOp?;QT=58iot_Qn&3{`vA>d;Ylo z=--}&Mo**BV+yt0(W*{cCMLC-Q5Z<*HDkK0n**bIU9)oweXWjpizOWTf>t(Wkq;{6 z#GEOgJa*C4j%br5od##4DwWY4_+31NJiikYuciS=3Eg;dT!i#rh26012XE z60kzWg#P1N(U_}oUd2SBs*76m`E+tmEQvr7Iaf^0 zl}Zx@Q`gHBkGL((74@7^FUib1w0Vs-q>aj0O{-Ql6S6>vr_{A+Dp=7Y@ciHp^1_5e53O4S)n zEL$oW)tYg)*eH|DBngWr8M8Z8Dc561^jgKTKf7E(tIWhoaLHL%l*cE2)DaG+!ziUx zp;E5#s8y|4G|JOlQNw3RPa9>OderJit!pHc9UqOQ#hLZH>eQ@`Pq8V&8ceZCbj3+a>?op08mp?lI#3~TDDLQc$6O5Z&c8uWy7HWnDh2+6Qa7~qp zZKad2{NatZ7oW&&nyHpF)so2#l2-9ltZ;#Q(+^T)E|ttAVjOVGhhZ*Cq{fr+cq*IW z*bYt=KaesaIgyJcvb^61H#;L+X})+ioz0|TG9>b4(KhzuW5RW7lO0?T69tkoG)zl* zsy+I2rlK~~mnmDsE}Epz1Bf$CjZGriR%CEQ4A>~xgtOJd84}Jm*Q2*H8br7%Ca=ka z?E;BiGzx166>$qh@`j`YYm}S9kob_giHMA9RZZAK?6DT*=k9DeLFY{%g#lx=sH<`a znK?{cr68u#saX_WvxX@{Td4Hzywtr^Zw&P;uL@m8-Fj|_gE6yi6y{15InIz(;z>Cx zlU?{nxL>XUO=MuZ7{;n<3Av&i+qnzGn^s4O@{=>8c1;m^2rLRALy6K6WSoL{gcT>q zMiU9N;ffRZA;`j^`J)US{`4|s^hFrPQJRPW+NZE&>x@4cL5H5um`15O@m$ zIzr%FIB_@xZtNxkH!Xs|uHZ3%)lD%#fgupsiRo4h6d!wAT=+NO1VexU=*GaGV0aPm zZ#xD!uA;S#fnAu?wHSzD^X3@n2muNVfxvD|_apEYI2|G2#6VyK;@HwcAOQ+UD$yh! z?me)_X72^D56zmr@On6bv3A!3#rC7QcVudDiLC^^YFr}s%tApohZA&MQCbLs9Hn=$ zTk94KH2ce8D`L|aT8kDzQ&bWg@sL}K)|6X|D*JCO3iSKSC^&s5zq>M+VtEbjTnW3| zv1>c8aWkVEx8JejmhVjd%t`InqG7;u3$nwSPwCC#Vfn!rDDj$GLGXx+xJN56y_FMI zD!t=)u-x$03KQr$s;KBhUcy66%PpNcNa_Gi_FHrfIC9^MsaPoUnx44`yG@5U31d7AW}Lyaq$yXPD{605|p{z(`lo+9J@^ zvg!adY)0T%Cow>QM1Z%2{H($=x`bGuR(>Q7g5%_nmf46&RgmCKEU}P_G>~94o-7u2 zVcg2c8$cm-DbfGlOWr52T{9Am>oUko-ok7|fgQ!dE(ll(0{3E_AaEB5LEsG#Dq7oE zh+|UM5cniEUsePtup%`*>)LP#xTQ)LV&KqnBS3*2Autmdfg3Q>y$_ri;6)q` zflpzD6$2l>V!#xrQRK1ME5@fW(j2jk+bfMBC)ca!Eb@x+I@taSjspGu()tzSHq0GC zi{6fh^@@QCT@v3gZXAEy2K##KACM#ho`V4K8dl&cnrQEw$GHVD(lAdRRM#@+VQk(4 zhah(sRyW~5fqooLT1jh|ZXsZQITO5&qlMkLb*cxak`7$QO+rxD5GY{tWkrAjLm)sa z`VpWuONjvofsGI#F%bA&hBZ*v5SYT|%?O03->|wV1}HED0@Il8M_?B?egqDJGVBocfJ~iq^J%<8|3J1PpAxtO!tG2n6oHbUy;Y>$esNJPwf(1A!5^6DzugKna^K zD*_Z40)bgf_ahLzerth%Q@;g9pxjLaD$9)k1%^PNx&VRif#c6Y!D=Dr9ylu!HU>U} zEv*W}j2m(4n;9Up^hrm5p z(KQ6|bWnlo?~ItHD)hQNK;d|45oz>X032?Y3KpjFl10)eX$nBlSz3q1>g zQ>*GVF-}{Sixnet&6Q^*i62bCH!f?W#Y>pXOM9|KQJ@&iCf8*@{D35+8a^pl=wy3R5+EO^95x&}%5Ljn{k)Q`Vr#U$TkUd>uW%*DUpS zbdJ|Je+KCMeaS{_;zYqZbR-<`+4vnDGW99xHKA@Ok*JGaJUvjPL5R3asMuZ`bnk0E&cT+ z1^RIq0;lCaEPV@u76OWLT*9sgr`rZ@`+r#4gIR9eu0l@)+zbIyBOC%pMQi)b;G>w- zH3S~R<{cm~hUI<)C@=&9t1;b1z%t-c5nut}M}W$yXl)UA9Fw|+z_+n^2MADiKLQjO z0)Zzm-A16Z82C9P`4PAY92KoC0#9O6*ARFLn|FW!Q>`BX3Jih3YD~8g2pa?RaW@Nn TfSw~\n~)~\n~SetApplicationAttribute(android:icon, "@drawable/icon")~\n~SetApplicationAttribute(android:label, "$LABEL$")~\n~CreateResourceFromFile(Macro, Themes.LightTheme)~\n~'End of default text.~\n~~\n~''''' CAMBIA LA CLAVE API~\n~AddApplicationText(~\n~~\n~ ~\n~)~\n~~\n~CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~SetApplicationAttribute(android:usesCleartextTraffic, "true")~\n~AddManifestText()~\n~AddPermission(android.permission.ACCESS_BACKGROUND_LOCATION)~\n~'AddManifestText()~\n~'AddManifestText()~\n~'AddManifestText() 'in order to access the device non-resettable identifiers such as IMEI and serial number.~\n~AddManifestText()~\n~'/////////////// FLP y FBMessageing MOD Inicia /////////////////////~\n~'CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~'CreateResourceFromFile(Macro, FirebaseAnalytics.Firebase)~\n~'CreateResourceFromFile(Macro, FirebaseAnalytics.FirebaseAnalytics)~\n~'CreateResourceFromFile(Macro, FirebaseNotifications.FirebaseNotifications)~\n~SetServiceAttribute(Tracker, android:foregroundServiceType, "location")~\n~'/////////////// FLP y FBMessageing MOD Termina /////////////////////~\n~~\n~'Si al cargar un mapa de google mande este error "java.lang.NoClassDefFoundError: Failed resolution of: Lorg/apache/http/ProtocolVersion". agregar la siguiente linea:~\n~AddApplicationText()~\n~~\n~'/////////////////////// App Updating ////////////////~\n~ AddManifestText(~\n~ )~\n~ AddApplicationText(~\n~ ~\n~ ~\n~ ~\n~ )~\n~ CreateResource(xml, provider_paths,~\n~ ~\n~ ~\n~ ~\n~ ~\n~ ~\n~ )~\n~AddManifestText()~\n~AddManifestText()~\n~AddManifestText()~\n~AddManifestText()~\n~~\n~AddPermission(android.permission.REQUEST_INSTALL_PACKAGES)~\n~AddPermission(android.permission.INTERNET)~\n~AddPermission(android.permission.INSTALL_PACKAGES)~\n~AddPermission(android.permission.READ_EXTERNAL_STORAGE)~\n~AddPermission(android.permission.WRITE_EXTERNAL_STORAGE)~\n~AddPermission(android.permission.READ_PHONE_STATE)~\n~AddPermission(android.permission.WAKE_LOCK)~\n~CreateResourceFromFile(Macro, JhsIceZxing1.CaturePortrait)~\n~ ~\n~SetApplicationAttribute(android:largeHeap, "true")~\n~~\n~AddManifestText(~\n~ ~\n~ )~\n~ ~\n~ SetApplicationAttribute(android:allowBackup, "false") +Library4=bctoast +Library5=bitmapcreator +Library6=byteconverter +Library7=camera +Library8=compressstrings +Library9=core +ManifestCode='This code will be applied to the manifest file during compilation.~\n~'You do not need to modify it in most cases.~\n~'See this link for for more information: https://www.b4x.com/forum/showthread.php?p=78136~\n~AddManifestText(~\n~~\n~)~\n~SetApplicationAttribute(android:icon, "@drawable/icon")~\n~SetApplicationAttribute(android:label, "$LABEL$")~\n~CreateResourceFromFile(Macro, Themes.LightTheme)~\n~'End of default text.~\n~~\n~''''' CAMBIA LA CLAVE API~\n~AddApplicationText(~\n~~\n~ ~\n~)~\n~~\n~CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~SetApplicationAttribute(android:usesCleartextTraffic, "true")~\n~AddManifestText()~\n~AddPermission(android.permission.ACCESS_BACKGROUND_LOCATION)~\n~'AddManifestText()~\n~'AddManifestText()~\n~'AddManifestText() 'in order to access the device non-resettable identifiers such as IMEI and serial number.~\n~AddManifestText()~\n~'/////////////// FLP y FBMessageing MOD Inicia /////////////////////~\n~'CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~'CreateResourceFromFile(Macro, FirebaseAnalytics.Firebase)~\n~'CreateResourceFromFile(Macro, FirebaseAnalytics.FirebaseAnalytics)~\n~'CreateResourceFromFile(Macro, FirebaseNotifications.FirebaseNotifications)~\n~SetServiceAttribute(Tracker, android:foregroundServiceType, "location")~\n~'/////////////// FLP y FBMessageing MOD Termina /////////////////////~\n~~\n~'Si al cargar un mapa de google mande este error "java.lang.NoClassDefFoundError: Failed resolution of: Lorg/apache/http/ProtocolVersion". agregar la siguiente linea:~\n~AddApplicationText()~\n~~\n~'/////////////////////// App Updating ////////////////~\n~ AddManifestText(~\n~ )~\n~ AddApplicationText(~\n~ ~\n~ ~\n~ ~\n~ )~\n~ CreateResource(xml, provider_paths,~\n~ ~\n~ ~\n~ ~\n~ ~\n~ ~\n~ )~\n~AddManifestText()~\n~AddManifestText()~\n~AddManifestText()~\n~AddManifestText()~\n~~\n~AddPermission(android.permission.REQUEST_INSTALL_PACKAGES)~\n~AddPermission(android.permission.INTERNET)~\n~AddPermission(android.permission.INSTALL_PACKAGES)~\n~AddPermission(android.permission.READ_EXTERNAL_STORAGE)~\n~AddPermission(android.permission.WRITE_EXTERNAL_STORAGE)~\n~AddPermission(android.permission.READ_PHONE_STATE)~\n~AddPermission(android.permission.WAKE_LOCK)~\n~CreateResourceFromFile(Macro, JhsIceZxing1.CaturePortrait)~\n~ ~\n~SetApplicationAttribute(android:largeHeap, "true")~\n~~\n~AddManifestText(~\n~ ~\n~ )~\n~ ~\n~ SetApplicationAttribute(android:allowBackup, "false")~\n~ ~\n~ ~\n~ 'Para que se registre para abrir bases de datos~\n~ AddActivityText(main,~\n~~\n~~\n~~\n~~\n~~\n~) Module1=appUpdater Module10=C_Historico Module11=C_Mapas @@ -2261,9 +2263,10 @@ Module22=DBRequestManager Module23=foto Module24=MAPA_CLIENTE Module25=MAPA_RUTAS -Module26=Starter -Module27=Subs -Module28=Tracker +Module26=QRGenerator +Module27=Starter +Module28=Subs +Module29=Tracker Module3=BatteryUtilities Module4=C_Buscar Module5=C_Cliente @@ -2272,14 +2275,14 @@ Module7=C_Detalle_Promo Module8=C_DetalleVenta Module9=C_Foto NumberOfFiles=1108 -NumberOfLibraries=26 -NumberOfModules=28 +NumberOfLibraries=28 +NumberOfModules=29 Version=12.8 @EndOfDesignText@ #Region Project Attributes #ApplicationLabel: GUNA Reparto #VersionCode: 1 - #VersionName: 4.10.02 + #VersionName: 5.01.25 'SupportedOrientations possible values: unspecified, landscape or portrait. #SupportedOrientations: portrait #CanInstallToExternalStorage: False diff --git a/B4A/GUNA_Reparto.b4a.meta b/B4A/GUNA_Reparto.b4a.meta index 15e8b15..ad2f7f2 100644 --- a/B4A/GUNA_Reparto.b4a.meta +++ b/B4A/GUNA_Reparto.b4a.meta @@ -20,6 +20,7 @@ ModuleBookmarks25= ModuleBookmarks26= ModuleBookmarks27= ModuleBookmarks28= +ModuleBookmarks29= ModuleBookmarks3= ModuleBookmarks4= ModuleBookmarks5= @@ -49,6 +50,7 @@ ModuleBreakpoints25= ModuleBreakpoints26= ModuleBreakpoints27= ModuleBreakpoints28= +ModuleBreakpoints29= ModuleBreakpoints3= ModuleBreakpoints4= ModuleBreakpoints5= @@ -68,7 +70,7 @@ ModuleClosedNodes16= ModuleClosedNodes17= ModuleClosedNodes18= ModuleClosedNodes19= -ModuleClosedNodes2=2 +ModuleClosedNodes2= ModuleClosedNodes20= ModuleClosedNodes21= ModuleClosedNodes22= @@ -78,6 +80,7 @@ ModuleClosedNodes25=2,4 ModuleClosedNodes26= ModuleClosedNodes27= ModuleClosedNodes28= +ModuleClosedNodes29= ModuleClosedNodes3= ModuleClosedNodes4= ModuleClosedNodes5= @@ -85,6 +88,6 @@ ModuleClosedNodes6= ModuleClosedNodes7= ModuleClosedNodes8= ModuleClosedNodes9= -NavigationStack=C_Principal,JobDone,857,0,Visual Designer,cliente.bal,-100,6,C_DetalleVenta,B4XPage_Appear,114,0,Subs,fechaKMT,67,0,C_Productos,b_prodMas_Click,973,0,C_Productos,CreateListItem,892,0,C_Productos,llenaProductos,844,0,C_NoVenta,GUARDA_Click,91,4,C_Principal,B4XPage_Appear,356,3,C_Principal,Subir_Click,541,4,C_DetalleVenta,cuentaProds,472,0 +NavigationStack=C_Cliente,Initialize,102,0,C_Cliente,B4XPage_Created,114,0,C_Cliente,Class_Globals,87,0,C_Cliente,B4XPage_Appear,222,6,C_Cliente,p_abonoPagare_Click,727,0,Visual Designer,cliente.bal,-100,6,C_Cliente,p_transAbonoPagare_Click,703,0,C_Cliente,et_montoAbono_TextChanged,745,6,Subs,fechaKMT,67,0,C_Cliente,b_aceptaAbono_Click,711,6 SelectedBuild=0 -VisibleModules=26,2,16,5,8,27,6,17,12 +VisibleModules=27,2,16,5,8,28,6,17,12,25 diff --git a/B4A/QRGenerator.bas b/B4A/QRGenerator.bas new file mode 100644 index 0000000..fa70268 --- /dev/null +++ b/B4A/QRGenerator.bas @@ -0,0 +1,491 @@ +B4J=true +Group=Default Group +ModulesStructureVersion=1 +Type=Class +Version=6.28 +@EndOfDesignText@ +'version 1.60 +Sub Class_Globals + Private xui As XUI + Public cvs As B4XCanvas + Private ModuleSize As Int + Private GFSize As Int = 256 + Private ExpTable(GFSize) As Int + Private LogTable(GFSize) As Int + Private PolyZero() As Int = Array As Int(0) + Private Generator1L() As Int = Array As Int(1, 127, 122, 154, 164, 11, 68, 117) + Private Generator4L() As Int = Array As Int(1, 152, 185, 240, 5, 111, 99, 6, 220, 112, 150, 69, 36, 187, 22, 228, 198, 121, 121, 165, 174) '4L + Private Generator4H() As Int = Array As Int(1, 59, 13, 104, 189, 68, 209, 30, 8, 163, 65, 41, 229, 98, 50, 36, 59) + Private Generator9L() As Int = Array As Int(1, 212, 246, 77, 73, 195, 192, 75, 98, 5, 70, 103, 177, 22, 217, 138, 51, 181, 246, 72, 25, 18, 46, 228, 74, 216, 195, 11, 106, 130, 150) + Private TempBB As B4XBytesBuilder + Private Matrix(0, 0) As Boolean + Private Reserved(0, 0) As Boolean + Private NumberOfModules As Int + Private mBitmapSize As Int + Type QRVersionData (Format() As Byte, Generator() As Int, MaxSize As Int, Version As Int, MaxUsableSize As Int, Alignments() As Int, _ + Group1Size As Int, Group2Size As Int, Block1Size As Int, Block2Size As Int, VersionName As String, VersionInformation() As Byte) + Private versions As List +End Sub + + +Public Sub Initialize (BitmapSize As Int) + TempBB.Initialize + mBitmapSize = BitmapSize + PrepareTables + versions.Initialize + Dim l0() As Byte = Array As Byte(1,1,1,0,1,1,1,1,1,0,0,0,1,0,0) + Dim h0() As Byte = Array As Byte(0,0,1,0,1,1,0,1,0,0,0,1,0,0,1) + versions.Add(CreateVersionData(1, "1L", Generator1L, l0, 19 * 8, 17, Array As Int(), 1, 0, 19, 0, Null)) + versions.Add(CreateVersionData(4, "4H", Generator4H, h0 , 36 * 8, 34, Array As Int(6, 26), 4, 0, 9, 0, Null)) + versions.Add(CreateVersionData(4, "4L", Generator4L, l0 , 80 * 8, 78, Array As Int(6, 26), 1, 0, 80, 0, Null)) + versions.Add(CreateVersionData(9, "9L", Generator9L, l0, 232 * 8, 230, Array As Int(6, 26, 46), 2, 0, 116, 0, Array As Byte(0,0,1,0,0,1,1,0,1,0,1,0,0,1,1,0,0,1))) + versions.Add(CreateVersionData(23, "23H", Generator9L, h0, 464 * 8, 461, Array As Int(6, 30, 54, 78, 102), 16, 14, 15, 16, _ + Array As Byte(0,1,0,1,1,1,0,1,1,1,1,1,1,0,1,1,0,0))) + versions.Add(CreateVersionData(40, "40H", Generator9L, h0, 1276 * 8, 1273, Array As Int(6, 30, 58, 86, 114, 142, 170), 20, 61, 15, 16, _ + Array As Byte(1,0,1,0,0,0,1,1,0,0,0,1,1,0,1,0,0,1))) + versions.Add(CreateVersionData(40, "40L", Generator9L, l0, 2956 * 8, 2953, Array As Int(6, 30, 58, 86, 114, 142, 170), 19, 6, 118, 119, _ + Array As Byte(1,0,1,0,0,0,1,1,0,0,0,1,1,0,1,0,0,1))) +End Sub + +Private Sub CreateVersionData (Version As Int, Name As String, Generator() As Int, Format() As Byte, MaxSize As Int, MaxUsableSize As Int, Alignments() As Int, _ + Group1Size As Int, Group2Size As Int, Block1Size As Int, Block2Size As Int, VersionInformation() As Byte) As QRVersionData + Dim v As QRVersionData + v.Initialize + v.Version = Version + v.VersionName = Name + v.Generator = Generator + v.Format = Format + v.MaxSize = MaxSize + v.MaxUsableSize = MaxUsableSize + v.Alignments = Alignments + v.Group1Size = Group1Size + v.Group2Size = Group2Size + v.Block1Size = Block1Size + v.Block2Size = Block2Size + v.VersionInformation = VersionInformation + Return v +End Sub + +Public Sub Create(Text As String) As B4XBitmap + Dim Bytes() As Byte = Text.GetBytes("utf8") 'non-standard but still recommended + Dim vd As QRVersionData + For Each version As QRVersionData In versions + If version.MaxUsableSize >= Bytes.Length Then + vd = version + Exit + End If + Next + If vd.IsInitialized = False Then + + Log("Too long!") + Return Null + End If + Log(vd.VersionName & ", Size: " & Bytes.Length) + + NumberOfModules = 17 + vd.Version * 4 + ModuleSize = mBitmapSize / (NumberOfModules + 8) + + mBitmapSize = ModuleSize * (NumberOfModules + 8) + Dim p As B4XView = xui.CreatePanel("") + p.SetLayoutAnimated(0, 0, 0, mBitmapSize, mBitmapSize) + cvs.Initialize(p) + + + Dim Matrix(NumberOfModules, NumberOfModules) As Boolean + Dim Reserved(NumberOfModules, NumberOfModules) As Boolean + + Dim Mode() As Byte = Array As Byte(0, 1, 0, 0) 'byte mode + Dim ContentCountIndicator() As Byte + If vd.Version >= 10 Then + ContentCountIndicator = IntTo16Bits(Bytes.Length) + Else + ContentCountIndicator = UnsignedByteToBits(Bytes.Length) + End If + Dim EncodedData As B4XBytesBuilder + EncodedData.Initialize + EncodedData.Append(Mode) + EncodedData.Append(ContentCountIndicator) + For Each b As Byte In Bytes + EncodedData.Append(UnsignedByteToBits(Bit.And(0xff, b))) + Next + 'add terminator + Dim PadSize As Int = Min(4, vd.MaxSize - EncodedData.Length) + Dim pad(PadSize) As Byte + EncodedData.Append(pad) + Do While EncodedData.Length Mod 8 <> 0 + EncodedData.Append(Array As Byte(0)) + Loop + + Do While EncodedData.Length < vd.MaxSize + EncodedData.Append(Array As Byte(1,1,1,0,1,1,0,0)) + If EncodedData.Length < vd.MaxSize Then EncodedData.Append(Array As Byte(0,0,0,1,0,0,0,1)) + Loop + VersionWithTwoGroups(vd.Generator, vd.Group1Size, vd.Group2Size, vd.Block1Size, vd.Block2Size, EncodedData) + AddFinders (vd) + AddDataToMatrix(EncodedData.ToArray, vd) + DrawMatrix + cvs.Invalidate + Dim bmp As B4XBitmap = cvs.CreateBitmap + cvs.Release + Return bmp +End Sub + +Private Sub VersionWithTwoGroups (generator() As Int, Group1Size As Int, Group2Size As Int, Block1Size As Int, Block2Size As Int, EncodedData As B4XBytesBuilder) + Dim ecs As List + ecs.Initialize + Dim dataBlocks As List + dataBlocks.Initialize + Dim PrevIndex As Int + For block1 = 0 To Group1Size + Group2Size - 1 + Dim BlockSize As Int + If block1 < Group1Size Then BlockSize = Block1Size Else BlockSize = Block2Size + Dim Data() As Byte = EncodedData.SubArray2(PrevIndex * 8, (PrevIndex + BlockSize) * 8) + PrevIndex = PrevIndex + BlockSize + Dim DataAsInts(Data.Length / 8) As Int + Dim i As Int + For i = 0 To Data.Length - 1 Step 8 + DataAsInts(i / 8) = BitsToUnsignedByte(Data, i) + Next + dataBlocks.Add(DataAsInts) + Dim ec() As Int = CalcReedSolomon(DataAsInts, generator) + If ec.Length < generator.Length - 1 Then + Dim ec2(generator.Length - 1) As Int + IntArrayCopy(ec, 0, ec2, generator.Length - 1 - ec.Length, ec.Length) + ec = ec2 + End If + ecs.Add(ec) + Next + Dim Interleaved As B4XBytesBuilder + Interleaved.Initialize + For i = 0 To Max(Block1Size, Block2Size) - 1 + For block1 = 0 To dataBlocks.Size - 1 + Dim ii() As Int = dataBlocks.Get(block1) + If ii.Length > i Then + Interleaved.Append(UnsignedByteToBits(ii(i))) + End If + Next + Next + For i = 0 To generator.Length - 2 + For block1 = 0 To dataBlocks.Size - 1 + Dim ii() As Int = ecs.Get(block1) + Interleaved.Append(UnsignedByteToBits(ii(i))) + Next + Next + EncodedData.Clear + EncodedData.Append(Interleaved.ToArray) +End Sub + + + +Private Sub AddDataToMatrix (Encoded() As Byte, vd As QRVersionData) + Dim format() As Byte = vd.Format + Dim order As List = CreateOrder + 'mask 0: (row + column) mod 2 == 0 + For Each b As Byte In Encoded + Dim xy() As Int = GetNextPosition(order) + Matrix(xy(0), xy(1)) = (b = 1) + If (xy(1) + xy(0)) Mod 2 = 0 Then Matrix(xy(0), xy(1)) = Not(Matrix(xy(0), xy(1))) + Next + For i = 0 To 5 + Matrix(i, 8) = format(i) = 1 + Matrix(8, NumberOfModules - 1 - i) = format(i) = 1 + Next + Matrix(7, 8) = format(6) = 1 + Matrix(8, NumberOfModules - 1 - 6) = format(6) = 1 + Matrix(8, 8) = format(7) = 1 + Matrix(8, 7) = format(8) = 1 + For i = 0 To 5 + Matrix(8, 5 - i) = format(i + 9) = 1 + Next + For i = 0 To 7 + Matrix(NumberOfModules - 1 - 7 + i, 8) = format(7 + i) = 1 + Next + If vd.Version >= 7 Then + Dim VersionInformation() As Byte = vd.VersionInformation + Dim c As Int = 18 + For x = 0 To 5 + For y = 0 To 2 + c = c - 1 + Matrix(x, NumberOfModules - 11 + y) = VersionInformation(c) = 1 + Matrix(NumberOfModules - 11 + y, x) = VersionInformation(c) = 1 + Next + Next + End If +End Sub + +Private Sub GetNextPosition (order As List) As Int() + Do While True + Dim xy() As Int = order.Get(0) + order.RemoveAt(0) + If Reserved(xy(0), xy(1)) = False Then Return xy + Loop + Return Null +End Sub + +Private Sub CreateOrder As List + Dim Order As List + Order.Initialize + Dim x As Int = NumberOfModules - 1 + Dim y As Int = NumberOfModules - 1 + Dim dy As Int = -1 + Do While x >= 0 And y >= 0 + Order.Add(Array As Int(x, y)) + Order.Add(Array As Int(x - 1, y)) + y = y + dy + If y = -1 Then + x = x - 2 + y = 0 + dy = 1 + Else If y = NumberOfModules Then + x = x - 2 + y = NumberOfModules - 1 + dy = -1 + End If + If x = 6 Then x = x - 1 + Loop + Return Order +End Sub + +Private Sub DrawMatrix + cvs.DrawRect(cvs.TargetRect, xui.Color_White, True, 0) + Dim r As B4XRect + For y = 0 To NumberOfModules - 1 + For x = 0 To NumberOfModules - 1 + r.Initialize((x + 4) * ModuleSize, (y + 4) * ModuleSize, 0, 0) + r.Width = ModuleSize + r.Height = ModuleSize + Dim clr As Int + If Matrix(x, y) Then + clr = xui.Color_Black + 'cvs.DrawCircle(r.CenterX, r.CenterY, r.Width / 2, clr, True, 0) + cvs.DrawRect(r, clr, True, 0) + End If + Next + Next +End Sub + + + +Private Sub BitsToUnsignedByte (b() As Byte, Offset As Int) As Int + Dim res As Int + For i = 0 To 7 + Dim x As Int = Bit.ShiftLeft(1, 7 - i) + res = res + b(i + Offset) * x + Next + Return res +End Sub + +Private Sub UnsignedByteToBits (Value As Int) As Byte() + TempBB.Clear + For i = 7 To 0 Step - 1 + Dim x As Int = Bit.ShiftLeft(1, i) + Dim ii As Int = Bit.And(Value, x) + If ii <> 0 Then + TempBB.Append(Array As Byte(1)) + Else + TempBB.Append(Array As Byte(0)) + End If + Next + + Return TempBB.ToArray +End Sub + +Private Sub IntTo16Bits (Value As Int) As Byte() + TempBB.Clear + For i = 15 To 0 Step - 1 + Dim x As Int = Bit.ShiftLeft(1, i) + Dim ii As Int = Bit.And(Value, x) + If ii <> 0 Then + TempBB.Append(Array As Byte(1)) + Else + TempBB.Append(Array As Byte(0)) + End If + Next + + Return TempBB.ToArray +End Sub + +Private Sub AddFinders (vd As QRVersionData) + AddFinder(0, 0, 6) + AddFinder(NumberOfModules - 7, 0, 6) + AddFinder(0, NumberOfModules - 7, 6) + AddAlignments(vd.Alignments) + If vd.Version >= 7 Then + For x = 0 To 2 + For y = 0 To 5 + Reserved(y, NumberOfModules - 11 + x) = True + Reserved(NumberOfModules - 11 + x, y) = True + Next + Next + End If + + For i = 8 To NumberOfModules - 8 + Matrix(i, 6) = (i Mod 2 = 0) + Matrix(6, i) = (i Mod 2 = 0) + Reserved(i, 6) = True + Reserved(6, i) = True + Next + Matrix(8, NumberOfModules - 1 - 7) = True + Reserved(8, NumberOfModules - 1 - 7) = True + For i = 0 To 7 + Reserved(7, i) = True + Reserved(7, NumberOfModules - 1 - i) = True + Reserved(8, NumberOfModules - 1 - i) = True + Reserved(NumberOfModules -1 - 7, i) = True + Reserved(i, 7) = True + Reserved(i,NumberOfModules -1 - 7) = True + Reserved(NumberOfModules -1 - i, 7) = True + Reserved(NumberOfModules -1 - i, 8) = True + Next + For i = 0 To 8 + Reserved(8, i) = True + Reserved(i, 8) = True + Next +End Sub + +Private Sub AddAlignments (Positions() As Int) + For Each left As Int In Positions + For Each top As Int In Positions + AddFinder (left - 2, top - 2, 4) + Next + Next +End Sub + +Private Sub AddFinder (Left As Int, Top As Int, SizeMinOne As Int) + For y = 0 To SizeMinOne + For x = 0 To SizeMinOne + If Reserved(Left + x, Top + y) Then + Return + End If + Next + Next + For y = 0 To SizeMinOne + For x = 0 To SizeMinOne + Dim value As Boolean + If x = 0 Or x = SizeMinOne Or y = 0 Or y = SizeMinOne Then + value = True + Else if x <> 1 And y <> 1 And x <> SizeMinOne - 1 And y <> SizeMinOne - 1 Then + value = True + End If + Matrix(Left + x, Top + y) = value + Reserved(Left + x, Top + y) = True + Next + Next +End Sub + +#Region ReedSolomon + +Private Sub CalcReedSolomon (Input() As Int, Generator() As Int) As Int() + Dim ecBytes As Int = Generator.Length - 1 + Dim InfoCoefficients(Input.Length) As Int + IntArrayCopy(Input, 0, InfoCoefficients, 0, Input.Length) + InfoCoefficients = CreateGFPoly(InfoCoefficients) + InfoCoefficients = PolyMultiplyByMonomial(InfoCoefficients, ecBytes, 1) + Dim remainder() As Int = PolyDivide(InfoCoefficients, Generator) + Return remainder +End Sub + + +Private Sub PrepareTables + Dim x = 1 As Int + Dim Primitive As Int = 285 + For i = 0 To GFSize - 1 + ExpTable(i) = x + x = x * 2 + If x >= GFSize Then + x = Bit.Xor(Primitive, x) + x = Bit.And(GFSize - 1, x) + End If + Next + For i = 0 To GFSize - 2 + LogTable(ExpTable(i)) = i + Next +End Sub + +Private Sub CreateGFPoly(Coefficients() As Int) As Int() + If Coefficients.Length > 1 And Coefficients(0) = 0 Then + Dim FirstNonZero As Int = 1 + Do While FirstNonZero < Coefficients.Length And Coefficients(FirstNonZero) = 0 + FirstNonZero = FirstNonZero + 1 + Loop + If FirstNonZero = Coefficients.Length Then + Return Array As Int(0) + End If + Dim res(Coefficients.Length - FirstNonZero) As Int + IntArrayCopy(Coefficients, FirstNonZero, res, 0, res.Length) + Return res + End If + Return Coefficients +End Sub + +Private Sub PolyAddOrSubtract(This() As Int, Other() As Int) As Int() + If This(0) = 0 Then Return Other + If Other(0) = 0 Then Return This + Dim Small() As Int = This + Dim Large() As Int = Other + If Small.Length > Large.Length Then + Dim temp() As Int = Small + Small = Large + Large = temp + End If + Dim SumDiff(Large.Length) As Int + Dim LengthDiff As Int = Large.Length - Small.Length + IntArrayCopy(Large, 0, SumDiff, 0, LengthDiff) + For i = LengthDiff To Large.Length - 1 + SumDiff(i) = Bit.Xor(Small(i - LengthDiff), Large(i)) + Next + Return CreateGFPoly(SumDiff) +End Sub + +Private Sub IntArrayCopy(Src() As Int, SrcOffset As Int, Dest() As Int, DestOffset As Int, Count As Int) + For i = 0 To Count - 1 + Dest(DestOffset + i) = Src(SrcOffset + i) + Next +End Sub + + + +Private Sub PolyMultiplyByMonomial (This() As Int, Degree As Int, Coefficient As Int) As Int() + If Coefficient = 0 Then Return PolyZero + Dim product(This.Length + Degree) As Int + For i = 0 To This.Length - 1 + product(i) = GFMultiply(This(i), Coefficient) + Next + Return CreateGFPoly(product) +End Sub + +Private Sub PolyDivide (This() As Int, Other() As Int) As Int() + Dim quotient() As Int = PolyZero + Dim remainder() As Int = This + Dim denominatorLeadingTerm As Int = Other(0) + Dim inverseDenominatorLeadingTerm As Int = GFInverse(denominatorLeadingTerm) + Do While remainder.Length >= Other.Length And remainder(0) <> 0 + Dim DegreeDifference As Int = remainder.Length - Other.Length + Dim scale As Int = GFMultiply(remainder(0), inverseDenominatorLeadingTerm) + Dim term() As Int = PolyMultiplyByMonomial(Other, DegreeDifference, scale) + Dim iterationQuotient() As Int = GFBuildMonomial(DegreeDifference, scale) + quotient = PolyAddOrSubtract(quotient, iterationQuotient) + remainder = PolyAddOrSubtract(remainder, term) + Loop + Return remainder +End Sub + +Private Sub GFInverse(a As Int) As Int + Return ExpTable(GFSize - LogTable(a) - 1) +End Sub + +Private Sub GFMultiply(a As Int, b As Int) As Int + If a = 0 Or b = 0 Then + Return 0 + End If + Return ExpTable((LogTable(a) + LogTable(b)) Mod (GFSize - 1)) +End Sub + +Private Sub GFBuildMonomial(Degree As Int, Coefficient As Int) As Int() + If Coefficient = 0 Then Return PolyZero + Dim c(Degree + 1) As Int + c(0) = Coefficient + Return c +End Sub + +#End Region \ No newline at end of file diff --git a/B4A/Subs.bas b/B4A/Subs.bas index c9d8970..a5c6303 100644 --- a/B4A/Subs.bas +++ b/B4A/Subs.bas @@ -926,4 +926,5 @@ Sub traeMatrizRuteo As String r.close Log("|" & m & "|") Return m -End Sub \ No newline at end of file +End Sub +