7 Commits

Author SHA1 Message Date
cvaldes1201
3a13a989f3 6.02.09_01 2026-03-10 10:38:41 -06:00
3cda52a8a3 VERSION 6.01.11
- Se agrego el mandaPendientes para los abonos.
- Se agrego que solo se pueda hacer solo una vez FIN DIA y despues de eso se necesita una contraseña (FD + dia + hora)
2026-01-24 21:50:41 -06:00
Javier
4f07b6d3d3 6.01.07 2026-01-19 11:31:32 -06:00
Javier
86c0d1f273 ... 2026-01-15 08:47:57 -06:00
Javier
e3614c5fcf ... 2025-11-04 10:26:50 -06:00
Javier
fa3cbabdc9 .... 2025-10-16 09:47:17 -06:00
Javier
9ea95e39f1 v. 5.08.31 2025-09-26 13:35:41 -06:00
22 changed files with 12341 additions and 2737 deletions

View File

@@ -1273,12 +1273,35 @@ Sub Class_Globals
Dim a As Cursor
Dim f As Cursor
Private b_abono As Button
Private cb_importarBDWA As CheckBox
Private p_importarBDWA As Panel
Dim intentUsado As Boolean = False
Private p_bypass As Panel
Private et_bypass As EditText
Private b_cancelabypass As Button
Private b_acepbypass As Button
Private b_bypass As Button
Private p_finDia As Panel
Private b_findiaOk As Button
Private b_fdCancelar As Button
Private et_autSup As EditText
Private b_borrarFinDia As Button
Private p_transFinDia As Panel
Private b_cancelarFD As Button
Private b_aceptarFD As Button
Private Panel10 As Panel
Private et_passFinDia As EditText
Private teclado As IME
End Sub
Public Sub Initialize
' B4XPages.GetManager.LogEvents = True
End Sub
'This event will be called once, before the page becomes visible.
Private Sub B4XPage_Created (Root1 As B4XView)
Root = Root1
@@ -1330,6 +1353,9 @@ Private Sub B4XPage_Created (Root1 As B4XView)
Subs.agregaColumna("CAT_GUNAPROD3", "CAT_DP_CANT_MIN_VENTA", "TEXT")
Subs.agregaColumna("ABONOS","TIPO_PAGO","TEXT")
Subs.agregaColumna("ABONOS","a_numpago","TEXT")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS COMENTARIOS (COMENTARTIO TEXT, CLIENTE TEXT, DESCARGADO TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS GEOCERCA (ACTIVA TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS BARRAS (BARRA BLOB)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS ABONOS (a_usuario TEXT, a_ruta TEXT, a_cliente TEXT, a_abono TEXT, a_fecha TEXT, a_enviado TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS PAGARES (PA_ALMACEN TEXT, PA_RUTA_REP TEXT, PA_RUTAPREV TEXT, PA_FECHA_PREV TEXT, PA_CAPTURA TEXT, PA_MONTO TEXT, PA_USUARIO TEXT, PA_CLIENTE TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS PICK_CIEGO (PC_ID_PROD TEXT, PC_NOM_PROD TEXT, PC_CANT TEXT, PC_ALMACEN TEXT, PC_RUTA TEXT, PC_FECHA TEXT)")
@@ -1340,6 +1366,11 @@ 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 CONTADOS (RUTA_PREV TEXT, RUTA_REP TEXT, FECHA_PREV TEXT, FECHA TEXT, ALMACEN TEXT, NUM_TICKET TEXT, MONTO TEXT, METODO_PAGO TEXT, USUARIO TEXT, CLIENTE TEXT, NUM_PAGO TEXT)")
' Starter.skmt.ExecNonQuery("DROP TABLE IF EXISTS ABONOSP")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS CHECADO_CHECK(CHECADO TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS BLOCKENVIO(ENVIADO TEXT)")
@@ -1363,6 +1394,7 @@ Private Sub B4XPage_Created (Root1 As B4XView)
Subs.agregaColumna("kmt_info", "SECUENCIA", "INT")
Subs.agregaColumna("NOVENTA", "NV_FOTO2", "BLOB")
Subs.agregaColumna("kmt_info", "CAT_CL_SALDODISPONIBLE", "TEXT")
Subs.agregaColumna("kmt_info", "CAT_CL_DIASCREDITO", "INT")
Subs.agregaColumna("kmt_info", "HORAENT", "TEXT")
@@ -1392,6 +1424,8 @@ Private Sub B4XPage_Created (Root1 As B4XView)
Subs.agregaColumna("HIST_VENTAS","CANTC_OR","TEXT")
Subs.agregaColumna("CAT_GUNAPROD","CONVERSION","TEXT")
Subs.agregaColumna("kmt_info","CAT_CL_LIMITECREDITO","TEXT")
Subs.agregaColumna("kmt_info","CAT_CL_VCREDITO","TEXT")
Subs.agregaColumna("kmt_info","CAT_CL_VCODIGO","TEXT")
Subs.agregaColumna("CAT_GUNAPROD","PRECIOCONVER","TEXT")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS RUTAA (RUTAA TEXT)")
Starter.skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS wayPoints (codigo TEXT, indice INT)")
@@ -1416,6 +1450,15 @@ Private Sub B4XPage_Created (Root1 As B4XView)
' IMEN.Text = "" 'P.GetDeviceId
' IMEI = "" 'P.GetDeviceId
' End If
'Revisamos si se disparo el intent de cargar la base de datos desde WhatApp.
If Subs.traeUsarIntentBDWA Then
Subs.importaBDDesdeWhatsApp
End If
p_transFinDia.top = 0 : p_transFinDia.Left = 0
p_transFinDia.Width = Root.Width : p_transFinDia.Height = Root.Height
Subs.centraPanel(Panel10, Root.Width)
End Sub
Sub B4XPage_Appear
@@ -1443,6 +1486,13 @@ Sub B4XPage_Appear
usuario = c.GetString("USUARIO")
End If
c.Close
cb_importarBDWA.Checked = Subs.traeUsarIntentBDWA
If user.Text.Trim = "KMTS1" Then
p_importarBDWA.Visible = True
Else
p_importarBDWA.Visible = False
End If
' Starter.rp.CheckAndRequest(Starter.rp.PERMISSION_WRITE_EXTERNAL_STORAGE)
' Wait For B4XPage_PermissionResult (Permission As String, Result As Boolean)
' If Result Then
@@ -1502,6 +1552,30 @@ Sub JobDone(Job As HttpJob)
Next
End If
End If
If result.Tag = "codigoAutorizacion" Then
If result.Rows.Size > 0 Then
Log("Si hay codigo de autorizaion")
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
Dim cmd As DBCommand
cmd.Initialize
cmd.Name = "delete_codigoAutorizacion_REP"
cmd.Parameters = Array As Object(et_passFinDia.Text.Trim, Subs.traeRutaReparto, Subs.traeAlmacen)
reqManager.ExecuteCommand(cmd , "deleteCodigoAutorizacion")
DateTime.DateFormat = "YYYY/MM/dd HH:mm:ss"
Starter.skmt.ExecNonQuery("UPDATE CAT_VARIABLES SET CAT_VA_VALOR = '' where CAT_VA_DESCRIPCION = 'FINDIA_FECHA'")
p_transFinDia.Visible = False
et_passFinDia.Text = ""
teclado.HideKeyboard
ToastMessageShow("Listo, ya se puede hacer FIN DIA.", True)
Else
ToastMessageShow("El codigo es incorrecto, por favor revise y vuelva a intentar!!", True)
End If
End If
If Job.JobName = "DBRequest" Then
Dim result As DBResult = reqManager.HandleJob(Job)
@@ -1722,18 +1796,30 @@ Private Sub i_engrane_Click
p_appUpdate.Width = Root.Width
p_appUpdate.Height = Root.Height
Subs.centraPanel(p_serverList, Root.Width)
Subs.centraPanel(p_serverList, Root.Width)
Subs.centraBoton(b_server, Root.Width)
Subs.centraBoton(b_apk, Root.Width)
Subs.centraBoton(b_envioBD, Root.Width)
Subs.centraBoton(b_regesar, Root.Width)
Subs.centraBoton(b_bypass, Root.Width)
Subs.centraBoton(b_borrarFinDia, Root.Width)
Subs.centraBoton(b_server, p_serverList.Width)
lv_server.Clear
lv_server.AddSingleLine("http://keymon.lat:1782")
lv_server.AddSingleLine("http://keymon.net:1782")
If user.Text = "KMTS1" Then lv_server.AddSingleLine("http://10.0.0.205:1782")
' l_server.Text = Starter.server
et_server.Text = server
Subs.panelVisible(p_appUpdate, 0, 0)
Subs.panelVisible(p_transFinDia, 0, 0)
p_transFinDia.Visible = False
If user.Text.Trim = "KMTS1" Then
p_importarBDWA.Visible = False
Else
p_importarBDWA.Visible = False
End If
If user.Text.trim = "KMTS1" Then b_bypass.Visible = True Else b_bypass.Visible = False
End Sub
Private Sub B4XPage_CloseRequest As ResumableSub
@@ -2202,4 +2288,85 @@ End Sub
Private Sub p_appUpdate_Click
End Sub
Private Sub cb_importarBDWA_CheckedChange(Checked As Boolean)
' LogColor($"cb_importarBDWA_CheckedChange = ${Checked}"$, Colors.Red)
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', '${Checked}')"$)
End Sub
Private Sub b_bypass_Click
c = Starter.skmt.ExecQuery("SELECT * FROM kmt_info")
If c.RowCount > 0 Then
Subs.panelVisible(p_bypass,0,0)
p_bypass.Visible = True
Else
MsgboxAsync("No hay ruta cargada, favor de cargar día","Atención")
End If
End Sub
Private Sub b_acepbypass_Click
DateTime.TimeFormat = "HH:mm:ss"
DateTime.DateFormat = "dd/MM/yyyy"
sDate = DateTime.Date(DateTime.Now)
sTime = DateTime.Time(DateTime.Now)
Dim datebypass() As String = Regex.Split("/",sDate)
Dim timebypass() As String = Regex.Split(":",sTime)
If et_bypass.Text = datebypass(0) & timebypass(0) & timebypass(1) Then
Starter.skmt.ExecNonQuery2("UPDATE GEOCERCA set ACTIVA = ? ", Array As Object(0))
et_bypass.Text = ""
MsgboxAsync("Geocerca Deshabilitada","Atención")
p_bypass.Visible = False
End If
End Sub
Private Sub b_cancelabypass_Click
p_bypass.Visible = False
et_bypass.Text = ""
End Sub
Private Sub p_bypass_Click
End Sub
Private Sub b_fdCancelar_Click
End Sub
Private Sub p_finDia_Click
End Sub
Private Sub b_borrarFinDia_Click
p_transFinDia.Visible = True
End Sub
Private Sub p_transFinDia_Click
End Sub
Private Sub b_aceptarFD_Click
If et_passFinDia.Text <> "KMTS1BAT" Then
Dim cmd As DBCommand
cmd.Initialize
cmd.Name = "select_codigoAutorizacion_rep"
cmd.Parameters = Array As Object(et_passFinDia.Text.Trim, Subs.traeRutaReparto, Subs.traeAlmacen)
reqManager.ExecuteQuery(cmd , 0, "codigoAutorizacion")
Else
Starter.skmt.ExecNonQuery("UPDATE CAT_VARIABLES SET CAT_VA_VALOR = '' where CAT_VA_DESCRIPCION = 'FINDIA_FECHA'")
p_transFinDia.Visible = False
et_passFinDia.Text = ""
End If
teclado.HideKeyboard
End Sub
Private Sub b_cancelarFD_Click
p_transFinDia.Visible = False
End Sub

File diff suppressed because it is too large Load Diff

View File

@@ -82,6 +82,8 @@ Sub B4XPage_Appear
Else
ListView1.Top = lv1Top + 100
End If
Starter.skmt.ExecNonQuery("delete from HIST_VENTAS WHERE HVD_CANT = 0")
c=Starter.skmt.ExecQuery("select distinct codigo, indice, CAT_CL_NOMBRE, CAT_CL_CALLE, CAT_CL_NOEXT from waypoints inner join kmt_info on waypoints.codigo = kmt_info.CAT_CL_CODIGO where gestion = 0 AND CAT_CL_RUTA <> 1000 order by indice")
@@ -723,8 +725,8 @@ Sub caculaRutaGPS(coords As List, agregarActual As Boolean)
ProgressDialogShow2("Calculando distancia y tiempo, un momento por favor.", False)
Dim j As HttpJob
j.Initialize("trip", Me) 'Calculamos el resto de la ruta.
j.Download($"http://keymon.lat:9002/ruteador?m=OSRM&r=${Subs.traeRutaReparto}&a=${Subs.traeAlmacen}&c=${coordsStr}"$) '&f=CEDIS,${Starter.cedisLocation.Longitude},${Starter.cedisLocation.Latitude}
Log($"http://keymon.lat:9002/ruteador?m=OSRM&r=${Subs.traeRutaReparto}&a=${Subs.traeAlmacen}&c=${coordsStr}"$) '&f=CEDIS,${Starter.cedisLocation.Longitude},${Starter.cedisLocation.Latitude}
j.Download($"http://keymon.net:9002/ruteador?m=OSRM&r=${Subs.traeRutaReparto}&a=${Subs.traeAlmacen}&c=${coordsStr}"$) '&f=CEDIS,${Starter.cedisLocation.Longitude},${Starter.cedisLocation.Latitude}
Log($"http://keymon.net:9002/ruteador?m=OSRM&r=${Subs.traeRutaReparto}&a=${Subs.traeAlmacen}&c=${coordsStr}"$) '&f=CEDIS,${Starter.cedisLocation.Longitude},${Starter.cedisLocation.Latitude}
Wait For (j) JobDone(j As HttpJob)
If j.Success Then
Dim jp As JSONParser

View File

@@ -86,6 +86,9 @@ End Sub
'You can see the list of page related events in the B4XPagesManager object. The event name is B4XPage.
Sub B4XPage_Appear
Subs.centraPanel(p_principal, Root.Width)
' b_guardar.Visible = False
' Titulo.Left = Round(p_principal.Width/2)-(Titulo.Width/2)
@@ -308,6 +311,8 @@ Sub B4XPage_Appear
Else
L_CANT.Text = NumberFormat2((arti + arti1 +arti2 + arti3),0,0,0,True)
End If
End Sub
Sub GPS_LocationChanged (Location1 As Location)
@@ -503,6 +508,20 @@ Sub CreateListItem2(Text As String, precioU As String, inv As Int, inv2 As Int,
End Sub
Sub b_prodMenos_Click
Dim x2 As Cursor =Starter.skmt.ExecQuery("SELECT gestion FROM kmt_info where CAT_CL_CODIGO IN (SELECT CUENTA FROM CUENTAA)")
x2.Position = 0
If x2.GetString("gestion") = 2 Then
MsgboxAsync("Ya se gestiono el cliente, no se pueden hacer modificaciones","Atención")
' Wait For Msgbox_Result (result2 As Int)
' If result= DialogResponse.NEGATIVE Then
' B4XPages.ShowPage("Principal")
' End If
' b_prodMas.Enabled = False
' b_prodMenos.Enabled = False
Else
etCantHasFocus = False
Log("etCantHasFocus=" & etCantHasFocus)
LogColor("b_prodMenos_Click", Colors.Magenta)
@@ -587,9 +606,20 @@ Sub b_prodMenos_Click
B4XPage_Appear
End If
Else
If laCant.Text = "" Then laCant.Text = 0
laCant.Text = $"$1.0{laCant.Text-1}"$
If laCant.Text < 0 Then laCant.Text = 0
' If laCant.Text = "" Then laCant.Text = 0
' laCant.Text = NumberFormat2(($"$1.0{laCant.Text-1}"$),0,0,0,False)
If laCant.Text = "" Then laCant.Text = 0
' Realizamos la resta de forma segura
Dim valorActual As Double = laCant.Text
Dim resultado As Double = valorActual - 1
If resultado < 0 Then resultado = 0
' Asignamos al Label/EditText sin comas de miles
laCant.Text = NumberFormat2(resultado, 1, 0, 0, False)
If laCant.Text < 0 Then laCant.Text = 0
Log("NO ES promo")
Starter.skmt.ExecNonQuery($"update HIST_VENTAS set HVD_RECHAZO = 1, HVD_RECHAZOCANT = IFNULL(HVD_RECHAZOCANT,0) + (1*'${minimoadesc}'), BCAJAS = 0, CANTC = 0 WHERE HVD_PROID = '${esteTag.Get(2)}' and HVD_cliente in (Select CUENTA from cuentaa) AND CONSECUTIVO = '${esteTag.Get(8)}'"$)
Starter.skmt.ExecNonQuery2("update cat_gunaprod set cat_gp_almacen = cat_gp_almacen + 1 where cat_gp_id = ?", Array As Object(esteTag.Get(2)))
@@ -637,9 +667,26 @@ Sub b_prodMenos_Click
' L_CANT.Text = cym.Get("cantidad")
' L_TOTAL.Text = Round2(cym.Get("monto"), 2)
' cuentaProds("-")
End If
End Sub
Sub b_prodMas_Click
Dim x2 As Cursor =Starter.skmt.ExecQuery("SELECT gestion FROM kmt_info where CAT_CL_CODIGO IN (SELECT CUENTA FROM CUENTAA)")
x2.Position = 0
If x2.GetString("gestion") = 2 Then
MsgboxAsync("Ya se gestiono el cliente, no se pueden hacer modificaciones","Atención")
' Wait For Msgbox_Result (result2 As Int)
' If result= DialogResponse.NEGATIVE Then
' B4XPages.ShowPage("Principal")
' End If
' b_prodMas.Enabled = False
' b_prodMenos.Enabled = False
Else
etCantHasFocus = False
' Log("etCantHasFocus=" & etCantHasFocus)
LogColor("b_prodMas_Click", Colors.Magenta)
@@ -728,6 +775,8 @@ Sub b_prodMas_Click
' If cantoriginal <= esteTag.Get(1) Then
' L_CANT.Text = L_CANT.Text + 1
' End If
End If
End Sub
Sub cuentaProds(accion As String)
@@ -1018,12 +1067,25 @@ Private Sub l_pCantC_Click
End Sub
Private Sub b_revversar_Click
Private c3 As Cursor = Starter.skmt.ExecQuery("SELECT * FROM PEDIDO WHERE PE_CLIENTEOR IN (SELECT CUENTA FROM CUENTAA)")
If c3.RowCount = 0 Then
Starter.skmt.ExecNonQuery($"update HIST_VENTAS set HVD_RECHAZO = 0, HVD_RECHAZOCANT = 0, BCAJAS = BCAJAS_OR, CANTC = CANTC_OR WHERE HVD_cliente in (Select CUENTA from cuentaa)"$)
B4XPage_Appear
Dim x2 As Cursor =Starter.skmt.ExecQuery("SELECT gestion FROM kmt_info where CAT_CL_CODIGO IN (SELECT CUENTA FROM CUENTAA)")
x2.Position = 0
If x2.GetString("gestion") = 2 Then
MsgboxAsync("Ya se gestiono el cliente, no se pueden hacer modificaciones","Atención")
' Wait For Msgbox_Result (result2 As Int)
' If result= DialogResponse.NEGATIVE Then
' B4XPages.ShowPage("Principal")
' End If
' b_prodMas.Enabled = False
' b_prodMenos.Enabled = False
Else
MsgboxAsync("Hay productos que ya se vendieron, no se puede regresar la venta","Atención")
Private c3 As Cursor = Starter.skmt.ExecQuery("SELECT * FROM PEDIDO WHERE PE_CLIENTEOR IN (SELECT CUENTA FROM CUENTAA)")
If c3.RowCount = 0 Then
Starter.skmt.ExecNonQuery($"update HIST_VENTAS set HVD_RECHAZO = 0, HVD_RECHAZOCANT = 0, BCAJAS = BCAJAS_OR, CANTC = CANTC_OR WHERE HVD_cliente in (Select CUENTA from cuentaa)"$)
B4XPage_Appear
Else
MsgboxAsync("Hay productos que ya se vendieron, no se puede regresar la venta","Atención")
End If
End If
End Sub
@@ -1141,7 +1203,7 @@ Private Sub B_IMP_Click
' impresoraConectada = False
' End If
ProgressDialogShow("Imprimiendo, un momento ...")
ProgressDialogShow2("Imprimiendo, un momento ...",False)
Printer1.DisConnect
If Not(Printer1.IsConnected) Then
' If logger Then Log("conectando 1")

View File

@@ -26,6 +26,16 @@ Sub Class_Globals
Dim reqManager As DBRequestManager
Private cb_reprogramar As CheckBox
Dim reprogramar As Int = 0
Private camEx As CameraExClass
Dim frontCamera As Boolean = False
Private p_cam As Panel
Dim nombrefoto As String = "0"
Private p_camara As Panel
Private teclado As IME
Dim fototomada As String
Private b_foto As Button
Private r_5 As RadioButton
End Sub
'You can add more parameters here.
@@ -50,8 +60,13 @@ Sub B4XPage_Appear
r_2.Checked = False
r_3.Checked = False
r_4.Checked = False
r_5.Checked = False
cb_reprogramar.Checked = False
p_camara.Width = Root.Width
p_camara.Height = Root.Height
p_camara.Visible = False
CallSubDelayed(Tracker, "Track")
CallSubDelayed(Tracker, "StartFLPSmall")
If Tracker.FLP.IsInitialized And Tracker.FLP.GetLastKnownLocation.IsInitialized Then 'Si tenemos "UltimaUbicaccionConocida" la usamos.
@@ -62,6 +77,11 @@ Sub B4XPage_Appear
End If
End Sub
Sub GPS_LocationChanged (Location1 As Location)
' LogColor($"Entrando a Cliente.GPS_LocationChanged"$, Colors.red)
If Tracker.FLP.GetLastKnownLocation.IsInitialized And Tracker.FLP.GetLastKnownLocation.Latitude <> 0 Then
@@ -102,7 +122,7 @@ Sub CANCELA_Click
End Sub
Sub GUARDA_Click
If r_1.Checked = False And r_2.Checked = False And r_3.Checked = False And r_4.Checked = False Then
If r_1.Checked = False And r_2.Checked = False And r_3.Checked = False And r_4.Checked = False And r_5 .Checked = False Then
MsgboxAsync("Selecciona un motivo de rechazo","Atención")
Else
@@ -112,6 +132,8 @@ Sub GUARDA_Click
motivo = "NO PIDIO"
Else If r_3.Checked Then
motivo = "CANCELA"
Else If r_5.Checked Then
motivo = "FALTA DE TIEMPO"
Else
motivo = "NO ESTA EL ENCARGADO"
End If
@@ -265,4 +287,148 @@ Private Sub cb_reprogramar_CheckedChange(Checked As Boolean)
Else
reprogramar = 0
End If
End Sub
Private Sub InitializeCamera2
Starter.rp.CheckAndRequest(Starter.rp.PERMISSION_CAMERA)
Wait For B4XPage_PermissionResult (Permission As String, resultC As Boolean)
If resultC Then
camEx.Initialize(p_cam, frontCamera, Me, "Camera1")
frontCamera = camEx.Front
Log("inicializamos Camara")
Else
ToastMessageShow("No permission Camara!!!", True)
End If
End Sub
Sub Camera1_Ready (Success As Boolean)
Log("Camara ready")
If Success Then
camEx.SetJpegQuality(90)
camEx.SetContinuousAutoFocus
camEx.CommitParameters
camEx.StartPreview
Log(camEx.GetPreviewSize)
Else
ToastMessageShow("Cannot open camera.", True)
Log("Cannot open camera")
End If
End Sub
Sub Camera1_PictureTaken (Data()As Byte)
DateTime.DateFormat="ddMMyyyyHHmmss"
nombrefoto = DateTime.Now & "_FOTO1.png"
teclado.HideKeyboard
fototomada = nombrefoto
Log("tome foto")
Dim filename As String = fototomada
Dim Dirp As String = File.DirInternal
Dim Dir As String
Dim Dir2 As String
Try
File.MakeDir(Dirp,"/md")
Dir = "/md"
Log("creado en promotoria " & Dirp & Dir)
Catch
Dir = ""
Log("creado en raiz")
End Try
Try
File.MakeDir(Dirp & Dir,"/reduccion")
Dir2 = "/reduccion"
Log("creado en promotoria " & Dirp & Dir & Dir2)
Catch
Dir = ""
Log("creado en raiz")
End Try
camEx.SavePictureToFile(Data, Dirp&Dir, filename)
camEx.StartPreview 'restart preview
' ToastMessageShow("Picture saved." & CRLF & "File size: " & File.Size(Dir, filename) & Dir &"," & filename, True)
Log("Picture saved." & CRLF & "File size: " & File.Size(Dir, filename) & Dir &"," & filename)
Dim img As B4XBitmap = xui.LoadBitmapResize(File.DirInternal & Dir, filename, 225, 300, True)
Dim out As OutputStream = File.OpenOutput(File.DirInternal & Dir & Dir2, filename, False)
img.WriteToStream(out, 100, "PNG")
' foto4 = File.ReadBytes(File.DirInternal & Dir & Dir2, nombrefoto3)
out.Close
motivo = "CERRADO"
DateTime.DateFormat = "MM/dd/yyyy"
DateTime.TimeFormat="HHmmss"
sDate=DateTime.Date(DateTime.Now)
sTime=DateTime.Time(DateTime.Now)
c=Starter.skmt.ExecQuery("select CUENTA from cuentaa")
c.Position = 0
cuenta = c.GetString("CUENTA")
c=Starter.skmt.ExecQuery("select usuario from usuarioa")
c.Position = 0
usuario = c.GetString("USUARIO")
c.Close
Dim rutaactualizar As String
Dim rut As Cursor = Starter.skmt.ExecQuery("SELECT CAT_CL_RUTA FROM kmt_info WHERE CAT_CL_CODIGO IN (SELECT CUENTA FROM CUENTAA)")
If rut.RowCount > 0 Then
rut.Position = 0
rutaactualizar = rut.GetString("CAT_CL_RUTA")
End If
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_RUTA,NV_REPROGRAMAR,NV_FOTO) VALUES(?,?,?,?,?,?,?,?,?,?) ", Array As Object (cuenta,sDate & sTime, usuario, motivo,e_comm.text, B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps,rutaactualizar,reprogramar,File.ReadBytes(File.DirInternal & Dir & Dir2, nombrefoto)))
Starter.skmt.ExecNonQuery($"UPDATE kmt_info set gestion = 3, HORAENT = '${sDate & " " & sTime}' where CAT_CL_CODIGO In (select cuenta from cuentaa) and CAT_CL_RUTA = '${rutaactualizar}'"$)
Starter.skmt.ExecNonQuery("DELETE FROM PEDIDO WHERE PE_CLIENTE IN (SELECT CUENTA FROM CUENTAA)")
Starter.skmt.ExecNonQuery("update HIST_VENTAS SET HVD_RECHAZO = 1, HVD_RECHAZOCANT = HVD_CANT, HVD_RECHAZOCANTC = CANTC, BCAJAS = 0 , CANTC = 0 WHERE HVD_CLIENTE IN (SELECT CUENTA FROM CUENTAA)")
Starter.skmt.ExecNonQuery($"update HIST_VENTAS set HVD_RECHAZO = 2, HVD_RECHAZOCANT = HVD_RECHAZOCANT WHERE HVD_PROID = HVD_CODPROMO and HVD_CLIENTE in (Select CUENTA from cuentaa)"$)
p_camara.Visible = False
StopCamera2
B4XPages.ShowPage("Principal")
End Sub
Private Sub p_camara_Click
End Sub
Private Sub b_foto_Click
camEx.TakePicture
p_camara.Visible = False
End Sub
Private Sub StopCamera2
' Capturing = False
If camEx.IsInitialized Then
camEx.Release
End If
End Sub
Private Sub r_1_CheckedChange(Checked As Boolean)
InitializeCamera2
p_camara.Visible = True
Subs.centraPanel(p_cam,p_camara.Width)
p_camara.BringToFront
End Sub
Private Sub B4XPage_CloseRequest As ResumableSub
If p_camara.Visible Then
p_camara.Visible = False
StopCamera2
r_1.Checked = False
Else
B4XPages.ShowPage("Cliente")
End If
Return False
End Sub

File diff suppressed because it is too large Load Diff

310
B4A/C_deviceLinker.bas Normal file
View File

@@ -0,0 +1,310 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=12.8
@EndOfDesignText@
'-----------------------------------------------------------------------------------
' Modulo de Clase: DeviceLinker.bas
' Propósito: Gestionar el GUID del dispositivo y verificar/ligar el dispositivo
' a un almacén y ruta en el servidor de forma segura.
'-----------------------------------------------------------------------------------
' Ejemplo de uso:
' ==== En config.properties ====
' sql.verify_device=Select nvl(CAT_RU_IDTELEFONO, 0) As CAT_RU_IDTELEFONO from kelloggs.CAT_RUTAS where cat_ru_idalmacen = ? And cat_ru_ruta = ?
' sql.registarMovil=update kelloggs.CAT_RUTAS set CAT_RU_IDTELEFONO = ? where cat_ru_idalmacen = ? And cat_ru_ruta = ?
' ==== En Class_Globals ====
' Dim linker As C_deviceLinker '<<<< Class_Globals
' ==== En B4XPage_Created ====
' linker.Initialize(Me, "Linker", True) '<<<<<< B4XPage_Created
' ==== En donde se quiera llamar ====
' linker.VerifyDevice(Subs.traeAlmacen, Subs.traeRuta)
' Sub Linker_Response(Status As String) ' << AÑADE ESTE SUB [New Query]
' If Starter.Logger Then LogColor($"Respuesta de DeviceLinker para la verificación del dispositivo: ${Status}"$, Colors.Magenta) '
' Select Status
' Case "OK"
' Log("########################################################")
' ToastMessageShow("Dispositivo verificado y vinculado correctamente.", False)
' ' Aquí puedes añadir lógica adicional si la verificación es exitosa, por ejemplo, habilitar ciertos botones o continuar con el flujo normal.
' Case "REGISTRO_COMPLETO"
' Log("########################################################")
' ToastMessageShow("¡Registro completo!", False)
' Case "SIN_REGISTRO"
' Log("########################################################")
' ToastMessageShow("¡Dispositivo sin registro!", False)
' linker.linkDevice(Subs.traeAlmacen, e_ruta.text) '<<<<<<<<< Si no esta registrado lo registramos.
' Case "REGISTRANDO"
' ToastMessageShow("¡Registro en proceso!", True)
' Case "YA_REGISTRADO"
' Log("########################################################")
' ToastMessageShow("¡¡El dispositivo ya esta registrado con otra ruta!!", True)
' Case Else ' Otros estados que tu servidor pueda devolver (ej. "UNAUTHORIZED", "PENDING_APPROVAL")
' Log("########################################################")
' ToastMessageShow($"Verificación del dispositivo: ${Status}"$, True)
' ' Puedes decidir si bloquear la funcionalidad o mostrar un mensaje específico según el estado.
' End Select
' End Sub
Sub Class_Globals
' Configuración del servidor y comandos
Private Const GUID_KEY_ALIAS As String = "DeviceGUID" ' << ALIAS PARA EL GUID EN EL KEYSTORE
' Objetos y variables internas
Private kvs As KeyValueStore ' << ALMACENAMIENTO SEGURO PARA EL GUID
Private CallBack As Object ' << OBJETO DE CALLBACK PARA ENVIAR RESPUESTAS
Private EventName As String ' << NOMBRE DEL EVENTO DE RESPUESTA
Public reqManager As DBRequestManager ' << GESTOR DE PETICIONES AL SERVIDOR jRDC
Private logger As Boolean ' << PARA CONTROLAR LOS LOGS DE ESTA CLASE
Dim lastJobDoneError As String = ""
Dim almacen As String = ""
Dim ruta As String = ""
Dim deviceId As String = ""
' Se requieren las siguientes librerías:
' - KeyValueStore2
' - DBRequestManager
' - XUI
Dim dlDB As SQL
End Sub
' Inicializa la clase DeviceLinker.
' PageObject: El módulo (ej. C_Principal) que inicializa esta clase y manejará sus respuestas (normalmente "Me").
' NameOfEvent: El prefijo para el evento de respuesta (ej. "DeviceLinker_Response").
' AppLogger: Booleano para activar/desactivar los logs internos de esta clase, siguiendo el Starter.Logger de la app.
Public Sub Initialize (PageObject As Object, NameOfEvent As String, AppLogger As Boolean)
CallBack = PageObject
EventName = NameOfEvent
logger = AppLogger ' Asignamos el estado del logger de la aplicación.
' Inicializamos el KeyValueStore para almacenamiento seguro del GUID
kvs.Initialize(File.DirInternal, "DeviceKeyStore.b4xkey")
If logger Then Log("B4XKeyStore 'DeviceKeyStore' inicializado.")
dlDB.Initialize(File.DirInternal, "deviceLink.db", True)
dlDB.ExecNonQuery("CREATE TABLE IF NOT EXISTS Registro (GUID_KEY_ALIAS TEXT)") ' Creamos la tabla si no existe
' Inicializamos el DBRequestManager para las comunicaciones con el servidor.
' 'Me' indica que el evento JobDone de esta clase se encargará de las respuestas de reqManager.
' reqManager.Initialize(Me, Starter.DBReqServer)
' reqManager.Initialize(Me, "http://keymon.net:9010/DB2") 'Servidor de pruebas
' reqManager.Initialize(Me, "http://keymon.net:1781") 'Servidor productivo
reqManager.Initialize(Me, B4XPages.MainPage.server) 'Servidor productivo
If logger Then Log("DBRequestManager para DeviceLinker inicializado.")
If logger Then Log("DeviceLinker inicializado y listo para operar.")
End Sub
' Verifica y liga el dispositivo con un almacén y una ruta en el servidor.
' Almacen: El identificador del almacén.
' Ruta: El identificador de la ruta.
Public Sub verifyDevice(Almacen_ As String, Ruta_ As String)
Private verificar As Boolean = True ' La verificacion se realiza por default
Private tv As Cursor = Starter.skmt.ExecQuery("select * from cat_variables where CAT_VA_DESCRIPCION = 'VERIFY_DEVICE'")
If tv.RowCount > 0 Then
tv.Position = 0
If tv.GetString("CAT_VA_VALOR") = 0 Then verificar = False
End If
If verificar Then ' Si VERIFY_DEVICE no está en CERO ... verificamos.
Dim DeviceId_ As String = GetDeviceGUID ' Obtenemos o generamos el GUID del dispositivo.
LogColor(DeviceId_, Colors.red)
almacen = Almacen_
ruta = Ruta_
deviceId = DeviceId_
If DeviceId_ = "" Then
If logger Then LogColor("Error: GUID del dispositivo no pudo ser obtenido o generado.", Colors.Red)
' Enviar una respuesta de error al callback si no se pudo obtener el GUID.
If SubExists(CallBack, EventName & "_Response") Then ' [New Query]
CallSub2(CallBack, EventName & "_Response", "GUID_ERROR") ' Dispara el evento Linker_Response("GUID_ERROR")
End If
Return
End If
If logger Then Log($"Enviando solicitud de verificación para DeviceId: ${DeviceId_}, Almacen: ${Almacen_}, Ruta: ${Ruta_}"$)
Dim cmd As DBCommand ' Creamos un comando para enviar al servidor.
cmd.Initialize
cmd.Name = "verify_device"
' Pasamos el almacén, la ruta y el GUID del dispositivo como parámetros.
cmd.Parameters = Array As Object(Almacen_, Ruta_) ', DeviceId_
Log($"Enviamos almacen: ${Almacen_} y ruta: ${Ruta_}"$)
' Ejecutamos el comando en el servidor. 'Me' indica que DBRequestManager_JobDone en esta clase manejará la respuesta.
reqManager.ExecuteQuery(cmd, 0, "verify_device")
Else ' Si está en CERO (Verificacion deshabilitada), regresamos "OK".
CallSub2(CallBack, EventName & "_Response", "OK")
End If
End Sub
Sub linkDevice(Almacen_ As String, Ruta_ As String)
Dim deviceId As String = GetDeviceGUID ' Obtenemos o generamos el GUID del dispositivo.
Log("########################################################")
Log("REGISTRANDO")
Dim cmd As DBCommand ' Creamos un comando para enviar al servidor.
cmd.Initialize
cmd.Name = "registarMovil"
' Pasamos el almacén, la ruta y el GUID del dispositivo como parámetros.
cmd.Parameters = Array As Object(deviceId, Almacen_, Ruta_)
reqManager.ExecuteCommand(cmd, "registramosGUID")
If SubExists(CallBack, EventName & "_Response") Then
CallSub2(CallBack, EventName & "_Response", "REGISTRANDO") ' Dispara el evento Linker_Response("REGISTRANDO")
End If
End Sub
'244500
' Obtiene el GUID único del dispositivo desde B4XKeyStore.
' Si no existe, lo genera y lo guarda utilizando Subs.GUID.
Private Sub GetDeviceGUID As String
' If kvs.ContainsKey(GUID_KEY_ALIAS) = False Then
' ' Corrección: Usamos la función GUID ya existente en el módulo Subs [1].
' Dim NewGUID As String = generaGUID
' kvs.Put(GUID_KEY_ALIAS, NewGUID) ' Lo guardamos de forma segura en el KeyStore.
' If logger Then LogColor($"Nuevo GUID generado y guardado: ${NewGUID}"$, Colors.Blue)
' Return NewGUID
' Else
' Dim ExistingGUID As String = kvs.Get(GUID_KEY_ALIAS) ' Recuperamos el GUID existente.
' If logger Then LogColor($"GUID existente cargado: ${ExistingGUID}"$, Colors.Blue)
' Return ExistingGUID
' End If
If deviceLinked = False Then
' Corrección: Usamos la función GUID ya existente en el módulo Subs [1].
Dim NewGUID As String = generaGUID
dlDB.ExecNonQuery($"insert into registro ('GUID_KEY_ALIAS') values ('${NewGUID}')"$) ' Guardamos nuevo registro
If logger Then LogColor($"Nuevo GUID generado y guardado: ${NewGUID}"$, Colors.Blue)
Return NewGUID
Else
Dim ExistingGUID As String
Private e As Cursor = dlDB.ExecQuery("select GUID_KEY_ALIAS from registro")
e.Position = 0
ExistingGUID = e.GetString("GUID_KEY_ALIAS")
If logger Then LogColor($"GUID existente cargado: ${ExistingGUID}"$, Colors.Blue)
Return ExistingGUID
End If
End Sub
' Callback para manejar las respuestas del DBRequestManager de esta clase.
Public Sub JobDone(Job As HttpJob) ' El nombre del sub debe ser 'JobDone' o el que se haya especificado en reqManager.Initialize(Me, ApiUrl)
If logger Then Log("INICA JOBDONE DEVICELINKER - " & Job.Tag)
If reqManager.reqsList.IsInitialized Then 'Si tenemos lista de requests, la procesamos.
If reqManager.reqsList.IndexOf(Job.tag) <> -1 Then
reqManager.reqsList.RemoveAt(reqManager.reqsList.IndexOf(Job.tag))
LogColor($">>>>>> Recibimos y quitamos ${Job.tag.As(String).ToUpperCase}"$, Colors.Blue)
End If
LogColor(">>>>>> " & reqManager.reqsList.Size & " - " & reqManager.reqsList, Colors.Blue)
End If
If Job.Success = False Then
lastJobDoneError = Job.ErrorMessage
LogColor("############################################", Colors.red)
LogColor("###### JobError: " & Job.Tag & " ######" & CRLF & "#### " & Job.ErrorMessage, Colors.red)
LogColor("############################################", Colors.red)
' Enviar una respuesta de error HTTP al callback.
If SubExists(CallBack, EventName & "_Response") Then
CallSub2(CallBack, EventName & "_Response", "HTTP_ERROR") ' Dispara el evento Linker_Response("HTTP_ERROR")
End If
Else 'If Job Success then ...
lastJobDoneError = ""
If Job.JobName = "DBRequest" Then ' Asegurarse de que sea una respuesta de DBRequestManager.
' Primero verificamos Job.Success para saber si la comunicación HTTP fue exitosa [New Query]
If Job.Success Then
Dim result As DBResult = reqManager.HandleJob(Job) ' Procesamos el HttpJob para obtener el DBResult.
If logger Then LogColor($"Petición exitosa al servidor. Registros devueltos: ${result.Rows.Size}"$, Colors.Green)
' If result.Tag = "hist_cliente_promos" Then 'query tag
' Starter.skmt.BeginTransaction
' For Each records() As Object In result.Rows
' Dim HCCP_CLIENTE As String = records(result.Columns.Get("HCCP_CLIENTE"))
' Starter.skmt.ExecNonQuery2("INSERT INTO HIST_CLIENTE_CANT_PROMOS(HCCP_CLIENTE, HCCP_PROMO, HCCP_CANT, HCCP_CANT_VENDIDA) VALUES (?,?,?,?)", Array As Object (HCCP_CLIENTE))
' Next
' Starter.skmt.TransactionSuccessful
' Starter.skmt.EndTransaction
' ' ToastMessageShow(" Historico Clientes Promociones Actualizado." , True)
' End If
If result.Tag = "verify_device" Then 'query tag
' Aquí es donde la lógica de la aplicación interpreta el éxito/falla de la operación en el servidor.
If result.Rows.Size > 0 Then
Subs.logJobDoneResultados(result)
For Each records() As Object In result.Rows
Dim Status As String = "" 'records(result.Columns.Get("ESTATUS"))
Dim CAT_RU_IDTELEFONO As String = records(result.Columns.Get("CAT_RU_IDTELEFONO"))
deviceId = GetDeviceGUID
Log($"|${deviceId}|${CAT_RU_IDTELEFONO}|"$)
' If deviceId <> CAT_RU_IDTELEFONO Then Status = "YA_REGISTRADO" ' Ya existe OTRO registro.
If CAT_RU_IDTELEFONO = 0 Or CAT_RU_IDTELEFONO.Length < 5 Then
Status = "SIN_REGISTRO"
' Log("########################################################")
' Log("REGISTRANDO")
' Dim cmd As DBCommand ' Creamos un comando para enviar al servidor.
' cmd.Initialize
' cmd.Name = "registarMovil"
' ' Pasamos el almacén, la ruta y el GUID del dispositivo como parámetros.
' cmd.Parameters = Array As Object(deviceId, almacen, ruta)
' reqManager.ExecuteCommand(cmd, "registramosGUID")
If SubExists(CallBack, EventName & "_Response") Then
CallSub2(CallBack, EventName & "_Response", "SIN_REGISTRO")
End If
else if CAT_RU_IDTELEFONO = deviceId Then
Status = "OK"
Starter.skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("LIGADO"))
Starter.skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("LIGADO", 1))
Log("OK")
LogColor("######### GUARDAMOS ###########", Colors.red)
Else
Status = "YA_REGISTRADO"
Starter.skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("LIGADO"))
Starter.skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("LIGADO", 0))
Log("YA_REGISTRADO")
LogColor("######### GUARDAMOS ###########", Colors.red)
End If
' Invocamos el callback en el módulo principal con el estado.
Next
Else
Status = "NO_EXISTE_RUTA"
End If
If SubExists(CallBack, EventName & "_Response") Then
CallSub2(CallBack, EventName & "_Response", Status) ' Dispara el evento Linker_Response("OK") o Linker_Response("YA_REGISTRADO")
End If
End If
If result.Tag = "registramosGUID" Then
Log("########################################################")
Log("REGISTRO_COMPLETO")
LogColor("######### GUARDAMOS ###########", Colors.red)
Subs.logJobDoneResultados(result)
Starter.skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("LIGADO"))
Starter.skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("LIGADO", 1))
If SubExists(CallBack, EventName & "_Response") Then
CallSub2(CallBack, EventName & "_Response", "REGISTRO_COMPLETO") ' Dispara el evento Linker_Response("REGISTRO_COMPLETO")
End If
End If
End If
End If
Job.Release ' Muy importante liberar el HttpJob para evitar fugas de memoria.
End If
End Sub
'Genera un GUID (globally unique identifier)
Sub generaGUID As String
Dim sb As StringBuilder
sb.Initialize
For Each stp As Int In Array(8, 4, 4, 4, 12)
If sb.Length > 0 Then sb.Append("-")
For n = 1 To stp
Dim c As Int = Rnd(0, 16)
If c < 10 Then c = c + 48 Else c = c + 55
sb.Append(Chr(c))
Next
Next
Return sb.ToString
End Sub
'Regresa true si existe registro
Sub deviceLinked As Boolean
Private e As Cursor = dlDB.ExecQuery("select * from registro")
If e.RowCount > 0 Then
Return True
Else
Return False
End If
End Sub

View File

@@ -1141,7 +1141,7 @@ Private Sub AStream_NewData (Buffer() As Byte)
If SubExists(CallBack, EventName & "_NewData") Then
CallSub2(CallBack, EventName & "_NewData", Buffer)
End If
Log("Data " & Buffer(0))
' Log("Data " & Buffer(0))
End Sub
Private Sub AStream_Error

Binary file not shown.

BIN
B4A/Files/comentario.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.9 KiB

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@@ -166,29 +166,29 @@ Sub MapFragment1_Ready
If pedidos.RowCount > 1 Then
If esteAzul = 1 Then esteAzul2= "marker-azul.png"
If esteAzul = 2 Then esteAzul2= "marker-azul1.png"
If esteAzul = 3 Then esteAzul2= "marker-azul2.png"
If esteAzul = 4 Then esteAzul2= "marker-azul3.png"
If esteAzul = 5 Then esteAzul2= "marker-azul4.png"
If esteAzul = 6 Then esteAzul2= "marker-azul1.png"
If esteAzul = 2 Then esteAzul2= "marker-azul.png"
If esteAzul = 3 Then esteAzul2= "marker-azul.png"
If esteAzul = 4 Then esteAzul2= "marker-azul.png"
If esteAzul = 5 Then esteAzul2= "marker-azul.png"
If esteAzul = 6 Then esteAzul2= "marker-azul.png"
Else If pedidos.RowCount = 1 Then
pedidos.Position = 0
If pedidos.GetString("HVD_PRONOMBRE") = "Cobranza Pendiente" Then
If esteAzul = 1 Then esteAzul2= "marker-amarillo.png"
If esteAzul = 2 Then esteAzul2= "marker-amarillo.png"
If esteAzul = 3 Then esteAzul2= "marker-amarillo.png"
If esteAzul = 4 Then esteAzul2= "marker-amarillo.png"
If esteAzul = 5 Then esteAzul2= "marker-amarillo.png"
If esteAzul = 6 Then esteAzul2= "marker-amarillo.png"
If esteAzul = 1 Then esteAzul2= "marker-azul.png"
If esteAzul = 2 Then esteAzul2= "marker-azul.png"
If esteAzul = 3 Then esteAzul2= "marker-azul.png"
If esteAzul = 4 Then esteAzul2= "marker-azul.png"
If esteAzul = 5 Then esteAzul2= "marker-azul.png"
If esteAzul = 6 Then esteAzul2= "marker-azul.png"
Else
If esteAzul = 1 Then esteAzul2= "marker-azul.png"
If esteAzul = 2 Then esteAzul2= "marker-azul1.png"
If esteAzul = 3 Then esteAzul2= "marker-azul2.png"
If esteAzul = 4 Then esteAzul2= "marker-azul3.png"
If esteAzul = 5 Then esteAzul2= "marker-azul4.png"
If esteAzul = 6 Then esteAzul2= "marker-azul1.png"
If esteAzul = 2 Then esteAzul2= "marker-azul.png"
If esteAzul = 3 Then esteAzul2= "marker-azul.png"
If esteAzul = 4 Then esteAzul2= "marker-azul.png"
If esteAzul = 5 Then esteAzul2= "marker-azul.png"
If esteAzul = 6 Then esteAzul2= "marker-azul.png"
End If
End If

View File

@@ -42,6 +42,8 @@ Sub Process_Globals
Dim inicioMapa As Boolean = False
Dim inicioLat As Double = 0
Dim inicioLon As Double = 0
Dim Logger As Boolean = False
Dim FECHA_HOY As String
End Sub
Sub Service_Create

View File

@@ -19,6 +19,8 @@ Sub Process_Globals
Dim rutaMaxPoints As Int = 3000
Dim rutaHrsAtras As Int = 48
' Dim rutaInicioHoy As String = ""
Dim in As Intent
Dim intentUsado As Boolean = False
End Sub
'Pone el valor de phn.Model en la variable global "devModel"
@@ -41,6 +43,62 @@ Sub getPhnId As String 'ignore
Return devModel
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
' Private tmpBDWA As Boolean = traeUsarIntentBDWA
Log("Revisamos intent de importar desde whatsapp")
Log(B4XPages.MainPage.intentUsado)
Log(in)
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(B4XPages.MainPage.intentUsado) And in <> Null Then
' Log(in)
LogColor("Importamos base de datos desde Whatsapp.", Colors.blue)
B4XPages.MainPage.intentUsado = True
' Log(in.As(String))
If in.GetData <> Null Then
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
'Regresa si se debe de usar el intent de importar la base d datos desde Whatsapp.
Sub traeUsarIntentBDWA As Boolean 'ignore
Private BDWA As Boolean = False
Private x As Cursor = Starter.skmt.ExecQuery($"select CAT_VA_VALOR from CAT_VARIABLES where CAT_VA_DESCRIPCION = 'IMPORTAR_BD_WA'"$)
If x.RowCount > 0 Then
x.Position = 0
If x.GetString("CAT_VA_VALOR") = "true" Then BDWA = True
End If
' Log($"cb_importarBDWA = ${BDWA}"$)
Return BDWA
End Sub
'Comprime y regresa un texto (str) en base64
Sub compress(str As String) As String 'ignore
'Requiere la libreria "CompressStrings"
@@ -730,7 +788,7 @@ Sub traeCliente As String 'ignore
cli.Position = 0
Private cl As String = cli.GetString("CUENTA")
cli.Close
Log("Algo paso..."& cl)
' Log("Algo paso..."& cl)
Return cl
End Sub

View File

@@ -192,47 +192,116 @@ Public Sub StopFLP
End Sub
Sub flp_LocationChanged (Location1 As Location)
Starter.trackerActividad = Subs.fechaKMT(DateTime.Now)
UUGCoords = Location1
' If Main.logger Then Log("SmallestDisplacement="&actualLR.GetSmallestDisplacement)
CallSub2(Starter, "GPS_LocationChanged", Location1)
' CallSub2(gestion, "GPS_LocationChanged", Location1)
' CallSubDelayed2(gestion, "GPS_LocationChanged", Location1)
' Starter.trackerActividad = Subs.fechaKMT(DateTime.Now)
' UUGCoords = Location1
'' If Main.logger Then Log("SmallestDisplacement="&actualLR.GetSmallestDisplacement)
' CallSub2(Starter, "GPS_LocationChanged", Location1)
'' CallSub2(gestion, "GPS_LocationChanged", Location1)
'' CallSubDelayed2(gestion, "GPS_LocationChanged", Location1)
' B4XPages.MainPage.lat_gps = Location1.Latitude
' B4XPages.MainPage.lon_gps = Location1.Longitude
''/////// para la ultima ubicacion FL
' Dim sDate,sTime As String
' DateTime.DateFormat = "MM/dd/yyyy"
' sDate=DateTime.Date(DateTime.Now)
' sTime=DateTime.Time(DateTime.Now)
' Try
' Starter.skmt.ExecNonQuery("DELETE FROM HIST_GPS")
' Starter.skmt.ExecNonQuery2("INSERT INTO HIST_GPS (HGDATE, HGLAT, HGLON) VALUES(?,?,?) ", Array As Object (sDate & sTime, B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps))
' Catch
' If B4XPages.MainPage.logger Then Log("Error al borrar o insertar nuevas coordendas en HIST_GPS")
' End Try
''///////
' Dim coords As String = Location1.Latitude&","&Location1.Longitude&","&formatoFecha(Location1.Time)
' Log("Loc changed : "&Location1.Latitude&","&Location1.Longitude)
' If B4XPages.MainPage.logger Then Log("Mandamos Ubicacion")
' If B4XPages.MainPage.logger Then Log(locRequest)
' ' Solo mandamos la ubicacion si la precision es menor a XX mts
' If Location1.Accuracy < 100 Then
' Subs.guardaInfoEnBD(coords)'Escribimos coordenadas y fecha en BD
'' CallSubDelayed2(FirebaseMessaging,"mandamosLoc",coords)
' Subs.mandamosLoc(coords)
' End If
' Dim origFormat As String = DateTime.TimeFormat 'Guardamos formato de fecha
' DateTime.TimeFormat = "HHmmss" ' Modificamos formato de fecha
' Dim minsDif As Int = DateTime.Time(DateTime.Now) - B4XPages.MainPage.ultimaActualizacionGPS
'' If Main.logger Then Log("UltimaAct="&Main.ultimaActualizacionGPS&" MinsDif="&minsDif)
' If Location1.Accuracy < 100 And minsDif > 240 Then 'Si precision de 100 y 4 min transcurridos manda a web
' If B4XPages.MainPage.logger Then Log("actualizamos Ubicacion Web")
' CallSubDelayed(Starter, "ENVIA_ULTIMA_GPS")
' End If
' DateTime.TimeFormat = origFormat 'Regresamos formato de fecha original
' 'Revisamos servicios
' Subs.monitor
' ToastMessageShow("Loc changed", False)
' Log($"Loc changed:${Location1.Longitude},${Location1.Latitude}"$)
B4XPages.MainPage.lat_gps = Location1.Latitude
B4XPages.MainPage.lon_gps = Location1.Longitude
'/////// para la ultima ubicacion FL
UUGCoords = Location1
' Log("SmallestDisplacement="&actualLR.GetSmallestDisplacement)
' If DateTime.Now > LastUpdateTime + 10 * DateTime.TicksPerSecond Then
' Dim n As Notification = CreateNotification($"$2.5{Location1.Latitude} / $2.5{Location1.Longitude}"$)
' n.Notify(nid)
' LastUpdateTime = DateTime.Now
' End If
'/////// para la ultima localización FL
Dim sDate,sTime As String
DateTime.DateFormat = "MM/dd/yyyy"
sDate=DateTime.Date(DateTime.Now)
sTime=DateTime.Time(DateTime.Now)
Try
Starter.skmt.ExecNonQuery("DELETE FROM HIST_GPS")
Starter.skmt.ExecNonQuery2("INSERT INTO HIST_GPS (HGDATE, HGLAT, HGLON) VALUES(?,?,?) ", Array As Object (sDate & sTime, B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps))
Catch
If B4XPages.MainPage.logger Then Log("Error al borrar o insertar nuevas coordendas en HIST_GPS")
End Try
'///////
' If Not(Starter.skmt.IsInitialized) Then Starter.skmt.Initialize(Starter.ruta,"kmt.db", True)
' Try
' B4XPages.MainPage.skmt.ExecNonQuery2("INSERT INTO HIST_GPS (HGDATE, HGLAT, HGLON) VALUES(?,?,?) ", Array As Object (sDate & sTime, B4XPages.MainPage.lat_gps, B4XPages.MainPage.lon_gps))
' B4XPages.MainPage.skmt.ExecNonQuery("DELETE FROM HIST_GPS")
' Catch
' LogColor(LastException, Colors.Red)
' End Try
'///////
Dim coords As String = Location1.Latitude&","&Location1.Longitude&","&formatoFecha(Location1.Time)
Log("Loc changed : "&Location1.Latitude&","&Location1.Longitude)
If B4XPages.MainPage.logger Then Log("Mandamos Ubicacion")
If B4XPages.MainPage.logger Then Log(locRequest)
' Log("Loc changed : "&Location1.Latitude&","&Location1.Longitude&"|"&B4XPages.MainPage.usuario&"|")
' Log("Mandamos Ubicacion")
' Log(FirebaseMessaging.locRequest)
' Solo mandamos la ubicacion si la precision es menor a XX mts
If Location1.Accuracy < 100 Then
Subs.guardaInfoEnBD(coords)'Escribimos coordenadas y fecha en BD
' CallSubDelayed2(FirebaseMessaging,"mandamosLoc",coords)
Subs.mandamosLoc(coords)
End If
Dim origFormat As String = DateTime.TimeFormat 'Guardamos formato de fecha
DateTime.TimeFormat = "HHmmss" ' Modificamos formato de fecha
Dim minsDif As Int = DateTime.Time(DateTime.Now) - B4XPages.MainPage.ultimaActualizacionGPS
' If Main.logger Then Log("UltimaAct="&Main.ultimaActualizacionGPS&" MinsDif="&minsDif)
If Location1.Accuracy < 100 And minsDif > 240 Then 'Si precision de 100 y 4 min transcurridos manda a web
If B4XPages.MainPage.logger Then Log("actualizamos Ubicacion Web")
CallSubDelayed(Starter, "ENVIA_ULTIMA_GPS")
CallSub2(Starter, "GPS_LocationChanged", Location1)
CallSub2(B4XPages.MainPage.cliente, "GPS_LocationChanged", Location1)
' CallSub2(gestion, "GPS_LocationChanged", Location1)
If B4XPages.MainPage.cliente.IsInitialized Then
CallSub2(B4XPages.GetPage("Cliente"), "GPS_LocationChanged", Location1)
End If
DateTime.TimeFormat = origFormat 'Regresamos formato de fecha original
'Revisamos servicios
Subs.monitor
' CallSub2(nuevocliente, "GPS_LocationChanged", Location1)
End Sub
Public Sub StartFLP2
Private logger As Boolean = True
If logger Then Log("StartFLP2 - flpStarted="&flpStarted)
Do While FLP.IsConnected = False
Sleep(500)
If logger Then Log("kll - sleeping")
Loop
dameUltimaUbicacionConocida 'Regresamos ultima ubicacion conocida
FLP.RequestLocationUpdates(CreateLocationRequest2) 'Buscamos ubicacion 2 peticiones
If logger Then LogColor("Buscamos ubicacion (movimientoMinimo = "&actualLR.GetSmallestDisplacement&")", Colors.Magenta)
' If logger Then Log(actualLR.GetSmallestDisplacement)
End Sub
Private Sub CreateLocationRequest2 As LocationRequest
Private logger As Boolean = True
If logger Then Log("Iniciamos CreateLocationRequest2")
Dim lr As LocationRequest
lr.Initialize
lr.SetInterval(1000) 'Intervalo deseado para actualizaciones de ubicacion
lr.SetFastestInterval(lr.GetInterval / 2) 'Intervalo minimo para actualizaciones de ubicacion
lr.setNumUpdates(2) 'Solicitamos solo 2 actualizaciones con estos parametros
lr.SetSmallestDisplacement(1) 'Solo registra cambio de ubicacion si es mayor a XX mts
lr.SetPriority(lr.Priority.PRIORITY_HIGH_ACCURACY)
actualLR=lr
Return lr
End Sub
Sub CreateNotification (Body As String) As Notification 'ignore

View File

@@ -78,7 +78,7 @@ Sub Process_Globals
'These variables can be accessed from all modules.
'Aqui va la liga al archivo .ver en el servidor que contiene la información de la aplicacion
Public lnk As String = "https://keymon.lat/movil/Guna/Guna_reparto.ver"
Public lnk As String = "https://keymon.net/movil/Guna/Guna_reparto.ver"
'/// En el servidor se necesita un archivo de texto (.ver) que tenga los siguientes
'/// datos separados por un tabulador

710
B4A/barcodeGenerator.bas Normal file
View File

@@ -0,0 +1,710 @@
B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=12.2
@EndOfDesignText@
'version 1.02
Sub Class_Globals
Private xui As XUI
Public cvs As B4XCanvas
Private xview As B4XView
End Sub
Public Sub Initialize
Dim xview As B4XView = xui.CreatePanel(Null)
xview.SetLayoutAnimated(0, 0, 0, 1050dip, 300dip)
xview.Color = xui.Color_White
End Sub
#Region EAN13
Public Sub EAN13(codigo As String) As B4XBitmap
cvs.Initialize(xview)
cvs.ClearRect(cvs.TargetRect)
If codigo.Length=12 Then codigo = "0" & codigo
If codigo.Length=13 Then
Dim novoCodigo As String = preparaEAN13(codigo)
If novoCodigo<>"" Then
'Dim canvas As B4XCanvas
Dim alturaPainel As Int = xview.Height
Dim larguraPainel As Int = xview.Width
Dim larguraCodigo As Int = xview.Width - 100dip
'Calcula as dimensões dos elementos do código de barras'
Dim alturaNumero As Int = 40dip 'altura dos números abaixo do código'
Dim larguraBarra As Int = larguraCodigo / 95 'largura de cada barra'
Dim alturaBarra As Int = alturaPainel - alturaNumero'altura das barras'
'Desenha as barras e os números do código de barras'
Dim rect As B4XRect
rect.Initialize(0, 0, larguraPainel, alturaPainel)
cvs.DrawRect(rect, xui.Color_White, True, 0) 'fundo branco'
Dim larguraAtual As Int = 50dip
For i=0 To novoCodigo.Length-1
Dim cor As Int = xui.Color_Black
If novoCodigo.CharAt(i) = "0" Then cor = xui.Color_White
If novoCodigo.CharAt(i) = "2" Then
cvs.DrawLine(larguraAtual, 0, larguraAtual, alturaBarra, cor, larguraBarra)
Else
cvs.DrawLine(larguraAtual, 0, larguraAtual, alturaBarra - alturaNumero, cor, larguraBarra)
End If
larguraAtual = larguraAtual + larguraBarra
Next
'Desenha o número abaixo do código de barras'
Dim fonte As B4XFont = xui.CreateFontAwesome(63)
Dim sb As StringBuilder
sb.Initialize
For i=1 To codigo.Length
Dim codigoCaracter As String = codigo.CharAt(i-1)
sb.Append(codigoCaracter)
If i=1 Then
sb.Append(" ")
Else If i=7 Then
sb.Append(" ")
Else If i=13 Then
'nao adiciona nada
Else
sb.Append(" ")
End If
Next
cvs.DrawText(sb.ToString, 1dip, alturaBarra+10dip, fonte, xui.Color_Black, "LEFT")
End If
End If
cvs.Invalidate
Dim res As B4XBitmap = cvs.CreateBitmap
cvs.Release
Return res
End Sub
Private Sub preparaEAN13(codigo As String) As String
Dim primeiroDigito As String = codigo.SubString2(0,1)
Dim primeiroGrupo As String = codigo.SubString2(1,7)
Dim segundoGrupo As String = codigo.SubString2(7,13)
Dim sequenciaNovo As String = ""
Dim codigoNovo As String = "-" & primeiroGrupo & "=" & segundoGrupo & "-"
If primeiroDigito="0" Then sequenciaNovo="-LLLLLL=RRRRRR-"
If primeiroDigito="1" Then sequenciaNovo="-LLGLGG=RRRRRR-"
If primeiroDigito="2" Then sequenciaNovo="-LLGGLG=RRRRRR-"
If primeiroDigito="3" Then sequenciaNovo="-LLGGGL=RRRRRR-"
If primeiroDigito="4" Then sequenciaNovo="-LGLLGG=RRRRRR-"
If primeiroDigito="5" Then sequenciaNovo="-LGGLLG=RRRRRR-"
If primeiroDigito="6" Then sequenciaNovo="-LGGGLL=RRRRRR-"
If primeiroDigito="7" Then sequenciaNovo="-LGLGLG=RRRRRR-"
If primeiroDigito="8" Then sequenciaNovo="-LGLGGL=RRRRRR-"
If primeiroDigito="9" Then sequenciaNovo="-LGGLGL=RRRRRR-"
Dim sb As StringBuilder
sb.Initialize
For i=0 To codigoNovo.Length-1
Dim digitoGrupo As String = codigoNovo.CharAt(i)
Dim sequenciaGrupo As String = sequenciaNovo.CharAt(i)
If sequenciaGrupo="L" Then
If digitoGrupo="0" Then sb.Append("0001101")
If digitoGrupo="1" Then sb.Append("0011001")
If digitoGrupo="2" Then sb.Append("0010011")
If digitoGrupo="3" Then sb.Append("0111101")
If digitoGrupo="4" Then sb.Append("0100011")
If digitoGrupo="5" Then sb.Append("0110001")
If digitoGrupo="6" Then sb.Append("0101111")
If digitoGrupo="7" Then sb.Append("0111011")
If digitoGrupo="8" Then sb.Append("0110111")
If digitoGrupo="9" Then sb.Append("0001011")
else If sequenciaGrupo="G" Then
If digitoGrupo="0" Then sb.Append("0100111")
If digitoGrupo="1" Then sb.Append("0110011")
If digitoGrupo="2" Then sb.Append("0011011")
If digitoGrupo="3" Then sb.Append("0100001")
If digitoGrupo="4" Then sb.Append("0011101")
If digitoGrupo="5" Then sb.Append("0111001")
If digitoGrupo="6" Then sb.Append("0000101")
If digitoGrupo="7" Then sb.Append("0010001")
If digitoGrupo="8" Then sb.Append("0001001")
If digitoGrupo="9" Then sb.Append("0010111")
Else If sequenciaGrupo="R" Then
If digitoGrupo="0" Then sb.Append("1110010")
If digitoGrupo="1" Then sb.Append("1100110")
If digitoGrupo="2" Then sb.Append("1101100")
If digitoGrupo="3" Then sb.Append("1000010")
If digitoGrupo="4" Then sb.Append("1011100")
If digitoGrupo="5" Then sb.Append("1001110")
If digitoGrupo="6" Then sb.Append("1010000")
If digitoGrupo="7" Then sb.Append("1000100")
If digitoGrupo="8" Then sb.Append("1001000")
If digitoGrupo="9" Then sb.Append("1110100")
Else If sequenciaGrupo="-" Then
sb.Append("202")
Else If sequenciaGrupo="=" Then
sb.Append("02020")
End If
Next
Return sb.ToString
End Sub
#End Region
#Region UPCA
Public Sub UPCA(codigo As String) As B4XBitmap
cvs.Initialize(xview)
cvs.ClearRect(cvs.TargetRect)
If codigo.Length=11 Then codigo = "0" & codigo
If codigo.Length=12 Then
Dim novoCodigo As String = preparaUPCA(codigo)
If novoCodigo<>"" Then
'Dim canvas As B4XCanvas
Dim alturaPainel As Int = xview.Height
Dim larguraPainel As Int = xview.Width
Dim larguraCodigo As Int = xview.Width - 100dip
'Calcula as dimensões dos elementos do código de barras'
Dim alturaNumero As Int = 40dip 'altura dos números abaixo do código'
Dim larguraBarra As Int = larguraCodigo / 95 'largura de cada barra'
Dim alturaBarra As Int = alturaPainel - alturaNumero'altura das barras'
'Desenha as barras e os números do código de barras'
Dim rect As B4XRect
rect.Initialize(0, 0, larguraPainel, alturaPainel)
cvs.DrawRect(rect, xui.Color_White, True, 0) 'fundo branco'
Dim larguraAtual As Int = 50dip
For i=0 To novoCodigo.Length-1
Dim cor As Int = xui.Color_Black
If novoCodigo.CharAt(i) = "0" Then cor = xui.Color_White
If novoCodigo.CharAt(i) = "2" Then
cvs.DrawLine(larguraAtual, 0, larguraAtual, alturaBarra, cor, larguraBarra)
Else
cvs.DrawLine(larguraAtual, 0, larguraAtual, alturaBarra - alturaNumero, cor, larguraBarra)
End If
larguraAtual = larguraAtual + larguraBarra
Next
'Desenha o número abaixo do código de barras'
Dim fonte As B4XFont = xui.CreateFontAwesome(63)
Dim sb As StringBuilder
sb.Initialize
For i=1 To codigo.Length
Dim codigoCaracter As String = codigo.CharAt(i-1)
sb.Append(codigoCaracter)
If i=1 Then
sb.Append(" ")
Else If i=6 Then
sb.Append(" ")
Else If i=11 Then
sb.Append(" ")
Else If i=12 Then
'nao adiciona nada
Else
sb.Append(" ")
End If
Next
cvs.DrawText(sb.ToString, 1dip, alturaBarra+10dip, fonte, xui.Color_Black, "LEFT")
End If
End If
cvs.Invalidate
Dim res As B4XBitmap = cvs.CreateBitmap
cvs.Release
Return res
End Sub
Private Sub preparaUPCA(codigo As String) As String
Dim primeiroGrupo As String = codigo.SubString2(0,6)
Dim segundoGrupo As String = codigo.SubString2(6,12)
Dim sequenciaNovo As String = "-JLLLLL=RRRRRS-"
Dim codigoNovo As String = "-" & primeiroGrupo & "=" & segundoGrupo & "-"
Dim sb As StringBuilder
sb.Initialize
For i=0 To codigoNovo.Length-1
Dim digitoGrupo As String = codigoNovo.CharAt(i)
Dim sequenciaGrupo As String = sequenciaNovo.CharAt(i)
If sequenciaGrupo="L" Then
If digitoGrupo="0" Then sb.Append("0001101")
If digitoGrupo="1" Then sb.Append("0011001")
If digitoGrupo="2" Then sb.Append("0010011")
If digitoGrupo="3" Then sb.Append("0111101")
If digitoGrupo="4" Then sb.Append("0100011")
If digitoGrupo="5" Then sb.Append("0110001")
If digitoGrupo="6" Then sb.Append("0101111")
If digitoGrupo="7" Then sb.Append("0111011")
If digitoGrupo="8" Then sb.Append("0110111")
If digitoGrupo="9" Then sb.Append("0001011")
Else If sequenciaGrupo="J" Then
If digitoGrupo="0" Then sb.Append("0001101".Replace("1","2"))
If digitoGrupo="1" Then sb.Append("0011001".Replace("1","2"))
If digitoGrupo="2" Then sb.Append("0010011".Replace("1","2"))
If digitoGrupo="3" Then sb.Append("0111101".Replace("1","2"))
If digitoGrupo="4" Then sb.Append("0100011".Replace("1","2"))
If digitoGrupo="5" Then sb.Append("0110001".Replace("1","2"))
If digitoGrupo="6" Then sb.Append("0101111".Replace("1","2"))
If digitoGrupo="7" Then sb.Append("0111011".Replace("1","2"))
If digitoGrupo="8" Then sb.Append("0110111".Replace("1","2"))
If digitoGrupo="9" Then sb.Append("0001011".Replace("1","2"))
Else If sequenciaGrupo="R" Then
If digitoGrupo="0" Then sb.Append("1110010")
If digitoGrupo="1" Then sb.Append("1100110")
If digitoGrupo="2" Then sb.Append("1101100")
If digitoGrupo="3" Then sb.Append("1000010")
If digitoGrupo="4" Then sb.Append("1011100")
If digitoGrupo="5" Then sb.Append("1001110")
If digitoGrupo="6" Then sb.Append("1010000")
If digitoGrupo="7" Then sb.Append("1000100")
If digitoGrupo="8" Then sb.Append("1001000")
If digitoGrupo="9" Then sb.Append("1110100")
Else If sequenciaGrupo="S" Then
If digitoGrupo="0" Then sb.Append("1110010".Replace("1","2"))
If digitoGrupo="1" Then sb.Append("1100110".Replace("1","2"))
If digitoGrupo="2" Then sb.Append("1101100".Replace("1","2"))
If digitoGrupo="3" Then sb.Append("1000010".Replace("1","2"))
If digitoGrupo="4" Then sb.Append("1011100".Replace("1","2"))
If digitoGrupo="5" Then sb.Append("1001110".Replace("1","2"))
If digitoGrupo="6" Then sb.Append("1010000".Replace("1","2"))
If digitoGrupo="7" Then sb.Append("1000100".Replace("1","2"))
If digitoGrupo="8" Then sb.Append("1001000".Replace("1","2"))
If digitoGrupo="9" Then sb.Append("1110100".Replace("1","2"))
Else If sequenciaGrupo="-" Then
sb.Append("202")
Else If sequenciaGrupo="=" Then
sb.Append("02020")
End If
Next
Return sb.ToString
End Sub
#End Region
#Region CODE128
Public Sub CODE128(codigo As String) As B4XBitmap
cvs.Initialize(xview)
cvs.ClearRect(cvs.TargetRect)
Dim novoCodigo As String = preparaCODE128(codigo)
If novoCodigo<>"" Then
'Dim canvas As B4XCanvas
Dim alturaPainel As Int = xview.Height
Dim larguraPainel As Int = xview.Width
Dim larguraCodigo As Int = xview.Width - 100dip
'Calcula as dimensões dos elementos do código de barras'
Dim alturaNumero As Int = 40dip 'altura dos números abaixo do código'
Dim larguraBarra As Int = larguraCodigo / ((codigo.Length*11)+11+11+13) 'largura de cada barra'
Dim alturaBarra As Int = alturaPainel - alturaNumero'altura das barras'
'Desenha as barras e os números do código de barras'
Dim rect As B4XRect
rect.Initialize(0, 0, larguraPainel, alturaPainel)
cvs.DrawRect(rect, xui.Color_White, True, 0) 'fundo branco'
Dim larguraAtual As Int = 50dip
For i=0 To novoCodigo.Length-1
Dim cor As Int = xui.Color_Black
If novoCodigo.CharAt(i) = "0" Then cor = xui.Color_White
If novoCodigo.CharAt(i) = "2" Then
cvs.DrawLine(larguraAtual, 0, larguraAtual, alturaBarra, cor, larguraBarra)
Else If novoCodigo.CharAt(i) = "3" Then
cvs.DrawLine(larguraAtual, 0, larguraAtual, alturaBarra, xui.Color_Blue, larguraBarra)
Else
cvs.DrawLine(larguraAtual, 0, larguraAtual, alturaBarra - alturaNumero, cor, larguraBarra)
End If
larguraAtual = larguraAtual + larguraBarra
Next
'Desenha o número abaixo do código de barras'
Dim fonte As B4XFont = xui.CreateFontAwesome(63)
cvs.DrawText(codigo, cvs.TargetRect.CenterX, alturaBarra+10dip, fonte, xui.Color_Black, "CENTER")
End If
cvs.Invalidate
Dim res As B4XBitmap = cvs.CreateBitmap
cvs.Release
Return res
End Sub
Private Sub preparaCODE128(codigo As String) As String
Dim codigoNovo As String = codigo
Dim sb As StringBuilder
sb.Initialize
sb.Append("11010010000") ' iniciar codigo b
Dim somatoria As Int = 104 ' valor do inicio
For i=0 To codigoNovo.Length-1
Dim digitoGrupo As String = codigoNovo.CharAt(i)
Dim multiplicador As Int = (i+1)
Dim valorDigito As Int = valorDigitoCODE128(digitoGrupo)
Dim valorDigitoMultiplicado As Int = (multiplicador*valorDigito)
somatoria = (somatoria + valorDigitoMultiplicado)
sb.Append(sequenciaDigitoCODE128(digitoGrupo))
Next
Dim checksum As Int = (somatoria Mod 103)
Dim checksumDigito As String = codigoDigitoCODE128(checksum)
sb.Append(sequenciaDigitoCODE128(checksumDigito))
sb.Append("1100011101011") 'fim do codigo
Return sb.ToString
End Sub
Private Sub sequenciaDigitoCODE128(digitoGrupo As String) As String
If digitoGrupo=" " Then Return "11011001100"
If digitoGrupo="!" Then Return "11001101100"
If digitoGrupo=$"""$ Then Return "11001100110"
If digitoGrupo="#" Then Return "10010011000"
If digitoGrupo="$" Then Return "10010001100"
If digitoGrupo="%" Then Return "10001001100"
If digitoGrupo="&" Then Return "10011001000"
If digitoGrupo="'" Then Return "10011000100"
If digitoGrupo="(" Then Return "10001100100"
If digitoGrupo=")" Then Return "11001001000"
If digitoGrupo="*" Then Return "11001000100"
If digitoGrupo="+" Then Return "11000100100"
If digitoGrupo="," Then Return "10110011100"
If digitoGrupo="-" Then Return "10011011100"
If digitoGrupo="." Then Return "10011001110"
If digitoGrupo="/" Then Return "10111001100"
If digitoGrupo="0" Then Return "10011101100"
If digitoGrupo="1" Then Return "10011100110"
If digitoGrupo="2" Then Return "11001110010"
If digitoGrupo="3" Then Return "11001011100"
If digitoGrupo="4" Then Return "11001001110"
If digitoGrupo="5" Then Return "11011100100"
If digitoGrupo="6" Then Return "11001110100"
If digitoGrupo="7" Then Return "11101101110"
If digitoGrupo="8" Then Return "11101001100"
If digitoGrupo="9" Then Return "11100101100"
If digitoGrupo=":" Then Return "11100100110"
If digitoGrupo=";" Then Return "11101100100"
If digitoGrupo="<" Then Return "11100110100"
If digitoGrupo="=" Then Return "11100110010"
If digitoGrupo=">" Then Return "11011011000"
If digitoGrupo="?" Then Return "11011000110"
If digitoGrupo="@" Then Return "11000110110"
If digitoGrupo="A" Then Return "10100011000"
If digitoGrupo="B" Then Return "10001011000"
If digitoGrupo="C" Then Return "10001000110"
If digitoGrupo="D" Then Return "10110001000"
If digitoGrupo="E" Then Return "10001101000"
If digitoGrupo="F" Then Return "10001100010"
If digitoGrupo="G" Then Return "11010001000"
If digitoGrupo="H" Then Return "11000101000"
If digitoGrupo="I" Then Return "11000100010"
If digitoGrupo="J" Then Return "10110111000"
If digitoGrupo="K" Then Return "10110001110"
If digitoGrupo="L" Then Return "10001101110"
If digitoGrupo="M" Then Return "10111011000"
If digitoGrupo="N" Then Return "10111000110"
If digitoGrupo="O" Then Return "10001110110"
If digitoGrupo="P" Then Return "11101110110"
If digitoGrupo="Q" Then Return "11010001110"
If digitoGrupo="R" Then Return "11000101110"
If digitoGrupo="S" Then Return "11011101000"
If digitoGrupo="T" Then Return "11011100010"
If digitoGrupo="U" Then Return "11011101110"
If digitoGrupo="V" Then Return "11101011000"
If digitoGrupo="W" Then Return "11101000110"
If digitoGrupo="X" Then Return "11100010110"
If digitoGrupo="Y" Then Return "11101101000"
If digitoGrupo="Z" Then Return "11101100010"
If digitoGrupo="[" Then Return "11100011010"
If digitoGrupo="\" Then Return "11101111010"
If digitoGrupo="]" Then Return "11001000010"
If digitoGrupo="^" Then Return "11110001010"
If digitoGrupo="_" Then Return "10100110000"
If digitoGrupo="`" Then Return "10100001100"
If digitoGrupo="a" Then Return "10010110000"
If digitoGrupo="b" Then Return "10010000110"
If digitoGrupo="c" Then Return "10000101100"
If digitoGrupo="d" Then Return "10000100110"
If digitoGrupo="e" Then Return "10110010000"
If digitoGrupo="f" Then Return "10110000100"
If digitoGrupo="g" Then Return "10011010000"
If digitoGrupo="h" Then Return "10011000010"
If digitoGrupo="i" Then Return "10000110100"
If digitoGrupo="j" Then Return "10000110010"
If digitoGrupo="k" Then Return "11000010010"
If digitoGrupo="l" Then Return "11001010000"
If digitoGrupo="m" Then Return "11110111010"
If digitoGrupo="n" Then Return "11000010100"
If digitoGrupo="o" Then Return "10001111010"
If digitoGrupo="p" Then Return "10100111100"
If digitoGrupo="q" Then Return "10010111100"
If digitoGrupo="r" Then Return "10010011110"
If digitoGrupo="s" Then Return "10111100100"
If digitoGrupo="t" Then Return "10011110100"
If digitoGrupo="u" Then Return "10011110010"
If digitoGrupo="v" Then Return "11110100100"
If digitoGrupo="w" Then Return "11110010100"
If digitoGrupo="x" Then Return "11110010010"
If digitoGrupo="y" Then Return "11011011110"
If digitoGrupo="z" Then Return "11011110110"
If digitoGrupo="{" Then Return "11110110110"
If digitoGrupo="|" Then Return "10101111000"
If digitoGrupo="}" Then Return "10100011110"
If digitoGrupo="~" Then Return "10001011110"
Return ""
End Sub
Private Sub valorDigitoCODE128(digitoGrupo As String) As Int
If digitoGrupo=" " Then Return 0
If digitoGrupo="!" Then Return 1
If digitoGrupo=$"""$ Then Return 2
If digitoGrupo="#" Then Return 3
If digitoGrupo="$" Then Return 4
If digitoGrupo="%" Then Return 5
If digitoGrupo="&" Then Return 6
If digitoGrupo="'" Then Return 7
If digitoGrupo="(" Then Return 8
If digitoGrupo=")" Then Return 9
If digitoGrupo="*" Then Return 10
If digitoGrupo="+" Then Return 11
If digitoGrupo="," Then Return 12
If digitoGrupo="-" Then Return 13
If digitoGrupo="." Then Return 14
If digitoGrupo="/" Then Return 15
If digitoGrupo="0" Then Return 16
If digitoGrupo="1" Then Return 17
If digitoGrupo="2" Then Return 18
If digitoGrupo="3" Then Return 19
If digitoGrupo="4" Then Return 20
If digitoGrupo="5" Then Return 21
If digitoGrupo="6" Then Return 22
If digitoGrupo="7" Then Return 23
If digitoGrupo="8" Then Return 24
If digitoGrupo="9" Then Return 25
If digitoGrupo=":" Then Return 26
If digitoGrupo=";" Then Return 27
If digitoGrupo="<" Then Return 28
If digitoGrupo="=" Then Return 29
If digitoGrupo=">" Then Return 30
If digitoGrupo="?" Then Return 31
If digitoGrupo="@" Then Return 32
If digitoGrupo="A" Then Return 33
If digitoGrupo="B" Then Return 34
If digitoGrupo="C" Then Return 35
If digitoGrupo="D" Then Return 36
If digitoGrupo="E" Then Return 37
If digitoGrupo="F" Then Return 38
If digitoGrupo="G" Then Return 39
If digitoGrupo="H" Then Return 40
If digitoGrupo="I" Then Return 41
If digitoGrupo="J" Then Return 42
If digitoGrupo="K" Then Return 43
If digitoGrupo="L" Then Return 44
If digitoGrupo="M" Then Return 45
If digitoGrupo="N" Then Return 46
If digitoGrupo="O" Then Return 47
If digitoGrupo="P" Then Return 48
If digitoGrupo="Q" Then Return 49
If digitoGrupo="R" Then Return 50
If digitoGrupo="S" Then Return 51
If digitoGrupo="T" Then Return 52
If digitoGrupo="U" Then Return 53
If digitoGrupo="V" Then Return 54
If digitoGrupo="W" Then Return 55
If digitoGrupo="X" Then Return 56
If digitoGrupo="Y" Then Return 57
If digitoGrupo="Z" Then Return 58
If digitoGrupo="[" Then Return 59
If digitoGrupo="\" Then Return 60
If digitoGrupo="]" Then Return 61
If digitoGrupo="^" Then Return 62
If digitoGrupo="_" Then Return 63
If digitoGrupo="`" Then Return 64
If digitoGrupo="a" Then Return 65
If digitoGrupo="b" Then Return 66
If digitoGrupo="c" Then Return 67
If digitoGrupo="d" Then Return 68
If digitoGrupo="e" Then Return 69
If digitoGrupo="f" Then Return 70
If digitoGrupo="g" Then Return 71
If digitoGrupo="h" Then Return 72
If digitoGrupo="i" Then Return 73
If digitoGrupo="j" Then Return 74
If digitoGrupo="k" Then Return 75
If digitoGrupo="l" Then Return 76
If digitoGrupo="m" Then Return 77
If digitoGrupo="n" Then Return 78
If digitoGrupo="o" Then Return 79
If digitoGrupo="p" Then Return 80
If digitoGrupo="q" Then Return 81
If digitoGrupo="r" Then Return 82
If digitoGrupo="s" Then Return 83
If digitoGrupo="t" Then Return 84
If digitoGrupo="u" Then Return 85
If digitoGrupo="v" Then Return 86
If digitoGrupo="w" Then Return 87
If digitoGrupo="x" Then Return 88
If digitoGrupo="y" Then Return 89
If digitoGrupo="z" Then Return 90
If digitoGrupo="{" Then Return 91
If digitoGrupo="|" Then Return 92
If digitoGrupo="}" Then Return 93
If digitoGrupo="~" Then Return 94
Return 0
End Sub
Private Sub codigoDigitoCODE128(digitoGrupo As Int) As String
If digitoGrupo=0 Then Return " "
If digitoGrupo=1 Then Return "!"
If digitoGrupo=2 Then Return $"""$
If digitoGrupo=3 Then Return "#"
If digitoGrupo=4 Then Return "$"
If digitoGrupo=5 Then Return "%"
If digitoGrupo=6 Then Return "&"
If digitoGrupo=7 Then Return "'"
If digitoGrupo=8 Then Return "("
If digitoGrupo=9 Then Return ")"
If digitoGrupo=10 Then Return "*"
If digitoGrupo=11 Then Return "+"
If digitoGrupo=12 Then Return ","
If digitoGrupo=13 Then Return "-"
If digitoGrupo=14 Then Return "."
If digitoGrupo=15 Then Return "/"
If digitoGrupo=16 Then Return "0"
If digitoGrupo=17 Then Return "1"
If digitoGrupo=18 Then Return "2"
If digitoGrupo=19 Then Return "3"
If digitoGrupo=20 Then Return "4"
If digitoGrupo=21 Then Return "5"
If digitoGrupo=22 Then Return "6"
If digitoGrupo=23 Then Return "7"
If digitoGrupo=24 Then Return "8"
If digitoGrupo=25 Then Return "9"
If digitoGrupo=26 Then Return ":"
If digitoGrupo=27 Then Return ";"
If digitoGrupo=28 Then Return "<"
If digitoGrupo=29 Then Return "="
If digitoGrupo=30 Then Return ">"
If digitoGrupo=31 Then Return "?"
If digitoGrupo=32 Then Return "@"
If digitoGrupo=33 Then Return "A"
If digitoGrupo=34 Then Return "B"
If digitoGrupo=35 Then Return "C"
If digitoGrupo=36 Then Return "D"
If digitoGrupo=37 Then Return "E"
If digitoGrupo=38 Then Return "F"
If digitoGrupo=39 Then Return "G"
If digitoGrupo=40 Then Return "H"
If digitoGrupo=41 Then Return "I"
If digitoGrupo=42 Then Return "J"
If digitoGrupo=43 Then Return "K"
If digitoGrupo=44 Then Return "L"
If digitoGrupo=45 Then Return "M"
If digitoGrupo=46 Then Return "N"
If digitoGrupo=47 Then Return "O"
If digitoGrupo=48 Then Return "P"
If digitoGrupo=49 Then Return "Q"
If digitoGrupo=50 Then Return "R"
If digitoGrupo=51 Then Return "S"
If digitoGrupo=52 Then Return "T"
If digitoGrupo=53 Then Return "U"
If digitoGrupo=54 Then Return "V"
If digitoGrupo=55 Then Return "W"
If digitoGrupo=56 Then Return "X"
If digitoGrupo=57 Then Return "Y"
If digitoGrupo=58 Then Return "Z"
If digitoGrupo=59 Then Return "["
If digitoGrupo=60 Then Return "\"
If digitoGrupo=61 Then Return "]"
If digitoGrupo=62 Then Return "^"
If digitoGrupo=63 Then Return "_"
If digitoGrupo=64 Then Return "`"
If digitoGrupo=65 Then Return "a"
If digitoGrupo=66 Then Return "b"
If digitoGrupo=67 Then Return "c"
If digitoGrupo=68 Then Return "d"
If digitoGrupo=69 Then Return "e"
If digitoGrupo=70 Then Return "f"
If digitoGrupo=71 Then Return "g"
If digitoGrupo=72 Then Return "h"
If digitoGrupo=73 Then Return "i"
If digitoGrupo=74 Then Return "j"
If digitoGrupo=75 Then Return "k"
If digitoGrupo=76 Then Return "l"
If digitoGrupo=77 Then Return "m"
If digitoGrupo=78 Then Return "n"
If digitoGrupo=79 Then Return "o"
If digitoGrupo=80 Then Return "p"
If digitoGrupo=81 Then Return "q"
If digitoGrupo=82 Then Return "r"
If digitoGrupo=83 Then Return "s"
If digitoGrupo=84 Then Return "t"
If digitoGrupo=85 Then Return "u"
If digitoGrupo=86 Then Return "v"
If digitoGrupo=87 Then Return "w"
If digitoGrupo=88 Then Return "x"
If digitoGrupo=89 Then Return "y"
If digitoGrupo=90 Then Return "z"
If digitoGrupo=91 Then Return "{"
If digitoGrupo=92 Then Return "|"
If digitoGrupo=93 Then Return "}"
If digitoGrupo=94 Then Return "~"
Return " "
End Sub
#End Region

File diff suppressed because one or more lines are too long

View File

@@ -24,6 +24,7 @@ ModuleBookmarks29=
ModuleBookmarks3=
ModuleBookmarks30=
ModuleBookmarks31=
ModuleBookmarks32=
ModuleBookmarks4=
ModuleBookmarks5=
ModuleBookmarks6=
@@ -56,6 +57,7 @@ ModuleBreakpoints29=
ModuleBreakpoints3=
ModuleBreakpoints30=
ModuleBreakpoints31=
ModuleBreakpoints32=
ModuleBreakpoints4=
ModuleBreakpoints5=
ModuleBreakpoints6=
@@ -88,12 +90,13 @@ ModuleClosedNodes29=
ModuleClosedNodes3=
ModuleClosedNodes30=
ModuleClosedNodes31=
ModuleClosedNodes32=
ModuleClosedNodes4=
ModuleClosedNodes5=
ModuleClosedNodes6=
ModuleClosedNodes7=
ModuleClosedNodes8=
ModuleClosedNodes9=
NavigationStack=C_Cliente,b_cancel_pagare_Click,2995,2,C_Cliente,Class_Globals,1,0,C_Cliente,CheckBox1_CheckedChange,1976,0,C_Cliente,b_cxc_Click,1794,6,C_Cliente,cb_tipopago_SelectedIndexChanged,1788,0,C_Cheklist,Class_Globals,0,0,C_Cliente,b_acred_Click,1771,0,C_Cliente,b_abono_Click,2070,6,C_Principal,Class_Globals,0,0,B4XMainPage,B4XPage_Created,1304,0
NavigationStack=C_Cliente,gest_Click,1562,0,C_Cliente,B_IMP_Click,2671,2,C_Principal,B4XPage_Appear,219,2,C_Cliente,imprime_pagare,6075,1,Subs,traeRutaReparto,1045,0,C_Principal,Class_Globals,0,0,C_Principal,connecta_LongClick,3838,0,C_Principal,Subir_Click,863,0,C_Principal,JobDone,1454,0,C_Principal,envioinfo,1083,3
SelectedBuild=0
VisibleModules=2,16,4,5,6,7,9,30,29,27
VisibleModules=2,17,5,6,8,10,31,30,28,7