QUEBRA DE LINHAS EM MSGBOX
Boas...
Tenho um project em VB6 para registro de filmes em DVD.
No project, tem uma consulta para ver se determinado filme possui um comentário.
Um clique no botão <Pesquisa> devolve a msgbox abaixo:
[ô]MsgBox [Ô]Não há anotações registradas[Ô] & vbCrLf & _
[ô] [Ô]para o filme:[Ô] & vbCrLf & _
[ô] Label9.Caption & [Ô] ...[Ô]
[ô] lblComent.Visible = False
[ô] Image3.Visible = True
[ô] End If
Quando o tÃtulo do filme é curto (ex.: até 18 caracteres), a msgbox tem um tamanho [ô]x[ô].
Todavia, quando o tÃtulo é longo, a msgbox é expandida para acomodar o texto.
Tem como quebrar o tÃtulo (contido no label9) quando o nome superar um determinado número
de caracteres, sem cortar a palavra no meio?
Agradeço a atenção.
Tenho um project em VB6 para registro de filmes em DVD.
No project, tem uma consulta para ver se determinado filme possui um comentário.
Um clique no botão <Pesquisa> devolve a msgbox abaixo:
[ô]MsgBox [Ô]Não há anotações registradas[Ô] & vbCrLf & _
[ô] [Ô]para o filme:[Ô] & vbCrLf & _
[ô] Label9.Caption & [Ô] ...[Ô]
[ô] lblComent.Visible = False
[ô] Image3.Visible = True
[ô] End If
Quando o tÃtulo do filme é curto (ex.: até 18 caracteres), a msgbox tem um tamanho [ô]x[ô].
Todavia, quando o tÃtulo é longo, a msgbox é expandida para acomodar o texto.
Tem como quebrar o tÃtulo (contido no label9) quando o nome superar um determinado número
de caracteres, sem cortar a palavra no meio?
Agradeço a atenção.
dentro do form coloque a seguinte função
Private Function delimitarTamanhoTexto(ByVal qtdCaracteres As Integer, ByVal MeuTexto As String) As String
Dim vTexto As String
Dim tam As Long
Dim tamLen As Long
Dim iCount As Integer
tam = CLng(Len(MeuTexto))
tamLen = 1
iCount = 0
vTexto = [Ô][Ô]
[ô]Pode Ser assim
[ô]==================================================================
While tamLen <= tam
If iCount = 18 Then
vTexto = vTexto & Mid$(MeuTexto, tamLen, iCount) & vbCrLf
tamLen = tamLen + iCount
iCount = 0
End If
iCount = iCount + 1
Wend
[ô]Ou pode ser assim
[ô]==================================================================
[ô]For tamLen = 1 To tam
[ô] If iCount = 18 Then
[ô] vTexto = vTexto & vbCrLf
[ô] iCount = 0
[ô] End If
[ô] vTexto = vTexto & Mid(MeuTexto, tamLen, 1)
[ô] iCount = iCount + 1
[ô]Next
delimitarTamanhoTexto = vTexto
End Function
para chamar é só fazer assim
[ô]MsgBox [Ô]Não há anotações registradas[Ô] & vbCrLf & _
[ô] [Ô]para o filme:[Ô] & vbCrLf & _
[ô] delimitarTamanhoTexto(18, Label9.Caption) & [Ô] ...[Ô]
[ô] lblComent.Visible = False
[ô] Image3.Visible = True
[ô] End If
ou atribuir em uma variavel antes
Private Function delimitarTamanhoTexto(ByVal qtdCaracteres As Integer, ByVal MeuTexto As String) As String
Dim vTexto As String
Dim tam As Long
Dim tamLen As Long
Dim iCount As Integer
tam = CLng(Len(MeuTexto))
tamLen = 1
iCount = 0
vTexto = [Ô][Ô]
[ô]Pode Ser assim
[ô]==================================================================
While tamLen <= tam
If iCount = 18 Then
vTexto = vTexto & Mid$(MeuTexto, tamLen, iCount) & vbCrLf
tamLen = tamLen + iCount
iCount = 0
End If
iCount = iCount + 1
Wend
[ô]Ou pode ser assim
[ô]==================================================================
[ô]For tamLen = 1 To tam
[ô] If iCount = 18 Then
[ô] vTexto = vTexto & vbCrLf
[ô] iCount = 0
[ô] End If
[ô] vTexto = vTexto & Mid(MeuTexto, tamLen, 1)
[ô] iCount = iCount + 1
[ô]Next
delimitarTamanhoTexto = vTexto
End Function
para chamar é só fazer assim
[ô]MsgBox [Ô]Não há anotações registradas[Ô] & vbCrLf & _
[ô] [Ô]para o filme:[Ô] & vbCrLf & _
[ô] delimitarTamanhoTexto(18, Label9.Caption) & [Ô] ...[Ô]
[ô] lblComent.Visible = False
[ô] Image3.Visible = True
[ô] End If
ou atribuir em uma variavel antes
[ô]Fiz assim:
Private Function delimitarTamanhoTexto(ByVal qtdCaracteres As Integer, ByVal MeuTexto As String) As String
Dim vTexto As String
Dim tam As Long
Dim tamLen As Long
Dim iCount As Integer
tam = CLng(Len(MeuTexto))
tamLen = 1
iCount = 0
vTexto = [Ô][Ô]
While tamLen <= tam
If iCount = 28 Then
vTexto = vTexto & Mid$(MeuTexto, tamLen, iCount) & vbCrLf
tamLen = tamLen + iCount
iCount = 0
End If
iCount = iCount + 1
Wend
delimitarTamanhoTexto = vTexto
End Function
[ô]para chamar:
MsgBox [Ô]Não há anotações registradas[Ô] & vbCrLf & _
[Ô]para o filme:[Ô] & vbCrLf & _
delimitarTamanhoTexto(28, Label9.Caption) & [Ô] ...[Ô]
lblComent.Visible = False
Image3.Visible = True
End If
[ô]A msgbox passa a ter o tamanho controlado pela quantidade de caracteres permitidos (no caso, 28).
[ô]Contudo, quando o tÃtulo ultrapassar os 28 caracteres, todo o restante é transferido para a linha de baixo, incluindo cortar parte do
[ô]tÃtulo da linha de cima, para continuar na linha de baixo...
[ô]Você conhece algum meio de impedir que uma parte do nome seja interrompida, para continuar na linha de baixo? (Lembro-me, vagamente,
[ô]de ter visto alguma coisa, num tratamento de textbox....).
[ô] No mais, seu código funcionou cem por cento! Agradeço pela colaboração.
Sirious.
acho que isso aqui resolve o seu problema!
Private Function delimitarTamanhoTexto(ByVal qtdCaracteres As Integer, ByVal MeuTexto As String) As String
Dim vTexto As String
Dim vTextoAux As String
Dim vetDic() As String
Dim iCount As Integer
Dim i As Integer
vetDic = Split(MeuTexto, [Ô] [Ô])
vTexto = [Ô][Ô]
vTextoAux = [Ô][Ô]
For i = 0 To UBound(vetDic)
iCount = (Len(vTextoAux) + Len(vetDic(i)))
If vTextoAux = [Ô][Ô] Then
vTextoAux = vetDic(i)
Else
If iCount < qtdCaracteres Then
vTextoAux = vTextoAux & Space$(1) & vetDic(i)
Else
vTextoAux = vTextoAux & vbCrLf
vTexto = vTextoAux
vTextoAux = vetDic(i)
End If
End If
Next
If vTexto = [Ô][Ô] Then
vTexto = vTextoAux
Else
vTexto = Mid(vTexto, 1, InStrRev(vTexto, vbCrLf) - 1)
vTexto = vTexto & vbCrLf & vTextoAux
End If
delimitarTamanhoTexto = vTexto
End Function
Valeu Filman.
Vou adaptar a rotina que vc passou ao project...
Muito obrigado.
Sirious
Tópico encerrado , respostas não são mais permitidas