Ir para conteúdo

Publicidade

 Estatísticas do Fórum

  • 0 Usuários ativos

    0 membros, 0 visitantes, 0 membros anônimos

Foto
- - - - -

Funções, rotinas e dicas

  • Por favor, faça o login para responder
23 respostas neste tópico

#1 slype

slype
  • Members
  • 99 posts

Postado 15 novembro 2005 - 09:48

Iai Amigos, blzzz...

Seguinte, vamos colocar aki nesse tópico algumas FUNÇÕES, ROTINAS, DICAS etc... (Algumas coisas Úteis e/ou Legais de VB)


Pra começar eu ja vo colocando uma rotina que uso muito em meus Projetos:


AUTO COMPLETE EM COMBOBOX:

1- Crie uma nova Classe de Módulo e renomeie como: clsAutoComplete

2- Na Classe de Módulo cole a rotina:


Private WithEvents pCombo As ComboBoxPrivate IsDelOrBack As BooleanPublic Sub Bind(Cmb As ComboBox)Set pCombo = CmbEnd SubPrivate Sub Class_Terminate()Set pCombo = NothingEnd SubPrivate Sub pCombo_Change()On Error Resume NextDim OldLen As IntegerDim i As IntegerIf Not pCombo.Text = "" And Not IsDelOrBack Then	OldLen = Len(pCombo.Text)	For i = 0 To pCombo.ListCount - 1		If InStr(1, Mid$(UCase(pCombo.List(i)), 1, OldLen), UCase(pCombo.Text)) Then			pCombo.Text = pCombo.List(i)			If pCombo.SelText = "" Then				pCombo.SelStart = OldLen			Else				pCombo.SelStart = InStr(pCombo.Text, pCombo.SelText)			End If			pCombo.SelLength = Len(pCombo.Text)			Exit For		End If	NextEnd IfEnd SubPrivate Sub pCombo_KeyDown(KeyCode As Integer, Shift As Integer)IsDelOrBack = (KeyCode = vbKeyBack Or KeyCode = vbKeyDelete)End Sub
3- No Form que for usar o Auto Complete declare a Classe de Módulo:

Dim Complete As New clsAutoComplete
4- E por fim, chame a Rotina no seu ComboBox:

Complete.Bind cboNome
* Onde cboNome é o nome do seu ComboBox.

Obs: Use o comando acima para chamar a rotina depois de ter Enchido ele ou no LOAD do Form.

É isso ae, Postem as suas agora.... até
  • 0

Publicidade

#2 slype

slype
  • Members
  • 99 posts

Postado 15 novembro 2005 - 04:29

Varias Opções para FORMs muito uteis:


CLIQUE AQUI
  • 0

#3 cassitos

cassitos

    vamu q vamu! ^_^

  • Members
  • 998 posts

Postado 17 novembro 2005 - 11:00

Eis outro link com dicas: http://www.silicio.c...s/abertura.html
  • 0

#4 slype

slype
  • Members
  • 99 posts

Postado 20 novembro 2005 - 10:50

Pode ser que muitos saibam dessas discas de uso, mais vou cita-las, são bem uteis:1- Quando estiver digitando um comando, utilize (CTRL + ESPAÇO), o VB te mostra todos os comando que você pode estar utilizando nessa linha.2- Quando desejar procurar uma propriedade de um Objeto, ao invez ficar rolando a barra com o mouse, aperte: CHIFT + CTRL + (a primeira letra da propriedade.Exemplo, você quer a propriedade "TEXT" = CHIFT + CTRL + T3 - Ao ver uma chamada de Função, Sub ou Variavel, para ir até a definição dela basta clicar com 'botão direito' no nome > 'Definition'4 - Para movimentar objetos de um Form com teclado: Segure CTRL e mova com as setas do teclado5 - Para redimensionar objetos de um Form com teclado: Segure SHIFT e redimensione com as setas do teclado...é isso ae Galera.... Em breve posto mais, continuem postando, Até mais!
  • 1

#5 Graymalkin

Graymalkin

    Ex-moderador

  • Members
  • 908 posts

Postado 20 novembro 2005 - 05:33

Dois tutoriais de sockets em VB: http://www.desenvolv...=article&sid=27 http://www.desenvolv...=article&sid=26 Ah, vou pendurar esse tópico para ficar sempre visível. Boa idéia, Slype! :D Abraços, Graymalkin
  • 0

#6 lgustavoc

lgustavoc
  • Members
  • 33 posts

Postado 22 novembro 2005 - 09:24

Função pra validar um e-mail
Public Function EmailOK(ByVal Email As String) As Boolean	Dim j As Long, C As String	If Email = "" Or Email Like "*@*" And _	(Email Like "*.??" Or Email Like "*.???") _	Then EmailOK = True	If Email Like "*.???" Then		C = Right$(Email, 4)		If C = ".com" Or C = ".net" Or C = ".edu" _		Or C = ".mil" Or C = ".gov" Or C = ".org" Then	Else		EmailOK = False	End IfEnd IfFor j = 1 To Len(Email)	C = Mid$(Email, j, 1)	If C = "@" Or C = "." Or C = "-" Or C = "_" _	Or C >= Chr(48) And C <= Chr(57) _	Or LCase(C) >= Chr(97) And _	LCase(C) <= Chr(122) ThenElse	EmailOK = FalseEnd IfNext jEnd Function
Pra chamar a função:
If EMailOK(seuemail.text)= true then  Msgbox "E-mail válido"Else  Msgbox "E-mail inválido"End If

  • 0

#7 slype

slype
  • Members
  • 99 posts

Postado 03 dezembro 2005 - 01:23

10 dicas básicas sobre impressão com Printer. http://www.macoratti.net/vb_print2.htm
  • 0

#8 Fabyo

Fabyo

    PHP

  • Masters
  • 5.911 posts

Postado 10 fevereiro 2006 - 01:00

Use Expressoes Regulares no VB

http://www.macoratti.net/vb_regex.htm
http://guia-er.sourceforge.net/

use ER muito melhor para validar dados tipo email, datas hora etc...
  • 0

#9 slype

slype
  • Members
  • 99 posts

Postado 20 fevereiro 2006 - 09:06

Uma SUBzinha bastante Util que eu mesmo Criei... Função: Escrever direto em uma MSFlexGrid Vamos Lá.... Cole em um Módulo:
Public Sub EscreveNaGrid(Grid As MSFlexGrid, Coluna As Integer, Linha As Integer, Key As Integer, SóNumero As Boolean)'Sub Criada por Slype - 20/02/2006	On Error Resume Next	If Key = 8 Then		Grid.TextMatrix(Linha, Coluna) = Left(Grid.TextMatrix(Linha, Coluna), Len(Grid.TextMatrix(Linha, Coluna)) - 1)	ElseIf Key = 13 Then		Grid.Row = Grid.Row + 1	Else		If SóNumero = True Then			If Not IsNumeric(Chr(Key)) And Key <> 44 Then Exit Sub		End If		Grid.TextMatrix(Linha, Coluna) = Grid.TextMatrix(Linha, Coluna) & Chr(Key)	End IfEnd Sub
Chame a função no Evento KeyPress do seu MSFlexGrid:
Private Sub NomeDoGrid_KeyPress(KeyAscii As Integer)	EscreveNaGrid NomeDoGrid, NomeDoGrid.Col, NomeDoGrid.Row, KeyAscii, FalseEnd Sub
... Caso queira que seje digitado Somente Numeros Então chame assim:
Private Sub NomeDoGrid_KeyPress(KeyAscii As Integer)	EscreveNaGrid NomeDoGrid, NomeDoGrid.Col, NomeDoGrid.Row, KeyAscii, TrueEnd Sub
É isso ai... Espero que Seje Util á Voces!!! falowww ate mais!!!
  • 0

#10 Fabyo

Fabyo

    PHP

  • Masters
  • 5.911 posts

Postado 27 fevereiro 2006 - 04:25

Trocar Tab por Enter

se precisar usar em varios campos coloque no keypress do formulario
e deixe o KeyPreview do formulário para True

If KeyAscii = 13 Then  SendKeys "{tab}"

para evitar um beep deixe o keyascii com valor 0 :

If KeyAscii = 13 Then
	  SendKeys "{tab}"
	  KeyAscii = 0
  End If

Permitir só numeros no campo text

coloque no KeyPress do campo text

KeyAscii = IIf(KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8, KeyAscii, 0)

Exibir a data atual no padrao dd/mm/yyyy

só usar o format()
Format(Date, "dd/mm/yyyy")

Ultimo dia do mes:
Format(DateSerial(Year(Now), Month(Now) + 1, 0), "dd/mm/yyyy")

Deixar o campo text somente com letras maiusculas:

KeyAscii = Asc(UCase(Chr(KeyAscii)))
obs: para forçar somente minusculas use a função LCase no lugar da UCase

Função que preenche com zeros a esquerda ou direita do numero

coloque num modulo a função abaixo:
Public Function FormataZero_Esquerda(Valor As String, Casas As String)
	FormataZero_Esquerda = Left(Casas, Len(Casas) - Len(Valor)) & Valor
End Function

modo de usar :
msgbox FormataZero_Esquerda("12", "00000")

obs: para preencher com zeros a direita só inverter "Valor" na função colocando ele na frente
e pode preencher com outro caracter sem ser zero
  • 0

#11 Fabyo

Fabyo

    PHP

  • Masters
  • 5.911 posts

Postado 29 março 2006 - 09:34

Conexao Com banco de Dados MySQL usando Dll nativa "libmySQL", sem usar ODBC ou Drivers

basta Referenciar a MyVbQL.dll

e usar assim:

Dim my As MYSQL_CONNECTION
Set my = New MYSQL_CONNECTION

my.OpenConnection "localhost", "usuario", "senha", "banco"

	If my.State = MY_CONN_OPEN Then
		MsgBox "successo"
	Else
		MsgBox "Falha na conexao"
	End If

Set MyRS = my.Execute("select * from tabela")

alguns metodos:

MsgBox MyRS.RecordCount
MsgBox MyRS.FieldCount
MsgBox MyRS.Fields(0).Name

procurem essa dll no google é facil de achar mas quem nao conseguir posta ai que eu envio a dll por email

e ela tem muitos outros recursos apenas mostrei como conectar

existe tbm MyOLEDB.exe para conectar usando Provider mas nao gostei muito prefiro a MyVbQL

qualquer duvida só postar
  • 1

#12 Fabyo

Fabyo

    PHP

  • Masters
  • 5.911 posts

Postado 03 abril 2006 - 07:32

Calcular idade:

Int(DateDiff("y", CDate(data_niver), Date) / 365.25)

  • 0

#13 slype

slype
  • Members
  • 99 posts

Postado 27 maio 2006 - 03:21

• Função para Encher um ComboBox com Dados de um Campo de uma Tabela (em ADO)

Função:
Public Function DadosCBOtabela(Cb As ComboBox, Tabela As String, Campo As String) As Boolean	Dim Seleção as ADODB.Recordset	StrTemp = Cb.Text	Cb.Clear	Set Seleção = New ADODB.Recordset		Seleção.Open "SELECT " & Campo & " FROM " & Tabela & " ORDER BY " & Campo, BDdados, adOpenDynamic, adLockReadOnly	If Seleção.EOF = True Then		DadosCBOtabela = False		Seleção.Close		Exit Function	End If	Do While Not Seleção.EOF		Cb.AddItem IIf(IsNull(Seleção(Campo)), "", Seleção(Campo))		Seleção.MoveNext	Loop	DadosCBOtabela = True	Seleção.Close	Cb.Text = StrTemp	StrTemp = ""End Function
*Onde BDdados é uma connexão ADO com um Banco....

Ex de uma connexão ADO com BD Access:
Dim BDdados as ADODB.Connection	Set BDdados = New ADODB.Connection	BDdados.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=SENHA;" & "Data Source=C:\Dados.mdb;" & "Persist Security Info=False"	BDdados.Open
Como chamar a Função:
DadosCBOtabela Cbo_Nome, "Clientes", "Nome"
...é isso ae galera.....Taí mais uma funçãozinha show de bola!!! =]
Até mais!!!
  • 0

#14 Dennys Lopes

Dennys Lopes
  • Members
  • 281 posts

Postado 23 agosto 2006 - 09:50

Função muito util na hora de criar uma pasta: Caso voce queira criar a pasta "c:\func\vb\imasters" e não existe nenhuma dessas pastas, nem a func, ao inves de criar uma por uma usando o MKDIR, jogue esse caminho nessa funcao:
Public Function NewPath(path As String) As StringDim QuebraPasta As VariantDim CriaPasta As StringDim cont As IntegerDim QuebraParametro As VariantOn Error GoTo trataIf Right(path, 1) = "\" Then path = Left(path, Len(path) - 1)If FileExist(path) = False Then	QuebraPasta = Split(path, "\")	For cont = 1 To UBound(QuebraPasta)		If cont = UBound(QuebraPasta) Then			QuebraParametro = Split(QuebraPasta(cont), ";")			If cont = 1 Then				CriaPasta = QuebraPasta(0) & "\" & QuebraParametro(0)			Else				CriaPasta = CriaPasta & "\" & QuebraParametro(0)			End If		Else			If CriaPasta = "" Then				CriaPasta = QuebraPasta(cont - 1) & "\" & QuebraPasta(cont)			Else				CriaPasta = CriaPasta & "\" & QuebraPasta(cont)			End If		End If		If Not FileExist(CriaPasta) Then MkDir (CriaPasta)	Next contEnd Iftrata:If Err.Number = 76 Or Err.Number = 75 Then	Resume NextElseIf Err.Number <> 0 Then	MsgBox Err.Number & " - " & Err.Description, vbCriticalEnd IfEnd Function

  • 0

#15 slype

slype
  • Members
  • 99 posts

Postado 03 setembro 2006 - 02:11

Tai mais uma de minhas Subs... essa é show de bola, quebra um galhão nos meus sistemas... • Serve para carregar um ComboBox com Informações (baseado no parametro (Tipo) que você passa) • Vcs podem colocar mais coisas nela... é só seguir o eskema:
Public Sub DadosCBO(Cb As ComboBox, Tipo As String, Optional NumIni As Double, Optional NumFim As Double)	Cb.Clear	Tipo = LCase(Tipo)	Select Case Tipo		Case "meses"			Cb.AddItem "Janeiro"			Cb.AddItem "Fevereiro"			Cb.AddItem "Março"			Cb.AddItem "Abril"			Cb.AddItem "Maio"			Cb.AddItem "Junho"			Cb.AddItem "Julho"			Cb.AddItem "Agosto"			Cb.AddItem "Setembro"			Cb.AddItem "Outubro"			Cb.AddItem "Novembro"			Cb.AddItem "Dezembro"		Case "diasemana"			Cb.AddItem "Domingo"			Cb.AddItem "Segunda"			Cb.AddItem "Terça"			Cb.AddItem "Quarta"			Cb.AddItem "Quinta"			Cb.AddItem "---ta"			Cb.AddItem "Sábado"		Case "numeros"			Do While NumIni <= NumFim				Cb.AddItem NumIni				NumIni = NumIni + 1			Loop		Case "estados"			Cb.AddItem "AC"			Cb.AddItem "AL"			Cb.AddItem "AM"			Cb.AddItem "AP"			Cb.AddItem "BA"			Cb.AddItem "CE"			Cb.AddItem "DF"			Cb.AddItem "ES"			Cb.AddItem "GO"			Cb.AddItem "MA"			Cb.AddItem "MG"			Cb.AddItem "MS"			Cb.AddItem "MT"			Cb.AddItem "PA"			Cb.AddItem "PB"			Cb.AddItem "PE"			Cb.AddItem "PI"			Cb.AddItem "PR"			Cb.AddItem "RJ"			Cb.AddItem "RN"			Cb.AddItem "RO"			Cb.AddItem "RR"			Cb.AddItem "RS"			Cb.AddItem "SC"			Cb.AddItem "SE"			Cb.AddItem "SP"			Cb.AddItem "TO"		Case "impressoras"			For Each ImprComputador In Printers				Cb.AddItem ImprComputador.DeviceName			Next ImprComputador		Case "estadocivil"			Cb.AddItem "Amasiado(a)"			Cb.AddItem "Casado(a)"			Cb.AddItem "Desquitado(a)"			Cb.AddItem "Divorciado(a)"			Cb.AddItem "Separado(a)"			Cb.AddItem "Solteiro(a)"			Cb.AddItem "Viúvo(a)"			Cb.AddItem "2º União"		Case "---o"			Cb.AddItem "Masculino"			Cb.AddItem "Feminino"	End SelectEnd Sub
... show de bola pessoal... continuem postando!!! Até mais!
  • 0

#16 Jattobá

Jattobá
  • Members
  • 21 posts

Postado 11 março 2007 - 09:11

Informar a data ex:Dim as dhoje as stringdhohe = RetDia(11/03/2007)Retorno = Domingo, 11 de Março de 2007Public Function RetDia(qData As Date) As String			  Dim Dia(), Mes(), lngValor As Integer			  Dia = Array("Domingo", "Segunda-Feira", "Terça-Feira", "Quarta-Feira", "Quinta-Feira", "---ta-Feira", "Sábado")			  lngValor = Weekday(qData)			  Mes = Array("Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", _			  "Julho", "Agosto", "Setembro", "Outubro", "Novembro", "Dezembro")			  RetDia = Dia(lngValor) + ", " + CStr(Day(qData)) + " de " + Mes(Month(qData)) + " de " + CStr(Year(qData))End Function

  • 0

#17 Jattobá

Jattobá
  • Members
  • 21 posts

Postado 18 março 2007 - 12:55

Algumas vezes precisamos realizar checks, comparações etc.Abaixo crieI uma função que me retorna se pode ou não digitar uma informação.No exemplo abaixo verifico se um lançamento de horas é valido ou não. ( Uso horas no formato texto 00:00 a 23:59 convertidos em minutos de 0 a 1439 )No form da digitação deixo um listbox invisivel, onde a função abaixo preenche com os parâmetros enviados.List1 = listboxtE1 = por exemplo : 720 , ou seja 12:00 * 60 minutos.tS2 = por exemplo : 1080 , ou seja 18:00 * 60 minutos.val(TxtAte.text) = o valor digitado.Será carregado no listbox os valores entre 720 a 1080'------------------------------------------------------------------------------------------------------------If ChekHorasDigitadas(List1, tE1, tS2, val(TxtAte.text)) = "S" Then   msgbox "Localizado"  'Ok permitidoendif'------------------------------------------------------------------------------------------------------------Public Function ChekHorasDigitadas(ListaResu As ListBox, HTabini, HTabfim, HDigit)	Dim a As Integer, f As Integer, I As Integer	Dim xHoraLocalizada As Integer	Dim Hinicial As Integer	Dim Hfinal As Integer			Hinicial = HTabini	Hfinal = HTabfim		If Hfinal < Hinicial Then		Hfinal = Hfinal + 1440	End If		ListaResu.Clear	For a = Hinicial To Hfinal		If a < 1440 Then		   ListaResu.AddItem a		End If		If a = 1440 Then		   Hinicial = 0		   Hfinal = Hfinal - 1440		   For f = Hinicial To Hfinal			   ListaResu.AddItem f		   Next		End If	Next		For I = 0 To ListaResu.ListCount - 1		xHoraLocalizada = ListaResu.List(I)		If xHoraLocalizada = HDigit Then		   ChekHorasDigitadas = "S"		   Exit Function		Else		   ChekHorasDigitadas = "N"		End If	Next	End Function'------------------------------------------------------------------------------------------------------------Utilizando a mesma lógica você pode usar a função com poucas modificação para fazer outras verificações, por exemplo :Verificação de UF, Cidades, Numeros sequenciais ou não, e outros conforme sua imaginação.Poderia tambem ser realizado ao invés de usar o ListBox, poderia ser usado uma Matrix(x), mas preferi dessa forma, visto que confiro todos os resultados no ato no listbox)tenha o cuidado de não permitir o estouro do listbox ou a performance, caso o conteudo temporários do listbox seja muito extensa.

  • 0

#18 Vegeta

Vegeta
  • Members
  • 11 posts

Postado 28 setembro 2007 - 04:08

fazer um form ficar na frente de todos, sem permitir que acesse outro form no aplicativo, tipo um msgbox! exemplo:
'NO ENVENTO EM QUE você VAI CHAMAR O FORMPrivate sub Command1_Click()form1.show 1end sub

  • 0

#19 Roney

Roney

    Roney

  • Members
  • 27 posts

Postado 25 janeiro 2008 - 07:17

Aê galera, beleza?
Não sei se será útil para alguém, mas eu precisei dessa coisa e num achei em lugar nenhum. Então, depois de feito, é hora de compartilhar...

Justificar parágrafo em VB com objeto PRINTER

Você vai precisar de um arquivo de módulo. No meu caso, chamei-o de modPrinter.bas

Public Const PHYSICALHEIGHT = 111
Public Const PHYSICALWIDTH = 110
Public Const PHYSICALOFFSETX = 112
Public Const PHYSICALOFFSETY = 113

Public Type SIZE
    cx As Long
    cy As Long
End Type

Public Declare Function _
    GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _
        ByVal hdc As Long, _
        ByVal lpsz As String, _
        ByVal cbString As Long, _
        lpSize As SIZE _
) As Long

Public Declare Function _
    SetTextJustification Lib "gdi32" ( _
        ByVal hdc As Long, _
        ByVal nBreakExtra As Long, _
        ByVal nBreakCount As Long _
) As Long

Public Declare Function _
    TextOut Lib "gdi32" Alias "TextOutA" ( _
        ByVal hdc As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal lpString As String, _
        ByVal nCount As Long _
) As Long

Public Declare Function _
    GetDeviceCaps Lib "gdi32" ( _
        ByVal hdc As Long, _
        ByVal nIndex As Long _
) As Long


E aqui vai o arquivo de classe, que chamei de CPrinter.cls

Option Explicit

Private m_hDC As Double
Private m_LeftMargin As Long
Private m_RightMargin As Long
Private m_LineSize As Long
Private m_LineHeight As Long


Private Function getLineSpaces(ByVal szText As String) As Long
    getLineSpaces = UBound(Split(szText, " "))
End Function


Public Property Let hdc(ByVal lngParm As Double)
    m_hDC = lngParm
End Property
Public Property Get hdc() As Double
    hdc = m_hDC
End Property


'Selectiona a impressora desejada pelo nome. Retorna o nome da impressora anteriormente selecionada
Public Function setPrinterDevice(ByVal szDeviceName) As String
    Dim sz As SIZE
    Dim lPtr As Printer
    setPrinterDevice = Printer.DeviceName
    Printer.KillDoc
    If (szDeviceName <> "") Then
        For Each lPtr In Printers
            If (lPtr.DeviceName = szDeviceName) Then
                Set Printer = lPtr
                Exit For
            End If
        Next
    End If
    m_hDC = Printer.hdc
    m_LeftMargin = GetDeviceCaps(m_hDC, PHYSICALOFFSETX)
    m_RightMargin = GetDeviceCaps(m_hDC, PHYSICALWIDTH) - (GetDeviceCaps(m_hDC, PHYSICALOFFSETX) * 2)
    m_LineSize = m_RightMargin - m_LeftMargin
    
    GetTextExtentPoint32 m_hDC, "X", 1, sz
    m_LineHeight = sz.cy
    
    Printer.Print
End Function


Public Function PrintText(ByVal szText As String)
    Dim sz As SIZE
    Dim iPos As Long
    Dim iOldPos As Long
    Dim szBuffer As String
    
    Do While (szText <> "")
        iPos = 0
        szBuffer$ = ""
        sz.cx = 0: sz.cy = 0
        Do While (sz.cx <= m_LineSize And iPos < Len(szText) And iPos <> -1)
            iOldPos = iPos
            iPos = InStr(iPos + 1, szText, " ")
            If (iPos = 0) Then
                szBuffer$ = szText$
                iPos = -1
            Else
                szBuffer$ = Left(szText$, iPos - 1)
            End If
            GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
        Loop
        If (iPos = -1) Then
            szBuffer$ = szText$
            szText$ = ""
        Else
            szBuffer$ = Left$(szText$, iOldPos - 1)
            szText$ = Mid$(szText$, iOldPos + 1)
        End If
    
        If (iPos <> -1) Then
            GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
            SetTextJustification m_hDC, m_LineSize - sz.cx, getLineSpaces(szBuffer$)
        Else
            SetTextJustification m_hDC, 0, 0
        End If
        TextOut m_hDC, 0, Printer.CurrentY, szBuffer$, Len(szBuffer$)
        SetTextJustification m_hDC, 0, 0
        Printer.CurrentY = Printer.CurrentY + sz.cy
    Loop
End Function

Public Sub newLine(Optional ByVal intLines As Integer = 1)
    Printer.CurrentX = 0
    Printer.CurrentY = Printer.CurrentY + (m_LineHeight * intLines)
End Sub

Public Sub EndDoc()
    Printer.EndDoc
End Sub

E agora, um exemplo de utilização. Crie um form e coloque um botão no mesmo. No evento de click do botão, coloque algo como isto:

Private Sub Command2_Click()
    Dim oPtr As New CPrinter
    Dim szBuffer As String
    
    'Seleciona a impressora desejada
    oPtr.setPrinterDevice "" 'Sem informar nada, assume a impressora padrão configurada
    
    szBuffer = "Coloque qualquer texto aqui. A função PrintText quebra as linhas e justifica para você"
    oPtr.PrintText szBuffer$
    
    'A função newLine salta um determinado número de linhas. Quando não for informado o número, assume o padrão de saltar 1 linha.
    'IMPORTANTE: A função PrintText já salta para a próxima linha. Utilize newLine apenas para saltar mais linhas

    oPtr.newLine     'Salta 1 linha
    oPtr.newLine 1  'Salta 1 linha
    oPtr.newLine 5  'Salta 5 linhas
    
    szBuffer$ = "Coloque qualquer outro texto aqui"
    oPtr.PrintText szBuffer$
    
    Printer.EndDoc 'Finaliza impressão e despeja para a impressora
End Sub

É isso aê... espero ter ajudado alguém. Funcionou direitinho em uma HP DeskJet, em uma HP Laserjet e jogando para PDF via Easy PDF Creator.
Abs,
Roney

Editado por Claudio Neto, 27 julho 2009 - 03:29 .
Trocadas tags <div> por [code] para deixar padronizado

  • 0

#20 gabrieldb

gabrieldb

    Si Vis Pacem, Para Bellum

  • Members
  • 286 posts

Postado 21 julho 2009 - 09:35

Criando uma aplicação em 3 camadas. http://www.macoratti.net/vb_3cam.htm http://www.macoratti.net/vb_3cam2.htm http://www.macoratti.net/vb_3cam3.htm
  • 1




Publicidade

/ins>