Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

~vêHagah#

Utilização SavePicture sem Form

Por , em Visual Basic

Recommended Posts

~vêHagah#    0

~vêHagah#
Postado

Bom dia pessoal.

Preciso fazer uma rotina que pegue um número e salve este número em arquivo bmp em código de barras.

Para fazer isto, peguei um projeto feito em form, onde possuia um edit para informar o número, uma PictureBox mostrando o código de barras e um botão para salvá-lo em bmp.

 

Beleza, a dúvida é a seguinte: a partir desta source em form, fiz alterações para gerar apenas um .bas. Eu posso continuar utilizando o "SavePicture PEan.Image" neste meu .bas? Ou terá funcionalidade apenas em forms?

 

Attribute VB_Name = "CodigoBarras"
Dim W As String 'a cor W é a cor do picture1'
Private Const N As String = &H0&
Private Const A As String = "A"
Private Const B As String = "B"
Private Const C As String = "C"

Private Function CorLinha(Digito As Integer, Numero As Integer, Posicion As Integer, NumeroLinea As Integer)
Dim Sequencia As Variant, SequenciaCor As Variant, Tipo As String

    Select Case Digito
        Case 0
            Sequencia = Array(12, A, A, A, A, A, A, C, C, C, C, C, C)
        Case 1
            Sequencia = Array(12, A, A, B, A, B, B, C, C, C, C, C, C)
        Case 2
            Sequencia = Array(12, A, A, B, B, A, B, C, C, C, C, C, C)
        Case 3
            Sequencia = Array(12, A, A, B, B, B, A, C, C, C, C, C, C)
        Case 4
            Sequencia = Array(12, A, B, A, A, B, B, C, C, C, C, C, C)
        Case 5
            Sequencia = Array(12, A, B, B, A, A, B, C, C, C, C, C, C)
        Case 6
            Sequencia = Array(12, A, B, B, B, A, A, C, C, C, C, C, C)
        Case 7
            Sequencia = Array(12, A, B, A, B, A, B, C, C, C, C, C, C)
        Case 8
            Sequencia = Array(12, A, B, A, B, B, A, C, C, C, C, C, C)
        Case 9
            Sequencia = Array(12, A, B, B, A, B, A, C, C, C, C, C, C)
    End Select

    Tipo = Sequencia(Posicion)

    Select Case Numero
        Case 0
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, W, N, N, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, W, W, N, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, N, W, W, N, W)
            End Select
        Case 1
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, N, N, W, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, N, W, W, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, W, W, N, N, W)
            End Select
        Case 2
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, N, W, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, N, W, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, W, N, N, W, W)
            End Select
        Case 3
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, N, N, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, W, W, W, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, W, W, W, N, W)
            End Select
        Case 4
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, W, W, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, N, N, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, N, N, N, W, W)
            End Select
        Case 5
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, W, W, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, N, N, W, W, N) 
                Case C
                    SequenciaCor = Array(7, N, W, W, N, N, N, W)
            End Select
        Case 6
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, W, N, N, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, W, W, N, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, N, W, W, W, W)
            End Select
        Case 7
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, N, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, W, W, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, W, W, N, W, W)
            End Select
        Case 8
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, W, N, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, W, N, W, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, W, N, W, W, W)
            End Select
        Case 9
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, W, N, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, W, N, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, N, W, N, W, W)
            End Select

    End Select
    CorLinha = SequenciaCor(NumeroLinea)
End Function

Private Function EndsWith(ByVal Texto As String, ByVal caracter As String) As Boolean
    If Len(Texto) > 0 Then
        If Mid(Texto, Len(Texto), 1) = caracter Then
            EndsWith = True
        Else
            EndsWith = False
        End If
    Else
        EndsWith = False
    End If
End Function

Private Function FormatoEan(EAN As String) As String

Dim Sequencia As Variant, i As Integer, Total As Integer, DigitoDeControle As Integer
    If Len(EAN) < 13 Then
        EAN = String(12 - Len(EAN), "0") & EAN
    Else
        EAN = Mid(EAN, 1, 12)
    End If

    Sequencia = Array(13, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)

    For i = 1 To 12
        Total = Total + Mid(EAN, i, 1) * Sequencia(i)
    Next i
    DigitoDeControle = IIf(Right(Total, 1) = 0, 0, 10 - Val(Right(Total, 1)))
    FormatoEan = EAN & DigitoDeControle
End Function

Private Sub SalvarIMG()
On Error GoTo trataerro
    SavePicture PEan.Image, IIf(EndsWith(App.Path, "\"), App.Path & TxtEan.Text, App.Path & "\" & TxtEan.Text) & ".bmp"
    Exit Sub
trataerro:
    MsgBox "Erro ao gerar imagem do Código de Barras: " & Err.Description
End Sub

Public Sub eTFICodBar(ByVal TxtEan)
On Error Resume Next
Dim x As Integer, x1 As Integer, Columna As Integer, NumeroDeGrupo As Integer, Grupo As Integer
Dim Inicial As Integer, Resto As String, NNumero As Integer, PPosicion As Integer
	PEan.Cls
	If IsNumeric(TxtEan) Then
		TxtEan = FormatoEan(TxtEan.Text)
		MsgBox TxtEan
		W = PEan.BackColor
		Inicial = Mid(TxtEan, 1, 1)
		Resto   = Mid(TxtEan, 2, TxtEan.Lenght())
		PEan.Line (135, 90)-(135, 840), &H0&
		PEan.Line (165, 90)-(165, 840), &H0&
		If Inicial <> "0" Then
			PEan.CurrentX = -20
			PEan.CurrentY = 700
			PEan.Print Inicial
		End If
		For Grupo = 1 To 2
			Select Case Grupo
				Case 1
					x = 165
					x1 = 165
				Case 2
					x = 870
					x1 = 870
			End Select
				For NumeroDeGrupo = 1 To 6
					PPosicion = IIf(Grupo = 1, NumeroDeGrupo, NumeroDeGrupo + 6)
					NNumero = IIf(Grupo = 1, Mid(Resto, NumeroDeGrupo, 1), Mid(Resto, NumeroDeGrupo + 6, 1))
					For Columna = 1 To 7
						If Columna = 1 Then
							PEan.CurrentY = 700
							If Grupo = 1 Then PEan.CurrentX = x - 15 Else PEan.CurrentX = x - 30
								PEan.Print NNumero
						End If
						PEan.Line (x + (15 * Columna), 90)-(x1 + (15 * Columna), 690), CorLinha(Inicial, NNumero, PPosicion, Columna), BF
					Next Columna
					x = (x + (7 * 15))
					x1 = (x1 + (7 * 15))
				Next NumeroDeGrupo
			Select Case Grupo
				Case 1
					PEan.Line (x + 30, 90)-(x + 30, 765), &H0&
					PEan.Line (x + 60, 90)-(x + 60, 765), &H0&
				Case 2
					PEan.Line (x + 15, 90)-(x + 15, 840), &H0&
					PEan.Line (x + 45, 90)-(x + 45, 840), &H0&
			End Select
		Next Grupo
		' SavePicture PEan.Image, IIf(EndsWith(App.Path, "\"), App.Path & TxtEan.Text, App.Path & "\" & TxtEan.Text) & ".bmp"'
		SavePicture PEan.Image, IIf(EndsWith(App.Path, "\"), App.Path & TxtEan, App.Path & "\" & TxtEan) & ".bmp"

	End If
End Sub

Compartilhar este post

Link para o post
Compartilhar em outros sites

~vêHagah#    0

~vêHagah#
Postado

Bom, encontrei uma outra solução que estarei trabalhando, a qual não precisarei gerar imagem, pois meu problema é que o vb6 não consegue utilizar fonte <> Arial em PDF.

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos Visual Basic
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito