From e67a1f20c428f3b5e47eed37545554e368e54b12 Mon Sep 17 00:00:00 2001 From: cvaldes1201 Date: Mon, 26 Feb 2024 10:59:00 -0600 Subject: [PATCH] ... --- B4A/B4XMainPage.bas | 36 +- B4A/C_Cliente.bas | 356 ++++++++-- B4A/C_Principal.bas | 103 +-- B4A/C_Productos.bas | 13 +- B4A/C_Promos.bas | 13 +- B4A/EscPosPrinter.bas | 1158 +++++++++++++++++++++++++++++++++ B4A/Files/cliente.bal | Bin 35421 -> 35427 bytes B4A/Files/guna.png | Bin 0 -> 3902 bytes B4A/Files/login.bal | Bin 11187 -> 12435 bytes B4A/Guna Vistas V3.1.b4a | 105 +-- B4A/Guna Vistas V3.1.b4a.meta | 17 +- B4A/Starter.bas | 12 +- 12 files changed, 1657 insertions(+), 156 deletions(-) create mode 100644 B4A/EscPosPrinter.bas create mode 100644 B4A/Files/guna.png diff --git a/B4A/B4XMainPage.bas b/B4A/B4XMainPage.bas index ab67706..4bbe465 100644 --- a/B4A/B4XMainPage.bas +++ b/B4A/B4XMainPage.bas @@ -94,6 +94,7 @@ Sub Class_Globals Private b_envioBD As Button Public Provider As FileProvider Public rutaBDBackup = "" + Private B4XSwitch1 As B4XSwitch End Sub Public Sub Initialize @@ -147,6 +148,7 @@ Private Sub B4XPage_Created (Root1 As B4XView) File.Copy(File.DirAssets, "kmt.db", ruta, "kmt.db") End If skmt.Initialize(ruta,"kmt.db", True) + skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS IMPRESORA (HABILITADA)") skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS HIST_CUOTAS (HC_META6 TEXT, HC_META5 TEXT, HC_META4 TEXT, HC_META3 TEXT, HC_META2 TEXT, HC_META1 TEXT, HC_RUTA TEXT, HC_CUOTA1 TEXT, HC_CUOTA2 TEXT, HC_CUOTA3 TEXT, HC_CUOTA4 TEXT, HC_CUOTA5 TEXT, HC_CUOTA6 TEXT)") skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS HIST_GPS (HGDATE TEXT, HGLAT TEXT, HGLON TEXT)") skmt.ExecNonQuery("CREATE TABLE IF NOT EXISTS HIST_STAY_STORE (HSS_CODIGO TEXT, HSS_IN TEXT, HSS_OUT TEXT, HSS_TOT TEXT)") @@ -241,8 +243,8 @@ Sub B4XPage_Appear Starter.rp.CheckAndRequest(Starter.rp.PERMISSION_READ_PHONE_STATE) Wait For B4XPage_PermissionResult (Permission As String, Result As Boolean) If Result Then - IMEN.Text = Phn.GetDeviceId - IMEI = Phn.GetDeviceId + IMEN.Text ="" + IMEI = "" LogColor($"////////////////// IMEI: ${IMEI} ////////////////// "$, Colors.Blue) IMEI="" 'Pruebas End If @@ -291,6 +293,19 @@ Sub B4XPage_Appear 'Obtenemos el usuario registrado CallSubDelayed(FirebaseMessaging, "SubscribeToTopics") dameUsuario + + c = skmt.ExecQuery("SELECT HABILITADA FROM IMPRESORA") + If c.RowCount > 0 Then + c.Position = 0 + If c.GetString("HABILITADA") = 1 Then + B4XSwitch1.Value = True + Else If c.GetString("HABILITADA") = 0 Then + B4XSwitch1.Value = False + End If + Else + B4XSwitch1.Value = False + End If + End Sub 'You can see the list of page related events in the B4XPagesManager object. The event name is B4XPage. @@ -640,6 +655,13 @@ Sub i_engrane_Click l_server.Text = Starter.server Subs.panelVisible(p_appUpdate,0,0) p_appUpdate.Height = Root.Height + + c = skmt.ExecQuery("SELECT HABILITADA FROM IMPRESORA") + If c.RowCount = 0 Then + skmt.ExecNonQuery2("INSERT INTO IMPRESORA VALUES (?)", Array As Object(0)) + Else + + End If End Sub Sub b_regesar_Click @@ -679,3 +701,13 @@ Private Sub b_envioBD_Click in.Flags = 1 'FLAG_GRANT_READ_URI_PERMISSION StartActivity(in) End Sub + + +Private Sub B4XSwitch1_ValueChanged (Value As Boolean) + If Value Then + skmt.ExecNonQuery2("UPDATE IMPRESORA SET HABILITADA = (?)",Array As Object(1)) + Else + Log("desactivado") + skmt.ExecNonQuery2("UPDATE IMPRESORA SET HABILITADA = (?)",Array As Object(0)) + End If +End Sub \ No newline at end of file diff --git a/B4A/C_Cliente.bas b/B4A/C_Cliente.bas index ea1429f..8f64893 100644 --- a/B4A/C_Cliente.bas +++ b/B4A/C_Cliente.bas @@ -28,7 +28,8 @@ Sub Class_Globals Dim cuenta As String Dim tipo_venta As String = "PREVENTA" Dim MAC_IMPRESORA As String - + Dim btAdmin As BluetoothAdmin + Dim Printer1 As EscPosPrinter Dim c As Cursor Dim s As Cursor @@ -371,6 +372,8 @@ Sub Class_Globals Private p_m2 As Panel Private p_m3 As Panel Private p_m4 As Panel + Dim impresoraConectada As Boolean = False + Dim errorImpresora As Int = 0 End Sub 'You can add more parameters here. @@ -573,6 +576,35 @@ Sub B4XPage_Appear Else b_like.Visible = False End If + c = skmt.ExecQuery2("select CAT_VA_VALOR from CAT_VARIABLES WHERE CAT_VA_DESCRIPCION = ?", Array As String ("MACIMP")) + If c.RowCount > 0 Then + c.Position = 0 + Starter.MAC_IMPRESORA = c.GetString("CAT_VA_VALOR") + End If + If Starter.MAC_IMPRESORA = "" Then Starter.MAC_IMPRESORA = "0" + Log("|" & Starter.MAC_IMPRESORA & "|") + Printer1.Initialize(Me, "Printer1") + + If Printer1.IsConnected = False Then +' Printer1.Connect + Log("1") + Else + Printer1.DisConnect + Printer1.Connect + Log("2") + End If + + c = skmt.ExecQuery("SELECT HABILITADA FROM IMPRESORA") + If c.RowCount > 0 Then + c.Position = 0 + If c.GetString("HABILITADA") = 1 Then + B_IMP.Visible = True + Else If c.GetString("HABILITADA") = 0 Then + B_IMP.Visible = False + End If + Else If c.RowCount = 0 Then + B_IMP.Visible = False + End If End Sub Sub GPS_LocationChanged (Location1 As Location) @@ -791,7 +823,6 @@ Private Sub b_preguntag_Click Select Case result Case DialogResponse.POSITIVE - @@ -817,6 +848,7 @@ Private Sub b_preguntag_Click ' ' ' Else +Log(que_modulo) If que_modulo = Null Or que_modulo = " " Then que_modulo = "1" ' Msgbox(que_modulo,"ALO") If que_modulo < = ENCUESTA Then @@ -1480,50 +1512,286 @@ Sub b_mapa_Click B4XPages.ShowPage("mapas") End Sub +Sub Printer1_Connected (Success As Boolean) +' If Logger Then Log("Printer1_Connected") + If Success Then + ToastMessageShow("Impresora conectada", False) + skmt.ExecNonQuery2("delete from CAT_VARIABLES where CAT_VA_DESCRIPCION = ?", Array As Object ("MACIMP")) + skmt.ExecNonQuery2("INSERT INTO CAT_VARIABLES(CAT_VA_DESCRIPCION, CAT_VA_VALOR) VALUES (?,?)", Array As Object ("MACIMP",Starter.mac_impresora)) + LogColor("Impresora conectada", Colors.Green) +' B_IMP2.Enabled = True + impresoraConectada = True + Else +' Msgbox(Printer1.ConnectedErrorMsg, "Error connecting.") 'ignore +' ToastMessageShow("Error conectando la impresora", False) + LogColor("Error conectando la impresora", Colors.Red) + errorImpresora = errorImpresora + 1 + If errorImpresora > 1 Then + Starter.MAC_IMPRESORA = "0" + errorImpresora = 0 + End If + End If +End Sub + Sub B_IMP_Click +' Printer1.Connect2 +' c=Starter.skmt.ExecQuery2("select count(*) AS CUANTOS from CAT_VARIABLES WHERE CAT_VA_DESCRIPCION = ?", Array As String ("PERFIL")) +' c.Position =0 +' perfil = c.GetString("CUANTOS") +' c.Close + +' If perfil > 0 Then +' c=Starter.skmt.ExecQuery2("select CAT_VA_VALOR from CAT_VARIABLES WHERE CAT_VA_DESCRIPCION = ?", Array As String ("PERFIL")) +' If c.RowCount > 0 Then +' c.Position =0 +' perfil = c.GetString("CAT_VA_VALOR") +' c.Close +' End If +' LogColor(perfil,Colors.Magenta) +' End If + + + + c=skmt.ExecQuery("select USUARIO from usuarioa") + c.Position=0 + usuario = c.GetString("USUARIO") + DateTime.DateFormat = "MM/dd/yyyy" + sDate=DateTime.Date(DateTime.Now) + sTime=DateTime.Time(DateTime.Now) + c.Close +' c=Starter.skmt.ExecQuery2("SELECT CAT_VA_VALOR FROM CAT_VARIABLES WHERE CAT_VA_DESCRIPCION =?", Array As String ("SUCURSAL")) +' c.Position = 0 +' sucursal = c.GetString("CAT_VA_VALOR") +' c.Close + + ProgressDialogShow("Imprimiendo, un momento ...") + Printer1.DisConnect + If Not(Printer1.IsConnected) Then + Log("Conectando a impresora ...") + Printer1.Connect + Private cont As Int = 0 + Do While Not(impresoraConectada) + Sleep(1000) + Log("++++++ " & cont) + cont = cont + 1 + If cont = 2 Then Printer1.Connect 'Tratamos de reconectar + If cont > 3 Then impresoraConectada = True + Loop + Sleep(500) + impresoraConectada = False + Else + Log("conectando 2") + Printer1.Connect + Private cont As Int = 0 + Do While Not(impresoraConectada) Or Not(Printer1.IsConnected) + Sleep(1000) + Log("****** " & cont) + cont = cont + 1 + If cont = 2 Then Printer1.Connect + If cont > 3 Then impresoraConectada = True + Loop + Sleep(500) + impresoraConectada = False + End If + TAMANO = 0 ESPACIO = 21 BLANCO = " " - printer.Initialize(cmp20.OutputStream) - printer.WriteLine("DURAKELO S.A. de C.V.") - printer.WriteLine("RFC: DUR-011025-T12") - printer.WriteLine("Tel.: 618-826-0104") - printer.WriteLine("Vendedor: KMTS ") - printer.WriteLine("Tienda: " & La_nombre.Text) - printer.WriteLine("-----------PREVENTA-----------") - s=B4XPages.MainPage.skmt.ExecQuery("select PE_PRONOMBRE, PE_CANT, length(pe_cant) as L_CANT, PE_COSTOU, length(PE_COSTOU) as L_COSTOU, PE_COSTO_TOT, length(PE_COSTO_TOT) as L_COSTO_TOT FROM PEDIDO WHERE PE_CLIENTE IN (Select CUENTA from cuentaa)") + Dim bmp As Bitmap + bmp.InitializeResize(File.DirAssets, "guna.png", 192, 192, True) 'ignore + Dim myimage As AnImage = Printer1.ImageToBWIMage(bmp) + + myimage = Printer1.DitherImage2D(myimage, 128) + + myimage= Printer1.PackImage(myimage) + Printer1.WriteString(CRLF) ' nudge the printer to show the user something is happening + Printer1.WriteString(Printer1.REVERSE) + + Printer1.PrintImage(myimage) + Printer1.WriteString(Printer1.UNREVERSE) + + 'Printer1.Justify = 1 + 'printer.Initialize(cmp20.OutputStream) +' Printer1.WriteString("DISTRIBUIDORA ROCHA TULA PACHUCA" & CRLF) + Printer1.WriteString("RFC: DRT-110316-9J1" & CRLF) +' Printer1.WriteString(sucursal & CRLF) + Printer1.WriteString(sDate & CRLF) + Printer1.WriteString(sTime & CRLF) + Printer1.WriteString("Vendedor:" & usuario & CRLF) + Printer1.WriteString("Tienda: " & La_nombre.Text & CRLF) + Printer1.WriteString("ID.Cliente: " & la_cuenta.Text & CRLF) + Printer1.WriteString("Calle: " & la_Calle.Text & CRLF) + Printer1.WriteString("Colonia: " & la_col.Text & CRLF) +' Printer1.WriteString("C.P.: " & la_cp.Text & CRLF) + Printer1.WriteString("Entre calle1: " & l_entre1.Text & CRLF) + Printer1.WriteString("Entre Calle2: " & l_entre2.Text & CRLF) + + + Printer1.WriteString("-----------PREVENTA-----------" & CRLF) + ' aqui es donde esta el pedo de julieta de los descuentos quitar el precio2 pero meter un if para saber si es ruta especial o es normal o que show. + s=skmt.ExecQuery2("select PE_PRONOMBRE, PE_CANT, length(pe_cant) as L_CANT, PE_COSTOU, length(PE_COSTOU) as L_COSTOU,PE_CANT * PE_COSTOU AS PE_COSTO_TOT, length(PE_CANT * PE_COSTOU) as L_COSTO_TOT,PE_PROID, PE_CEDIS FROM PEDIDO WHERE PE_CEDIS <> ? AND LENGTH(PE_CEDIS) < 4 AND PE_CLIENTE IN (Select CUENTA from cuentaa) order by PE_PROID", Array As String("DUR")) If S.RowCount>0 Then For i=0 To S.RowCount -1 S.Position=i - printer.WriteLine(s.GetString("PE_CANT") & " " & s.GetString("PE_PRONOMBRE")) - TAMANO = s.GetLong("L_CANT") + TAMANO - TAMANO = s.GetLong("L_COSTOU") + TAMANO - TAMANO = s.GetLong("L_COSTO_TOT") + TAMANO - ESPACIO = ESPACIO - TAMANO - For E=0 To ESPACIO -1 - BLANCO = " " & BLANCO - Next - printer.WriteLine(BLANCO & s.GETSTRING("PE_CANT") & " X $" & s.GETSTRING("PE_COSTOU") & " $" & s.GETSTRING("PE_COSTO_TOT") ) - TAMANO = 0 - ESPACIO = 21 - BLANCO = " " + If s.GetString("PE_CEDIS") = s.GetString("PE_PROID") Then + Printer1.WriteString(s.GetString("PE_PRONOMBRE") & CRLF) + + Else + + Printer1.WriteString(s.GetString("PE_CANT") & " " & s.GetString("PE_PRONOMBRE") & CRLF) + TAMANO = s.GetLong("L_CANT") + TAMANO + TAMANO = s.GetLong("L_COSTOU") + TAMANO + TAMANO = s.GetLong("L_COSTO_TOT") + TAMANO + + ESPACIO = ESPACIO - TAMANO + + For E=0 To ESPACIO -1 + BLANCO = " " & BLANCO + Next + Printer1.WriteString(BLANCO & s.GETSTRING("PE_CANT") & " X $" & s.GETSTRING("PE_COSTOU") & " $" & s.GETSTRING("PE_COSTO_TOT") & CRLF ) + TAMANO = 0 + ESPACIO = 21 + BLANCO = " " + End If Next End If s.Close - printer.WriteLine("Total Preventa: $" & total_cliente) - printer.WriteLine("------------VENTA-------------") - printer.WriteLine(" ") - printer.WriteLine("TOTAL: $" & total_cliente) - printer.WriteLine(" ") - printer.WriteLine("----ESTE TICKET NO ES UN -----") - printer.WriteLine("--COMPROBANTE FISCAL, SOLO ES-") - printer.WriteLine("--------INFORMATIVO-----------") - printer.WriteLine("------------------------------") - printer.WriteLine(" ") - printer.Flush -' printer.Close + Printer1.WriteString(" " & CRLF) + s=skmt.ExecQuery("select PE_PRONOMBRE, PE_CANT, length(pe_cant) as L_CANT, PE_COSTOU, length(PE_COSTOU) as L_COSTOU,PE_CANT * PE_COSTOU AS PE_COSTO_TOT, length(PE_CANT * PE_COSTOU) as L_COSTO_TOT,PE_PROID, PE_CEDIS FROM PEDIDO WHERE LENGTH(PE_CEDIS) > 3 AND PE_PROID NOT IN (SELECT CAT_PA_ID FROM PROMOS_COMP ) AND PE_CLIENTE IN (Select CUENTA from cuentaa) order by PE_CEDIS, PE_COSTOU") + If S.RowCount>0 Then + Printer1.WriteString("------------PROMOS------------" & CRLF) + For i=0 To S.RowCount -1 + S.Position=i + If s.GetString("PE_CEDIS") = s.GetString("PE_PROID") Then + Printer1.WriteString(s.GetString("PE_PRONOMBRE") & CRLF) + + Else + + Printer1.WriteString(s.GetString("PE_CANT") & " " & s.GetString("PE_PRONOMBRE") & CRLF) + TAMANO = s.GetLong("L_CANT") + TAMANO + TAMANO = s.GetLong("L_COSTOU") + TAMANO + TAMANO = s.GetLong("L_COSTO_TOT") + TAMANO + + ESPACIO = ESPACIO - TAMANO + + For E=0 To ESPACIO -1 + BLANCO = " " & BLANCO + Next + Printer1.WriteString(BLANCO & s.GETSTRING("PE_CANT") & " X $" & s.GETSTRING("PE_COSTOU") & " $" & s.GETSTRING("PE_COSTO_TOT") & CRLF ) + TAMANO = 0 + ESPACIO = 21 + BLANCO = " " + End If + Next + Printer1.WriteString(" " & CRLF) + End If + s.Close + +' Printer1.WriteString("-------------RMI..-----------" & CRLF) +' ' aqui es donde esta el pedo de julieta de los descuentos quitar el precio2 pero meter un if para saber si es ruta especial o es normal o que show. +' s=skmt.ExecQuery2("select PE_PRONOMBRE, PE_CANT, length(pe_cant) as L_CANT, PE_COSTOU, length(PE_COSTOU) as L_COSTOU,PE_CANT * PE_COSTOU AS PE_COSTO_TOT, length(PE_CANT * PE_COSTOU) as L_COSTO_TOT,PE_PROID, PE_CEDIS FROM PEDIDO WHERE PE_TIPO = ? AND PE_CEDIS = ? AND LENGTH(PE_CEDIS) < 4 AND PE_CLIENTE IN (Select CUENTA from cuentaa) order by PE_PROID", Array As String("PREVENTA","DUR")) +' If S.RowCount>0 Then +' For i=0 To S.RowCount -1 +' S.Position=i +' If s.GetString("PE_CEDIS") = s.GetString("PE_PROID") Then +' Printer1.WriteString(s.GetString("PE_PRONOMBRE") & CRLF) +' +' Else +' +' Printer1.WriteString(s.GetString("PE_CANT") & " " & s.GetString("PE_PRONOMBRE") & CRLF) +' TAMANO = s.GetLong("L_CANT") + TAMANO +' TAMANO = s.GetLong("L_COSTOU") + TAMANO +' TAMANO = s.GetLong("L_COSTO_TOT") + TAMANO +' +' ESPACIO = ESPACIO - TAMANO +' +' For E=0 To ESPACIO -1 +' BLANCO = " " & BLANCO +' Next +' Printer1.WriteString(BLANCO & s.GETSTRING("PE_CANT") & " X $" & s.GETSTRING("PE_COSTOU") & " $" & s.GETSTRING("PE_COSTO_TOT") & CRLF ) +' TAMANO = 0 +' ESPACIO = 21 +' BLANCO = " " +' End If +' Next +' End If +' s.Close + + s=skmt.ExecQuery("select SUM(PE_COSTO_TOT) AS TOTAL FROM PEDIDO WHERE PE_CLIENTE IN (Select CUENTA from cuentaa)") + s.Position =0 + ' If s.GetString("TOTAL") - s.GetString("TOTAL2") <> 0 Then + ' Printer1.WriteString("Descuento: $" & (s.GetString("TOTAL2") - s.GetString("TOTAL"))) + ' End If + Printer1.WriteString("Total Preventa: $" & s.GetString("TOTAL") & CRLF) + s.Close + c= skmt.ExecQuery("select sum(PE_CANT) as PC_NOART from PEDIDO where PE_CLIENTE in (Select CUENTA from cuentaa) AND PE_PROID NOT IN (SELECT CAT_PA_ID FROM PROMOS_COMP )") + C.Position=0 + Printer1.WriteString("Total Articulos: " & c.GetString("PC_NOART") & CRLF) + c.Close + + Printer1.WriteString(" " & CRLF) + Printer1.WriteString("------------------------------" & CRLF) + Printer1.WriteString("ENTREGA EN :" & CRLF) + Printer1.WriteString(la_Calle.Text & CRLF) + Printer1.WriteString("----ESTE TICKET NO ES UN -----" & CRLF) + Printer1.WriteString("--COMPROBANTE FISCAL, SOLO ES-" & CRLF) + Printer1.WriteString("--------INFORMATIVO-----------" & CRLF) + Printer1.WriteString("------------------------------" & CRLF) + Printer1.WriteString(" " & CRLF) + + Sleep(1000) + Printer1.DisConnect + + ProgressDialogHide +' printer.Flush + ' printer.Close + End Sub +'Sub B_IMP_Click +' TAMANO = 0 +' ESPACIO = 21 +' BLANCO = " " +' printer.Initialize(cmp20.OutputStream) +' printer.WriteLine("DURAKELO S.A. de C.V.") +' printer.WriteLine("RFC: DUR-011025-T12") +' printer.WriteLine("Tel.: 618-826-0104") +' printer.WriteLine("Vendedor: KMTS ") +' printer.WriteLine("Tienda: " & La_nombre.Text) +' printer.WriteLine("-----------PREVENTA-----------") +' s=B4XPages.MainPage.skmt.ExecQuery("select PE_PRONOMBRE, PE_CANT, length(pe_cant) as L_CANT, PE_COSTOU, length(PE_COSTOU) as L_COSTOU, PE_COSTO_TOT, length(PE_COSTO_TOT) as L_COSTO_TOT FROM PEDIDO WHERE PE_CLIENTE IN (Select CUENTA from cuentaa)") +' If S.RowCount>0 Then +' For i=0 To S.RowCount -1 +' S.Position=i +' printer.WriteLine(s.GetString("PE_CANT") & " " & s.GetString("PE_PRONOMBRE")) +' TAMANO = s.GetLong("L_CANT") + TAMANO +' TAMANO = s.GetLong("L_COSTOU") + TAMANO +' TAMANO = s.GetLong("L_COSTO_TOT") + TAMANO +' ESPACIO = ESPACIO - TAMANO +' For E=0 To ESPACIO -1 +' BLANCO = " " & BLANCO +' Next +' printer.WriteLine(BLANCO & s.GETSTRING("PE_CANT") & " X $" & s.GETSTRING("PE_COSTOU") & " $" & s.GETSTRING("PE_COSTO_TOT") ) +' TAMANO = 0 +' ESPACIO = 21 +' BLANCO = " " +' Next +' End If +' s.Close +' printer.WriteLine("Total Preventa: $" & total_cliente) +' printer.WriteLine("------------VENTA-------------") +' printer.WriteLine(" ") +' printer.WriteLine("TOTAL: $" & total_cliente) +' printer.WriteLine(" ") +' printer.WriteLine("----ESTE TICKET NO ES UN -----") +' printer.WriteLine("--COMPROBANTE FISCAL, SOLO ES-") +' printer.WriteLine("--------INFORMATIVO-----------") +' printer.WriteLine("------------------------------") +' printer.WriteLine(" ") +' printer.Flush +'' printer.Close +'End Sub + Sub Printer_Connected (Success As Boolean) If Success Then B_IMP.Enabled = True @@ -2177,19 +2445,27 @@ Private Sub B_guardaencuesta_m3_Click If P9_M3 = "" Then PASA = "0" If P5_M3 = "" Then PASA = "0" - P3_M3 = CB1_P3_M3.Checked & "," & CB2_P3_M3.Checked & "," & CB3_P3_M3.Checked & "," & CB4_P3_M3.Checked & "," & CB5_P3_M3.Checked +' P3_M3 = CB1_P3_M3.Checked & "," & CB2_P3_M3.Checked & "," & CB3_P3_M3.Checked & "," & CB4_P3_M3.Checked & "," & CB5_P3_M3.Checked If CB1_P3_M3.Checked = False And CB2_P3_M3.Checked = False And CB3_P3_M3.Checked = False And CB4_P3_M3.Checked = False And CB5_P3_M3.Checked = False Then PASA = "0" - P4_M3 = CB1_P4_M3.Checked & "," & CB2_P4_M3.Checked & "," & CB3_P4_M3.Checked & "," & CB4_P4_M3.Checked & "," & CB5_P4_M3.Checked +' P4_M3 = CB1_P4_M3.Checked & "," & CB2_P4_M3.Checked & "," & CB3_P4_M3.Checked & "," & CB4_P4_M3.Checked & "," & CB5_P4_M3.Checked If CB1_P4_M3.Checked = False And CB2_P4_M3.Checked = False And CB3_P4_M3.Checked = False And CB4_P4_M3.Checked = False And CB5_P4_M3.Checked = False Then PASA = "0" - P6_M3 = CB1_P6_M3.Checked & "," & CB2_P6_M3.Checked & "," & CB3_P6_M3.Checked & "," & CB4_P6_M3.Checked & "," & CB5_P6_M3.Checked & "," & CB6_P6_M3.Checked & "," & ET_P6_M3.TEXT +' P6_M3 = CB1_P6_M3.Checked & "," & CB2_P6_M3.Checked & "," & CB3_P6_M3.Checked & "," & CB4_P6_M3.Checked & "," & CB5_P6_M3.Checked & "," & CB6_P6_M3.Checked & "," & ET_P6_M3.TEXT - P7_M3 = CB1_P7_M3.Checked & "," & CB2_P7_M3.Checked & "," & CB3_P7_M3.Checked & "," & CB4_P7_M3.Checked +' P7_M3 = CB1_P7_M3.Checked & "," & CB2_P7_M3.Checked & "," & CB3_P7_M3.Checked & "," & CB4_P7_M3.Checked If CB1_P7_M3.Checked = False And CB2_P7_M3.Checked = False And CB3_P7_M3.Checked = False And CB4_P7_M3.Checked = False Then PASA = "0" - P8_M3 = CB1_P8_M3.Checked & "," & CB2_P8_M3.Checked & "," & CB3_P8_M3.Checked & "," & CB4_P8_M3.Checked +' P8_M3 = CB1_P8_M3.Checked & "," & CB2_P8_M3.Checked & "," & CB3_P8_M3.Checked & "," & CB4_P8_M3.Checked If CB1_P8_M3.Checked = False And CB2_P8_M3.Checked = False And CB3_P8_M3.Checked = False And CB4_P8_M3.Checked = False Then PASA = "0" + If rb1_m3_p1.Checked Then P3_M3 = "7 A 9" + If RB2_M3_P1.Checked Then P3_M3 = "9 A 11" + If RB3_M3_P1.Checked Then P3_M3 = "11 A 13" + If RB4_M3_P1.Checked Then P3_M3 = "13 +" + If RB1_M3_P2.Checked Then P4_M3 = "2 A 4" + If RB2_M3_P2.Checked Then P4_M3 = "4 A 6" + If RB3_M3_P2.Checked Then P4_M3 = "6 A 8" + If RB4_M3_P2.Checked Then P4_M3 = "8 +" If CB5_P4_M3.Checked = True And ( CB2_P4_M3.Checked = True Or CB3_P4_M3.Checked = True Or CB4_P4_M3.Checked = True Or CB1_P4_M3.Checked = True ) Then PASA = "0" @@ -3174,5 +3450,3 @@ Private Sub CB4_P8_M3_CheckedChange(Checked As Boolean) End Sub - - diff --git a/B4A/C_Principal.bas b/B4A/C_Principal.bas index 07283ca..78192fe 100644 --- a/B4A/C_Principal.bas +++ b/B4A/C_Principal.bas @@ -456,7 +456,7 @@ Sub B4XPage_Appear '/////// CallSub(Starter, "ENVIA_ULTIMA_GPS") ' panel_5.Visible = False -' Log("panel5 visible FALSE") +' 'Log("panel5 visible FALSE") End Sub Sub Subir_Click @@ -699,7 +699,7 @@ Sub Subir_Click If x2.RowCount>0 Then For i=0 To x2.RowCount -1 x2.Position=i - LogColor(x2.GetString("CLIENTE"),Colors.Red) + 'Logcolor(x2.GetString("CLIENTE"),Colors.Red) Dim cmd As DBCommand cmd.Initialize cmd.Name = "insert_ENCUESTA_MODULO3" @@ -807,7 +807,7 @@ Sub cargar_Click sTime=DateTime.Time(DateTime.Now) Dim P As PhoneId - imei = P.GetDeviceId + imei = "" cmd.Initialize cmd.Name ="insert_drop_GV2_2" cmd.Parameters = Array As Object(usuario,e_ruta.text,sDate,imei,sTime,"","","","","CARGA",ALMACEN) @@ -845,7 +845,7 @@ Sub cargar_Click cmd.Initialize cmd.Name = "select_hist_datos_GV2_2" - cmd.Parameters = Array As Object(e_ruta.text, ALMACEN,e_ruta.text, ALMACEN) + cmd.Parameters = Array As Object(e_ruta.text, ALMACEN,e_ruta.text, ALMACEN,e_ruta.text, ALMACEN) B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "hist_datos") cmd.Initialize @@ -870,8 +870,8 @@ Sub cargar_Click B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "kmt_datos2") cmd.Initialize - cmd.Name = "select_hist_datos_GV2" - cmd.Parameters = Array As Object(E_RUTA2.text, ALMACEN) + cmd.Name = "select_hist_datos_GV2_2" + cmd.Parameters = Array As Object(E_RUTA2.text, ALMACEN,E_RUTA2.text, ALMACEN,E_RUTA2.text, ALMACEN) B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "hist_datos") cmd.Initialize @@ -940,9 +940,9 @@ End Sub Sub JobDone(Job As HttpJob) ' If Job.JobName = "DBRequest" Then ' Dim RESULT As DBResult = B4XPages.MainPage.reqManager.HandleJob(Job) -' Log($"Tag: ${RESULT.tag}, success=${Job.Success}"$) +' 'Log($"Tag: ${RESULT.tag}, success=${Job.Success}"$) ' End If - + 'Log(Job.Tag) If Job.Success = False Then 'ToastMessageShow("Error: " & Job.ErrorMessage, True) If Job.ErrorMessage = "STREAM" Then @@ -955,7 +955,7 @@ Sub JobDone(Job As HttpJob) End If End If Else 'If Job Success then ... - LogColor("JobDone: '" & B4XPages.MainPage.reqManager.HandleJob(Job).tag & "' - Registros: " & B4XPages.MainPage.reqManager.HandleJob(Job).Rows.Size, Colors.Green) 'Mod por CHV - 211027 + 'Logcolor("JobDone: '" & B4XPages.MainPage.reqManager.HandleJob(Job).tag & "' - Registros: " & B4XPages.MainPage.reqManager.HandleJob(Job).Rows.Size, Colors.Green) 'Mod por CHV - 211027 'Verificamos que el usuario guardado en BD sea VALIDO. If Job.JobName = "DBRequest" Then Dim RESULT As DBResult = B4XPages.MainPage.reqManager.HandleJob(Job) @@ -964,20 +964,20 @@ Sub JobDone(Job As HttpJob) For Each records() As Object In RESULT.Rows n = records(RESULT.Columns.Get("USUARIO")) Next - LogColor("**************************"&n, Colors.Green) + 'Logcolor("**************************"&n, Colors.Green) If n = "OKActivo" Then - Log("Usuario guardado en BD es 'Valido'") - Else If n = "OKExpirado" Then - Msgbox("Usuario Expirado llamar al administrador","") 'ignore - B4XPages.ShowPage("B4XMainPage") - Else If n = "OKCancelado" Then - Msgbox("Usuario Cancelado llamar al administrador","") 'ignore - B4XPages.ShowPage("B4XMainPage") + Dim cmd As DBCommand + cmd.Initialize + cmd.Name = "select_ruta_GV2_70_2" + cmd.Parameters = Array As Object(ALMACEN,e_ruta.text) + B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "ruta") + 'Log("Usuario guardado en BD es 'Valido'") Else Msgbox("Usuario o password No validos","") 'ignore - B4XPages.ShowPage("B4XMainPage") + B4XPages.MainPage.skmt.ExecNonQuery("delete from usuarioa") + ExitApplication End If - Log("***************** "&n) + 'Log("***************** "&n) End If End If @@ -1011,7 +1011,7 @@ Sub JobDone(Job As HttpJob) Next Listo1 = 1 S_CC.Text = "LISTO" - If Starter.marcaCel <> "Sony" Then ToastMessageShow("Catalogo Clientes Actualizados." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow("Catalogo Clientes Actualizados." , True) If Listo1 =1 And Listo2 =1 And Listo3 = 1 And Listo4 = 1 Then B4XPage_Appear img2.Visible=False @@ -1108,7 +1108,7 @@ Sub JobDone(Job As HttpJob) Next Listo1 = 1 S_CC.Text = "LISTO" - If Starter.marcaCel <> "Sony" Then ToastMessageShow("Catalogo Resumen Actualizado." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow("Catalogo Resumen Actualizado." , True) End If End If @@ -1120,7 +1120,7 @@ Sub JobDone(Job As HttpJob) Dim HP_CODIGO_PROMOCION As String = records(RESULT.Columns.Get("HP_CODIGO_PROMOCION")) B4XPages.MainPage.skmt.ExecNonQuery2("INSERT INTO HIST_PROMOS(HP_CLIENTE, HP_CODIGO_PROMOCION) VALUES (?,?)", Array As Object (HP_CLIENTE, HP_CODIGO_PROMOCION)) Next - If Starter.marcaCel <> "Sony" Then ToastMessageShow("Historico Promociones Actualizado." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow("Historico Promociones Actualizado." , True) If PB1.Progress = 0 Then PB1.Progress = 30 S_CH.Text = "CARGANDO" @@ -1142,7 +1142,7 @@ Sub JobDone(Job As HttpJob) Dim HCCP_CANT As String = records(RESULT.Columns.Get("HCCP_CANT")) B4XPages.MainPage.skmt.ExecNonQuery2("INSERT INTO HIST_CLIENTE_CANT_PROMOS(HCCP_CLIENTE, HCCP_PROMO, HCCP_CANT) VALUES (?,?,?)", Array As Object (HCCP_CLIENTE, HCCP_PROMO,HCCP_CANT)) Next - If Starter.marcaCel <> "Sony" Then ToastMessageShow(" Historico Clientes Promociones Actualizado." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow(" Historico Clientes Promociones Actualizado." , True) End If End If @@ -1154,7 +1154,7 @@ Sub JobDone(Job As HttpJob) Dim HMC_TOTAL As String = records(RESULT.Columns.Get("HMC_TOTAL")) B4XPages.MainPage.skmt.ExecNonQuery2("INSERT INTO HIST_MARCAS_CUOTAS(HMC_MARCA, HMC_TOTAL) VALUES (?,?)", Array As Object (HMC_MARCA, HMC_TOTAL)) Next - If Starter.marcaCel <> "Sony" Then ToastMessageShow(" Historico Marcas" , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow(" Historico Marcas" , True) End If End If @@ -1287,7 +1287,7 @@ Sub JobDone(Job As HttpJob) PB2.Progress = 100 S_CP.Text = "LISTO" End If - If Starter.marcaCel <> "Sony" Then ToastMessageShow("Productos Actualizados." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow("Productos Actualizados." , True) If Listo1 =1 And Listo2 =1 And Listo3 = 1 And Listo4 = 1 Then B4XPage_Appear img2.Visible=False @@ -1327,7 +1327,7 @@ Sub JobDone(Job As HttpJob) PB2.Progress = 100 S_CP.Text = "LISTO" End If - If Starter.marcaCel <> "Sony" Then ToastMessageShow("Promociones Actualizados." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow("Promociones Actualizados." , True) Listo4=1 If Listo1 =1 And Listo2 =1 And Listo3 = 1 And Listo4 = 1 Then B4XPage_Appear @@ -1364,15 +1364,15 @@ Sub JobDone(Job As HttpJob) If PB2.Progress = 0 Then PB2.Progress = 30 S_CP.Text = "CARGANDO" - Log("C4") + 'Log("C4") ELSE If PB2.Progress = 30 Then PB2.Progress = 60 ELSE IF PB2.Progress = 60 Then PB2.Progress = 100 S_CP.Text = "LISTO" - Log("3") + 'Log("3") End If - If Starter.marcaCel <> "Sony" Then ToastMessageShow("Promociones especiales Actualizados." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow("Promociones especiales Actualizados." , True) Listo4=1 If Listo1 =1 And Listo2 =1 And Listo3 = 1 And Listo4 = 1 Then @@ -1430,12 +1430,17 @@ Sub JobDone(Job As HttpJob) If Job.JobName = "DBRequest" Then Dim RESULT As DBResult = B4XPages.MainPage.reqManager.HandleJob(Job) If RESULT.Tag = "hist_datos" Then 'query tag + Dim cont As Int = 0 For Each records() As Object In RESULT.Rows + cont = cont +1 + Dim HVD_CLIENTE As String = records(RESULT.Columns.Get("HVD_CLIENTE")) Dim HVD_PRONOMBRE As String = records(RESULT.Columns.Get("HVD_PRONOMBRE")) Dim HVD_CANT As String = records(RESULT.Columns.Get("HVD_CANT")) Dim HVD_COSTO_TOT As String = records(RESULT.Columns.Get("HVD_COSTO_TOT")) + Log(cont &" " &HVD_CLIENTE&"--"&HVD_PRONOMBRE&"--"&HVD_CANT&"--"&HVD_COSTO_TOT) B4XPages.MainPage.skmt.ExecNonQuery2("INSERT INTO HIST_VENTAS(HVD_CLIENTE,HVD_PRONOMBRE,HVD_CANT,HVD_COSTO_TOT) VALUES (?,?,?,?)", Array As Object (HVD_CLIENTE,HVD_PRONOMBRE,HVD_CANT,HVD_COSTO_TOT)) + Next Listo3 =1 If PB1.Progress = 0 Then @@ -1447,7 +1452,7 @@ Sub JobDone(Job As HttpJob) PB1.Progress = 100 S_CH.Text = "LISTO" End If - If Starter.marcaCel <> "Sony" Then ToastMessageShow("Venta historico Actualizado." , True) +' If Starter.marcaCel <> "Sony" Then ToastMessageShow("Venta historico Actualizado." , True) If Listo1 =1 And Listo2 =1 And Listo3 = 1 And Listo4 = 1 Then B4XPage_Appear img2.Visible=False @@ -1540,7 +1545,7 @@ Sub JobDone(Job As HttpJob) Next PB2.Progress = 100 S_CP.Text = "LISTO" - Log("5") + 'Log("5") End If End If @@ -1655,24 +1660,24 @@ Sub connecta_Click Private usrT As String = c.GetString("USUARIO") Private passT As String = c.GetString("PASS") cmd.Initialize - cmd.Name = "select_usuario_guna_GV2_1" + cmd.Name = "select_usuario_guna_GV2_10" cmd.Parameters = Array As Object(usrT, passT) B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "usuarioA") End If c.Close - If imei = "" Then - cmd.Initialize - cmd.Name = "select_ruta_GV2_70" - cmd.Parameters = Array As Object(ALMACEN,e_ruta.text,imei) - B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "ruta") - Else - Dim cmd As DBCommand - cmd.Initialize - cmd.Name = "select_ruta_GV2_70" - cmd.Parameters = Array As Object(ALMACEN,e_ruta.text,imei) - B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "ruta") - End If +' If imei = "" Then +' cmd.Initialize +' cmd.Name = "select_ruta_GV2_70_2" +' cmd.Parameters = Array As Object(ALMACEN,e_ruta.text,imei) +' B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "ruta") +' Else +' Dim cmd As DBCommand +' cmd.Initialize +' cmd.Name = "select_ruta_GV2_70_2" +' cmd.Parameters = Array As Object(ALMACEN,e_ruta.text,imei) +' B4XPages.MainPage.reqManager.ExecuteQuery(cmd , 0, "ruta") +' End If If e_ruta.Text = "KMTS1" Then cargar.Visible = True @@ -1710,7 +1715,7 @@ Sub BUSCA_Click End Sub Sub b_mapa_Click - Log("mapClic") + 'Log("mapClic") B4XPages.GetPage("Mapas") End Sub @@ -2032,7 +2037,7 @@ Sub resdia_Click ' '/// Al parecer d.GetString("MONTO_DIA") regresa null y la funcion numberFormat truena '///////////////////////////////////////////////////////////////////////////////// - Log("|"&d.GetString("MONTO_DIA")&"|") + 'Log("|"&d.GetString("MONTO_DIA")&"|") 'L_PRIO.Text = NumberFormat(d.GetString("MONTO_DIA"),0,2) L_PRIO.Text = d.GetString("MONTO_DIA") d.Close @@ -2110,16 +2115,16 @@ End Sub '''''''''''''''''''''''''''''''''''' VALIDAR CARACTERES Sub e_ruta_TextChanged (Old As String, New As String) Dim validChars As String ="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 " -' Log("Antes: " & Old & " | " & New) +' 'Log("Antes: " & Old & " | " & New) If Old <> "KMTS1" Then -' Log("Desp: " & Old & " | " & New) +' 'Log("Desp: " & Old & " | " & New) Try If validChars.Contains(New.SubString(New.Length-1)) = False Then e_ruta.Text = New.SubString2(0, New.Length-1) e_ruta.SelectionStart = e_ruta.Text.Length End If Catch - Log(LastException) + 'Log(LastException) End Try End If End Sub diff --git a/B4A/C_Productos.bas b/B4A/C_Productos.bas index 338047d..b9497ee 100644 --- a/B4A/C_Productos.bas +++ b/B4A/C_Productos.bas @@ -338,7 +338,10 @@ Private Sub B4XPage_CloseRequest As ResumableSub ' BACK key pressed ' Return True To close, False To cancel ' ya_entro ="0" : Log("ya_entro=0") - If l_info.Visible Then + If lv_catalogos.visible = True Then + B4XPages.ShowPage("Cliente") + Return False + ELSE If l_info.Visible Then l_info.Visible = False Return False else if lv_promos.visible Then @@ -521,6 +524,8 @@ Sub cuentaProds Private m As Map m=CreateMap("cant":cant1.Text, "precio":esteTag.get(0)) prodsMap.Put(esteTag.Get(2), m) + Else + prodsMap.Remove(esteTag.Get(2)) End If l_total.Visible = True l_totProds.Visible = True @@ -528,7 +533,7 @@ Sub cuentaProds l_totProds.text = $"Prods: ${totalProds}"$ Next ' LogColor("TIEMPO cuentaProds -=" & ((DateTime.Now-inicioContador)/1000), Colors.Red) -' LogColor(prodsMap, Colors.blue) + LogColor(prodsMap, Colors.blue) p_botonesVenta.Visible = True Log($"Total Prods: ${totalProds}, Total Compra: $$1.2{totalCompra}"$) End Sub @@ -601,7 +606,9 @@ Private Sub b_continuar_Click p1 = prodsMap.Get(p) Log(p & "|" & p1) Private pn As String = Subs.traeProdNombre(p) - If pn <> "N/A" Then Subs.guardaProducto(Subs.traeAlmacen, p1.Get("precio"), p1.Get("cant"), pn, p, Subs.traeCliente, Subs.traeFecha, Subs.traeUsuarioDeBD, Subs.traeRuta, 0, B4XPages.MainPage.tipo_venta) + If pn <> "N/A" Then + Subs.guardaProducto(Subs.traeAlmacen, p1.Get("precio"), p1.Get("cant"), pn, p, Subs.traeCliente, Subs.traeFecha, Subs.traeUsuarioDeBD, Subs.traeRuta, 0, B4XPages.MainPage.tipo_venta) + End If Next Log("promos-inv, prods-inv, cat-vis") lv_promos.Visible = False diff --git a/B4A/C_Promos.bas b/B4A/C_Promos.bas index 418192a..6a1170c 100644 --- a/B4A/C_Promos.bas +++ b/B4A/C_Promos.bas @@ -357,14 +357,21 @@ End Sub Private Sub b_continuar_Click cuentaProds Log("====================================================================") -' Log($"${prodsIds}${CRLF}${prodsCants}${CRLF}${prodsPrecios}"$) + Log($"${prodsIds}${CRLF}${prodsCants}${CRLF}${prodsPrecios}"$) For t = 0 To prodsIds.Size - 1 'Guardamos los productos fijos de la promocion en pedido. Private pn As String = Subs.traeProdNombre(prodsIds.Get(t)) - Subs.guardaProducto(estaPromo, prodsPrecios.Get(t), prodsCants.Get(t), pn, prodsIds.Get(t), Subs.traeCliente, Subs.traeFecha, Subs.traeUsuarioDeBD, Subs.traeRuta, 0, B4XPages.MainPage.tipo_venta) + LogColor(pn,Colors.Red) + If pn <> "N/A" Then + Subs.guardaProducto(estaPromo, prodsPrecios.Get(t), prodsCants.Get(t), pn, prodsIds.Get(t), Subs.traeCliente, Subs.traeFecha, Subs.traeUsuarioDeBD, Subs.traeRuta, 0, B4XPages.MainPage.tipo_venta) + End If Next + Log(prodsIds2) For t = 0 To prodsIds2.Size - 1 'Guardamos los productos variables de la promocion en pedido. Private pn As String = Subs.traeProdNombre(prodsIds2.Get(t)) - Subs.guardaProducto(estaPromo, prodsPrecios2.Get(t), prodsCants2.Get(t), pn, prodsIds2.Get(t), Subs.traeCliente, Subs.traeFecha, Subs.traeUsuarioDeBD, Subs.traeRuta, 0, B4XPages.MainPage.tipo_venta) + LogColor(pn,Colors.Green) + If pn <> "N/A" Then + Subs.guardaProducto(estaPromo, prodsPrecios2.Get(t), prodsCants2.Get(t), pn, prodsIds2.Get(t), Subs.traeCliente, Subs.traeFecha, Subs.traeUsuarioDeBD, Subs.traeRuta, 0, B4XPages.MainPage.tipo_venta) + End If Next lv_prodsFijos.Clear ' Activity_KeyPress(KeyCodes.KEYCODE_BACK) diff --git a/B4A/EscPosPrinter.bas b/B4A/EscPosPrinter.bas new file mode 100644 index 0000000..f0a9536 --- /dev/null +++ b/B4A/EscPosPrinter.bas @@ -0,0 +1,1158 @@ +B4A=true +Group=Default Group +ModulesStructureVersion=1 +Type=Class +Version=9.3 +@EndOfDesignText@ +#IgnoreWarnings: 9 +' 9 = unused variable + +Sub Class_Globals + ' 1.0 Initial version + ' 2.0 Added FeedPaper, changed many WriteString(.." & Chr(number)) instances to WriteBytes(params) + ' This is to avoid Unicode code page transformations on some numbers > 32 + ' Added PrintAndFeedPaper, setRelativePrintPosn, + ' Added user defined characters, DefineCustomCharacter, DeleteCustomCharacter and setUseCustomCharacters + ' Addedhelper methods CreateCustomCharacter, CreateLine, CreateBox and CreateCircle + Private Version As Double = 2.0 ' Printer class version + + Type AnImage(Width As Int, Height As Int, Data() As Byte) + + Private EventName As String 'ignore + Private CallBack As Object 'ignore + + Private Serial1 As Serial + Private Astream As AsyncStreams + Private Connected As Boolean + Private ConnectedError As String + + Dim ESC As String = Chr(27) + Dim FS As String = Chr(28) + Dim GS As String = Chr(29) + + 'Bold and underline don't work well in reversed text + Dim UNREVERSE As String = GS & "B" & Chr(0) + Dim REVERSE As String = GS & "B" & Chr(1) + + ' Character orientation. Print upside down from right margin + Dim UNINVERT As String = ESC & "{0" + Dim INVERT As String = ESC & "{1" + + ' Character rotation clockwise. Not much use without also reversing the printed character sequence + Dim UNROTATE As String = ESC & "V0" + Dim ROTATE As String = ESC & "V1" + + ' Horizontal tab + Dim HT As String = Chr(9) + + ' Character underline + Dim ULINE0 As String = ESC & "-0" + Dim ULINE1 As String = ESC & "-1" + Dim ULINE2 As String = ESC & "-2" + + ' Character emphasis + Dim BOLD As String = ESC & "E1" + Dim NOBOLD As String = ESC & "E0" + + ' Character height and width + Dim SINGLE As String = GS & "!" & Chr(0x00) + Dim HIGH As String = GS & "!" & Chr(0x01) + Dim WIDE As String = GS & "!" & Chr(0x10) + Dim HIGHWIDE As String = GS & "!" & Chr(0x11) + + ' Default settings + Private LEFTJUSTIFY As String = ESC & "a0" + Private LINEDEFAULT As String = ESC & "2" + Private LINSET0 As String = ESC & "$" & Chr(0x0) & Chr(0x0) + Private LMARGIN0 As String = GS & "L" & Chr(0x0) & Chr(0x0) + Private WIDTH0 As String = GS & "W" & Chr(0xff) & Chr(0xff) + Private CHARSPACING0 As String = ESC & " " & Chr(0) + Private CHARFONT0 As String = ESC & "M" & Chr(0) + Dim DEFAULTS As String = CHARSPACING0 & CHARFONT0 & LMARGIN0 & WIDTH0 & LINSET0 & LINEDEFAULT & LEFTJUSTIFY _ + & UNINVERT & UNROTATE & UNREVERSE & NOBOLD & ULINE0 + +End Sub + +'********** +'PUBLIC API +'********** + +'Initialize the object with the parent and event name +Public Sub Initialize(vCallback As Object, vEventName As String) + EventName = vEventName + CallBack = vCallback + Serial1.Initialize("Serial1") + Connected = False + ConnectedError = "" +End Sub + +' Returns any error raised by the last attempt to connect a printer +Public Sub ConnectedErrorMsg As String + Return ConnectedError +End Sub + +' Returns whether a printer is connected or not +Public Sub IsConnected As Boolean + Return Connected +End Sub + +' Returns whether Bluetooth is on or off +Public Sub IsBluetoothOn As Boolean + Return Serial1.IsEnabled +End Sub + +' Ask the user to connect to a printer and return whether she tried or not +' If True then a subsequent Connected event will indicate success or failure +Public Sub Connect As Boolean + 'leos +' Serial1.Connect("88:6B:0F:3E:53:9E") +' Return True + Try + If Starter.MAC_IMPRESORA = "0" Then + Dim PairedDevices As Map + PairedDevices = Serial1.GetPairedDevices + Dim l As List + l.Initialize + Log("aqui 1") + For i = 0 To PairedDevices.Size - 1 + l.Add(PairedDevices.GetKeyAt(i)) + Log("aqui 2") + DisConnect + Next + Dim Res As Int + Res = InputList(l, "Choose a printer", -1) 'show list with paired devices 'ignore + If Res <> DialogResponse.CANCEL Then + Serial1.Connect(PairedDevices.Get(l.Get(Res))) 'convert the name to mac address + 'Msgbox(PairedDevices.Get(l.Get(Res)),"mac") + Starter.mac_impresora = PairedDevices.Get(l.Get(Res)) + Return True + DisConnect + Log("aqui 3") + End If + Log("aqui 4") + Return False + Else + Serial1.Connect(Starter.mac_impresora) + ' Starter.mac_impresora = colonia.MAC_IMPRESORA + Return True + DisConnect + Log("aqui 5") + End If + Catch + Log(LastException) + Return False + End Try +End Sub + + +' Disconnect the printer +Public Sub DisConnect + Serial1.Disconnect + Connected = False +End Sub + +' Reset the printer to the power on state +Public Sub Reset + WriteString(ESC & "@") +End Sub + +'-------------- +' Text Commands +'-------------- + +' Print any outstanding characters then feed the paper the specified number of units of 0.125mm +' This is similar to changing LineSpacing before sending CRLF but this has a one off effect +' A full character height is always fed even if units = 0. Units defines the excess over this minimum +Public Sub PrintAndFeedPaper(units As Int) + WriteString(ESC & "J") + Dim params(1) As Byte + params(0) = units + WriteBytes(params) +End Sub + +' Set the distance between characters +Public Sub setCharacterSpacing(spacing As Int) + WriteString(ESC & " ") + Dim params(1) As Byte + params(0) = spacing + WriteBytes(params) +End Sub + +' Set the left inset of the next line to be printed +' Automatically resets to 0 for the following line +' inset is specified in units of 0.125mm +Public Sub setLeftInset(inset As Int) + Dim dh As Int = inset / 256 + Dim dl As Int = inset - dh + WriteString(ESC & "$" & Chr(dl) & Chr(dh)) + Dim params(2) As Byte + params(0) = dl + params(1) = dh + WriteBytes(params) +End Sub + +' Set the left margin of the print area, must be the first item on a new line +' margin is specified in units of 0.125mm +' This affects barcodes as well as text +Public Sub setLeftMargin(margin As Int) + Dim dh As Int = margin / 256 + Dim dl As Int = margin - dh + WriteString(GS & "L") + Dim params(2) As Byte + params(0) = dl + params(1) = dh + WriteBytes(params) +End Sub + +' Set the width of the print area, must be the first item on a new line +' margin is specified in units of 0.125mm +' This affects barcodes as well as text +' This appears to function more like a right margin than a print area width when used with LeftMargin +Public Sub setPrintWidth(width As Int) + Dim dh As Int = width / 256 + Dim dl As Int = width - dh + WriteString(GS & "W") + Dim params(2) As Byte + params(0) = dl + params(1) = dh + WriteBytes(params) +End Sub + +' Set the distance between lines in increments of 0.125mm +' If spacing is < 0 then the default of 30 is set +Public Sub setLineSpacing(spacing As Int) + If spacing < 0 Then + WriteString(ESC & "2") + Else + WriteString(ESC & "3") + Dim params(1) As Byte + params(0) = spacing + WriteBytes(params) + End If +End Sub + +' Set the line content justification, must be the first item on a new line +' 0 left, 1 centre, 2 right +Public Sub setJustify(justify As Int) + WriteString(ESC & "a" & Chr(justify + 48)) +End Sub + +' Set the codepage of the printer +' You need to look at the printer documentation to establish which codepages are supported +Public Sub setCodePage(codepage As Int) + WriteString(ESC & "t") + Dim params(1) As Byte + params(0) = codepage + WriteBytes(params) +End Sub + +' Select the size of the font for printing text. 0 = Font A (12 x 24), 1 = Font B (9 x 17) +' For font B you may want to set the line spacing to a lower value than the default of 30 +' This affects only the size of printed characters. The code page determines the actual character set +' On my printer setting UseCustomCharacters = while Font B is selected crashes the printer and turns it off +Public Sub setCharacterFont(font As Int) + WriteString(ESC & "M" & Chr(Bit.And(1,font))) +End Sub + +' Set the positions of the horizontal tabs +' Each tab is specified as a number of character widths from the beginning of the line +' There may be up to 32 tab positions specified each of size up to 255 characters +' The printer default is that no tabs are defined +Public Sub setTabPositions(tabs() As Int) + WriteString(ESC & "D") + Dim data(tabs.Length+1) As Byte + For i = 0 To tabs.Length - 1 + data(i) = tabs(i) + Next + data(tabs.Length) = 0 + WriteBytes(data) +End Sub + +' Set print position relative to the current position using horizontal units of 0.125mm +' relposn can be negative +' Unless I have misundertood this doesn't work as documented on my printer +' It only seems take effect at the beginning of a line as a one off effect +Public Sub setRelativePrintPosn(relposn As Int) + Dim dh As Int = relposn / 256 + Dim dl As Int = relposn - dh + WriteString(ESC & "\") + Dim params(2) As Byte + params(0) = dl + params(1) = dh + WriteBytes(params) +End Sub + +' Send the contents of an array of bytes to the printer +' Remember that if the printer is expecting text the bytes will be printed as characters in the current code page +Public Sub WriteBytes(data() As Byte) + If Connected Then + Astream.Write(data) + End If +End Sub + +' Send the string to the printer in IBM437 encoding which is the original PC DOS codepage +' This is usually the default codepage for a printer and is CodePage = 0 +' Beware of using WriteString with Chr() to send numeric values as they may be affected by Unicode to codepage translations +' Most character level operations are pre-defined as UPPERCASE string variables for easy concatenation with other string data +Public Sub WriteString(data As String) + WriteString2(data, "IBM437") +End Sub + +' Send the string to the printer in the specified encoding +' You also need to set the printer to a matching encoding using the CodePage property +' Beware of using WriteString2 with Chr() to send numeric values as they may be affected by codepage substitutions +' Most character level operations are pre-defined as UPPERCASE string variables for easy concatenatipon with other string data +Public Sub WriteString2(data As String, encoding As String) + Try + If Connected Then + Astream.Write(data.GetBytes(encoding)) + End If + Catch + Log("Printer error : " & LastException.Message) + AStream_Error + End Try +End Sub + +'----------------------------------------- +' User defined character commands commands +'----------------------------------------- + +' Delete the specified user defined character mode +' This command deletes the pattern defined for the specified code in the font selected by ESC ! +' If the code is subsequently printed in custom character mode the present code page character is printed instead +Public Sub DeleteCustomCharacter(charcode As Int) + WriteString(ESC & "?") + Dim params(1) As Byte + params(0) = charcode + WriteBytes(params) +End Sub + +' Enable the user defined character mode if custom is True, revert to normal if custom is False +' If a custom character has not been defined for a given character code then the default character for the present font is printed +' FontA and FontB have separate definitions for custom characters +' On my printer setting UseCustomCharacters = while Font B is selected crashes the printer and turns it off +' Therefore the cuatom character routines have not been tested on ont B +Public Sub setUseCustomCharacters(custom As Boolean) + If custom Then + WriteString(ESC & "%1") + Else + WriteString(ESC & "%0") + End If +End Sub + +' Define a user defined character +' The allowable character code range is the 95 characters) from ASCII code 32 (0x20) to 126 (0x7E) +' Characters can be defined in either font A (12*24) or font B (9*17) as selected by present setting of CharacterFont +' The programmer must ensure that the correct font size definition is used for the present setting of CharacterFont +' The user-defined character definition is cleared when Reset is invoked or the printer is turned off +' The vertical and horizontal printed resolution is approximaely 180dpi +' Characters are always defined by sets of three bytes in the vertical direction and up to 9 or 12 sets horizontally +' Each byte defines a vertical line of 8 dots. The MSB of each byte is the highest image pixel, the LSB is the lowest +' Byte(0+n) defines the topmost third of the vertical line, Byte(1+n) is below and Byte(2+n) is the lowest +' Set a bit to 1 to print a dot or 0 to not print a dot +' If the lines to the right of the character are blank then there set of three bytes can be omiited from the byte array +' When the user-defined characters are defined in font B (9*17) only the most significant bit of the 3rd byte of data is used +' charcode defines the character code for the character being defined +' bitdata is a Byte array containing the character definitiopn as described above. +' If the length of bitdata is not a multiple of 3 the definition is ignored and a value of -1 returned +Public Sub DefineCustomCharacter(charcode As Int, bitdata() As Byte) As Int + Dim excess As Int = bitdata.Length Mod 3 + If excess <> 0 Then Return -1 + Dim size As Int = bitdata.Length / 3 + WriteString(ESC & "&") + Dim params(4) As Byte + params(0) = 3 + params(1) = charcode + params(2) = charcode + params(3) = size + WriteBytes(params) + WriteBytes(bitdata) + Return 0 +End Sub + +' The third triangle point is hacked into spare bits keeping the generated Int human readable i hex for other shapes +' The shape array contains the character shapes and characterfont is 0 for a 12*24 character andd 1 for a 9*17 character +' Returns a Byte(36) for characterfont = 0 and a Byte(27) for characterfont = 1 +' The returned array can be directly passed to DefineCustomCharacter +' To define a custom character requires specifying up to 288 data points +' This is a lot of data and in most cases it is mainly white space +' This method takes a character definition that defines only the shapes in the character that are to be printed black +' It will be easier use the outputs from CreateLine, CreateTriangle, CreateBox and CreateCircle rather then building the actual Int values +' Each shape is defined by a single Int value containing four parameters in hex format plugs some single bit flags +' Taking the representation of the Int as eight hex characters numbered from the MS end as 0x01234567 +' 0 contains the shape to draw. 0 = Line, 1 = Box, 2 = Circle, 3 = Triangle +' 1 contains a value between 0 and 0xF. This is either an X coordinate or for a circle the radius +' 2 and 3 contain a value between 0 and 0x1F. This is either a Y coordinate or for a circle the quadrants to draw +' 4 contains a value between 0 and 0xF. This is 0 for an empty shope or 1 for a filled shape +' 5 contains a value between 0 and 0xF. This is an X coordinate +' 5 and 6 contain a value between 0 and 0x1F. This is a Y coordinate +' The coordinate 0,0 is at the top left of the character +' Line +' One point of the vector is contained in the top part of the Int and the other in the bottom half +' To define a single point place its coordinates as both sr=start and end of a line +' Box +' The two X,Y coordinates specify the top left and bottom right corners of the box +' Circle +' The left X parameter is now the radius of the circle, the left Y is the quadrants to be drawn +' The right X and Y parameters are the centre of the circle' +' The quadrants to draw are bit ORed together, UpperRight = 0x1, LowerRight = 0x2, LowerLeft = 0x4, Upper Left = 0x8 +' Triangle +' The left X and Y parameters are now one point of the triangle, the right X and Y parameters another point +' The third triangle point is hacked into spare bits keeping the generated Int human readable in hex for the other shapes +' The bit allocations of a shape are as follows. f = fill as 0 or 1, s = shape as 0 to 7, xn as 0 to 15, yn as 0 to 31 +' Shape 0 = line, 1 = box, 2 = triangle, 3 = circle, 4 to 7 = unused +' fsss xxxx -yyy yyyy xxxx xxxx yyyy yyyy +' 0000 220 0000 2222 1111 2221 1111 +' x0 y2 y0 x2 x1 y2 y1 +' The shape array contains the character shapes and characterfont is 0 for a 12*24 character andd 1 for a 9*17 character +' Returns a Byte(36) for characterfont = 0 and a Byte(27) for characterfont = 1 +' The returned array can be directly passed to DefineCustomCharacter +Public Sub CreateCustomCharacter(shapes() As Int, characterfont As Int) As Byte() + Dim masks(8) As Byte + masks(0) = 0x80 + masks(1) = 0x40 + masks(2) = 0x20 + masks(3) = 0x10 + masks(4) = 0x08 + masks(5) = 0x04 + masks(6) = 0x02 + masks(7) = 0x01 + ' rather than try to catch errors whenever we access this array we Dim it to the maximum possible values of X and Y + ' then copy the top left of it to the final character definition array of the correct size + Dim points(16,32) As Byte + ' initialise the character to all white + For x = 0 To 15 + For y = 0 To 31 + points(x,y) = 0 + Next + Next + Dim size As Int = 12 + If characterfont = 1 Then size = 9 + Dim charbyes(size * 3) As Byte + For c = 0 To charbyes.Length - 1 + charbyes(c) = 0 + Next + ' set the points array from the shapes provided + For i = 0 To shapes.Length -1 + Dim fill As Int = Bit.UnsignedShiftRight(Bit.And(0x80000000, shapes(i)), 31) + Dim shape As Int = Bit.UnsignedShiftRight(Bit.And(0x70000000, shapes(i)), 28) + Dim x0 As Int = Bit.UnsignedShiftRight(Bit.And(0x0f000000, shapes(i)), 24) + Dim y0 As Int = Bit.UnsignedShiftRight(Bit.And(0x001f0000, shapes(i)), 16) + Dim x1 As Int = Bit.UnsignedShiftRight(Bit.And(0x00000f00, shapes(i)), 8) + Dim y1 As Int = Bit.And(0x0000001f, shapes(i)) + Dim x2 As Int = Bit.UnsignedShiftRight(Bit.And(0x0000f000, shapes(i)), 12) + Dim y2 As Int = Bit.UnsignedShiftRight(Bit.And(0x00e00000, shapes(i)), 18) + Bit.UnsignedShiftRight(Bit.And(0x000000e0, shapes(i)), 5) + ' The bit allocations of a shape are as follows. f = fill as 0 or 1, s = shape as 0 to 7, xn as 0 to 15, yn as 0 to 31 + ' Shape 0 = line, 1 = box, 2 = triangle, 3 = circle, 4 to 7 = unused + ' fsss xxxx -yyy yyyy xxxx xxxx yyyy yyyy + ' 0000 220 0000 2222 1111 2221 1111 + ' x0 y2 y0 x2 x1 y2 y1 + Dim logmsg As String = ": Fill=" & fill & " : Points " & x0 & "," & y0 & " " & x1 & "," & y1 & " " & x2 & "," & y2 + If shape = 3 Then + Log("Triangle " & logmsg) + PlotTriangle(x0, y0, x1, y1, x2, y2, points, fill) + else If shape = 2 Then + Log("Circle " & logmsg) + PlotCircle(x0, y0, x1, y1, points, fill) + Else If shape = 1 Then + Log("Box " & logmsg) + PlotBox(x0, y0, x1, y1, points, fill) + Else + Log("Line " & logmsg) + PlotLine(x0, y0, x1, y1, points) + End If + ' map the points array onto the character definition array + For x = 0 To size -1 ' 9 or 12 horizontal bytes + For y = 0 To 2 ' 3 vertical bytes + Dim bits As Byte = 0 + For b = 0 To 7 ' 8 vertical bits + If points(x, y*8+b) <> 0 Then + bits = Bit.Or(bits, masks(b)) + End If + Next + charbyes(x*3+y) = bits + Next + Next + Next + Return charbyes +End Sub + +' This is a higher level method that builds the Int values to pass to CreateCustomCharacter in the shapes array +' Create the value to draw a line in a custom character +' The line starts at X0,Y0 and ends at X1,Y1 +Public Sub CreateLine(x0 As Int, y0 As Int, x1 As Int, y1 As Int) As Int + Dim line As Int = 0 + line = line + Bit.ShiftLeft(Bit.And(0xf,x0), 24) + line = line + Bit.ShiftLeft(Bit.And(0x1f,y0), 16) + line = line + Bit.ShiftLeft(Bit.And(0xf,x1), 8) + line = line + Bit.And(0x1f,y1) + Return line +End Sub + +' This is a higher level method that builds the Int values to pass to CreateCustomCharacter in the shapes array +' Create the value to draw a circle in a custom character +' The circle is centred on X1,Y1 and the quadrants to draw are bit ORed together +' UpperRight = 0x1, LowerRight = 0x2, LowerLeft = 0x4, Upper Left = 0x8 +Public Sub CreateCircle(radius As Int, quadrants As Int, x1 As Int, y1 As Int, fill As Boolean) As Int + Dim circle As Int = 0x20000000 + If fill Then circle = circle + 0x80000000 + circle = circle + Bit.ShiftLeft(radius, 24) + circle = circle + Bit.ShiftLeft(quadrants, 16) + circle = circle + Bit.ShiftLeft(x1, 8) + circle = circle + y1 + Return circle +End Sub + + +' This is a higher level method that builds the Int values to pass to CreateCustomCharacter in the shapes array +' Create the value to draw a triangle in a custom character +' The triangles corners are at X0,Y0 X1,Y1 and X2,Y2 +Public Sub CreateTriangle(x0 As Int, y0 As Int, x1 As Int, y1 As Int, x2 As Int, y2 As Int, fill As Boolean) As Int + Dim triangle As Int = 0x30000000 + If fill Then triangle = triangle + 0x80000000 + triangle = triangle + Bit.ShiftLeft(Bit.And(0xf,x0), 24) + triangle = triangle + Bit.ShiftLeft(Bit.And(0x1f,y0), 16) + triangle = triangle + Bit.ShiftLeft(Bit.And(0xf,x1), 8) + triangle = triangle + Bit.And(0x1f,y1) + triangle = triangle + Bit.ShiftLeft(Bit.And(0xf,x2), 12) ' extra X + triangle = triangle + Bit.ShiftLeft(Bit.And(0x7,y2), 5) ' extra Y lsbits * 3 + triangle = triangle + Bit.ShiftLeft(Bit.And(0x18,y2), 18) ' extra Y msbits * 2 + Return triangle +End Sub + +' This is a higher level method that builds the Int values to pass to CreateCustomCharacter in the shapes array +' Create the value to draw a box in a custom character +' The box top left start is X0,Y0 and bottom right is X1,Y1 +Public Sub CreateBox(x0 As Int, y0 As Int, x1 As Int, y1 As Int, fill As Boolean) As Int + Dim box As Int = 0x10000000 + If fill Then box = box + 0x80000000 + box = box + Bit.ShiftLeft(Bit.And(0xf,x0), 24) + box = box + Bit.ShiftLeft(Bit.And(0x1f,y0), 16) + box = box + Bit.ShiftLeft(Bit.And(0xf,x1), 8) + box = box + Bit.And(0x1f,y1) + Return box +End Sub + +'----------------------------------------- +' Private custom character drawing methods +'----------------------------------------- + +Private Sub PlotTriangle(x0 As Int, y0 As Int, x1 As Int, y1 As Int, x2 As Int, y2 As Int, points(,) As Byte, Fill As Int) + ' This is a pretty crude algorithm, but it is simple, works and it isn't invoked often + PlotLine(x0, y0, x1, y1, points) + PlotLine(x1, y1, x2, y2, points) + PlotLine(x2, y2, x0, y0, points) + If Fill > 0 Then + FillTriangle(x0, y0, x1, y1, x2, y2, points) + End If +End Sub + +Private Sub FillTriangle(x0 As Int, y0 As Int, x1 As Int, y1 As Int, x2 As Int, y2 As Int, points(,) As Byte) + ' first sort the three vertices by y-coordinate ascending so v0 Is the topmost vertice */ + Dim tx, ty As Int + If y0 > y1 Then + tx = x0 : ty = y0 + x0 = x1 : y0 = y1 + x1 = tx : y1 = ty + End If + If y0 > y2 Then + tx = x0 : ty = y0 + x0 = x2 : y0 = y2 + x2 = tx : y2 = ty + End If + If y1 > y2 Then + tx = x1 : ty = y1 + x1 = x2 : y1 = y2 + x2 = tx : y2 = ty + End If + + Dim dx0, dx1, dx2 As Double + Dim x3, x4, y3, y4 As Double + Dim inc As Int + + If y1 - y0 > 0 Then dx0=(x1-x0)/(y1-y0) Else dx0=0 + If y2 - y0 > 0 Then dx1=(x2-x0)/(y2-y0) Else dx1=0 + If y2 - y1 > 0 Then dx2=(x2-x1)/(y2-y1) Else dx2=0 + x3 = x0 : x4 = x0 + y3 = y0 : y4 = y0 + If dx0 > dx1 Then + While + Do While y3 <= y1 + If x3 > x4 Then inc = -1 Else inc = 1 + For x = x3 To x4 Step inc + points(x, y3) = 1 + Next + y3 = y3 + 1 : y4 = y4 + 1 : x3 = x3 + dx1 : x4 = x4 + dx0 + Loop + x4=x1 + y4=y1 + Do While y3 <= y2 + If x3 > x4 Then inc = -1 Else inc = 1 + For x = x3 To x4 Step inc + points(x ,y3) = 1 + Next + y3 = y3 + 1 : y4 = y4 + 1 : x3 = x3 + dx1 : x4 = x4 + dx2 + Loop + Else + While + Do While y3 <= y1 + If x3 > x4 Then inc = -1 Else inc = 1 + For x = x3 To x4 Step inc + points(x, y3) = 1 + Next + y3 = y3 + 1 : y4 = y4 + 1 : x3 = x3 + dx0 : x4 = x4 +dx1 + Loop + x3=x1 + y3=y1 + Do While y3<=y2 + If x3 > x4 Then inc = -1 Else inc = 1 + For x = x3 To x4 Step inc + points(x, y3) = 1 + Next + y3 = y3 + 1 : y4 = y4 + 1 : x3 = x3 + dx2 : x4 = x4 + dx1 + Loop + End If +End Sub + +Private Sub PlotBox(x0 As Int, y0 As Int, x1 As Int, y1 As Int, points(,) As Byte, Fill As Int) + ' This is a pretty crude algorithm, but it is simple, works and itsn't invoked often + PlotLine(x0, y0, x0, y1, points) + PlotLine(x0, y0, x1, y0, points) + PlotLine(x1, y0, x1, y1, points) + PlotLine(x0, y1, x1, y1, points) + If Fill > 0 Then + For x = x0 To x1 + PlotLine(x, y0, x, y1, points) + Next + End If +End Sub + + +Private Sub PlotCircle(radius As Int, quadrants As Int, x1 As Int, y1 As Int, points(,) As Byte, fill As Int) + ' This is a pretty crude algorithm, but it is simple, works and itsn't invoked often + Dim mask As Int = 1 + For q = 3 To 0 Step -1 + If Bit.And(quadrants, mask) <> 0 Then + For i = q*90 To q*90+90 Step 1 + Dim x,y As Double + x = x1 - SinD(i)*radius + y = y1 - CosD(i)*radius + If fill > 0 Then + PlotLine(x1, y1, x, y, points) + Else + points(Round(x), Round(y)) = 1 + End If + Next + End If + mask = Bit.ShiftLeft(mask, 1) + Next +End Sub + +' Bresenham's line algorithm - see Wikipedia +Private Sub PlotLine(x0 As Int, y0 As Int, x1 As Int, y1 As Int, points(,) As Byte ) + If Abs(y1 - y0) < Abs(x1 - x0) Then + If x0 > x1 Then + PlotLineLow(x1, y1, x0, y0, points) + Else + PlotLineLow(x0, y0, x1, y1, points) + End If + Else + If y0 > y1 Then + PlotLineHigh(x1, y1, x0, y0, points) + Else + PlotLineHigh(x0, y0, x1, y1, points) + End If + End If +End Sub + +Private Sub PlotLineHigh(x0 As Int, y0 As Int, x1 As Int, y1 As Int, points(,) As Byte ) + Dim dx As Int = x1 - x0 + Dim dy As Int = y1 - y0 + Dim xi As Int = 1 + If dx < 0 Then + xi = -1 + dx = -dx + End If + Dim D As Int = 2*dx - dy + Dim x As Int = x0 + For y = y0 To y1 + points(x,y) = 1 + If D > 0 Then + x = x + xi + D = D - 2*dy + End If + D = D + 2*dx + Next +End Sub + +Private Sub PlotLineLow(x0 As Int, y0 As Int, x1 As Int,y1 As Int, points(,) As Byte ) + Dim dx As Int = x1 - x0 + Dim dy As Int = y1 - y0 + Dim yi As Int = 1 + If dy < 0 Then + yi = -1 + dy = -dy + End If + Dim D As Int = 2*dy - dx + Dim y As Int = y0 + For x = x0 To x1 + points(x,y) = 1 + If D > 0 Then + y = y + yi + D = D - 2*dx + End If + D = D + 2*dy + Next +End Sub + + +'------------------- +' Image commands +'------------------- +' There are two different image printing options with different pixel formats. +' PrintImage prints an entire image at once with a maximum size of 576x512 +' PrintImage2 prints a slice of an image with a height of 8 or 24 and a maximum width of 576 +' One or other may look better on your particular printer + +' Printer support method for pre-processing images to print +' Convert the bitmap supplied to an array of pixel values representing the luminance value of each original pixel +Sub ImageToBWIMage(bmp As Bitmap) As AnImage + Dim BC As BitmapCreator 'ignore + Dim W As Int = bmp.Width + Dim H As Int = bmp.Height + Dim pixels(W * H) As Byte + + For y = 0 To H - 1 + For x = 0 To W - 1 + Dim j As Int = bmp.GetPixel(x, y) + ' convert color to approximate luminance value + Dim col As ARGBColor + BC.ColorToARGB(j, col ) + Dim lum As Int = col.r * 0.2 + col.b*0.1 + col.g*0.7 + If lum> 255 Then lum = 255 + ' save the pixel luminance + pixels(y*W + x) = lum + Next + Next + Dim ret As AnImage + ret.Width = bmp.Width + ret.Height = bmp.Height + ret.Data = pixels + Return ret +End Sub + +' Printer support method for pre-processing images to print +' Convert the array of luminance values to an array of 0s and 1s according to the threshold value +Sub ThresholdImage(img As AnImage, threshold As Int) As AnImage 'ignore + Dim pixels(img.Data.Length) As Byte + For i = 0 To pixels.Length - 1 + Dim lum As Int = Bit.And(img.Data(i), 0xff) ' bytes are signed values + If lum < threshold Then + lum = 1 + Else + lum = 0 + End If + pixels(i) = lum + Next + Dim ret As AnImage + ret.Width = img.Width + ret.Height = img.Height + ret.Data = pixels + Return ret +End Sub + +' Printer support method for pre-processing images to print +' Convert the array of luminance values to a dithered array of 0s and 1s according to the threshold value +' The dithering algorithm is the simplest one-dimensional error diffusion algorithm +' Normally threshold should be 128 but some images may look better with a little more or less. +' This algorithm tends to produce vertical lines. DitherImage2D will probably look far better +Sub DitherImage1D(img As AnImage, threshold As Int) As AnImage 'ignore + Dim pixels(img.Data.Length) As Byte + Dim error As Int + For y = 0 To img.Height - 1 + error = 0 ' reset on each new line + For x = 0 To img.Width - 1 + Dim lum As Int = Bit.And(img.Data(y*img.Width + x), 0xff) ' bytes are signed values + lum = lum + error + If lum < threshold Then + error = lum + lum = 1 + Else + error = lum - 255 + lum = 0 + End If + pixels(y*img.Width + x) = lum + Next + Next + Dim ret As AnImage + ret.Width = img.Width + ret.Height = img.Height + ret.Data = pixels + Return ret +End Sub + + +' Printer support method for pre-processing images to print +' Convert the array of luminance values to a dithered array of 0s and 1s according to the threshold value +' The dithering algorithm is the simplest two-dimensional error diffusion algorithm +' Normally threshold should be 128 but some images may look better with a little more or less. +' Anything more sophisticated might be overkill considering the image quality of most thermal printers +Sub DitherImage2D(img As AnImage, threshold As Int) As AnImage + Dim pixels(img.Data.Length) As Byte + Dim xerror As Int + Dim yerrors(img.Width) As Int + For i = 0 To yerrors.Length -1 + yerrors(0) = 0 + Next + For y = 0 To img.Height - 1 + xerror = 0 ' reset on each new line + For x = 0 To img.Width - 1 + Dim lum As Int = Bit.And(img.Data(y*img.Width + x), 0xff) ' bytes are signed values + lum = lum + xerror + yerrors(x) + If lum < threshold Then + xerror = lum/2 + yerrors(x) = xerror + lum = 1 + Else + xerror = (lum - 255)/2 + yerrors(x) = xerror + lum = 0 + End If + pixels(y*img.Width + x) = lum + Next + Next + Dim ret As AnImage + ret.Width = img.Width + ret.Height = img.Height + ret.Data = pixels + Return ret +End Sub + + +' GS v0 printing +'--------------- + +' Prints the given image at the specified height and width using the "GS v" command +' Image data is supplied as bytes each containing 8 bits of horizontal image data +' The top left of the image is Byte(0) and the bottom right is Byte(width*height-1) +' MSB of the byte is the leftmost image pixel, the LSB is the rightmost +' Maximum width is 72 bytes (576 bits), Maximum height is 512 bytes +' The printed pixels are square +' Returns status 0 : OK, -1 : too wide, -2 : too high, -3 : array too small +' The printer can take a long time to process the data and start printing +Public Sub PrintImage(img As AnImage) As Int + ' max width = 72 ' 72mm/576 bits wide + ' max height = 512 ' 64mm/512 bits high + If img.width > 72 Then Return -1 + If img.height > 512 Then Return -2 + If img.data.Length < img.width * img.height Then Return -3 + Dim xh As Int = img.width / 256 + Dim xl As Int = img.width - xh * 256 + Dim yh As Int = img.height / 256 + Dim yl As Int = img.height - yh * 256 + Dim params(5) As Byte + params(0) = 0 ' + params(1) = xl + params(2) = xh + params(3) = yl + params(4) = yh + WriteString(GS & "v0") + WriteBytes(params) + WriteBytes(img.data) + WriteString(CRLF) + Return 0 +End Sub + +' Printer support method for pre-processing images to print by PrintImage +' Takes an array of image pixels and packs it for use with PrintImage +' Each byte in the imagedata array is a single pixel valued zero or non-zero for white and black +' The returned array is 8 x smaller and packs 8 horizontal black or white pixels into each byte +' If the horizontal size of the image is not a multiple of 8 it will be truncated so that it is. +Public Sub PackImage(imagedata As AnImage) As AnImage + Dim xbytes As Int = imagedata.width/8 + Dim pixels(xbytes * imagedata.height) As Byte + Dim masks(8) As Byte + masks(0) = 0x80 + masks(1) = 0x40 + masks(2) = 0x20 + masks(3) = 0x10 + masks(4) = 0x08 + masks(5) = 0x04 + masks(6) = 0x02 + masks(7) = 0x01 + Dim index As Int = 0 + For y = 0 To imagedata.Height - 1 + For x = 0 To xbytes - 1 + Dim xbyte As Byte = 0 + For b = 0 To 7 + ' get a pixel + Dim pix As Byte = imagedata.Data(index) + If pix <> 0 Then + xbyte = xbyte + masks(b) + End If + index = index + 1 + Next + pixels(y*xbytes + x) = xbyte + Next + Next + Dim ret As AnImage + ret.Width = xbytes + ret.Height = imagedata.Height + ret.Data = pixels + Return ret +End Sub + + +' ESC * printing +'--------------- + +' Prints the given image slice at the specified height and width using the "ESC *" command +' Image data is supplied as bytes each containing 8 bits of vertical image data +' Pixels are not square, the width:height ratio varies with density and line height +' Returns status 0 = OK, -1 = too wide, -2 = too high, -3 = wrong array length +' Line spacing needs to be set to 0 if printing consecutive slices +' The printed pixels are not square, the ratio varies with the highdensity and dots24 parameter settings +' The highdensity parameter chooses high or low horizontal bit density when printed +' The dots24 parameter chooses 8 or 24 bit data slice height when printed +' Not(highdensity) +' Maximum width is 288 bits. Horizontal dpi is approximately 90 +' MSB of each byte is the highest image pixel, the LSB is the lowest +' highdensity +' Maximum width is 576 bits. Horizontal dpi is approximately 180 +' Not(dots24) +' Vertical printed height is 8 bits at approximately 60dpi +' One byte in the data Array represents one vertical line when printed +' Array size is the same as the width +' MSB of each byte is the highest image pixel, the LSB is the lowest +' dots24 +' Vertical printed height is 24 bits at approximately 180dpi +' Three consecutive bytes in the data array represent one vertical 24bit line when printed +' Array size is 3 times the width +' Byte(n+0) is the highest, byte (n+2) us the lowest +' MSB of each byte is the highest image pixel, the LSB is the lowest +Public Sub PrintImage2(width As Int, data() As Byte, highdensity As Boolean, dotds24 As Boolean) As Int + Dim d As String = Chr(0) + If Not(highdensity) And Not(dotds24 ) Then + d = Chr(0) + If width > 288 Then Return -1 + If data.Length <> width Then Return -3 + Else If highdensity And Not(dotds24) Then + d = Chr(1) + If width > 576 Then Return -1 + If data.Length <> width Then Return -3 + Else If Not(highdensity) And dotds24 Then + d = Chr(32) + If width > 288 Then Return -1 + If data.Length <> width*3 Then Return -3 + Else ' highdensity And dotds24 + d = Chr(33) + If width > 576 Then Return -1 + If data.Length <> width*3 Then Return -3 + End If + Dim xh As Int = width / 256 + Dim xl As Int = width - xh * 256 + Dim params(2) As Byte + params(0) = xl + params(1) = xh + WriteString(ESC & "*" & d) + WriteBytes(params) + WriteBytes(data) + WriteString(CRLF) + Return 0 +End Sub + +' Printer support method for pre-processing images to print by PrintImage2 +' Takes an array of image pixels and packs one slice of it for use with PrintImage2 +' Each byte in the imagedata array is a single pixel valued zero or non-zero for white and black +' The returned array packs 8 vertical black or white pixels into each byte +' If dots24 is True then the slice is 24 pixels high otherwise it is 8 pixels high +Public Sub PackImageSlice(img As AnImage, slice As Int, dots24 As Boolean) As Byte() + Dim bytes As Int = img.width + If dots24 Then + Dim pixels(bytes * 3) As Byte + Dim slicestart As Int = slice * bytes * 8 * 3 + Else + Dim pixels(bytes) As Byte + Dim slicestart As Int = slice * bytes * 8 + End If + + Dim masks(8) As Byte + masks(0) = 0x80 + masks(1) = 0x40 + masks(2) = 0x20 + masks(3) = 0x10 + masks(4) = 0x08 + masks(5) = 0x04 + masks(6) = 0x02 + masks(7) = 0x01 + ' You could compress this into a single code block but I left it as two to make it more obvious what's happening + If dots24 Then + For x = 0 To bytes - 1 + For s = 0 To 2 + Dim xbyte As Byte = 0 + For b = 0 To 7 + ' get a pixel + Dim pix As Byte = img.Data(slicestart + ((b + s*8) * bytes) + x) + If pix <> 0 Then + xbyte = xbyte + masks(b) + End If + Next + pixels(x*3+s) = xbyte + Next + Next + Else + For x = 0 To bytes - 1 + Dim xbyte As Byte = 0 + For b = 0 To 7 + ' get a pixel + Dim pix As Byte = img.Data(slicestart + (b * bytes) + x) + If pix <> 0 Then + xbyte = xbyte + masks(b) + End If + Next + pixels(x) = xbyte + Next + End If + Return pixels +End Sub + +'---------------- +'Barcode commands +'---------------- + +' Set the height of a 2D bar code as number of dots vertically, 1 to 255 +' Automatically resets to the default after printing the barcode +Public Sub setBarCodeHeight(height As Int) + WriteString(GS & "h") + Dim params(1) As Byte + params(0) = height + WriteBytes(params) +End Sub + +' Set the left inset of a 2D barcode, 0 to 255 +' This does not reset on receipt of RESET +Public Sub setBarCodeLeft(left As Int) + WriteString(GS & "x") + Dim params(1) As Byte + params(0) = left + WriteBytes(params) +End Sub + +' Set the width of each bar in a 2D barcode. width value is 2 to 6, default is 3 +' 2 = 0.250, 3 - 0.375, 4 = 0.560, 5 = 0.625, 6 = 0.75 +' Resets to default after printing the barcode +Public Sub setBarCodeWidth(width As Int) + WriteString(GS & "w") + Dim params(1) As Byte + params(0) = width + WriteBytes(params) +End Sub + +'Selects the printing position of HRI (Human Readable Interpretation) characters when printing a 2D bar code. +'0 Not printed, 1 Above the bar code, 2 Below the bar code, 3 Both above And below the bar code +' Automatically resets to the default of 0 after printing the barcode +' The docs say this can be Chr(0, 1 2 or 3) or "0" "1" "2" or "3" but the numeric characters don't work +Public Sub setHriPosn(posn As Int) + WriteString(GS & "H") + Dim params(1) As Byte + params(0) = posn + WriteBytes(params) +End Sub + +'Selects the font for HRI (Human Readable Interpretation) characters when printing a 2D bar code. +'0 Font A (12 x 24), 1 Font B (9 x 17) +' Automatically resets to the default of 0 after printing the barcode +' The docs say this can be Chr(0 or 1) or "0" or "1" but the numeric characters don't work +Public Sub setHriFont(font As Int) + WriteString(GS & "f" & Chr(font)) +End Sub + +' If given invalid data no barcode is printed, only strange characters +' CODABAR needs any of A,B,C or D at the start and end of the barcode. Some decoders may not like them anywhere else +' Bartype Code Number of characters Permitted values +' A | UPC-A | 11 or 12 characters | 0 to 9 | The 12th printed character is always the check digit +' B | UPC-E | 6 characters | 0 to 9 | The 12th printed character is always the check digit +' C | EAN13 | 12 or 13 characters | 0 to 9 | The 12th printed character is always the check digit +' D | EAN8 | 7 or 8 characters | 0 to 9 | The 8th printed character is always the check digit +' E | CODE39 | 1 or more characters | 0 to 9, A to Z, Space $ % + - . / +' F | ITF | 1 or more characters | 0 to 9 | even number of characters only +' G | CODABAR| 3 to 255 characters | 0 to 9, A to D, $ + - . / : | needs any of A,B,C or D at the start and end +' H | CODE93 | 1 to 255 characters | Same as CODE39 +' I | CODE128| 2 to 255 characters | entire 7 bit ASCII set +Public Sub WriteBarCode(bartype As String, data As String) + Dim databytes() As Byte = data.GetBytes("ASCII") + Dim dlow As Int = databytes.Length + Log("Barcode " & bartype & ", Size " & dlow & ", " & data) + WriteString(GS & "k" & bartype.ToUpperCase.CharAt(0)) + Dim params(1) As Byte + params(0) = dlow + WriteBytes(params) + WriteBytes(databytes) +End Sub + +' On my printer QR codes don't seem to be able to be decoded and on high ECs look obviously wrong :( +' size is 1 to 40, 0 is auto-size. Successive versions increase module size by 4 each side +' size = 1 is 21x21, 2 = 25x25 ... size 40 = 177x177 +' EC is error correction level, "L"(7%) or "M"(15%) or "Q"(25%) or "H"(30%) +' scale is 1 to 8, 1 is smallest, 8 is largest +Public Sub WriteQRCode(size As Int, EC As String, scale As Int, data As String) + Dim databytes() As Byte = data.GetBytes("ISO-8859-1") + Dim dhigh As Int = databytes.Length / 256 + Dim dlow As Int = databytes.Length - dhigh*256 + Log("QR Code : Size " & size & ", EC " & EC & ", Scale " & scale & ", Size " & dlow & " " & dhigh & " : Data = " & data) + Dim params(3) As Byte + params(0) = scale + params(1) = dlow + params(2) = dhigh + WriteString(ESC & "Z" & Chr(size) & EC.ToUpperCase.CharAt(0)) + WriteBytes(params) + WriteBytes(databytes) +End Sub + + +'**************** +' PRIVATE METHODS +'**************** + +'----------------------- +' Internal Serial Events +'----------------------- + +Private Sub Serial1_Connected (Success As Boolean) + If Success Then + Astream.Initialize(Serial1.InputStream, Serial1.OutputStream, "astream") + Connected = True + ConnectedError = "" + Serial1.Listen + Else + Connected = False + ConnectedError = LastException.Message + End If + If SubExists(CallBack, EventName & "_Connected") Then + CallSub2(CallBack, EventName & "_Connected", Success) + End If +End Sub + +'---------------------------- +' Internal AsyncStream Events +'---------------------------- + +Private Sub AStream_NewData (Buffer() As Byte) + If SubExists(CallBack, EventName & "_NewData") Then + CallSub2(CallBack, EventName & "_NewData", Buffer) + End If + Log("Data " & Buffer(0)) +End Sub + +Private Sub AStream_Error + If SubExists(CallBack, EventName & "_Error") Then + CallSub(CallBack, EventName & "_Error") + End If +End Sub + +Private Sub AStream_Terminated + Connected = False + If SubExists(CallBack, EventName & "_Terminated") Then + CallSub(CallBack, EventName & "_Terminated") + End If +End Sub diff --git a/B4A/Files/cliente.bal b/B4A/Files/cliente.bal index bb8041c55bda244aed40755243bea0b574e48dc7..b4bb1f996723f4492022ad83831cece93c09537e 100644 GIT binary patch delta 3985 zcmb_f3sjU<5M~I}{ZH<{!mkD-C>bi2?k)<{vOG!>G;~D+G6_(8f^Eo4W66+3vj?bS z+0#0en%cu!OM9W2W)D*kmFYKC!MNh9JKXUm~MM_)~vfPHLL12NCp_ zo|=}L?mDkrX^?KB5wS>@fly<{+CjZ~XA;}p$0spSPlP|nVm1p+j^MxyBKuK;eCibU zc;ldZM&C>%gG?quD7%E3kM0)gcz6mC*<$2Y>T;+-Id$Uar_zy&!z+Ua2ng085y3ig zi7-*Sv^RBR$*IAIArA*c1>%t**3dldEOBOP{ytG+@l-TfLvT`LP0%!A*%o2CO6hb0 z>fLPyi(pm1zE{Q(Ig^^M4|TJsb!%?=y?M46nL}NmAo39+g9lD0Qe_u$1=RfA`az}t zsiDzO=xP{R3esF!aTPV)ZP;t!Xj!l-2sDK&fm3O$uUKNIZloY?$7KbtWHxd9*-rOB24zPcemv*ur%cJye3vg}JM6{1ID|dAw4^%ESdR!=%<@ zTZb>j^nq&J7kdU4W3LJExW6z!UaZ++H9l!EqwU%zSb|9wo4iCj>w3}>4p@JUf|rjS zD#TH~R!@*ZD6={i^$9wB!1^L4T5>$22jiP?M_db+mDq%%;uW;zu(W)y7T%*g$rW;4 zHsHGn3iglgj{CBsv2UVKV+!vl-A^K%%(a+QF%s)$E0{9M0+qNd%>i`?$+plsEh=&9 zQ-OCDgy22N6>ygjS&^J$sPA4|S9S?XliH*90M?{9;Xwvi#Q>`= z4&Wi|KE??TGr%JZ@W{mhJc>)lI^i(}cpQt$<8kb`0Qqq(2z&hUv|{Xe;~`JPR*x&j zy0qmKBP(W)(}#O|r`=YcLfPhor&-Z6lvg(6Gg>9YsRPgsU=1#x;DohU6#4@0On1OK zOqytu*J(j0_!00d#XJ=alPs{FS6`UqfDN=d9={9=kT-N7v5_TgV{|w^!wk={k46iZJ z>wNzI$_)s8y-P5DK~wT7;0-o=-c$$H=Z4Uc9EgT+I{kU>V;KQ&wfcGYG&9tblF67* z69n7nUKLOEP<$>wz__hTWi+WhMBDLnz7yVN)%VZofkS4LNIPg1zoGB&8!A|>`yz0= zMZ&9R_G*1I^*DE?1$Ht_<}3&7V#n`lC)rPWm&W*V+3mSp#>0Ca?GEYv7R?{9X2E)C zhT7J*I+$;!h5`$G$PVAbeppjzjoYJ@Bd*KneMAeQsda1iNj;C_tybKdqQm^TX4uP? zQ6@?IXr6ttpDhz?d&`n4+*O3zvgLM*@-eM*Kc=4$#pS@KTn-%Y1TDyL15K1u^OOZN z9T{vqKm#g#;=0_yXIOu`6ApT;O~us%qTq8r;-71Q_=tbel1RRiFHXoX;s@1|>e+64 z4m}lXk5KU_il1L5byT`)UfYIFUfTwGZIiKnn&cWWZwkPdA|>#$Qaz9Wy)xodaw6D8 zM6qt#aLg@9{+~+Sukd7vs?-%0E7WvfQP<|z1{_qnsME^z5QRuxxvrS)H?EVy^)SJ@ z3s)kzxV8~tq{dY)t3E`WN;Po>cthD#D8%(;yWt2uA2#`jb`4i{U*pf^wF=UVJCTkO z#fj8N;Teo?%#VO?C<46)9HR+1OW!7JNh5J=No$$^4aFl2{~jEGb&fH($?Q*WXHn=V zw1r)U=N9aOZ$-jTUl%a~j#G*_m4^w#t+ahkbXt6!=p-FZa5^-{1fYGvK+K&d|MyUT zM|NoIF4YId_u{KYYWu1|+rmC@f<9srT^lO10e;}C=m&ym^FG-~8TccOaR&a_nt?qR z>0Cz_lGINu^-~8@CtIXWs-(8UDL&8*i>&e~FClm3R;fHj;}`AC(^_vXrtoq$o#tTP z=iCElSaD&E)p$mu_%v}{UK&lKTZ*@E(X4Y~SC5S>a+#NUKK_-<#*YQlGPc(&y zE*_mmk9rP`E+x%+-Z4%%>$D49IARTElbEVp}nHse&jG{-cdJIrc*; z_1irF?r~}6QeF<>=TWHbJd{Af8VOW}_)(dtt5jqC_!Q00cv_ywCh2qU@)+daGZ5F; z#$wCFIDXtO+kGs%{a$nM!n+8SQ3tzq=~xwLb7ip5aHtG;mV1$kRoWIU1T*OOcl z@5m%u2wwLb#L4K0{w$Ak5RSA7Ve+k-^DP-IN&Ru&rp39`c&fwI)X|PkEavVl1Gn>f zJ~tB9h+iPx6-iPf(%lqH_osQE%+4AnIzyrw`_pdV*{KE?bH<`BL9ctf%X&kC1;)u< z7;H|eW`|ku0N%U)We=6sg0WJ4i={4qXIp-67zM|+OPTwFl(Y0%T3D%5J^m`%`#w3D7L4pi_c*f{40 zl-DEw&PXP1;wDiU1tE-%;-(JP+$uDe45dblFRkjaTKkbXO+8e~p9g>okysWN z^%)O4o!iKxby!fAPmjV~cAA=`ue|feLN`mVYf|o&73M|0r|p=rX^vqJulmlvnJMY~ z7QgegIJGJ1o>rb#8Yxoc3vP6i4VTuo@JRWE(aPRP#MvZ07HwWcFL?HEHW6JC_Xzjm z^Xbdr&9S50%I}&+)6M@zQK`i-bolb=au0!USp))CZF-!jNcsQW`W4IZeKmdE!&lSS zyrc8bFMHNk?j!mp7;E1smu0Md%X2c;z752hr|B_{&?`Z%D`B{<2Dq*UxX|>N8pEpG z)FxfqT$QeC>%u6WxSVa3hF|i04+-@>2YO9;pxfEI@>#qlefg~GeY!5C7gwj7uPdZq z<592qegnG{vV^iU>la#R0{yMGJfJMP3U!Z+=|7^EF&+a61| zSfOzm@v$o7upPFVxR_f!?DUh+&4 F`X86xj~M^} diff --git a/B4A/Files/guna.png b/B4A/Files/guna.png new file mode 100644 index 0000000000000000000000000000000000000000..bb22f3b3195f748ea06ccc30245c5bdd3c1b3786 GIT binary patch literal 3902 zcmV-E55e$>P)@TsgZKd7j#+Foh9^0Kwu zGdVy_ucoZoaC*bAwch;i@BjV%?(g{H<@2|@;JCfv%g*VUpw#^F@{E+u9W0>x>FVTV zYSWPfwUSs*)-Zn(4ijvOnqNT{p=>Px!=52ATvfSO@@V~?46eOIGn9y~8#o62M z>4AkfMXREy*#7$Zpr_a8cYEl1eo9ue?2(lB(9+)E@!2OWh>*>|#N;YDr5Y-qe}~Du z!Q*0Wz2sqL_Q=XTO05|vo+L7&YIMMlm(borN$BbIhmXwRcl!enl~=zW2+xZmxSnI<));#FJVOj0yLsxLjKMpLonX>ReZu=mc; z^~A>FSza?isqUVkXmY>aK1BK7;P%YU{r2|RBr4h|F!aE}+&4Y)wzySbw_9eq?U|fb zVYn^~T8c!^QKvz4X4o+b=cREi>IZK!S_P-a$s$A}QN2HxeS7*BK!6_4@t& z{`va-$IIvG>h>5Xou8)Hm7LNRC7t;A{Qmy`_xJlDFroYW{nFL!{QUlTg2$_|+~nr; z#K`9B?e}_v$0IVLC^w|=@%i%e`XDc%<>&PC^!ony_tDhr=IHe2==JRG_uu03+T8EV z&*?)@u+-P>7bcw(Bb)K^`S$kv&e7`7)9d*8{QKwU)7I_V-SExO>V1aDA~B-%_4`_7 zxy8xnB{QR*rPf$uxbN`z(bepMiOSa;Bk!fCl$+Ak*zJIb$v;f4>+JSfWVz>acXE5f z>g)Eqz~bRhRo5FLTxYs_gvZv|?#9aJL{YGXjm-S)?U$a@uC(3x+uZu$;@BW3>yDAy zCoYqk(*5-Hj+M`mnbDY^)56B({`>sT((5`$tk>G^Pg}J`QnB;6y88S5gN)0=$L9b3 z{v0fy{O#^(bHJ9J)A!WX`sC$=jmuG8wxp`r_x1VehKko3A?J8}sju7k*4X&g*ZcJL z_RGxt>+D}@yq%=h`t9!b)6{&0$QG$1=>Px=)Ja4^RCwC#n|D|fX&%Sj1O=2XO$B)c z0vJG0L;@&TQ5184E=D0X#D*@mJx_7ZNr7k}AX24w5ET)7$Bw%8vi62$n{K_^c&s(o1MWp(BWPPsf8b} zVjAd(0~rY6i5Lb-GfGFOL`r6X_HN=(ftE7dL)qa}9@aMu1J!J%@YqCTG7RKN?V#Wk zrpqamHl)aLe(EEyk$s{;lXtSTq43O+m5ix;s zq$VTgi1GFjGeAv-LxMMX z|CUCA=5>A6pL+NH>{VAMPyo&o&{x)P=tyFy?)b|Im_}GEdEHty zbYdS8l20kk@rqZ?pDnc~(1|d0?n2X@-#^b+C$Xos1oE1 z9xhDTstySV z%ta^9FLB7*ZF?7iY=@{ro4rrxC1IY*{cy7+Kw2Hh>wqU;(nX+e2Ys#{wA*t#dDib| z3_-EnDHDKEEBPJpAkRS;fdKfs#?%r9zb`Zv8etArI>e)J7187rXD}PqkoW7)!hID zMvz?g%Z^4(T6_}rh@v)PE0lvqg|z43C=`l%_=IsmcL0Hzq!hCE+qYALVE1simoCF) zximJHpsx{X;`T9gns|8YfG;1<1?pSE7&Ft2#g#7NSOnqSs3AxO{ zo$ch2eRvy&ks&cHkb-Uj0)t33@S3?4J-5W-Dmqs~u9>M$E3VrT=tklB}u`I_3} zI?&KArN?|uNwmie7z04Ec`=-&w!M9pBnvynsWZ)1E#2|$km!N^aMBGAFQJ8kAa z8}iZ>EJ1mf^(0+@yhaSaKnOkd^UgN^w|YY>pB0!a1B?Ix@Z`${bBE3tIBnW!pQ$e= z_21@b$YVX&r38Q}Ac|&p;sH0tz_VLux&g@ayqkMV#4bs*U6*8gl#m`vJ?Dang|dQ_DvyS(s(Q%p@%jzlM{m@4 z%0eLB>XPGaoM>3vE7I0uThqi?KT53Gd zD68EDFTCL~+xVhyYrsAD*|MW6VadT^`K!O|p0%~0wx}MjioUD8iFr}!5ywq|Cqq-T z0FoT^{SK}2@~;L@!MAG^MSO)`w>CV0X78+I{IT=lu{;jK-vEz2*4m(t^^$;Xo~P6s z26&I~4)W!om*g>LUJJspg%9C+Se=v`N3gS;0xp3R23JC0l$8na~Z}YM@?eqs1pG7yYPsBvs@dU70Rq+p5P<980UHeX`^-}T$aI3s^Z^#wohvN< zA&uN2gRfA)8xO`t`s45M6AgUq_Nyi=MVEH!hDcFOI{4{e9f z8#d_%q;Lao1F2nG*}XGp4XNO@AAwGQ%rTMFOgEq+&vyW2ls!Cyx(sctfSUN zJ0NpyfC@w5p5;W>9i+)m11J+N`K4QG2gKF}C>rv-sFso)BMl(18-5^EJD}ZK04bre zFWj%WF_tb+4HiI6-vgw1dF690fNH2#BID8pk_5tdytZSY7W8<9I#6ah3$*}hg9j~| zI?_o_7YL-l;9(P1Kn8LsBPM`)xim9~3&XJd_`89kwgKP`4_@Q3G0jZ1o6(j)PQ4w@ z4aEz`?HV8(Z`GZ0__jSqQ-CtZJy!V06`lsl-pY;CA!y%t)avuGtqr@-*p=O8C@;eP z9F#~i$v3rTVam6SD17-!Z0WxhH!XaFEzbtw8|DBd%nL=>(vET;ydJMMh731EJ>9%j zqP{RBR*opRSsS59%d?cytU8=R4MK#Z-L%L`Rd{n%|F?%51rsYSwzobx6;xYc>)`2M zpHPjur)r^9WL}B>I?WQfJTfQaumCQ~oH}Sq2S_3V8RtBn?vHNsyccGyVwjB8L9+eE zsA=Wk(hfT*+nZA*u!S zEKo99z=)`cZUwAq4%}o0r~rCJ1;w??4noTp`7r~O8jny@KQzf;p=CMGS<29mDZQa{ z;ncD(`;}J|S6Q;L86CHtIXNaRITHI@8dtRZOrkH87Z97s^GfD`(8#gNpS+`mb<*Or z6fg;dMQc~@Yk7Hrj^3k+^^%?*NDrh3(gW#%^gwzbJ<$I*(EkJ&00!Fg4)75Fw*UYD M07*qoM6N<$g4KiL&j0`b literal 0 HcmV?d00001 diff --git a/B4A/Files/login.bal b/B4A/Files/login.bal index 7d2081dbb51d91de3e48eda75de5494788d32189..37ccfd408c482a8b22a51ad27421a351fc233669 100644 GIT binary patch delta 1152 zcmZvaOH30{6o%(kUIPVrRoYSulolEul@fd`D)R7|NNAvf3u7{E2We=TI&B3OTHhk# z11}r5E{zE>v-c6>LRRR?oo)Kbg7CXU z5GwKQT&s@v6O0U;om_~eBeVW`tbC)HR9Z<)#pH!)RZ1phmCo!q*Os0zKNs06X65hM zXja57ov4C#LC7wcp=ziG+HK%k1J{A+z6Pk#z!n4VF>sTCtza8u7liXdGr$4ug`5U% zF>tGa+YIaiw?l5o18x66$F^VlVEV+^y7sK3wVXM5wxVhOPAmT3F8axc-ov1(pnd6> zoa&{>>`r8N9*;_C>4X}KQvdQHp{1luKXD;5FJ0>Q&B;p%W!@K2628QuFFdfA(jSWY zdQwWJW0B*s91Tm6xe9p3XJ$r~xT2O5&+AB!lbTi3H06!Zs_@u!XJ|H)2Lv=o-(`Mt5=#IecoiD7D7XguiUTcShzRy9?_qS~PS zZ#g^6FS`9&+*M*S{SkP;)u%mmkC@n7?Q4gbu^|6tw)0wNDgWHOp}qE=VJu4l**Nl1 zPC>j3VSb=h~f~2k;ix@CCOYfma-Y876qhUvzpLt3bWTLV47H p;_~=LT_x{pY^!{PE&Vap_)EKkJx0@d_`5DQ=zG@y512J9cnJgI?C}!qbpa3p+jGC-N_T*2Ij8i$x|0w o@2joPa>Cz<=6Nlm0r%P^4vf!XwaA4y%P*~\n~)~\n~SetApplicationAttribute(android:icon, "@drawable/icon")~\n~SetApplicationAttribute(android:label, "$LABEL$")~\n~CreateResourceFromFile(Macro, Themes.LightTheme)~\n~AddApplicationText(~\n~)~\n~CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~ 'End of default text.~\n~ ~\n~ ''''' CAMBIA LA CLAVE API~\n~AddApplicationText(~\n~~\n~ ~\n~)~\n~AddApplicationText(~\n~~\n~)~\n~AddManifestText(~\n~~\n~)~\n~''CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~ 'End of default text.~\n~ ~\n~SetApplicationAttribute(android:usesCleartextTraffic, "true")~\n~ AddManifestText(~\n~~\n~)~\n~AddPermission(android.permission.ACCESS_BACKGROUND_LOCATION)~\n~AddManifestText(~\n~~\n~)~\n~AddManifestText(~\n~~\n~) 'in order to access the device non-resettable identifiers such as IMEI and serial number.~\n~~\n~'///////////////////////// FLP Y PUSH /////////////~\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~'//////////////////////////////////////////////////////~\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") +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~AddApplicationText(~\n~)~\n~CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~ 'End of default text.~\n~ ~\n~ ''''' CAMBIA LA CLAVE API~\n~AddApplicationText(~\n~~\n~ ~\n~)~\n~AddApplicationText(~\n~~\n~)~\n~AddManifestText(~\n~~\n~)~\n~''CreateResourceFromFile(Macro, FirebaseAnalytics.GooglePlayBase)~\n~ 'End of default text.~\n~ ~\n~SetApplicationAttribute(android:usesCleartextTraffic, "true")~\n~ AddManifestText(~\n~~\n~)~\n~AddPermission(android.permission.ACCESS_BACKGROUND_LOCATION)~\n~AddManifestText(~\n~~\n~)~\n~AddManifestText(~\n~~\n~) 'in order to access the device non-resettable identifiers such as IMEI and serial number.~\n~~\n~'///////////////////////// FLP Y PUSH /////////////~\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~'//////////////////////////////////////////////////////~\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~SetApplicationAttribute(android:allowBackup, "false")~\n~AddPermission(android.permission.BLUETOOTH_ADVERTISE)~\n~AddPermission(android.permission.BLUETOOTH_CONNECT)~\n~AddPermission(android.permission.BLUETOOTH_SCAN)~\n~AddManifestText() Module1=appUpdater Module10=C_NuevoCliente Module11=C_Pedidos @@ -159,12 +163,13 @@ Module14=C_Promos Module15=C_TicketsDia Module16=C_UpdateAvailable Module17=DBRequestManager -Module18=FirebaseMessaging -Module19=MAPA_RUTAS +Module18=EscPosPrinter +Module19=FirebaseMessaging Module2=B4XMainPage -Module20=Starter -Module21=Subs -Module22=Tracker +Module20=MAPA_RUTAS +Module21=Starter +Module22=Subs +Module23=Tracker Module3=BatteryUtilities Module4=C_Cliente Module5=C_Clientes @@ -172,15 +177,15 @@ Module6=C_Historico Module7=C_Mapas Module8=C_Nota Module9=C_NoVenta -NumberOfFiles=58 +NumberOfFiles=60 NumberOfLibraries=33 -NumberOfModules=22 +NumberOfModules=23 Version=12.5 @EndOfDesignText@ #Region Project Attributes #ApplicationLabel: Guna V3.1 #VersionCode: 1 - #VersionName: 4.01.19_1ENC + #VersionName: 4.02.21ENC 'SupportedOrientations possible values: unspecified, landscape or portrait. #SupportedOrientations: portrait #CanInstallToExternalStorage: False diff --git a/B4A/Guna Vistas V3.1.b4a.meta b/B4A/Guna Vistas V3.1.b4a.meta index 59ac547..43f3971 100644 --- a/B4A/Guna Vistas V3.1.b4a.meta +++ b/B4A/Guna Vistas V3.1.b4a.meta @@ -14,6 +14,7 @@ ModuleBookmarks2= ModuleBookmarks20= ModuleBookmarks21= ModuleBookmarks22= +ModuleBookmarks23= ModuleBookmarks3= ModuleBookmarks4= ModuleBookmarks5= @@ -37,6 +38,7 @@ ModuleBreakpoints2= ModuleBreakpoints20= ModuleBreakpoints21= ModuleBreakpoints22= +ModuleBreakpoints23= ModuleBreakpoints3= ModuleBreakpoints4= ModuleBreakpoints5= @@ -48,18 +50,19 @@ ModuleClosedNodes0= ModuleClosedNodes1=5,7,8,9,10,11,12,13,14 ModuleClosedNodes10= ModuleClosedNodes11=6 -ModuleClosedNodes12=2,3,8,10,11,13,14,15 -ModuleClosedNodes13=6,8,10,11,12,13,14,15,16,17,18,19,20,21,22,23 +ModuleClosedNodes12=2,3,8,10,14,15 +ModuleClosedNodes13=6,10,11,13,14,16,17,20,21,22,23 ModuleClosedNodes14= ModuleClosedNodes15= ModuleClosedNodes16= ModuleClosedNodes17= ModuleClosedNodes18= -ModuleClosedNodes19=3,4 +ModuleClosedNodes19= ModuleClosedNodes2= -ModuleClosedNodes20=1 -ModuleClosedNodes21= +ModuleClosedNodes20=3,4 +ModuleClosedNodes21=1 ModuleClosedNodes22= +ModuleClosedNodes23= ModuleClosedNodes3= ModuleClosedNodes4= ModuleClosedNodes5=7 @@ -67,6 +70,6 @@ ModuleClosedNodes6= ModuleClosedNodes7= ModuleClosedNodes8= ModuleClosedNodes9= -NavigationStack=C_Principal,Class_Globals,0,0,Diseñador Visual,ENCUESSTA_M3.bal,-100,3,C_Cliente,B_guardaencuesta_m3_Click,2159,6,C_Cliente,p6_TextChanged,2500,0,C_Principal,cargar_Click,907,0,C_Cliente,p8_TextChanged,2529,0,C_Cliente,b_preguntag_Click,794,1,Main,Globals,24,0,C_Principal,JobDone,1018,2,C_Cliente,B_guardaencuesta_m2_Click,2093,0 +NavigationStack=B4XMainPage,b_envioBD_Click,673,0,B4XMainPage,Class_Globals,91,0,B4XMainPage,B4XPage_Created,144,6,B4XMainPage,i_engrane_Click,642,2,Diseñador Visual,login.bal,-100,6,C_Cliente,B_IMP_Click,1596,6,B4XMainPage,B4XSwitch1_ValueChanged,706,6,C_Principal,Class_Globals,0,0,C_Cliente,B4XPage_Appear,599,4,B4XMainPage,B4XPage_Appear,299,6 SelectedBuild=0 -VisibleModules=20,2,21,12,13,4,8,11,5,10 +VisibleModules=21,2,22,12,13,4,8,11,5,10 diff --git a/B4A/Starter.bas b/B4A/Starter.bas index 72d6ed8..e0ed5f9 100644 --- a/B4A/Starter.bas +++ b/B4A/Starter.bas @@ -29,6 +29,9 @@ Sub Process_Globals Dim logger As Boolean = False Dim marcaCel As String = ph.manufacturer Dim muestraProgreso = 0 + Private BTAdmin As BluetoothAdmin + Dim MAC_IMPRESORA As String + Public BluetoothState As Boolean End Sub Sub Service_Create @@ -36,7 +39,7 @@ Sub Service_Create 'This is a good place to load resources that are not specific to a single activity. gps.Initialize("GPS") CallSubDelayed(FirebaseMessaging, "SubscribeToTopics") 'Para Push FirebaseMessaging - + BTAdmin.Initialize("admin") Timer1.Initialize("Timer1", Interval * 1000) Timer1.Enabled = True ' 'Para los Logs @@ -47,6 +50,13 @@ Sub Service_Create CallSubDelayed(FirebaseMessaging, "SubscribeToTopics") 'Para Push FirebaseMessaging End Sub +Private Sub BTAdmin_StateChanged (NewState As Int, OldState As Int) + If logger Then Log("BT state changed: " & NewState) + BluetoothState = NewState = BTAdmin.STATE_ON +' StateChanged +End Sub + + Sub Service_Start (StartingIntent As Intent) Service.StopAutomaticForeground 'Starter service can start in the foreground state in some edge cases. Subs.revisaBD