VB Tip: Conceitos de socket, conexão entre dois aplicativos remotamente.

Olá.
Devido à uma dúvida sobre o assunto na comunidade do orkut Visual Basic Brasil, irei postar hoje sobre soquetes e como se dá a conexão entre dois aplicativos (pois não só ocorre conexão entre dois aplicativos de computadores diferentes como também pode ocorrer a conexão entre dois aplicativos de um mesmo computador, como em muitos casos).

É notável que existe pouca informação prática na internet a respeito de como utilizar soquetes de conexão no Visual Basic, e isso com certeza deixa na dúvida aqueles que querem criar desde um simples programa de bate-papo até aos que querem criar seus próprios sistemas de VNC. Este artigo irá ajudar os dois casos (claro, neste artigo irei tratar apenas do envio e recepção de informações entre soquetes; um sistema de VNC muito provavelmente eu farei, em outro artigo).

Índice:

1. Conceito
2. Protocolos: TCP e UDP. Qual usar?
3. Conexão entre dois computadores ou dois aplicativos
4. Colocando em prática: projeto

Conceito

Primeiramente, vamos saber como importar o controle de soquetes para um projeto do Visual Basic. Com o projeto aberto (não pode ser DLL, somente Standard Exe ou ActiveX EXE), pressione Ctrl+T, ou clique com o botão direito na barra de ferramentas do VB6 (aonde estão a textbox, listbox, entre outros) e selecione Components...
Abrirá a seguinte janela:



Feito isso, procure por Microsoft Winsock Control:


Caso não estiver com aquele V do lado esquerdo ao Winsock (em outras palavras, caso o Winsock não estiver marcado), marque-o. Feito isso, clique em Aplicar e Ok.

Repare na barra de ferramentas do VB que surgiu um novo controle, de dois monitores, um verde e outro azul, cada um em cima de uma gabinete, e conectados com um fio vermelho:

Com isso, coloque uma instância do novo controle no form (clicando duas vezes no controle). Nomeie-o para "ws".

Assim, o controle fora totalmente importado para o projeto e estará disponível para uso. Abaixo veremos conceitos de protocolos.

Protocolos: TCP e UDP. Qual usar?

Com a importação do novo controle, reparamos a propriedade protocol e seus dois valores: TCP e UDP. Nesta seção aprenderemos brevemente sobre cada um e qual é o mais apropriado para o projeto. Para quem não gosta de textos longos e descritivos ou quem gosta de textos práticos, pule para o quarto parágrafo seguinte a esse.

TCP e UDP são os protocolos mais usados na internet para conexão com outro computador. O TCP (Transmission Control Protocol) é um protocolo sob o qual se assenta o núcleo da internet (Wikipédia: http://pt.wikipedia.org/wiki/Transmission_Control_Protocol). Nele se há a certeza da integridade dos dados, ou seja, sabe-se que os dados chegarão inteiros ao outro lado, às vezes cortados, mas sempre inteiros. Serve para transmissões HTTP (HyperText Transfer Protocol), FTP (File Transfer Protocol) e vários outros protocolos de comunicação. Uma desvantagem do TCP é a latência, uma vez que primeiro há de se ter uma confirmação da integridade dos dados antes de prosseguir, o que torna o fluxo de dados lento.

Já o UDP (User Datagram Protocol) é um protocolo largamente utilizado em compartilhadores P2P famosos como o Ares, eMule e outros do gênero (também usam TCP). Com ele não se há a certeza de que os dados irão chegar do outro lado. É usado para casos em que se admite uma perda de dados. A vantagem do UDP é a simplicidade do cabeçalho de comunicação (Porta de origem, porta de destino, mensagem e checksum) e a rapidez com qual os dados são transmitidos (pois não necessita de Acknowledge, ou seja, não precisa de confirmação da chegada e integridade dos dados), entretanto, a desvantagem é que a transmissão de arquivos sem um protocolo de comunicação específico torna-se perigoso, uma vez que um programa, por exemplo, irá chegar corrompido, devido a não-integridade dos dados.

A maioria das (se não, todas as) placas de rede têm em seu firmware por padrão o protocolo TCP, o que torna possível o processamento dele em modo de hardware, assim sendo mais rápido que o processamento em software. Além do mais, é o protocolo mais confiável para a camada de internet, com qual temos de ter a certeza da integridade dos dados enviados ou recebidos.

No nosso caso do Visual Basic, recomendo usar o protocolo TCP, que já vem por padrão selecionado no Winsock. Alguns comandos entre TCP e UDP do Winsock são diferentes. Exemplo: o comando Listen do TCP equivale ao Bind do UDP. Enfim, deixe o protocolo TCP selecionado no winsock.

Na próxima seção veremos sobre o conceito de conexão entre dois computadores ou dois aplicativos de um mesmo computador. Você pode pular para o parágrafo com parte prática, em negrito.

Conexão entre dois computadores ou dois aplicativos

Para uma conexão ocorrer, é necessário abrir portas. Um soquete conectado não consegue receber outro cliente, pois já está conectado a um cliente. Podem existir várias portas locais com um mesmo endereço (exemplo, várias portas com o número 500) desde que as existentes estejam já conectadas (com exceção para o Svchost.exe do Windows, que estranhamente tem duas portas locais com mesmo valor mas ambas estão ouvindo). O porquê disso é: imagine duas instâncias diferentes do Winsock ouvindo na mesma porta. Se um cliente se conecta à essa porta, haveria um conflito: qual deles irá atender aquele cliente, uma vez que os dois estão programados para aceitar um cliente quando este se conectar e uma vez que ambos estão atuando na mesma porta? O mais rápido?

Agora imagine uma situação diferente: uma instância de soquete está atuando em uma porta. Quando um cliente se conectar àquela porta, além dele aceitar a conexão com o cliente, ele irá criar outra instância, que atuará na mesma porta ouvindo. Pois bem, um cliente se conecta àquela porta, e o soquete irá criar outra porta, com o mesmo número, e ouvirá ali. Assim, se outro cliente fizer o mesmo processo do primeiro cliente, conseguirá se conectar, mas em outra instância do soquete do aplicativo. Esse é basicamente o sistema que um servidor web (Apache, IIS) usa: um site como o Google é amplamente usado e deve receber em média 100 conexões por segundo. Como citado na segunda frase do primeiro parágrafo, um soquete conectado não consegue receber outro cliente, assim, o aplicativo de servidor HTTP do Google (que provavelmente não é terceirizado, ou seja, provavelmente foi desenvolvido pela própria equipe do Google, mas para uso apenas da empresa), a cada conexão nova, cria uma nova instância do soquete web, atuando na mesma porta (80). Quando um cliente desconecta, aquele soquete é destruído, entretanto, sempre há de permanecer um para ouvir e atender aquela porta. Mesmo que por um segundo ninguém (e nada) esteja acessando o Google, ainda sim haverá de ter um soquete atuando na porta 80 do servidor do Google, prestes a atender uma nova conexão.


Na próxima seção, veremos sobre os dados transmitidos pelo Winsock.

Tipos de dados no Winsock

Os dados, sejam eles no computador ou na rede, são matrizes de bytes estruturadas. No Winsock, podemos enviar qualquer tipo de dado, e o outro pode receber em qualquer tipo. Serei mais específico: O soquete pode enviar dados em forma de matriz de bytes, em forma de texto (string), em forma de uma variável de integer, variável de byte, variável de string, variável de string fixa (Dim Mystring As String * 5). Na recepção dos dados, pode-se receber em forma de matriz de bytes, em forma de texto (string), enfim, da mesma forma. Recomendo enviar e receber sempre em forma de matriz de bytes.

Na próxima seção, criaremos um exemplo prático utilizando winsock. Enviarei e receberei dados em forma de string, por ser uma forma de transmissão de texto puro.

Colocando em prática: projeto

Direto ao ponto, criaremos um simples programa de bate-papo de apenas um cliente só, utilizando esses conceitos.

Você pode baixar o projeto pronto (zipado) em: http://dl.dropbox.com/u/47975575/Tuto_Sockets.zip.

1) Abra o Visual Basic 6.
2) Inicie um projeto do tipo Standard Exe.
3) Importe o controle Winsock.
4) Crie uma instância dele no form (também ensinado na seção "conceitos").
5) Nomeie o controle winsock para "ws".
6) Crie no form: Cinco textboxes, Cinco labéis, Dois options, Um botão, Um timer. De modo que fiquem posicionados e identificados deste modo:


No código:
'Variáveis: Dim OtherTyping As Boolean 'indica se o outro está digitando Dim MeTyping As Boolean 'indica se eu estou digitando Dim OtherApelido As String 'Apelido do outro Function STS(ByVal nState As Integer) As String 'Resumo: Dependendo o código do nState, retorna um estado em texto. '0: fechado '1: Aberto (UDP) '2: Ouvindo '3: Conexão pendente '4: Resolvendo host '5: Host resolvido '6: Conectando '7: conectado '8: Fechando (cliente desconectou) '9: Erro. Select Case nState Case 0 STS = "Fechado" Case 8 STS = "Fechando..." Case 7 STS = "Conectado" Case 6 STS = "Conectando..." Case 3 STS = "Conexão Pendente" Case 9 STS = "Erro" Case 5 STS = "Host resolvido" Case 2 STS = "Ouvindo" Case 1 STS = "Aberto" Case 4 STS = "Resolvendo host" End Select End Function Private Sub bConnect_Click() 'função disparada no clique do botão desconectar. 'Resumo do procedimento: Se o soquete não estiver conectado, ele ordena a desconexão. 'Caso estiver fechado, ele verificará qual modo foi selecionado. 'Se o modo cliente foi selecionado, define o host remoto e a porta remota para se conectar. 'Se o usuário inseriu valores errados, disparará um erro, que será tratado 'na label erro, mostrando uma mensagem de erro. 'Se o modo servidor foi selecionado, define a porta local e ordena que o soquete ouça aquela porta. On Error GoTo erro If ws.State <> sckClosed Then ws.Close Else If Option1.Value Then 'cliente ws.RemoteHost = tHost.Text ws.RemotePort = tPorta.Text ws.Connect Else 'servidor ws.LocalPort = tPorta.Text ws.Listen End If End If Exit Sub erro: MsgBox "Host ou ip inválido!", vbCritical, "Erro!" End Sub Private Sub clientmessage_Change() 'Resumo: quando o usuário digitar, verifica se o soquete está conectado para enviar um comando que 'indicará ao outro aplicativo que o usuário está digitando. If ws.State = sckConnected And clientmessage.Text <> "" Then ws.SendData "%%%%TYP&&" End If End Sub Private Sub clientmessage_KeyDown(KeyCode As Integer, Shift As Integer) 'Resumo: se o usuário pressionar enter, a mensagem será enviada (se o soquete estiver conectado) e 'o texto apagado. If KeyCode = 13 Then '13 é o código da tecla enter If ws.State = sckConnected Then ws.SendData clientmessage.Text clientmessage.Text = "" End If End Sub Private Sub tApelido_KeyDown(KeyCode As Integer, Shift As Integer) 'Resumo: se o usuário "mudar de nick", envia esse novo apelido ao outro. If KeyCode = 13 And ws.State = sckConnected Then ws.SendData "%%%%COM&& " & tApelido.Text End If End Sub Private Sub Timer1_Timer() 'Resumo: habilita o controle thost apenas se for cliente e o soquete estiver fechado. 'Habilita o controle tporta apenas se o soquete estiver fechado. 'Habilita os modos se o soquete estiver fechado 'Se o estado do soquete for "fechando", ou "erro", fecha a conexão. 'Se o estado for fechado, então: 'Exibe o status "Desconectado" 'Se for Conectado, então: 'Se o outro estiver digitando, exibe tal informação (Fulano está digitando) 'Senão, exibe "conectado a (ip do cliente ou apelido se tiver)" 'Caso não estiver conectado e nem desconectado (resolvendo host, conectando, etc): 'Exibe o status correspondente. tHost.Enabled = Option1.Value And (ws.State = sckClosed) tPorta.Enabled = (ws.State = sckClosed) Option1.Enabled = tPorta.Enabled Option2.Enabled = tPorta.Enabled If ws.State = sckClosing Or ws.State = sckError Then ws.Close End If If ws.State = sckClosed Then OtherApelido = "" lStatus.Caption = "Desconectado" ElseIf ws.State = sckConnected Then If OtherTyping Then lStatus.Caption = IIf(OtherApelido <> "", OtherApelido, ws.RemoteHost) & " está digitando" Else lStatus.Caption = "Conectado a " & IIf(OtherApelido <> "", OtherApelido, ws.RemoteHost) End If Else lStatus.Caption = STS(ws.State) End If End Sub Private Sub ws_ConnectionRequest(ByVal requestID As Long) 'Resumo: ao receber a nova conexão, fecha o soquete, aceita a conexão e envia um comando que indicará o apelido. ws.Close ws.Accept requestID ws.SendData "%%%%REQ&&" End Sub Private Sub ws_DataArrival(ByVal bytesTotal As Long) 'Resumo: recebe os dados recebidos, e de acordo com o que recebeu executa uma ação. OtherTyping = False Dim comandos() As String Dim receiveddata As String ws.GetData receiveddata If InStr(1, receiveddata, "%%%%") > 0 Then comandos = Split(receiveddata, "%%%%") For i = 1 To UBound(comandos) If comandos(i) = "REQ&&" Then 'requer apelido ws.SendData "%%%%COM&& " & tApelido.Text If OtherApelido = "" Then ws.SendData "%%%%REQ&&" End If ElseIf InStr(1, comandos(i), "COM&&") > 0 Then 'enviou um apelido OtherApelido = Split(comandos(i), " ")(1) ElseIf comandos(i) = "TYP&&" Then 'DIGITANDO OtherTyping = True Else chathistory.Text = chathistory.Text & OtherApelido & " (" & CStr(Time) & "): " & comandos(i) & vbCrLf chathistory.SelStart = Len(chathistory.Text) chathistory.SelLength = 0 End If Next i Else chathistory.Text = chathistory.Text & OtherApelido & " (" & CStr(Time) & "): " & receiveddata & vbCrLf chathistory.SelStart = Len(chathistory.Text) chathistory.SelLength = 0 End If End Sub

Para executar o processo será necessário compilá-lo e rodá-lo em duas instâncias. Entretanto, se tiver dois ou mais computadores, rode o mesmo projeto nos dois computadores.
No campo de Host, caso o servidor esteja em outra instância em seu computador, digite 127.0.0.1 (endereço de ip local). Caso o servidor esteja em outro computador de rede local, digite o ip do mesmo (você encontra na lista de DHCP do roteador).

É isso, pessoal.
Dúvidas, sugestões de artigos, só enviar por email (twitter_diegorw@hotmail.com), twitter (@diegojsRW) ou pelos comentários daqui do blog.
Até o próximo artigo.

VB Tip: Imagens transparentes

Olá.
Neste artigo ensinarei como inserir imagens transparentes em uma picturebox e principalmente, como carregar e usar imagens sem que elas sejam de resources ou de arquivos.
Para tanto, criei o primeiro tutorial em vídeo para o Blog Diego Silva.

O projeto zipado encontra-se em https://skydrive.live.com/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA!154 (pasta do SkyDrive).
É isso pessoal. Até o próximo artigo.

VB Tip: obter uso de memória RAM e de CPU

Olá.
Essa semana, pelos comentários, perguntaram como acessar o uso de memória RAM e de CPU no Visual Basic 6, uma vez que o MultiSystem Sidebar consegue tal feito. Ensinarei aqui o código necessário para acessar tais informações.


Primeiramente se deve saber de uma coisa: o funcionamento ou não do código dependerá do sistema operacional utilizado. Pelo menos aqui no Seven funciona, no Vista também funciona (já testei) e no XP, idem (foi lá onde desenvolvi o aplicativo). Sendo assim, o código deverá não funcionar em sistemas operacionais antigos como WinME ou Win98. Mas quem ainda usa esses sistemas operacionais hoje em dia?? Enfim.
Irei dividir em duas partes: a primeira tratará do uso de RAM e o outro tratará do uso de CPU.

Uso de RAM

Iremos precisar da API GlobalMemoryStatus da biblioteca kernel32 (onde a maioria das APIs são para acesso à seção de hardware. Beep é um exemplo.) cujo único parâmetro é uma referência do tipo MEMORYSTATUS.
Antes de começarmos, crie um novo projeto Standard EXE (pode ser também uma DLL).
Adicione ao projeto um módulo e uma classe. Chamaremos o módulo de mApi (mas pode-se colocar qualquer nome no módulo;a classe trataremos depois, portanto, não mexa nela).

Feito isso, adicione o seguinte código ao módulo:
Public Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Feita a declaração da API e do tipo necessários para a obtenção das informações desejadas, iremos criar uma função que retornará o valor de utilização da memória RAM.

Adicione a seguinte função abaixo das declarações do módulo:
Public Function UsoDeRAM() As String 'Aqui pode ser qualquer nome que desejar. Dim Mem As MEMORYSTATUS Mem.dwLength = Len(Mem) GlobalMemoryStatus Mem UsoDeRAM=CStr(Mem.dwMemoryLoad) 'Se alterar o nome da função, altere aqui também! End Function

Feito isso, você pode usar a função UsoDeRAM a qualquer momento, seja na atribuição à propriedade Caption de uma label ou à uma função Print de algum container.

Uso de CPU

A obtenção do uso de CPU requer uma classe. Utilizaremos a classe que criamos anteriormente. Nomeie-a de cCpu.

Nela, insira o seguinte código:

Option Explicit Private Const SYSTEM_BASICINFORMATION = 0& Private Const SYSTEM_PERFORMANCEINFORMATION = 2& Private Const SYSTEM_TIMEINFORMATION = 3& Private Const NO_ERROR = 0 Private Type LARGE_INTEGER dwLow As Long dwHigh As Long End Type Private Type SYSTEM_BASIC_INFORMATION dwUnknown1 As Long uKeMaximumIncrement As Long uPageSize As Long uMmNumberOfPhysicalPages As Long uMmLowestPhysicalPage As Long uMmHighestPhysicalPage As Long uAllocationGranularity As Long pLowestUserAddress As Long pMmHighestUserAddress As Long uKeActiveProcessors As Long bKeNumberProcessors As Byte bUnknown2 As Byte wUnknown3 As Integer End Type Private Type SYSTEM_PERFORMANCE_INFORMATION liIdleTime As LARGE_INTEGER dwSpare(0 To 75) As Long End Type Private Type SYSTEM_TIME_INFORMATION liKeBootTime As LARGE_INTEGER liKeSystemTime As LARGE_INTEGER liExpTimeZoneBias As LARGE_INTEGER uCurrentTimeZoneId As Long dwReserved As Long End Type Private Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal dwInfoType As Long, ByVal lpStructure As Long, ByVal dwSize As Long, ByVal dwReserved As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long) Private liOldIdleTime As LARGE_INTEGER Private liOldSystemTime As LARGE_INTEGER Public Sub Initialize() Dim SysTimeInfo As SYSTEM_TIME_INFORMATION Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION Dim Ret As Long Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&) If Ret <> NO_ERROR Then Debug.Print "Error while initializing the system's time!", vbCritical Exit Sub End If Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&) If Ret <> NO_ERROR Then Debug.Print "Error while initializing the CPU's idle time!", vbCritical Exit Sub End If liOldIdleTime = SysPerfInfo.liIdleTime liOldSystemTime = SysTimeInfo.liKeSystemTime End Sub Public Function Query() As Long Dim SysBaseInfo As SYSTEM_BASIC_INFORMATION Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION Dim SysTimeInfo As SYSTEM_TIME_INFORMATION Dim dbIdleTime As Currency Dim dbSystemTime As Currency Dim Ret As Long Query = -1 Ret = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(SysBaseInfo), LenB(SysBaseInfo), 0&) If Ret <> NO_ERROR Then Debug.Print "Error while retrieving the number of processors!", vbCritical Exit Function End If Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&) If Ret <> NO_ERROR Then Debug.Print "Error while retrieving the system's time!", vbCritical Exit Function End If Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&) If Ret <> NO_ERROR Then Debug.Print "Error while retrieving the CPU's idle time!", vbCritical Exit Function End If dbIdleTime = LI2Currency(SysPerfInfo.liIdleTime) - LI2Currency(liOldIdleTime) dbSystemTime = LI2Currency(SysTimeInfo.liKeSystemTime) - LI2Currency(liOldSystemTime) If dbSystemTime <> 0 Then dbIdleTime = dbIdleTime / dbSystemTime dbIdleTime = 100 - dbIdleTime * 100 / SysBaseInfo.bKeNumberProcessors + 0.5 Query = Int(dbIdleTime) liOldIdleTime = SysPerfInfo.liIdleTime liOldSystemTime = SysTimeInfo.liKeSystemTime End Function Private Function LI2Currency(liInput As LARGE_INTEGER) As Currency CopyMemory LI2Currency, liInput, LenB(liInput) End Function Public Sub Terminate() 'Nada a fazer. End Sub

Sim, o código é realmente extenso. Portanto, explicarei somente o necessário. No módulo que criamos, insira, abaixo da declaração "GlobalMemoryStatus", o seguinte código:

Dim cpusage as cCpu Sub InitCPU() Set cpusage = new cCpu 'Cria uma nova instância de cCpu End Sub Sub EndCPU() Set cpusage = Nothing ' Remove a instância de cCpu da memória End Sub Function GetCPU() As String GetCPU = CStr(Abs(cpusage.Query)) 'retorna o valor de uso da cpu End Function

A função Query retorna o valor de uso da cpu através da classe e de suas APIs internas.

Se quiser, pode baixar o exemplo pronto através do link https://skydrive.live.com/?cid=B278D5E7A71B5DCA&sc=documents#!/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA!152!cid=B278D5E7A71B5DCA&id=B278D5E7A71B5DCA!152 (pasta do SkyDrive).

É isso pessoal.
Até o próximo artigo!

VB Tip: Criando menu de modo fácil - MenuCreator

Olá.
Neste artigo irei disponibilizar uma nova classe/livraria que criei, chamada MenuCreator, cuja classe chama-se cMenu. O objetivo principal dele é criar e manipular menus de modo bem simples. O link dele é https://skydrive.live.com/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA%21146# (pasta do SkyDrive). Nele há cinco métodos, entre eles:

• Add (menuh as Long, Pos as Long, Text as String, [Flags as long, lpimage as stdpicture]): Adiciona um item à um menu existente.
  Menuh recebe o endereço handle do menu.
  Pos recebe um número que posteriormente será identificado por sua função, número este maior que 0.
  Text recebe o texto do item. Flags (opcional) recebe as opções do item, listadas abaixo (que podem ser combinadas com o operador binário OR):
  * MF_DISABLED = &H2& - Desabilita o item (mas não o torna cinza, veremos isso depois);
  * MF_GRAYED = &H1& - Torna o item cinza (mas não o torna desabilitado; para desabilitá-lo e torná-lo cinza, use (MF_DISABLED OR MF_GRAYED).);
  * MF_SEPARATOR = &H800& (NÃO COMBINÁVEL!) - Torna o item em uma barra horizontal de separação de itens.
  * MF_POPUP = &H10& - Inicia um novo menu ao lado.
  


• Count (menuh as Long) as Long: Retorna a quantidade de itens em um determinado menu. Menuh recebe o endereço handle do menu.


• Create () As Long: Cria um novo menu, e retorna seu handle para ser manipulado pelas outras quatro funções.


• Destroy (menuHandle as Long): remove um menu da memória, menu este determinado pelo endereço handle em menuHandle.


• Show (menuh as Long, owner as Long, x as Double, y as Double) as Long: Exibe um menu. Menuh recebe o endereço handle do menu, owner recebe o endereço handle do formulário pai (Me.hWnd), x e y recebem a posição absoluta (em pixels) do menu, na tela.

Para o valor de x e y no método show, usamos uma das duas APIs seguintes:
* ClientToScreen - Transforma uma coordenada local do formulário em uma coordenada absoluta da tela.
* GetCursorPos - Obtém a posição atual do cursor do mouse.

Ambos usam a estrutura POINTAPI, cujos elementos são X, como LONG, e Y, também LONG.

Abaixo vai um exemplo. Crie um form em um projeto do tipo Standard Exe, adicione um botão no topo esquerdo do form e adicione o seguinte código no formulário:
Private Type POINTAPI x As Long y As Long End Type Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Sub Command1_Click() Me.ScaleMode = vbPixels Dim pt As POINTAPI Dim r As Long Dim h As Long Dim m As New cMenu h = m.Create For i = 1 To 20 m.Add h, i, "Meu item " & CStr(i) Next i pt.x = Command1.Left pt.y = Command1.Top ClientToScreen Me.hwnd, pt r = m.Show(h, Me.hwnd, pt.x, pt.y) m.Destroy h Set m = Nothing Select Case r Case 1 To 20 MsgBox "Você selecionou o item " & CStr(r) Case Else MsgBox "Você não selecionou nenhum item" End Select End Sub
"h=m.create" cria um novo menu e atribui o endereço do novo menu ao h. m.add adiciona os itens de 1 a 20 no menu criado. pt.x, pt.y, e clienttoscreen transformam a posição do botão em coordenadas absolutas da tela.

"r=m.show" exibe o menu na tela e retorna o item selecionado, e, caso nenhum item for selecionado, retorna zero. Daí a necessidade dos itens adicionados terem identificação (Pos as long) maior que 0.
"m.destroy" e "set m=nothing" são necessários para liberar memória, tanto do menu (destroy h) quanto da classe cMenu (set m=nothing).

Para manipulações mais complexas como por exemplo, adição de linhas verticais no menu para dispô-los em colunas, deve-se usar APIs externas à classe, como SetMenuItemInfo e similares.

Com essa classe, você pode criar um menu customizado para um formulário borderless (BorderStyle=0), abaixo do que seria o título.
Enfim, você poderá usar essa classe para facilitar a programação com menus.
Em breve, nova versão do Multisystem com formulários renovados e com menus, com auxílio dessa nova classe por mim criada.
É isso, pessoal.
Até o próximo artigo!

VB Tip: utilidade para Subclassing.

Olá.

Como prometido em alguns posts anteriores, achei uma utilidade para o subclassing nos formulários. Trata-se de conhecer comandos que levem a uma determinada ação.

Por exemplo: numa janela sem borda (BorderStyle=0) não há menu de contexto do sistema (aquele com opções da janela: ). E para fazer que o contexto do título funcione no nosso formulário customizado, devemos criar um menu para substituir o menu padrão do título. Para isso temos de saber o momento em que o usuário clica com o botão direito na janelinha do aplicativo na barra de tarefas. Daí vem o subclassing.

Escutando comandos para detectar chamada ao menu de contexto da janela

O projeto pronto (zipado) se encontra em https://skydrive.live.com/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA%21144 (pasta pessoal do Windows Live SkyDrive). Caso cair em alguma outra pasta, procure pela pasta Subclassing e pelo arquivo SubClassMenu.zip.
Dentro do arquivo zipado há o programa compilado, mas também há o código usado no subclassing criado, cujo código postarei abaixo por partes.

Iniciando o projeto

1º: Inicie um novo projeto Standard Exe.
2º: Vá em project > Add Module e adicione um módulo comum.
3º: No módulo, cole o seguinte código:
Public oldproc As Long Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Const WM_SYSCOMMAND = &H112 Public Const WM_CONTEXTMENU = &H7B Public Const SC_MOVE = &HF010& Public Const SC_SIZE = &HF000& Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Type POINTAPI X As Long Y As Long End Type Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Const GWL_WNDPROC = (-4) Public Const WM_POPUPSYSTEMMENU = &H313 Public Function WProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If Msg = WM_POPUPSYSTEMMENU Or Msg = WM_CONTEXTMENU Then Dim mc As New cMenu Dim h As Long h = mc.Create mc.Add h, 800, "--Menu--", 3 mc.Add h, 801, "", &H800 mc.Add h, 1, "Restaurar", IIf(Form1.WindowState <> 0, 0, 3) mc.Add h, 2, "Mover", IIf(Form1.WindowState <> 0, 3, 0) mc.Add h, 3, "Tamanho", IIf(Form1.WindowState <> 0, 3, 0) mc.Add h, 4, "Minimizar", IIf(Form1.WindowState <> vbMinimized, 0, 3) mc.Add h, 5, "Maximizar", IIf(Form1.WindowState <> vbMaximized, 0, 3) mc.Add h, 6, "", &H800& mc.Add h, 7, "Fechar" Dim pt As POINTAPI GetCursorPos pt Dim retval As Long retval = mc.Show(h, Form1.hwnd, pt.X, pt.Y) mc.Destroy h Set mc = Nothing Select Case retval Case 1 Form1.WindowState = vbNormal Case 2 SendMessage Form1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0 Case 3 SendMessage Form1.hwnd, WM_SYSCOMMAND, SC_SIZE, 0 Case 4 Form1.WindowState = vbMinimized Case 5 Form1.WindowState = vbMaximized Case 7 Unload Form1 End Select WProc = 1 Else WProc = CallWindowProc(oldproc, hwnd, Msg, wParam, lParam) End If End Function
4º: Adicione uma classe, de nome cMenu.
5º: Na nova classe, cole o seguinte código:
Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type MENUITEMINFO cbSize As Long fMask As Long fType As Long fState As Long wID As Long hSubMenu As Long hbmpChecked As Long hbmpUnchecked As Long dwItemData As Long dwTypeData As String cch As Long End Type Private Declare Function SetMenuItemBitmaps Lib "user32" _ (ByVal hMenu As Long, ByVal nPosition _ As Long, ByVal wFlags As Long, ByVal _ hBitmapUnchecked As Long, ByVal _ hBitmapChecked As Long) As Long Private Declare Function GetMenu Lib "user32" _ (ByVal hwnd As Long) As Long Private Declare Function GetMenuItemCount Lib "user32" _ (ByVal hMenu As Long) As Long Private Declare Function GetSubMenu Lib "user32" _ (ByVal hMenu As Long, ByVal nPos As Long) As Long Private Declare Function GetMenuItemInfo Lib "user32" _ Alias "GetMenuItemInfoA" _ (ByVal hMenu As Long, ByVal un As Long, _ ByVal b As Boolean, lpmii As MENUITEMINFO) As Long Private Declare Function SetMenuItemInfo Lib "user32" _ Alias "SetMenuItemInfoA" _ (ByVal hMenu As Long, ByVal uItem As Long, _ ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long Private Declare Function CreatePopupMenu Lib "user32" () As Long Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private hMenu As Long Private Const MIIM_STATE As Long = &H1 Private Const MIIM_ID As Long = &H2 Private Const MIIM_SUBMENU As Long = &H4 Private Const MIIM_CHECKMARKS As Long = &H8 Private Const MIIM_TYPE As Long = &H10 Private Const MIIM_DATA As Long = &H20 Private Const MFT_RADIOCHECK As Long = &H200 Private Const MFT_STRING As Long = &H0 Private Const RGB_STARTNEWCOLUMNWITHVERTBAR As Long = &H20 Private Const RGB_STARTNEWCOLUMN As Long = &H40 Private Const RGB_EMPTY As Long = &H100 Private Const RGB_VERTICALBARBREAK As Long = &H160 Private Const RGB_SEPARATOR As Long = &H800 Private Const MF_CHECKED = &H8& Private Const MF_APPEND = &H100& Private Const TPM_LEFTALIGN = &H0& Private Const MF_DISABLED = &H2& Private Const MF_GRAYED = &H1& Private Const MF_SEPARATOR = &H800& Private Const MF_STRING = &H0& Public Function Create() As Long On Error GoTo fim Create = CreatePopupMenu Exit Function fim: Create = CLng(False) End Function Public Function Count(ByVal menuh As Long) As Long GetMenuItemCount menuh End Function Public Function Show(ByVal menuh As Long, ByVal owner As Long, ByVal X As Double, ByVal Y As Double) As Long Dim rc As RECT Show = TrackPopupMenu(menuh, 256, X, Y, 0, owner, rc) End Function Public Sub Add(ByVal menuh As Long, ByVal pos As Long, ByVal Text As String, Optional ByVal Flags As Long = 0, Optional lpImage As StdPicture) On Error Resume Next AppendMenu menuh, Flags, pos, Text If lpImage Then SetMenuItemBitmaps menuh, pos, 0, lpImage, lpImage End Sub Public Sub Destroy(ByVal menuHandle As Long) On Error Resume Next DestroyMenu menuHandle End Sub

A classe acima eu irei explicar no próximo artigo, ainda hoje, mas a função dele é criar menus e manipulá-los.
6º: Volte ao form1 criado por padrão pelo VB, e adicione o seguinte código no load do form:
Private Sub Form_Load() oldproc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WProc) End Sub
7º: Execute o programa. Ao clicar com o botão direito do mouse no título da janela você verá que o mesmo irá exibir o nosso menu customizado e não mais o menu padrão da janela. Isso é útil para janelas com BorderStyle 0 (borderless form).

Considerações finais

O Subclassing tem ilimitadas funcionalidades, seja para criar um título customizado sem usar picturebox, seja para, como vimos acima, criar um menu próprio de janela, ou também para obter quando o formulário foi abandonado ou foi focalizado pelo usuário (pois o lostfocus e gotfocus nativos dos formulários do VB não funcionam..).
É isso aí, pessoal. No próximo artigo, irei explicar a classe acima, de menus, e disponibilizá-la, seja em cls ou em dll.
Até o próximo artigo.

VB Tip: Math Parser Básico

Olá.
Essa semana estou criando um editor de imagem profissional, que contará com um sistema de console de comando, tipo como no AutoCad, como no Blender ou como, simplesmente, o Prompt de Comando (para quem não conhece, aqui está alguns exemplos: Console do Blender e Prompt de comando). Também pode se assemelhar ao sistema do Immediate Pane do VB6.
Enfim, e em todos esses sistemas de console, há funções de evaluate, que nada mais é que um sistema que resolve fórmulas em strings para números reais. Andei pesquisando na internet e encontrei alguns exemplos que usam o Eval() do Microsoft Scripting Runtime; Entretanto, para implementar esse sistema em seu aplicativo é necessário redistribuir esse pacote (msscrrun.dll, se não me engano) e isso pode causar problemas de copyright, pois é um complemento da Microsoft.

Pesquisando mais a fundo e com keywords mais apropriadas, encontrei o termo "Math Parser" (em tradução livre, "Interpretador de Matemática") e alguns exemplos prontos. Aí resolvi criar um Math Parser próprio, com um sistema um pouco diferente dos que vi na internet.

O código

Abaixo, o código que criei, para quem passar pela mesma situação.
Function Eval(ByVal strFormula As String) As Double On Error GoTo fim Dim formula As String Dim resultado As String Dim nmbr As String Dim ops() As String: Dim opC As Long: Dim opB As Boolean Dim nmbs() As String: Dim nmbC As Long formula = strFormula For i = 1 To Len(formula) c = Mid(formula, i, 1) Select Case c Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "," nmbr = nmbr & c Case "+", "-", "*", "/", "^", "%" ReDim Preserve nmbs(nmbC) nmbs(nmbC) = nmbr nmbC = nmbC + 1 ReDim Preserve ops(opC) ops(opC) = c opC = opC + 1 nmbr = "" Case Else 'erro na fórmula GoTo fim End Select Next i If nmbr <> "" Then ReDim Preserve nmbs(nmbC) nmbs(nmbC) = nmbr nmbC = nmbC + 1 nmbr = "" Else GoTo fim End If For j = 0 To opC - 1 atu = ops(j) op1 = nmbs(j) op2 = nmbs(j + 1) Select Case atu Case "+" nmbs(j + 1) = CStr(CDbl(op1) + CDbl(op2)) Case "-" nmbs(j + 1) = CStr(CDbl(op1) - CDbl(op2)) Case "*" nmbs(j + 1) = CStr(CDbl(op1) * CDbl(op2)) Case "/" nmbs(j + 1) = CStr(CDbl(op1) / CDbl(op2)) End Select Next j resultado = nmbs(j) Eval = resultado Exit Function fim: Eval = 0 End Function
Se alguém quiser implementar mais o código, colocar suporte a fórmulas e parênteses, seria ótimo para divulgar o conhecimento.

E como prometido, irei divulgar posteriormente um código pronto de subclassing. Não houve possibilidade de criar um subclassing essa semana porque, como citado no início deste artigo, estou trabalhando em um editor de imagem profissional com um sistema de console. Mas a qualquer momento divulgarei.
Nota: Esse editor de imagem fará parte do projeto MultiSystem; Houve um problema de compatibilidade na minha migração de XP para Seven quanto ao DirectX, e terei que retirar a referência do DirectX8;Infelizmente, por questões burocráticas, a Microsoft fez com que o DirectX atual, que vem integrado no Seven, não fosse compatível com o Visual Basic 6 e sim com o VB.NET. Não há como negar que a linguagem .NET tem mais recursos; Entretanto, ao divulgar um programa feito em VB.NET, por mais leve que o programa em si seja, o cliente tem de baixar outro programa, chamado .NET Framework, que pesa mais de 30MB! Ou seja, o peso final do aplicativo, juntamente com o pacote Framework, fica inviável divulgar.
E ao migrar para o VB.NET, há questões de incompatibilidade com certos códigos que antigamente (não tão antigo..) eram usados no VB6, seja na conversão de tipos (a declaração e conversão de tipos no .NET é explícita, diferente do VB6, que permite que sejam realizadas operações matemáticas com strings contendo números, o que NÃO vem a ser um Math Parsing; ele não interpreta nativamente (e acredito que nem o .NET) strings contendo equações) ou no uso de certas DLLs ou certos complementos OCX. É por essas e outras que muitos programadores, inclusive eu, usamos o VB6 como linguagem padrão de Visual Basic.
Enfim, até o próximo artigo.

VB Tip: Entendendo e utilizando subclassing e mensagens WM.

Olá.

Hoje estive vendo e estudando sobre subclassing, e estarei ensinando de um modo fácil a entender e usar subclassing.

Subclassing serve para receber os comandos de uma janela em uma função específica;nessa função o programador pode, por exemplo, criar menus personalizados, limitar o tamanho ou posição de uma janela, enfim, o que ser possível, através das variáveis que tal função recebe.

Criando um subclassing local

Para se criar um subclassing, use a API SetWindowLong com a constante GWL_WNDPROC = (-4), sendo o terceiro parâmetro o endereço da função que irá receber as mensagens do subclassing, como mostrado abaixo:
Dim OldProcAddr as Long Private Const GWL_WNDPROC = (-4) Sub SubclassTo(ByVal hWnd As Long) OldProcAddr = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc) End Sub

OBSERVAÇÕES IMPORTANTES: antes de definir um subclassing, é necessário obter o endereço da função de subclassing padrão. Para isso, simplismente atribua o SetWindowLong com tais parâmetros acima, à uma variável do tipo Long. A variável, então, receberá o valor antigo do endereço que processa por padrão as mensagens da janela. Isso é importante para quando finalizarmos o formulário, restaurarmos a função padrão, para não ocorrer um crash no sistema.

Recebendo dados através do subclassing

Na seção acima aprendemos a configurar o formulário para enviar as mensagens para nossa função. Nesta seção aprenderemos a MONTAR essa função.

A função, seja ela com qual nome for (isso vai do gosto do programador), tem obrigatoriamente QUATRO parâmetros, entre eles:

• ByVal Hwnd as Long: irá retornar a handle do formulário
• ByVal wMsg as Long: irá retornar o WM relacionado ao comando atual da janela (explicarei na próxima seção)
• ByVal wParam as Long: irá retornar um valor relacionado ao wmsg, tipo como um parâmetro
• ByVal lParam as Long: dependendo do wMsg, retorna o endereço de uma estrutura, seja ela WINDOWPOS ou KBDSTRUCT. Só temos de declarar o tipo que será usado para a finalidade desejada.

A função deve ter essa estrutura:

[Private/Public] Function [NomeDaFunção] (ByVal hWnd as Long, ByVal wMsg as Long, ByVal wParam as Long, ByVal lParam as Long)
'Aqui serão feitas as condições para executar determinada ação
If wMsg = WM_MENSAGEMDESEJADA then
'executa uma ação caso o wmsg seja a constante desejada
NomeDaFunção=1 'Continua recebendo os valores, entretanto, executa a própria ação definida pelo programador
Else
NomeDaFunção = CallWindowProc(OldProcAddr, hWnd, wMsg, wParam, lParam)
'necessário para fazer a ação padrão relacionada ao wMsg.
End If
End Function
Hwnd, wParam, wmsg e lparam podem receber outros nomes, mas tem necessariamente que estarem na mesma posição padrão.

Entendendo o wMsg e as constantes WM_

Como vimos na seção anterior, o wMsg (ou seja lá qual for o nome escolhido pelo programador para declarar tal variável na função) recebe um valor oriundo das constantes iniciadas por "WM_". Irei explicar algumas delas e pra que servem.

• WM_ACTIVATE (&H6): mensagem executada quando o formulário é ativado.
• WM_SHOWWINDOW (&H18): mensagem executada quando o formulário aparece. É o primeiro comando executado quando o formulário se inicia
• WM_WINDOWPOSCHANGING (&H46): mensagem executada quando o sistema processa a posição e tamanho da janela. Sucedido por:
• WM_WINDOWPOSCHANGED (&H47): mensagem executada após o sistema processar a posição e tamanho da janela. Ambos (WINDOWPOSCHANGING e WINDOWPOSCHANGED) recebem como lParam o endereço de uma estrutura WINDOWPOS.
• WM_KILLFOCUS (&H8): mensagem executada quando o usuário deixa o formulário em questão.
• WM_MOUSEMOVE (&H200): mensagem executada quando o usuário move o mouse dentro do formulário.
• WM_NCPAINT (&H85): mensagem executada quando o sistema desenha a titlebar e os botões da janela em questão. Interceptar essa mensagem permite ao programador criar seu próprio titlebar.
• WM_NCHITTEST (&H84): mensagem executada para determinar se o mouse está em um determinado ponto da janela (digo, das bordas e do título). O CallWindowProc retorna uma das constantes precedidas por "HT" (HTCaption=título da janela)
• WM_CAPTURECHANGED (&h215): mensagem executada quando o formulário perde a captura do mouse (relacionado com SetCapture, ReleaseCapture e GetCapture)

Mais constantes de wMsg você encontra detalhado no site da Microsoft, aqui (em inglês).


No próximo artigo veremos um exemplo pronto de subclassing.
Até o próximo artigo.

Visual Basic Tip: Detectando colisões entre dois objetos

Olá. Neste artigo vou disponibilizar uma função interessante: a função para detectar colisões entre dois objetos retangulares. Ele funciona com shapes, pictureboxes, images e até mesmo com coordenadas virtuais (variáveis).

Tal função é:
Public Function DetectCollision(ax, ay, aw, ah, bx, by, bw, bh) cx = (bx + bw >= ax) And (ax + aw >= bx) cy = (by + bh >= ay) And (ay + ah >= by) DetectCollision = (cx And cy) End Function

Irei explicar todos os atributos com um exemplo: imagine dois pictureboxes Pict1 e Pict2. Onde quer que eles estejam, a função vai determinar se um está sobre/sob o outro, mesmo que por um mísero ponto dos dois. Em outras palavras, ele vai determinar se existe uma intersecção entre os dois objetos. Sendo assim, o código para estas duas pictureboxes do exemplo seria:

dim Colisao as boolean
Colisao = DetectCollision(Pict1.left, Pict1.top, pict1.width, pict1.height, pict2.left, pict2.top, pict2.width, pict2.height)

Como pode-se ver, há a necessidade de se passar não só a posição dos dois mas também o tamanho de ambos. Lembrando que os quatro primeiros atributos são do primeiro objeto e os outros quatro, do segundo. Nesta ordem: posição horizontal do primeiro objeto, posição vertical do primeiro objeto, largura do primeiro objeto, altura do primeiro objeto, posição horizontal do segundo objeto, posição vertical do segundo objeto, largura do segundo objeto e altura do segundo objeto.

É isso pessoal.
Em breve estarei divulgando a nova versão do MultiSystem. Atualmente estou desenvolvendo os jogos. Ele vai ter jogo de Tetris (já desenvolvido e funcionando legal, com música e tudo), Pac-man (em desenvolvimento) e outros que vier em mente.
Fiquem atentos!

Programa que criei: Multisystem Sidebar (à parte)

Olá. Neste artigo estarei divulgando o programa MultiSystem Sidebar. Ele faz parte do Multisystem mas nesta versão disponibilizada abaixo só terá a Sidebar, individualmente.


A sidebar foi criada baseado na barra lateral (sidebar, em inglês..) do Windows Vista. Para quem não teve contato com o Vista, ela é uma gadget própria do Windows Vista que contém um slider de imagens, um relógio analógico e digital, um calendário, um player de música, um "bloco de notas" integrado e também medidores de CPU, RAM, e em algumas versões, de temperatura interna do processador. Também tem um sistema rss que mostra temperatura ambiente de cidades, fusos horários e até uma barra de pesquisa que abre uma nova instância do navegador com a página de pesquisa do google com o termo pesquisado.
Em outros termos: A barra lateral é uma das coisas mais bacanas do Windows Vista, também conhecida como “Windows Sidebar”, ela tem vários mini aplicativos, chamados de gadgets, além de ser personalizável, suportando outras gadgets e skins, ela é ideal para você ficar informado, em tempo real, das atualizações de seus blogs favoritos e também da temperatura e a previsão para sua cidade. (Retirado do blog marlonpalmas.wordpress)

O MultiSystem Sidebar, entretanto, não necessita de ser rodada em sistemas Windows Vista. Foi desenvolvida para ser usada também em Windows XP (principalmente em Windows XP). Nesta versão não há barra de pesquisa ou gadget que mostra temperatura de cidades, mas em breve novas versões serão lançadas e tais recursos serão disponibilizados.

E ao contrário de outras sidebars desenvolvidas por outras pessoas ou empresas, a MultiSystem Sidebar não pesa no HD, tendo apenas 670KB no total (sendo que 394 KB são das imagens contidas na pasta Paisagens, que podem ser removidas a qualquer momento, desde que seja deixada a pasta e pelo menos uma imagem dentro, pois a sidebar ao iniciar procura por ela e sem ela o programa não inicia por não encontrá-la). O programa exe em si tem apenas 272 KB e não precisa de Frameworks (diferente de outras sidebars que são desenvolvidos em .net e necessitam do .net framework, que sozinho pesa mais de 50MB!).

O link para download é http://cid-b278d5e7a71b5dca.office.live.com/self.aspx/.Documents/setup-msys-sb.exe.

Abaixo se encontra alguns prints do MultiSystem Sidebar.



É isso! Em breve estarei divulgando o Multisystem na sua nova versão.
Até o próximo artigo!

Programa que criei: EconomyObserver

Me surgiu a ideia de criar um programa que mostre de modo bem simples a cotação do dólar, do euro e o valor do Dow Jones.

O link do aplicativo é http://cid-b278d5e7a71b5dca.office.live.com/self.aspx/.Documents/EconomyObserver.exe e em breve divulgarei os arquivos-fonte do programa.
Atenção: quem já havia baixado a versão 1.0.0, baixe novamente pois o link acima é mais recente, da versão 1.3.0.2.

O programa funciona apenas em sistemas x86 (32bits). Mas vale a pena testar se o aplicativo funciona em seu computador 64 bits.
Qualquer erro com o aplicativo me avisem que irei consertar.
Prints:


É isso.
Até o próximo artigo!
Aguarde

Visual Basic Tip: Macros parte II - Projeto pronto

No artigo anterior tratei sobre programas de criação de macros. Neste artigo, publicarei o link do projeto pronto.

O projeto zipado se encontra em http://cid-b278d5e7a71b5dca.office.live.com/self.aspx/.Documents/macro.zip

É isso.
Até o próximo artigo.

Visual Basic'n'Delphi Tip: Detectando e simulando cliques e posição do mouse: Macros

Olá pessoal.
Neste artigo iremos tratar sobre a criação de programas de macro, tanto no VB como no Delphi.
Creio que alguém já teve de criar um programa que detectasse clique fora da janela do programa ou mesmo simular o clique.
Pois bem. Iremos por etapas.

Detectando posição do mouse

Este algoritmo é muito fácil. Deve-se usar a API GetCursorPos da biblioteca User32 e usar o tipo POINTAPI. O código é o seguinte:

Private Type POINTAPI X as Long Y as Long End Type Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 'exemplo segue abaixo Sub Timer1_Timer() Dim pt As POINTAPI GetCursorPos pt Me.Cls Me.Print pt.X, pt.Y 'os valores de x e y serão respectivamente pt.x e pt.y End Sub
No Delphi, fica:
procedure TForm1.Button1Click(Sender: TObject); var pt: TPoint; begin GetCursorPos(pt); self.Caption:=IntToStr(pt.x) + 'x' + IntToStr(pt.y) end;

Detectando cliques

Creio que muita gente não sabe, mas é possível detectar o botão do mouse como se fosse do teclado. Não é necessário usar nenhum hook complexo nem funções complicadas. Usa-se somente a função GetAsyncKeyState da biblioteca User32. O código dos botões do mouse equivalem aos valores vbLeftButton, vbRightButton e vbMiddleButton, respectivamente 1,2 e 4.
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 'exemplo segue abaixo Sub Timer1_Timer() me.cls me.print iif(GetAsyncKeyState(1), "Left", iif(GetAsyncKeyState(2),"Right","None")) End Sub
No delphi, é simplesmente "self.Caption:=IntToStr(GetAsyncKeyState(1));" pois não há a necessidade de declarar tal função.

"Clicando" automaticamente

Existe a função mouse_event, que simula cliques.
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Private Const MOUSEEVENTF_LEFTDOWN = &H2 Private Const MOUSEEVENTF_LEFTUP = &H4 Private Const MOUSEEVENTF_RIGHTDOWN = &H8 Private Const MOUSEEVENTF_RIGHTUP = &H10 Private Const MOUSEEVENTF_ABSOLUTE = &H8000 Sub SimulaClick() mouse_event MOUSEEVENTF_LEFTDOWN, 0,0,0,0 mouse_event MOUSEEVENTF_LEFTUP, 0,0,0,0 'fecha o clique 'caso não for colcada a linha acima, ele simula a função de drag-drop (arrastar e soltar) End sub

No delphi é simplismente:
mouse_event(MOUSEEVENTF_LEFTDOWN, 0,0,0,0); mouse_event(MOUSEEVENTF_LEFTUP, 0,0,0,0);

Lembrando que tal função clica no local onde o cursor está. Por isso, há necessidade de se mover o mouse antes de se clicar. Veremos a função de mover o mouse a seguir.

Movendo o mouse automaticamente

Existe a função SetCursorPos da biblioteca User32.
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long 'exemplo segue abaixo Sub MoverMouse() SetCursorPos 500,200 '(move-se o mouse até o ponto 500x200px. No delphi é simplismente "SetCursorPos(500,200)", e onde é 500 e 200, irá a sua posição de cursor.

Programa para gravar macro

Juntando todas essas APIs, você pode construir um programa de criação de macros do simples ao avançado.

Estarei postando em breve o programa de criação de macros.

Fique ligado!

Visual Basic Tip: Constantes matemáticas

Uma dica simples mas útil. Quando se precisa de uma constante como PI ou E, certos programadores usam o número em si. Exemplo:

Const PI=3.141593 Const E=2.718281 Const PHI=1.618033

Mas existe outra maneira de obter tais constantes, maneira esta mais precisa nos resultados. São através de fórmulas matemáticas.
O código delas são: Dim PI as Double Dim E as Double Dim PHI as Double PI = 4*Atn(1) E = 2 ^ (1 / Log(2)) PHI = (Sqr(5) + 1) / 2 Pi, por exemplo, equivale ao quadruplo do arco tangente de 1 radiano. Sendo assim:

Agora a constante de Euler. Nesse temos de ir por partes para entender o porquê da fórmula.
Vamos supor o logarítmo natural de 2:

Podemos afirmar que:

Sendo assim:

Como queremos saber o valor de , manteremos ele em evidência:

Obtendo assim "2,71828....".
O código então é:

e = 2 ^ (1 / Log(2))

Representando .

A outra constante matemática que pode ser usada na programação é a razão áurea (representada pela letra grega phi: ). A fórmula para ela é:

phi = (Sqr(5) + 1) / 2

Representa-se pela fórmula: cujo resultado é ~1.61803398874989.


É isso pessoal! Em breve postarei novas dicas e novos programas! Fiquem atentos!


----------------------- 10/12/2011 - Errata na fórmula de Euler acima. A equação do VB está correta, entretanto, na explicação, me equivoquei ao dizer que e=raíz 0.69... de 2. Na verdade, e = Raíz de (1/0.69...) de 2.

Visual Basic Tip: Criando efeito de "fade" entre imagens.

Aqueles que baixaram a versão alpha do programa MultiSystem que publiquei semana passada, puderam reparar que na Sidebar as imagens passam em "fade" (ou seja, se sobrepoem translucidamente). Isso eu creio que não vão encontrar em lugar nenhum na Internet, portanto, postarei aqui caso alguém quiser executar o mesmo efeito em algum programa. É de sua conta colocar ou não os créditos da minha autoria do tal "algorítimo".
Para quem não baixou, aí está um print:


Pois bem, eu não usei APIs para tal efeito, usei apenas algumas funções e procedures criadas por mim.

Criando tal efeito

Abra um novo projeto no VB do tipo Standard EXE (pode ser algum existente, desde que não haja conflitos com nomes de variáveis e de objetos) (também pode ser um activex, mas nesse tutorial usaremos apenas EXE).

Nas propriedades do form, defina ScaleMode=vbPixels.

Crie três pictureboxes, ambos com tamanho de 100x80. Nomes: "Picture1", "Picture2" e "resultado". Nas propriedades das pictureboxes, defina o ScaleMode deles para VbPixels e defina AutoRedraw para true.

Crie três images, ambas também com o tamanho de 100x80. Nomes: "Image1", "Image2" e "Image3". Nas propriedades, ative o Stretch.

Insira dois timers, "timer1" e "timer2". Timer1 com intervalo igual a 1 e timer2 com intervalo igual a 2000, este último desabilitado (em outras palavras, enabled=false).

Defina alguma imagem para Image1 e Image2. No exemplo usei duas imagens da pasta Wallpapper localizada em c:/WINDOWS/Web.

No código insira o seguinte:
Dim alpha As Integer Private Type tRGB R As Long G As Long B As Long End Type Private Function OLEtoRGB(OLEHX As Long) As tRGB kde = Hex(OLEHX) If Len(kde) = 1 Then kde = "00000" & kde If Len(kde) = 2 Then kde = "0000" & kde If Len(kde) = 3 Then kde = "000" & kde If Len(kde) = 4 Then kde = "00" & kde If Len(kde) = 5 Then kde = "0" & kde B = Mid(kde, 1, 2) G = Mid(kde, 3, 2) R = Mid(kde, 5, 2) B = CLng("&H" & B) G = CLng("&H" & G) R = CLng("&H" & R) OLEtoRGB.B = B OLEtoRGB.G = G OLEtoRGB.R = R End Function Private Function CalculateHalf(ColorA As tRGB, colorB As tRGB, AlphaA As Integer) As tRGB ialpha = AlphaA / 100 nialpha = 1 - ialpha CalculateHalf.R = ((ColorA.R * ialpha) + (colorB.R * nialpha)) CalculateHalf.G = ((ColorA.G * ialpha) + (colorB.G * nialpha)) CalculateHalf.B = ((ColorA.B * ialpha) + (colorB.B * nialpha)) End Function Private Sub Form_Load() alpha = 100 Picture1.PaintPicture Image1.Picture, 0, 0, 100, 80 Picture2.PaintPicture Image2.Picture, 0, 0, 100, 80 End Sub Private Sub Timer1_Timer() If alpha = 0 Then Timer1.Enabled = False Timer2.Enabled = True End If For y = 0 To 80 For x = 0 To 100 Step 5 Dim cora As tRGB Dim corb As tRGB Dim corr As tRGB cora = OLEtoRGB(Picture1.Point(x, y)) corb = OLEtoRGB(Picture2.Point(x, y)) corr = CalculateHalf(cora, corb, alpha) resultado.PSet (x, y), RGB(corr.R, corr.G, corr.B) cora = OLEtoRGB(Picture1.Point(x + 1, y)) corb = OLEtoRGB(Picture2.Point(x + 1, y)) corr = CalculateHalf(cora, corb, alpha) resultado.PSet (x + 1, y), RGB(corr.R, corr.G, corr.B) cora = OLEtoRGB(Picture1.Point(x + 2, y)) corb = OLEtoRGB(Picture2.Point(x + 2, y)) corr = CalculateHalf(cora, corb, alpha) resultado.PSet (x + 2, y), RGB(corr.R, corr.G, corr.B) cora = OLEtoRGB(Picture1.Point(x + 3, y)) corb = OLEtoRGB(Picture2.Point(x + 3, y)) corr = CalculateHalf(cora, corb, alpha) resultado.PSet (x + 3, y), RGB(corr.R, corr.G, corr.B) cora = OLEtoRGB(Picture1.Point(x + 4, y)) corb = OLEtoRGB(Picture2.Point(x + 4, y)) corr = CalculateHalf(cora, corb, alpha) resultado.PSet (x + 4, y), RGB(corr.R, corr.G, corr.B) Next x Next y resultado.Refresh Image3.Picture = resultado.Image alpha = alpha - 50 End Sub Private Sub Timer2_Timer() Timer2.Enabled = False Image3.Picture = Image2.Picture Image2.Picture = Image1.Picture Image1.Picture = Image3.Picture Picture1.PaintPicture Image1.Picture, 0, 0, 100, 80 Picture2.PaintPicture Image2.Picture, 0, 0, 100, 80 Image3.Picture = resultado.Image alpha = 100 Timer1.Enabled = True End Sub

Explicação:
tRGB é o tipo que irá receber valores RGB.
OLEtoRGB é a função que vai transformar cor OLE (&H00000000FF) em RGB(255,0,0).
CalculateHalf é a função que irá mesclar as cores.


Se quiser, você pode baixar o projeto pronto zipado pelo link: http://ys8hqw.bay.livefilestore.com/y1pJFGceE-n1OZLcKyEAABLEnbOdzOc0vTPhbjwRbIWTyYuGwDypb9B6Rl7KqHPIQdlRohvQejyH564qQuIZtf3MR8o3Ev7-Evi/FormFadeExample.zip?download&psid=1 ou http://cid-b278d5e7a71b5dca.office.live.com/self.aspx/.Documents/FormFadeExample.zip. Ao baixar, descompacte tudo em uma pasta antes de executar o projeto.

É isso, pessoal. Em breve postarei mais dicas e também programas que eu criar. Fiquem atentos!

Programa que criei: MultiSystem

O MultiSystem é um mini sistema operacional que roda dentro do Windows. Ele conta com o design do Vista, e com uma sidebar semelhante a do vista. Está na versão alfa (ou seja, ainda tem poucos recursos) mas mesmo assim já demonstra o que o Multisystem, em sua futura versão 1.0, vai ser.

Ele contém o BasicAlarm integrado, cujo link postei em um artigo anterior a este.

Quaisquer bugs decorrentes do programa, avisem que eu consertarei.

Quando iniciar, ele irá pedir senha através do sistema de login dele. Simplismente digite "admin" nas duas caixas (tanto no username como senha).

O link é http://cid-b278d5e7a71b5dca.office.live.com/self.aspx/.Documents/multisys-setup.exe ou http://ys8hqw.bay.livefilestore.com/y1pZY3jJZKHUfbvdHuUQI7LL3fpmGCjrkZ44jU9-1hVRuOwPLx786o1Gs9OhQkV2QBire69l5hT0BMUk_gQxCr5I3adYmx2y5OD/multisys-setup.exe?psid=1 (link direto) e pesa 5MB ao todo.

Os programas a serem implementados dentro dele prevista na versão 1.0 são o Virtual ContactBook, LotoMan e uma calculadora. Estes programas infelizmente não herdam a aparência do programa MultiSystem (skin do vista), mas irei fazê-lo assim que terminar a versão 1.0.


Abaixo se encontram alguns prints da versão acima:

Programa que criei: BasicAlarm

O BasicAlarm, como o próprio nome diz, permite criar alarmes. É um programa útil e extremamente simples de mexer.
Obs: O programa, quando um alarme desperta, emite um som pelo auto-falante interno do CPU. Portanto, se ouvir um apito no CPU se um alarme estiver despertando não se deve à alta temperatura no processador nem à problemas de memória RAM. Isso se deve ao alarme estar sendo despertado, e isso ocorre graças à API Beep (dwFrequence, dwMilliseconds) da livraria kernel32.dll

Falando em APIs, em breve postarei dicas de APIs para você que é programador e que deseja utilizar tais APIs em seus programas.

Voltando ao assunto principal do post, abaixo está o link do meu programa:
http://cid-b278d5e7a71b5dca.office.live.com/self.aspx/.Documents/Instalador-BasicAlarm.exe ou http://ys8hqw.bay.livefilestore.com/y1p_F1KQTPmvG-v0qOxzSxiCs-s-uwChw23WbhRc77aK7ZqzB4tDMMVJZgZbosPUvwFZR0cpiU1bKGhBQbFI8irJlhue09vTYYv/Instalador-BasicAlarm.exe?psid=1 (um é link do diretório do SkyDrive, outro o link direto do SkyDrive).

Abaixo estão alguns prints:

Programa que criei: Calendário

É extemamente simples, mas útil.
http://ys8hqw.bay.livefilestore.com/y1pbmqaTC1wT623O619dQhRTbdqNntpap0VEIx5J8N-LXSZV3eFsAVcIfq0BHGZGffwQH0tvsytKiEo_OqYS4sXH2H8j1jzt7hY/calendar32.exe?psid=1

Programa que criei: LotoMan

O LotoMan é um programa que exibe e confere concursos de loteria. A primeira versão suporta apenas Lotomania, Lotofácil e Mega-sena, mas serão futuramente implantados outros jogos.
É um programa simples que pesa apenas 70 KB. O link para download é http://ys8hqw.bay.livefilestore.com/y1p-JJPszEW5Q-rtk46hbsUZk09Ptekc2L23DBiR269lgx097E4vD6SP-TP0CtJFW2FDvrC0n11nnLWl95G_uBPrSaBi01KLtYz/lotoman-setup.exe?psid=1 (ou http://cid-b278d5e7a71b5dca.office.live.com/self.aspx/.Documents/lotoman-setup.exe) (Não é virus).

Abaixo estão algumas fotos do programa:

Programa que criei: Virtual ContactBook

O Virtual ContactBook é uma agenda virtual que grava contatos, eventos e notas de texto. Tem 1948 KB (1,90 MB) de tamanho (não muito pesado) mas é muito simples e fácil de se mexer. Funciona com sistema de login, ou seja, você e seu irmão podem ter, cada um, os seus próprios contatos e notas. É seguro pois só quem sabe a senha pode entrar na sua conta. Abaixo se encontram algumas imagens do programa. Caso queira baixar, o link é http://migre.me/24JdC, ou link direto: http://dc177.4shared.com/download/mX_IK-1I/vcb-setup.exe?tsid=20101108-114813-1527efc9 (não é virus).

O programa está em inglês, mas eu adicionei um manual em português e, mesmo que você não saiba inglês, saberá mexer facilmente nele.
Abaixo estão as fotos do programa: