** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Instalar, leer fuente de windows(codigo barras)
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoInstalar, leer fuente de windows(codigo barras)

 Responder Responder
Autor
Mensaje
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 2171
Enlace directo a este mensaje Tema: Instalar, leer fuente de windows(codigo barras)
    Enviado: 15/Agosto/2019 a las 17:45
Hola

Hay alguna forma desde vba que access lea la fuente de codigo de barras sin tenerla instalada??
El objetivo es que lo lea desde una carpeta que yo designe.

Tambien he probado desde vba a copiar la fuente a la carpeta windows\Fonts  pero no lo hace e instala.

Saludos
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 2171
Enlace directo a este mensaje Enviado: 15/Agosto/2019 a las 18:02
Algo he conseguido buscando en google esto  AddFontResource Lib "gdi32"






Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long

Instala la fuente

Dim result As Long

result = AddFontResource("C:\Users\Norco\Desktop\BD16 Biblioteca\IDAutomationHC39M.ttf")


Desinstala la fuente

Dim result As Long

result = RemoveFontResource("C:\Users\Norco\Desktop\BD16 Biblioteca\IDAutomationHC39M.ttf")


Pero lo ideal seria que lo leiese desde la carpeta que yo quiera, ademas de la forma anterior si no esres administrador dudo mucho que lo instale.

Lo curioso de usar el sistema expuesto es que en la carpeta de las fuentes no sale, pero esta instalado.


Editado por rokoko - 15/Agosto/2019 a las 18:06
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 2171
Enlace directo a este mensaje Enviado: 25/Agosto/2019 a las 15:13
Algo he conseguido.
Si ulilizo una fuente instalada no hay problema.

He encontrado este codigo que funciona, siempre que no esten los asteriscos en el codigo de barras. Si pongo asteriscos me lo saca asi con este simbolo (   por ejemplo el codigo 000002 sale   (000002(  no tengo ni idea por que.... El codigo del asterisco por lo que he visto es el correcto, lo remarco en el codigo. A alguno se os ocurre el porque???


Public Function FC_barcode3of9(ByVal strWord As String, _
                               ByVal strObj As Object)


Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim pos As Integer
Dim Barcode As String
Dim Cur As String
Dim CurVal As Integer
Dim BC(0 To 43) As String

    BC(0) = "000110100" '0
    BC(1) = "100100001" '1
    BC(2) = "001100001" '2
    BC(3) = "101100000" '3
    BC(4) = "000110001" '4
    BC(5) = "100110000" '5
    BC(6) = "001110000" '6
    BC(7) = "000100101" '7
    BC(8) = "100100100" '8
    BC(9) = "001100100" '9
    BC(10) = "100001001" 'A
    BC(11) = "001001001" 'B
    BC(12) = "101001000" 'C
    BC(13) = "000011001" 'D
    BC(14) = "100011000" 'E
    BC(15) = "001011000" 'F
    BC(16) = "000001101"
    BC(17) = "100001100"
    BC(18) = "001001100"
    BC(19) = "000011100"
    BC(20) = "100000011"
    BC(21) = "001000011"
    BC(22) = "101000010"
    BC(23) = "000010011"
    BC(24) = "100010010"
    BC(25) = "001010010"
    BC(26) = "000000111"
    BC(27) = "100000110"
    BC(28) = "001000110"
    BC(29) = "000010110"
    BC(30) = "110000001"
    BC(31) = "011000001"
    BC(32) = "111000000" 'W
    BC(33) = "010010001" 'X
    BC(34) = "110010000" 'Y
    BC(35) = "011010000" 'Z
    BC(36) = "010000101" '-
    BC(37) = "110000100" '.
    BC(38) = "011000100" '<spc>
    BC(39) = "010101000" '$
    BC(40) = "010100010" '/
    BC(41) = "010001010" '+
    BC(42) = "000101010" '&#37;
    BC(43) = "010010100"   '*  (used for start/stop character only)
    
strObj.Cls
pos = 20 '10
Barcode = UCase(strWord)

'Add Start & Stop characters?
'If Check1.value Then Barcode = "*" & Barcode & "*"

'If Check1.Value Then
Barcode = "*" & Barcode & "*"


'Generate Barcode
For x = 1 To Len(Barcode)
    Cur = Mid$(Barcode, x, 1)
    Select Case Cur
    Case "0" To "9"
        CurVal = Val(Cur)
    Case "A" To "Z"
        CurVal = Asc(Cur) - 55
    Case "-"
        CurVal = 36
    Case "."
        CurVal = 37
    Case " "
        CurVal = 38
    Case "$"
        CurVal = 39
    Case "/"
        CurVal = 40
    Case "+"
        CurVal = 41
    Case "%"
        CurVal = 42
    Case "*"
        CurVal = 43
    Case Else 'oops!
        strObj.Cls
        strObj.Print Cur & " is Invalid"
        Exit Function
    End Select
    
    For y = 1 To 9
        If y / 2 = Int(y / 2) Then
            'SPACE
            pos = pos + 1 + (3 * Val(Mid$(BC(CurVal), y, 1)))
        Else
            'BAR
            For z = 1 To 1 + (3 * Val(Mid$(BC(CurVal), y, 1)))
                strObj.Line (pos, 1)-(pos, 50) ''strObj.Line (pos, 1)-(pos, 50)
                pos = pos + 1
            Next z
        End If
    Next y
    pos = pos + 1 'make inter-character gap (ie: 1 narrow space)
Next x

'Add Label?
'If Check2.value = True Then 'false
'    strObj.CurrentX = Len(Barcode) * 7 'kinda center
'    strObj.Print Barcode
'End If




End Function 'BC



Arriba
MexMan70 Ver desplegable
Colaborador
Colaborador


Unido: 17/Julio/2007
Localización: DarkSide
Estado: Sin conexión
Puntos: 9233
Enlace directo a este mensaje Enviado: 27/Agosto/2019 a las 17:00
Hola Rokoko, no he entendido tu pregunta. Acaso te refieres a que Acces verifique si esta instalada una tipografía (fuenre) y en caso de no existir que la instalé?
O acaso simplemente deseas leer los "palitos" ?

Saludos !
OneDrive: http://sdrv.ms/Vk6eJd
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 2171
Enlace directo a este mensaje Enviado: 27/Agosto/2019 a las 23:01
Lo que quiero es tener codigo de barras pero que no lo coja de una fuente(para no tener obligación de tenerla instalada). Que sea mediante codigo vba.

Saludos
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 2171
Enlace directo a este mensaje Enviado: 02/Octubre/2019 a las 13:16
Se puede cerrar. Lo he solucionado como el tercer mensaje quitando los asteriscos.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable