Pesquisar na Comunidade

Boa noite! Estou utilizando vb6 em uma aplicação recebendo dados da serial,os dados estáo recebendo pelo text1.text o seguinte formato: 0,140,450,780,890,560,450,560,250,410,780,620,950,260,150,490,150,460,29 E preciso separar e mostrar no text2.text apenas no formato 0,14. agradecido

Boa noite amigos, se alguém puder me ajudar, o meu problema é o seguinte: Monte um Media player de vídeo com 2 playlist, esta tudo funcionando direitinho, o meu único problema, é que eu gostaria que quando um playlist chegue ao fim o outro começa, (ai que está o problema) Como faço?

Alguém pode me ajudar ? Criei um programa , e quando tentei rodar em outra máquina aparece um erro conforme descrição abaixo : Run-time error '339': Component ' MSCHRT20.OCX' or one of its dependencies not correctly registered: a file is missing or invalid

Srs , Alguém poderia me ajudar a resolver esse probleminha : Preciso pegar o maior valor da ultima coluna : ListView1.ListItems.Item(1).ListSubItems.Add.Text = TextGrafico.Text ListView1.ListItems.Add(1).Text = s ListView1.ListItems.Item(1).ListSubItems.Add.Text = TextVacc_NC_CV.Text ListView1.ListItems.Item(1).ListSubItems.Add.Text = TextVacc_C_CV.Text ListView1.ListItems.Item(1).ListSubItems.Add.Text = TextVacc_NC_VB.Text ListView1.ListItems.Item(1).ListSubItems.Add.Text = TextVacc_C_VB.Text ListView1.ListItems.Item(1).ListSubItems.Add.Text = TextGrafico.Text Agradeço desde já

Senhores , alguem pode me ajudar ... não estou conseguindo inserir no meu projeto uma condição : Quero que a cor de a Label1 fique vermelha quando o valor da Text1 for maior ou = 1,5 e menor ou = -1,5 Quero que a cor da Label1 fique Amarela quando o valor da Text1 estiver entre 1 e 1,5 e entre -1 e -1,5 Quero que a cor da Label1 fique Verde quando o valor da Text1 for menor ou =1,0 e maior ou = -1

Boa tarde, Programo ocasionalmente e em VB 6.0, sou novo no forum e neste momento deparo-me com um problema que nunca antes me tinha acontecido. Imaginem que adiciono 5 linhas a uma mshflexgrid e depois removo todas menos a do cabeçalho, se voltar a inserir linhas na mesma grid elas não aparecem no entanto o valor das rows continua a aumentar, mais esquisito ainda e as linhas começam a aparecer à décima linha. Alguém me pode dar uma dica? Obrigado desde já.

Galera, vamos enviar um email utilizando SMTP, muuuuito facil mesmo! Segue o codigo: clsCDOmail.cls Option Explicit ' para la conexión a internet Private Declare Function InternetGetConnectedState _ Lib "wininet.dll" ( _ ByRef lpdwFlags As Long, _ ByVal dwReserved As Long) As Long Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 Private Const INTERNET_RAS_INSTALLED As Long = &H10 Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40 ' variables locales Private mServidor As String Private mPara As String Private mDe As String Private mAsunto As String Private mMensaje As String Private mAdjunto As String Private mPuerto As Variant Private mUsuario As String Private mPassword As String Private mUseAuntentificacion As Boolean Private mSSL As Boolean Public Event Error(Descripcion As String, Numero As Variant) Public Event EnvioCompleto() Function Enviar_Backup() As Boolean ' Variable de objeto Cdo.Message Dim oCDO As Object ' chequea si hay conexión If InternetGetConnectedState(0&, 0&) = False Then RaiseEvent Error("No se puede enviar el correo. " & _ "Verificar la conexión a internet si está disponible", 0) Exit Function End If ' chequea que el puerto sea un número, o que no esté vacío If Not IsNumeric(puerto) Then RaiseEvent Error("No se ha indicado el puerto del servidor", 0) Exit Function End If ' Crea un Nuevo objeto CDO.Message Set oCDO = CreateObject("CDO.Message") ' Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre _ del servidor o su dirección IP ) oCDO.Configuration.Fields( _ "http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServidor oCDO.Configuration.Fields( _ "http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' Puerto. Por defecto se usa el puerto 25, _ en el caso de Gmail se usa el puerto 465 oCDO.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mPuerto ' Indica el tipo de autentificación con el servidor de correo _ El valor 0 no requiere autentificarse, el valor 1 es con autentificación oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _ "configuration/smtpauthenticate") = Abs(mUseAuntentificacion) ' Tiempo máximo de espera en segundos para la conexión oCDO.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10 ' Configura las opciones para el login en el SMTP If mUseAuntentificacion Then ' Id de usuario del servidor Smtp ( en el caso de gmail, _ debe ser la dirección de correro mas el @gmail.com ) oCDO.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusername") = mUsuario ' Password de la cuenta oCDO.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mPassword ' Indica si se usa SSL para el envío. En el caso de Gmail requiere que esté en True oCDO.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mSSL End If ' Estructura del mail ''''''''''''''''''''''''''''''''''''''''''''''' ' Dirección del Destinatario oCDO.To = mPara ' Dirección del remitente oCDO.From = mDe ' Asunto del mensaje oCDO.Subject = mAsunto ' Cuerpo del mensaje oCDO.TextBody = mMensaje 'Ruta del archivo adjunto If mAdjunto <> "" Then If Len(Dir(mAdjunto)) = 0 Then ' ..error RaiseEvent Error("No se ha encontrado el archivo en la siguiente ruta: ", 0) Exit Function Else ' ..lo agrega oCDO.AddAttachment (mAdjunto) End If End If ' Actualiza los datos antes de enviar oCDO.Configuration.Fields.Update On Error Resume Next Screen.MousePointer = vbHourglass ' Envía el email oCDO.Send Screen.MousePointer = 0 ' .. si no hubo error If Err.Number = 0 Then Enviar_Backup = True RaiseEvent EnvioCompleto ElseIf Err.Number = -2147220973 Then RaiseEvent Error("Posible error : nombre del Servidor " & _ "incorrecto o número de puerto incorrecto", Err.Number) ElseIf Err.Number = -2147220975 Then RaiseEvent Error("Posible error : error en la el nombre de usuario, " & _ "o en el password ", Err.Number) Else RaiseEvent Error(Err.Description, Err.Number) End If ' Descarga la referencia If Not oCDO Is Nothing Then Set oCDO = Nothing End If Err.Clear Screen.MousePointer = vbNormal End Function ' propiedades ''''''''''''''''''''' Property Get servidor() As String servidor = mServidor End Property Property Let servidor(value As String) mServidor = value End Property Property Get para() As String para = mPara End Property Property Let para(value As String) mPara = value End Property Property Get de() As String de = mDe End Property Property Let de(value As String) mDe = value End Property Property Get Asunto() As String Asunto = mAsunto End Property Property Let Asunto(value As String) mAsunto = value End Property Property Get Mensaje() As String Mensaje = mMensaje End Property Property Let Mensaje(value As String) mMensaje = value End Property Property Get Adjunto() As String Adjunto = mAdjunto End Property Property Let Adjunto(value As String) mAdjunto = value End Property Property Get puerto() As Variant puerto = mPuerto End Property Property Let puerto(value As Variant) mPuerto = value End Property Property Get Usuario() As String Usuario = mUsuario End Property Property Let Usuario(value As String) mUsuario = value End Property Property Get PassWord() As String PassWord = mPassword End Property Property Let PassWord(value As String) mPassword = value End Property Property Get UseAuntentificacion() As Boolean UseAuntentificacion = mUseAuntentificacion End Property Property Let UseAuntentificacion(value As Boolean) mUseAuntentificacion = value End Property Property Get ssl() As Boolean ssl = mSSL End Property Property Let ssl(value As Boolean) mSSL = value End Property Nas privates, coloque: Dim WithEvents Omail As clsCDOmail Vamos enviar o email agora, em um Command, coloque: Private Sub enviar_Click() Set Omail = New clsCDOmail '------------------------ 'use as funções With Omail .servidor = "smtp.live.com" ' O servidor SMTP .puerto = "25" ' A porta .UseAuntentificacion = True ' Faz a autenticação .ssl = True ' modo ssl, vai variar de acordo com seu servior de email, aqui no caso, vamos usar TRUE .Usuario = "seuemail@gmail.com" ' Coloca aqui o teu email .PassWord = "senhadousuario" ' Senha do email .Asunto = "Assunto" ' Assunto da mensagem .Adjunto = "" ' aqui eh o anexo, se quiser colocar algum anexo, coloque o local do arquivo, ex: C:\arquivo.exe, caso nao queira anexo, deixe como esta .de = "TheMarKs" ' Nome do remetente .para = "email_do_seu_amigo@hotmail.com" ' Email do destinatario .Mensaje = "Sua mensagem aqui" .Enviar_Backup ' Envia o email End With Set Omail = Nothing 'exclui MsgBox "Email enviado com sucesso!", vbNormal, "Email enviado!" End Sub Bom, eh isso! Muito facil neh?

Estou criando um launcher para abrir um jogo, mas preciso que ele abra somente um, e que se houver a tentativa de abrir dois eles gere uma mensagem "Você não pode abrir dois launchers" e não abra o segundo. Se alguém puder ajudar ficaria grato.

Senhores preciso de ajuda para acionar o botão " CmdLogin " através do acionamento da tecla ENTER .. Private Sub CmdLogin_Click() If TextUsuario.Text = "SILVERIO" And TextSenha.Text = "TBG" Or TextUsuario.Text = "GERALDO" And TextSenha.Text = "TBG" Or TextUsuario.Text = "DIEGO" And TextSenha.Text = "TBG" Or TextUsuario.Text = "FLAVIO" And TextSenha.Text = "TBG" Then Unload Me frmConector.Show 1 Else: MsgBox " *** Login e ou Senha incorreto tente novamente *** ", vbOKOnly, "CVTEST" TextUsuario.Text = "" TextSenha.Text = "" End If End Sub

Olá pessoas... Eu estou com uma duvida nesse codigo <p> <a class="btn" href="/scenes/jobsAccept/2845270"><font color="green">SIM</font></a> <a class="btn" href="/scenes/jobsReject/2845270"><font color="red">NÃO</font></a> </p> preciso fazer o meu button clicar no "sim" pelo webbrowser do vb , porque a class dos 2 são iguais e o link que fica no href é gerado , só se tivesse como fazer o form identificar se está escrito "JobsAccept" e clicar nesse botão mas eu não sei fazer isso , me ajudem por favor...

Alguém poderia me ajudar a inserir essa fórmula no meu projeto ??? Essa é uma fórmula que se encontra no excel TextVacc_C_VB.Text = TextVacc_NC_VB * (TextPop.Text / TextPb) * (TextTb.Text / TextTop.Text) * (TextZb.Text / TextZop.Text) Agradecimentos desde já

Alguém poderia me ajudar a colocar as fórmulas abaixo que estão em Excel no VB6 ??? Zoperacional =1/(1+(517060*10^(1.785*Densidade Relativa)*PTabs/TEabs^3.825)) Zbase =1/(1+(517060*10^(1.785* Densidade Relativa)*1.033/293.15^3.825)) Agradeço desde já

Alguém pode me ajudar ??? quero quebrar a linha de código ... está muito comprida ...: como faço ???? LblTotalMassaMolecular.Caption = LblNitrogen_AXJ.Caption + LblCo2_AXJ.Caption + LblCo2_AXJ.Caption + LblMethane_AXJ.Caption + LblEthane_AXJ.Caption + LblPropane_AXJ.Caption + Lbln_Butane_AXJ.Caption + Lbli_Butane_AXJ.Caption + Lbln_Pentane_AXJ.Caption + Lbli_Pentane_AXJ.Caption + LblHexane_AXJ.Caption + LblHeptane_AXJ.Caption + LblOctane_AXJ.Caption + LblNonane_AXJ.Caption + LblDecane_AXJ.Caption + LblH2S_AXJ.Caption + LblWater_AXJ.Caption + LblHelium_AXJ.Caption + LblOxygen_AXJ.Caption + LblCO_AXJ.Caption + LblHydrogen_AXJ.Caption + LblArgon_AXJ.Caption

Preciso fazer que um botão encontre o usuário da pessoa do Windows e logo depois vá para Documentos deletar o arquivo que preciso, alguma idéia de como posso achar o usuário da pessoa do Windows de quem esta executando o programa? Exemplo de código que estou usando File.Delete("C:\Users\USUÁRIO DA PESSOA\Documents\KONAMI\Pro Evolution Soccer 2013\PesJP\OPTION.bin")

Bom dia, poderiam me ajudar a criar um contador no visual basic numa base de dados em acess para de seguida mostrar numa textbox? Obrigado

Boa noite! Tenho programinha que to fazendo para ler dados da serial no meu caso dados de uma balança. segue abaixo o software inteiro: Private Sub Command1_Click() MSComm1.Output = Chr$(240) + Chr$(1) + Chr$(1) + Chr$(240) End Sub Private Sub Command2_Click() ' Usa COM2. MSComm1.CommPort = 2 ' 9600 baud, no parity, 8 data, and 1 stop bit. MSComm1.Settings = "9600,N,8,1" ' Indica que o controle deve ler todo o conteúdo do buffer ' quando o input é usado. MSComm1.InputLen = 0 ' Indica que os dados que chegarem estarão no formato texto MSComm1.InputMode = comInputModeBinary ' Gera um evento OnComm a cada byte recebido MSComm1.RThreshold = 1 ' Espera o buffer de saída ter apenas 1 byte para enviá-lo MSComm1.SThreshold = 1 ' Abre a porta. MSComm1.PortOpen = True End Sub Private Sub MSComm1_OnComm() Dim strsaida As Variant Dim tamanho, tamanho2 As Integer Select Case MSComm1.CommEvent ' Handle each event or error by placing ' code below each case statement ' Errors Case comEventBreak ' A Break was received. Case comEventCDTO ' CD (RLSD) Timeout. Case comEventCTSTO ' CTS Timeout. Case comEventDSRTO ' DSR Timeout. Case comEventFrame ' Framing Error Case comEventOverrun ' Data Lost. Case comEventRxOver ' Receive buffer overflow. Case comEventRxParity ' Parity Error. Case comEventTxFull ' Transmit buffer full. Case comEventDCB ' Unexpected error retrieving DCB] ' Events Case comEvCD ' Change in the CD line. Case comEvCTS ' Change in the CTS line. Case comEvDSR ' Change in the DSR line. Case comEvRing ' Change in the Ring Indicator. Case comEvReceive ' Received RThreshold # of chars. Text2.Text = MSComm1.InBufferCount Text2.Text = MSComm1.Input Case comEvEOF ' An EOF charater was found in ' the input stream End Select End Sub neste caso preciso que joga o valor chegando da balança no text2.text,alguem poderia me ajudar? obrigado

Srs , estou com uma dúvida ... estou querendo exportar um arquivo txt só que no lugar de OM conforme meu código abaixo eu envie um número que se encontra em uma TEX1.text : Exemplo : Dentro da Text1.text tenho um número = 7770000 , quero enviar o arquivo 777000.txt e não OM.txt conforme meu código abaixo : Public Sub Cmd_Exportar_Click() Dim ret As Boolean 'Envia o controle MSFlexGrid, caminho do arquivo txt e delimitador ret = Exportar_FlexGrid_txt(MSTXT, "C:\Dados SAP-PM\OM.txt", vbTab) If ret Then MsgBox "O arquivo gerado se encontra no diretório C:\Dados SAP-PM\OM.txt , renomeie o arquivo com o número da OM !!!", vbInformation End If End Sub

Boas pessoal, Preciso de uma ajuda aqui na aplicação que estou a desenvolver! É o seguinte: estou a desenvolver uma aplicação que tem como objetivo ser acedida em qualquer lugar que a tenha instalada. Sou novo nestas andanças e queria saber como deveria fazer e a melhor solução para isto. Neste momento estou a usar BD em access, e por norma não vai ter mais do que 2/3 pessoas a trabalhar na aplicação ao mesmo tempo. Obrigado desde ja pela ajuda

Boas, estou a fazer uma aplicação em VBA com 2 forms. No form1 tenho uma flexgrid que carrega registos de uma base de dados e no form 2 tenho uma textbox que introduz registo na mesma base de dados. O que quero fazer é ao clicar no botão de adicionar do form2 a grid do form1 atualize automaticamente. Como faço para atualizar visto que se tratam de forms diferentes? ps: Não posso ter botões no form1 para atualizar, tem que ser mesmo automaticamente após o clique no botão adicionar do form2. Obrigado

então eu estou com dificuldade de traduzir essa classe em java import java.io.*; import java.net.*; public class GravaXML { public static void main(String[] args) { SaveXML("C:/teste.xml"); } public static void SaveXML(String mfile){ try { File fileXML = new File(mfile); String xmlin = MontaBusca(); URL url = new URL("http://websro.correios.com.br/sro_bin/sroii_xml.eventos "); URLConnection connection = url.openConnection(); connection.setDoOutput(true); connection.setUseCaches(false); connection.setRequestProperty("Content-Type","application/x-www-form-urlencoded"); connection.setAllowUserInteraction(false); PrintStream outStream = new PrintStream(connection.getOutputStream()); outStream.println("usuario=ECT&senha=SRO&tipo=L&resultado=U&objetos=" + xmlin); outStream.close(); DataInputStream inStream = new DataInputStream(connection.getInputStream()); String inputLine; FileWriter f = new FileWriter(fileXML); while ((inputLine = inStream.readLine()) != null) { f.write(inputLine); } f.close(); inStream.close(); } catch (MalformedURLException e) { e.printStackTrace(); } catch (IOException e) { e.printStackTrace(); } } private static String MontaBusca(){ String Objetos = "PH082984697BR"; return Objetos; } } o Que fiz até agora pois esta dando erro essas linhas Dim url As URL = New URL("http://websro.correios.com.br/sro_bin/sroii_xml.eventos ") Dim connection As URLConnection = url.openConnection Dim outStream As PrintStream = New PrintStream(connection.getOutputStream) Dim inStream As DataInputStream = New DataInputStream(connection.getInputStream) Dim f As FileWriter = FileWriter(fileXML) Public Sub Localizar(ByRef MeuArquivo As String) Try Dim fileXML As FileStream = File.Create(MeuArquivo) Dim xmlin As String = "" Dim url As URL = New URL("http://websro.correios.com.br/sro_bin/sroii_xml.eventos ") Dim connection As URLConnection = url.openConnection connection.setDoOutput(True) connection.setUseCaches(False) connection.setRequestProperty("Content-Type", "application/x-www-form-urlencoded") connection.setAllowUserInteraction(False) Dim outStream As PrintStream = New PrintStream(connection.getOutputStream) outStream.println(("usuario=ECT&senha=SRO&tipo=L&resultado=U&objetos=" + xmlin)) outStream.close() Dim inStream As DataInputStream = New DataInputStream(connection.getInputStream) Dim inputLine As String Dim f As FileWriter = New FileWriter(fileXML) While (Not (inStream.readLine) Is Nothing) f.write(inputLine) End While f.close() inStream.close() Catch e As Exception MsgBox(e.Message) End Try End Sub

Gostaria de vincular uma exportar dados de uma listview para um Gráfico do mschart , alguem pode me ajudar ?

Eu queria saber se para subtrair produto comprado por um cliente ao stock inicial, se preciso de usar um programa que use a minha bd para efectuar esta acção. Se me pudessem ajudar agradecia.

boa tarde, tudo bem? a minha duvida era a seguinte como é que consigo importar dados de uma base de dados para a windows form? por exemplo o utilizador faz o login e quero que seja importado da database os dados correspondentes ao utilizador, espero que me ajudem cumprimentos

Boa tarde! Qual o melhor editor de código VB 6.0? Cumprimentos!

Eu estou tentando trabalhar com 3 barras de progresso onde um preencher outro. Está associado a treenodes em treeview. Quando o precesso de pesquisa é concluído com cada nó em determinado nível, precisa estar preenchendo a barra de progresso associada ao nó pai. Mas eu não posso fazer para funcionar corretamente. Preciso de ajuda para entender a lógica. Private Sub AtualizaSubcategorias(ByVal execucao As BackgroundWorker) Dim pbar_step_n2 As Double = 0 Dim pbar_total_n2 As Double = 0 Dim pbar_step_n3 As Double = 0 Dim pbar_total_n3 As Double = 0 Dim pbar_step_n4 As Double = 0 Dim pbar_total_n4 As Double = 0 Dim pbar_alvo As String = "" Dim menos3 As String '********************** TREEVIEW TEMPORÁRIA ************************* 'tiver que criar essa tree prq tava dando erro ao tentar adicionar os nodes na tree_menu 'prq foi criado por outra thread e o backgroundworker não consegue alterar controles criados fora dele 'decidi que criar esta tree 'e melhor do que passar as nodes pelo ProgressChanged Dim tree_temp As New TreeView 'clona nodes da tree_menu Dim n As New TreeNode n = tree_menu.Nodes(0).Clone tree_temp.Nodes.Add(n) '******************************************************************** '********************** SUBCATEGORIAS ******************************* '---------------- NÍVEL 2 (FILHOS) pbar_alvo = "n2" 'define o progressbar da vez 'envia comando para definir o valor maximo do progressbar menos3 = pbar_alvo & "|@|" & "100" execucao.ReportProgress(-3, menos3) pbar_total_n2 = 0 pbar_step_n2 = (pbar_n2.Maximum / categoriasPARAatualizar.Count) For Each n2 As TreeNode In tree_temp.Nodes(0).Nodes 'n1.Nodes 'filhas das principais 'se foi clicado em cancelar, para a execuição If (execucao.CancellationPending = True) Then Exit For 'se esta categoria foi selecionada para atualização If categoriasPARAatualizar.Contains(n2.Tag.ToString) Then 'envia comando para exibir o título da categoria no label Dim catTitulo = Split(n2.Text.ToString, "{") execucao.ReportProgress(-1, catTitulo(0).ToUpper) 'obtem subcategorias nível 2 Capturador(n2.Tag.ToString, 2, n2) If pbar_total_n2 >= pbar_n2.Maximum Then 'se rodou todos os filhos, completa o total do n2 execucao.ReportProgress(pbar_n2.Maximum, pbar_alvo) Else 'execucao.ReportProgress(pbar_total_n3, pbar_alvo) End If '---------------- NÍVEL 3 (NETOS) pbar_alvo = "n3" 'define o progressbar da vez 'verifica se exitem netos If n2.Nodes.Count = 0 Then 'envia comando para definir o valor maximo do progressbar menos3 = pbar_alvo & "|@|" & categoriasPARAatualizar.Count execucao.ReportProgress(-3, menos3) 'se não tem netos, completa o total do n3 execucao.ReportProgress(pbar_n3.Maximum, pbar_alvo) 'preenche um step do n2 pbar_total_n2 = pbar_total_n2 + pbar_step_n2 Else 'envia comando para definir o valor maximo do progressbar menos3 = pbar_alvo & "|@|" & n2.Nodes.Count execucao.ReportProgress(-3, menos3) pbar_total_n3 = 0 pbar_step_n3 = (pbar_step_n2 / n2.Nodes.Count) For Each n3 As TreeNode In n2.Nodes 'netas das principais 'se foi clicado em cancelar, para a execução If (execucao.CancellationPending = True) Then Exit For 'obtem subcategorias nível 3 Capturador(n3.Tag.ToString, 2, n3) 'pbar_total_n3 = pbar_total_n3 + pbar_step_n3 If pbar_total_n3 >= pbar_n3.Maximum Then 'se rodou todos os netos, completa o total do n3 execucao.ReportProgress(pbar_n3.Maximum, pbar_alvo) 'preenche um step do n2 pbar_total_n2 = pbar_total_n2 + pbar_step_n2 Else 'execucao.ReportProgress(pbar_total_n3, pbar_alvo) End If '---------------- NÍVEL 4 (BISNETOS) pbar_alvo = "n4" 'define o progressbar da vez 'verifica se exitem bisnetos If n3.Nodes.Count = 0 Then 'envia comando para definir o valor maximo do progressbar menos3 = pbar_alvo & "|@|" & "100" execucao.ReportProgress(-3, menos3) 'se não tem bisnetos, completa o total do n4 execucao.ReportProgress(pbar_n4.Maximum, pbar_alvo) 'preenche um step do n3 pbar_total_n3 = pbar_total_n3 + pbar_step_n3 Else 'envia comando para definir o valor maximo do progressbar menos3 = pbar_alvo & "|@|" & n3.Nodes.Count execucao.ReportProgress(-3, menos3) pbar_total_n4 = 0 pbar_step_n4 = (pbar_step_n3 / n3.Nodes.Count) For Each n4 As TreeNode In n3.Nodes 'bisnetas das principais 'se foi clicado em cancelar, para a execução If (execucao.CancellationPending = True) Then Exit For 'obtem subcategorias nível 4 Capturador(n4.Tag.ToString, 2, n4) pbar_total_n4 = pbar_total_n4 + pbar_step_n4 If pbar_total_n4 >= pbar_n4.Maximum Then 'se rodou todos os bisnetos, completa o total do n4 execucao.ReportProgress(pbar_n4.Maximum, pbar_alvo) 'preenche um step do n3 pbar_total_n3 = pbar_total_n3 + pbar_step_n3 Else execucao.ReportProgress(pbar_total_n4, pbar_alvo) End If Next 'n4 End If 'n4 Next 'n3 End If 'n3 End If 'execucao.ReportProgress(1) Next '********************************************************************** 'envia comando para obter a tree temporaria e clonar-la para a tree_menu execucao.ReportProgress(-2, tree_temp) End Sub Private Sub subcategorias_BckGrndWorker_ProgressChanged(sender As Object, e As ProgressChangedEventArgs) Handles subcategorias_BckGrndWorker.ProgressChanged ' ----- A tarefa em segundo plano atualiza a barra de progresso e/ou a label '******************* INTERPRETANDO INFORMAÇÃO ENVIADA ********************* 'valores negativos indicam algum comando enviado 'valores positivos indica progresso para progressbar '------------ COMANDOS If e.ProgressPercentage < 0 Then Select e.ProgressPercentage Case -1 'alterar label lbl_categoria.Text = e.UserState 'atualiza label Case -2 'obter a tree temporaria, clonar para a tree_menu e apresentar-la tree_menu.Nodes.Clear() tree_menu = e.UserState Panel1.Controls.Add(tree_menu) tree_menu.Dock = DockStyle.Fill tree_menu.ExpandAll() Case -3 'definir o valor maximo do progressbar Dim splt = Split(e.UserState, "|@|") If UCase(splt(0)) = "N2" Then pbar_n2.Maximum = Int(splt(1)) ElseIf UCase(splt(0)) = "N3" Then pbar_n3.Maximum = Int(splt(1)) ElseIf UCase(splt(0)) = "N4" Then pbar_n4.Maximum = Int(splt(1)) End If End Select End If '------------ PROGRESSBAR If e.ProgressPercentage > 0 Then Select Case UCase(e.UserState) Case "N2" 'atualiza barra de progresso pbar_n2.Value = e.ProgressPercentage If pbar_n2.Value = pbar_n2.Maximum Then pbar_n2.Value = 0 Case "N3" 'atualiza barra de progresso pbar_n3.Value = e.ProgressPercentage If pbar_n3.Value = pbar_n3.Maximum Then pbar_n3.Value = 0 Case "N4" 'atualiza barra de progresso pbar_n4.Value = e.ProgressPercentage If pbar_n4.Value = pbar_n4.Maximum Then pbar_n4.Value = 0 End Select End If End Sub