.jpg?ph=984947a9b0)
Programação
Reservei este espaço no site para divulgar e compartilhar meus trabalhos de programação , seja na criação de programas , jogos , aplicativos , sites , comunidades e etc...
Meu objetivo mão é so ajudar , mas tambem aprernder !...
neste momento estou aprendendo a utilizar a ferramenta visual basic 2010 , pois ja trabalho com a versão vb6 a algum tempo , paralelamente , tambem estou aprendendo a manusear EngineUDK , MAYA 3D, 3Dmax, estes voltados para criação de jogos .
para os interessados ja faço parte de diversas comunides , nestes assuntos , estou sempre postando dicas e compartilhando ideias e principalmente , aprendendo muito .
Dicas para Visual Basic 6
***************************************************
FORMATAR DINHEIRO
Format(Text23, "#,##0.00")
********************************************************************************************
AJUSTAR MS FLEX GRID
'MSFlexGrid1.ColWidth(0) = 800 'codigo
'MSFlexGrid1.ColWidth(1) = 3500 'produto
'MSFlexGrid1.ColWidth(2) = 3500 ' preço
'MSFlexGrid1.ColWidth(3) = 1500 'fornecedor
'MSFlexGrid1.ColWidth(4) = 1800 ' estoque
**************************************************************************************************
'SOMENTE NUMEROS KeyAscii = IIf(IsNumeric(Chr(KeyAscii)), KeyAscii, 0)
****************************************************************************************************
'MAIUSCULASA KeyAscii = Asc(UCase(Chr(KeyAscii)))
************************************************************************************************
BUSCAR POR ITEN
'Data1.RecordSource = "SELECT * FROM TABELA1 WHERE cÓdigo like '*" & (Text15) & "*' order by cÓdigo "
'Data1.Refresh
**************************************************************************************************************************
MOSTRAR E TRAZER PARA FRENTE
'Frame1.Visible = True
'Frame1.ZOrder (vbBringToFront)
**************************************************************************************************************
ORGANIZAR POR NOME
'Data1.RecordSource = "select* from TABELA1 order by nome"
'Data1.Refresh
**************************************************************
TRATAMENTO DE ERROS
'antes da linha do erro
On error Goto Trata_Erro
aki ta a linha com erro prpriamente dito !
' apos a linha do erro
Exit sub
Trata_Erro:
msgbox "esta linha esta com erro!"
' ou execute qualquer tarefa p substituir o erro
end sub
**********************************************************************
DELETAR ARQUIVOS
Kill c:\teste\arq1.txt
*******************************************************************************
COPIAR E MOVER ARQUIVOS
FileCopy "arq1.txt", "arq2.txt"
Neste exemplo o arquivo arq1.txt é copiado do diretório atual com o nome de arq2.txt para o mesmo diretório.
Você pode especificar a localização dos arquivos informando o drive e o diretório para o fonte e o destino. Assim:
FileCopy "c:\teste\arq1.txt", "c:\windows\arq2.txt"
***********************************************************************************
RENOMEAR E MOVER ARQUIVOS
Usando"name" podemos renomear e mover o arquivo para outro diretório , mas não podemos criar um novo arquivo , diretório ou pasta.
Se o arquivo origem não for localizado ou estiver aberto o VB retorna uma mensagem de erro identica a que ocorre quando estamos copiando um arquivo.
Exemplo:
Name "c:\teste\arq1.txt" As "c:\windows\arq2.txt"
Renomeia e move o arquivo arq1.txt localizado em c:\teste para o diretório c:\windows com o nome de arq2.txt
**************************************************************
TRATAMENTO DE ERROS
Private Sub Command1_Click()
On Error GoTo trata_Erro
PrintForm ' Imprime o formulário atual
Exit Sub
trata_Erro:
Msg = "O formulário não pode ser impresso !"
MsgBox Msg
Resume Next
End Sub
******************************************************************************
BUSCA PRODUTO PELO NOME DIGITADO
Data1.RecordSource = "SELECT * FROM produto WHERE codigo like '*" & (Text1)& "*' order by codigo "
Data1.Refresh
*********************************************************************
CRIAR ARQUIVO EXCEL A PARTIR DE UMA LIST BOX
Private Sub Command1_Click()
Dim exclApp As Object
Dim exclBook As Object
Dim excSheet As Object
'Carregar o Excel:
Set exclApp = CreateObject("Excel.Application")
'Crie um WorkBook:
Set exclBook = exclApp.WorkBooks.Add
'Defina a planilha ativa p/ facilitar o trabalho:
Set exclSheet = exclApp.ActiveWorkBook.ActiveSheet
Dim a As Integer 'COLUNA
Dim b As Integer ' LINHA
a = 1
b = 1
With exclSheet
For o = 1 To List1.ListCount - 1
.Cells(a, b).Value = List1.List(i) ' IMPRIMIR BOLETO
a = a + 1
' b = b + 1
Next o
.SaveAs "C:\Users\Jacyr Jr\Desktop\teste1.xls" 'Salvar o Arquivo
End With
'Limpe as variáveis de Objeto:
Set exclSheet = Nothing
Set exclBook = Nothing
Set exclApp = Nothing
End Sub
*****************************************************************************
simulador de mouse
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
'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 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
'mostrar coordenadas ao mover o mouse
Private Sub Form_MouseMove(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
Text3.Text = X
Text4.Text = Y
End Sub
'form clica salvar cordenadas
'text1.text = (text3)
'text2.text = (text4)'
'end
' timer clica automatico
Private Sub Timer1_Timer()
SetCursorPos (Text1), (Text2)
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 'fecha o clique
'segundo click
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 'fecha o clique
end sub
**************************************************************************************
simulador de teclas
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" ( _
ByVal cChar As Byte) As Integer
Private Declare Function VkKeyScanW Lib "user32" ( _
ByVal cChar As Integer) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Sub KeyDown(ByVal vKey As KeyCodeConstants)
keybd_event vKey, 0, KEYEVENTF_EXTENDEDKEY, 0
End Sub
Public Sub KeyUp(ByVal vKey As KeyCodeConstants)
keybd_event vKey, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End Sub
Public Function KeyCode(ByVal sChar As String) As KeyCodeConstants
Dim bNt As Boolean
Dim iKeyCode As Integer
Dim b() As Byte
Dim iKey As Integer
Dim vKey As KeyCodeConstants
Dim iShift As ShiftConstants
' Determina se nós temos suporte Unicode ou não:
bNt = ((GetVersion() And &H80000000) = 0)
' Obtém o código de teclado para o caractere
If (bNt) Then
b = sChar
CopyMemory iKey, b(0), 2
iKeyCode = VkKeyScanW(iKey)
Else
b = StrConv(sChar, vbFromUnicode)
iKeyCode = VkKeyScan(b(0))
End If
KeyCode = (iKeyCode And &HFF&)
End Function
Private Sub Command1_Click()
KeyDown KeyCode("A") 'pressiona a tecla A
KeyUp KeyCode("A") 'solta a tecla A
End Sub
************************************************************************************************
formatar datas
Text1.Text = Format(Date, "dddd/dd/MMMM /MM /YYYY/YY")
*************************************
busca no click
Private Sub MSFlexGrid1_DblClick()
Text17.Text = MSFlexGrid1 ' seleciona item da lista
Data1.RecordSource = "SELECT * FROM produto WHERE codigo like '*" & Text17.Text & "*' order by codigo "
Data1.Refresh
***********************************
numeros aleatorios de 1 a 60
Dim au1 As Double
au1 = CInt(60 - 100 * Rnd)
If au1 > 0 Then a1.Text = au1
If au1 < 0 Then a1.Text = (-1) * au1
**************************************
mover figura com o mouse
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button > 0 Then
x2 = X
y2 = Y
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button > 0 Then
Picture1.Move Picture1.Left - (x2 - X), Picture1.Top - (y2 - Y)
End If
End Sub
************************************
som no vb
MediaPlayer1.FileName = "C:\projetos\forca\Music005.mid" ' som durante o jogo
******************************
salvar dentro do text box
Marcelo 17/01/2007 04:43 ...No evento Click do botao digita o codigo:
SaveSetting("Aplicaçao", "Localizaçao", "Chave", Controle)
* Onde Aplicaçao voce substitui pelo nome da sua aplicaçao
* Localizaçao, a seçao onde se encontra a propriedade que vc quer gravar
* Chave, nome que voce darà à sua propriedade
* Controle : o controle que vc quer salvar... No seu caso, uma das "barrinhas" (de agora em diante chame-as de TextBox... :P)
Por ex.:
No evento click digita:
SaveSetting("PROGRAMA", "FORM1", "BARRINHA1", TextBox1.Text)
Com isso voce salva, pra voce obter as informaçoes a cada vez que o programa for iniciado, tem q adicionar a propriedade GetSetting (é sò substituir oo SaveSetting na linha acima) no evento Load do form.
Por ex.:
No evento load do FORM1 digita:
GetSetting("Aplicaçao", "Localizaçao", "Chave", TextBox2.Text)
Onde TextBox2 é a caixa onde serà visualizado o conteudo que foi salvo na TextBox1 na proxima vez que o form for carregado.
************************************
2 digitos apos a virgula
Text8.Text = Format(Text8, "#,##0.00")
Text8.Text = Round(Text8, 2)
***********************************
soma de caixas de texto p evitar concatenação
valorTotal = ccur(text1.txt) + ccur(txt2.text)
**************************************
função print screem
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, ByVal bScan As _
Byte, ByVal dwFlags As Long, ByVal _
dwExtraInfo As Long)
Private Sub Command1_Click()
'P/ capturar a tela:
Picture1.AutoSize = True
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
End Sub
Private Sub Command2_Click()
'P/ salvar a imagem:
SavePicture Picture1.Image, "C:\Teste.BMP"
End Sub
*******************************
cripitografia com 2 digitos
Public kk, ki, ko
Private Sub Command1_Click()
Timer1.Interval = 1000
End Sub
Private Sub Form_Load()
Text2.Text = " "
End Sub
Private Sub Timer1_Timer()
If ko = Len(Text1.Text) Then
ko = 0
Timer1.Interval = 0
Else
ko = ko + 1
Text1.SelStart = ko
Text1.SelLength = 1
On Error Resume Next
kk = AscW(Text1.SelText)
Text2.Text = Text2.Text & " " & Hex(kk)
End If
End Sub
*******************************
destravando o XP
1. Vá em iniciar > executar
2. Digite "regedit" (sem aspas) e clique em OK
3. No regedit, navegue aé a seguinte chave: "HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/WindowsNT/CurrentVersion/WPAEvents"
4. No painel à direita, dê um duplo clique em "OOBEtimer" e apague os valores que aparecerem, clique em OK e feche o regedit
5. Vá novamente em iniciar > executar
6. Desta vez digite: "%systemroot%\system32\oobe\msoobe.exe /a" (sem aspas)
7. Na janela que se abriu, escolha a opção "sim, desejo telefonar"
8. Na proxima etapa, clique em "alterar chave do produto"
9. Use este serial "ORIGINAL": THMPV 77D6F 94376 8HGKG VRDRQ e clique no botão "Atualizar", neste momento a tela voltará a seu estágio anterior. Clique em lembrar mais tarde e reinicie o PC.
10. Com o PC reiniciado, vá novamente em "%systemroot%\system32\oobe\msoobe.exe /a" (sem aspas)
11. Aparecerá a seguinte mensagem: "O Windows já está ativado".
12. Clique em OK para sair...
pode ate deixar fazer atualizações automaticas
****************************
funções dentro do texto
1- API SendMessage com as fLAGS
WM_CUT(RECORTAR)
, WM_COPY(COPIAR),
WM_PASTE(COLAR)
wM_SELECTALL ...
***************************
resto de uma divisao
Text1.Text = 29 Mod 6'29/6
resposta = 5
*****************************
calculo entre datas
Label1.Caption = Date
Text2.Text = DateDiff("d", (Label1), (Text1)) 'dia
Text3.Text = DateDiff("m", (Label1), (Text1)) 'mes
Text4.Text = DateDiff("d", (Label1), (Text1)) / 365 'ano
Text5.Text = Text2.Text / 7
**************************************
mudar o foco do text quando encher
If Len(Text1.Text) = 5 Then'quantidade de digitos
Text2.SetFocus
******************************
numero de semamas no ano
Text1.Text = DatePart("ww", "25/12/2006")
**********************
movendo figura
Propriedade do Form Keypreview=True
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 37 Then
Picture1.Left = Picture1.Left - 15
End If
If KeyCode = 39 Then
Picture1.Left = Picture1.Left + 15
End If
If KeyCode = 38 Then
Picture1.Top = Picture1.Top - 15
End If
If KeyCode = 40 Then
Picture1.Top = Picture1.Top + 15
End If
End Sub
Right_37
Left__39
Up____38
Down__40
************************************
abrindo arquivo do excel
Dim xl As New Excel.Application
Dim xlw As Excel.Workbook
'*****
'***** Abrir o arquivo do Excel
'*****
Set xlw = xl.Workbooks.Open("C:\ARQUIVOS DE PROGRAMAS\CAFPLUS\OS.xls")
xlw.Close False 'Salva os dados numa nova planilha
'Liberamos a memória
Set xlw = Nothing
Set xl = Nothing
****************************************
pular linha no text e no label
Label1.Caption = "Teste" + vbCrLf + "teste"
Text1.Text = "Teste" + vbCrLf + "teste"
************************************
mouse scrol no vb
]Tem que registrar a dll...
Coloca a dll "VB6IDEMouseWheelAddin.dll" na pasta system e roda esse comando no iniciar>executar:
regsvr32 C:\WINDOWS\system\VB6IDEMouseWheelAddin.dll
**********************************
o efeito de piscar pode ser feito de varias formas
uma delas e trocar a cor da letra ou tornar o texto visivel
ex
add um evento timer com interval = 500 e enabled = false
crie um if no texto
If Text1.Text > 5 Then
Timer1.Enabled = True
Else
Timer1.Enabled = False
End If
crie outro no timer
Private Sub Timer1_Timer()
If Text1.ForeColor = &H0& Then 'preto
Text1.ForeColor = &HFFFFFF 'branco
Else
Text1.ForeColor = &H0& 'preto
End If
End Sub
**********************************
criar pasta e copiar arquivos e pastas
Private Sub Command1_Click()
Set MyFSO = CreateObject("Scripting.FileSystemObject")
MyFSO.CopyFolder "C:\Meus documentos\antigas", "C:\WINDOWS\Desktop\xadrez", True
End Sub
****************************
impressao jato de tinta
Printer.CurrentY = 800 'margem vertical (altura)
Do While Not banco.EOF
Printer.CurrentX = 500 ' margem esquerda
Printer.FontSize = 12 'tamanho da letra
Printer.Print campo1, campo2, campo3,etc...'campos, textos, listas, flexgrides
banco.MoveNext
Loop
Printer.EndDoc
***********************************
controlando porta paralela
Crie:
1 botão de comando
1 textbox
'Em um módulo
Public Declare Function Inp Lib "inpout32.dll" _
Alias "Inp32" (ByVal PortAddress As Integer) As Integer
Public Declare Sub Out Lib "inpout32.dll" _
Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)
'No Form
Private Sub Form_Load()
Value = 0
'Endereço da porta:
PortAddress = &H378
End Sub
Private Sub Command1_Click()
Out PortAddress, Value
Text1.Text = Inp(PortAddress)
Value = Value + 1
If Value = 255 Then Value = 0
End Sub
'0 ao 7 ( Saida )
'o terra 18 ao 25
'1º Lugar baixe a DLL inpout32.dll
************************************
efeito degrade
Coloque isso no Evento Activate do Formulario para
que ele possa Ter uma alterção de Cor
O Xlinha é a Posiçao da linha, o Xcor é o
Valor da Cor para fazer a mudança.
Static XLinha As Single
Static Xcor As Single
For i = 1 To Me.Height
XLinha = XLinha + 15 'nivel de claro e escuro
Xcor = Xcor + 1
Me.Line (0, XLinha)-(Me.Width, XLinha), RGB(Xcor, 0, 0)'===>(r,g,b)
Next
se você quizer outra cor é só alterar
o RGB(0,Xcor,0) para outra que vc quizer OK.
******************************************
ordem alfabetica
DB.RecordSource = "select* from clientes order by TB!nome_cli"
**************************************
loop
Do While Not DB.Recordset.EOF
List1.AddItem TB!nome_cli
DB.Recordset.MoveNext
Loop
***************************************
mover o botao
Private Sub Form_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Source.Move X, Y
End Sub
PS: "Com alguns bugs...."
deixe a prop do botao dragmode=auto !!!
**************************************
declarando variavel e função loop
Private Sub Form_Load()
Dim i As Integer 'Declara a variável i como integer (Inteiro (Numérica ))
i = 0 'Define o valor de i como 0
Do While i <= 10 'Começa o loop: Fazer enquanto i for menor ou igual a 10
MsgBox i 'Exibe uma janela de alerta com o valor de i
i = i + 1 'Aumenta o valor de i em 1
Loop 'Retorna ao começo do Do/Loop
End Sub
************************************************
retirar acento graficos
Dim sujo As String ' carateres acentuados
Dim limpo As String ' carateres não acentuados
Dim texto As String
Dim i As Integer
Dim j As Integer
texto = Text1.Text
sujo = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ"
limpo = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN"
For i = 1 To Len(texto)
For j = 1 To Len(sujo)
texto = Replace(texto, Mid(sujo, j, 1), Mid(limpo, j, 1))
Next
Next
Text2.Text = texto
*******************************************
criar evento en tempo real (botao)
Private Sub Form_Load()
Me.Controls.Add "VB.commandbutton", "command1"
Me.Controls.Item("command1").Width = 400 'largura
Me.Controls.Item("command1").Height = 400 'altura
Me.Controls.Item("command1").Left = 2000 'posição horizontal
Me.Controls.Item("command1").Top = 2000 'posilçao vertical
Me.Controls.Item("command1").Visible = True
End Sub
***************************************
Captura somente os números digitados...
.
Private Sub NomeObjeto_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 Then
If InStr("0123456789", Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End Sub
************************************
Desativando Crtl+Alt+Del
Olá amigos venho aqui deixar essa dica como desativar Crtl+Alt+Del
Crie 2 Botões de comando
cmdBloqueia (Para bloquear)
cmdDesbloqueia (Para desbloquear )
Private Sub cmdBloqueia_Click()
Open "C:\Windows\system32\taskmgr.exe" For Random Lock Read As #1
End Sub
Private Sub cmdDesbloqueia_Click()
Close #1
End Sub
Prontinho!! Valeu
*******************************************
raiz quadrada
Dois levado na terceira potência: 2³ = 2 ^ 3
Raiz quadrada de dois: v2 = 2 ^ (1 / 2)
************************************
' somente letras
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = IIf(IsNumeric(Chr(KeyAscii)), 0, KeyAscii)
End Sub
'somente numeros
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = IIf(IsNumeric(Chr(KeyAscii)), KeyAscii, 0)
End Sub
**************************************
gravando dados no banco sem usar o data1...
23/11/2006 09:32 Salvar Dados
é o seguinte vou te mostrar o mais facil que é o método DAO.
Para isso depois de criado seu projeto acesse o Menu Project/References e depois selecione Microsoft Dao 3.51 ou 3.6 tanto faz.
em Seguida abra o codigo de seu projeto e digite o seguinte na seção general que é a parte de cima da tela de codigo ,
Dim Banco as Database 'Cria uma variavel para acessar o Banco
dim Tb as Recordset 'Cria uma Variavel pra acessar a Tabela
' Depois dentro da sub Form_load é necessário abrir o banco e a tabela
Private sub Form_Load()
Set banco = opendatabase("c:\BancodeDados",false,false,";pwd=")
set Tb = Banco.openrecordset("Tabela")
End Sub
' Ate aqui Apenas abrimos o Banco e a tabela , se o banco possui senha coloque
'logo apos o ;pwd= ,senão não ponha nda
'Em seguida ponha no botão Gravar
Private sub CmdGravar_Click()
tb.Addnew
tb("Codigo") = TxtCodigo.text
tb("Nome")=txtnome.text
'... assim sucessivamente todos os campos
tb.update ' Grava os Dados
End Sub
******************************************
data escrita
text1.text = Format(Date, "Dddd" & "DD")
terça-feira, 21 de novembro de 2006
********************************************
algarismo romano no vb
Function ToRoman(X As Integer) As String
Dim sFinished As String
sFinished = String(Int(X / 1000), "M")
X = X - (Int(X / 1000) * 1000)
If X >= 900 Then
sFinished = sFinished & "CM"
ElseIf X >= 500 And X < 900 Then
sFinished = sFinished & "D" & String(Int((X - 500) / 100), "C")
ElseIf X >= 400 And X < 500 Then
sFinished = sFinished & "CD"
Else
sFinished = sFinished & String(Int(X / 100), "C")
End If
X = X - (Int(X / 100) * 100)
If X >= 90 Then
sFinished = sFinished & "XC"
ElseIf X >= 50 And X < 90 Then
sFinished = sFinished & "L" & String(Int((X - 50) / 10), "X")
ElseIf X >= 40 And X < 50 Then
sFinished = sFinished & "XL"
Else
sFinished = sFinished & String(Int(X / 10), "X")
End If
X = X - (Int(X / 10) * 10)
If X >= 9 Then
sFinished = sFinished & "IX"
ElseIf X >= 5 And X < 9 Then
sFinished = sFinished & "V" & String(Int((X - 5) / 1), "I")
ElseIf X >= 4 And X < 5 Then
sFinished = sFinished & "IV"
Else
sFinished = sFinished & String(Int(X / 1), "I")
End If
ToRoman = sFinished
End Function
**************************************
'coloque estes no objeto "timer"
'e modifique a propriedade interval = 1
'se quiser data e hora
text.text = now
'se quiser dia da semana
text.text = format(now,"ddd")
'dia mes e ano
text.text= format (now,"dd/mm/yy")
vlw
*************************************
instrução for
For i = [inicio] to [fim]
...
next
----------------------------------------
For i = 1 to 50
Print "Rotina Número " & i
next
semelhante ao loop
*************************************
botao sair
09/11/2006 18:30 If (MsgBox("Deseja sair?", vbExclamation + vbYesNo, "Sair") = vbYes) Then
End
End If
]****************************************
controlar porta paralela
aki tah o link pra vc fazer download da DLL Win95io.dll
f t p : // ftp. softcircuits.com/tools/win95io.zip
Declare Sub vbOut Lib "WIN95IO.DLL" (ByVal nPort As Integer, ByVal nData As Integer)
Declare Sub vbOutw Lib "WIN95IO.DLL" (ByVal nPort As Integer, ByVal nData As Integer)
Declare Function vbInp Lib "WIN95IO.DLL" (ByVal nPort As Integer) As Integer
Declare Function vbInpw Lib "WIN95IO.DLL" (ByVal nPort As Integer) As Integer
aki tah o link pra vc fazer download da DLL Win95io.dll
f t p : // ftp. softcircuits.com/tools/win95io.zip
Declare Sub vbOut Lib "WIN95IO.DLL" (ByVal nPort As Integer, ByVal nData As Integer)
Declare Sub vbOutw Lib "WIN95IO.DLL" (ByVal nPort As Integer, ByVal nData As Integer)
Declare Function vbInp Lib "WIN95IO.DLL" (ByVal nPort As Integer) As Integer
Declare Function vbInpw Lib "WIN95IO.DLL" (ByVal nPort As Integer) As Integer
**********************************************************
rotina de impressao matrixial
'1ª parte colar em (General) (Declarations)
Option Explicit
Private Type DOCINFO
pDocName As String
pOutputFile As String
pDatatype As String
End Type
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
ByVal pDefault As Long) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias _
"StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pDocInfo As DOCINFO) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal _
hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, _
pcWritten As Long) As Long
Dim lhPrinter As Long
'2º parte '********************************************************
'colar este ao comando de imprimir (botao)
Dim lReturn As Long
Dim lDoc As Long
Dim MyDocInfo As DOCINFO
lReturn = OpenPrinter(Printer.DeviceName, lhPrinter, 0)
If lReturn = 0 Then
MsgBox "Impressora não é Reconhecida."
Exit Sub
End If
MyDocInfo.pDocName = "teste"
MyDocInfo.pOutputFile = vbNullString
MyDocInfo.pDatatype = vbNullString
lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo)
Call StartPagePrinter(lhPrinter)
'imprime
Dim K As Integer
For K = 0 To List1.ListCount - 1
Dim lpcWritten As Long
Dim sWrittenData As String
' o espaço entre aspas indica margem esquerda do boleto
sWrittenData = " " & (List1.List(K)) & vbCrLf
lReturn = WritePrinter(lhPrinter, ByVal sWrittenData, _
Len(sWrittenData), lpcWritten)
Next
lReturn = EndPagePrinter(lhPrinter)
lReturn = EndDocPrinter(lhPrinter)
lReturn = ClosePrinter(lhPrinter)
******************************************************************
***********************************************
mover a picture com o mouse
Dim AntX As Single, AntY As Single
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button <> 1 Then Exit Sub
AntX = x
AntY = y
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button <> 1 Then Exit Sub
Picture1.Left = Picture1.Left + x - AntX
Picture1.Top = Picture1.Top + y - AntY
End Sub
*******************************************************
função busca modo seek
pesquisa de produto click
Data1.Recordset.Index = "produto"
Data1.Recordset.Seek "=", campo nome do produto
inStr(1,"esta é uma string", "uma")
no caso acima a busca pela string começa no primeiro caractere
em vermelho está a frase onde quer se pesquisar
e por ultimo o termo pesquisado
modo sql
String_sql = "SELECT campos FROM tabela WHERE nome LIKE '%paulo%'"
Neste exemplo ele vai procurar por (paulo) em qualquer lugar daquele campo. Não importa se é no começo, no fim, no meio. Claro que você pode modificar o coringa de lugar, por exemplo:
String_sql = "SELECT campos FROM tabela WHERE nome LIKE 'paulo%'"
Neste segundo caso, vai procurar por tudo que COMECE com paulo independente do que vier depois... E por aí vai!
*************************************
executar outros programas atraves do vb
instala se esse reurso shell
Executar o Bloco de Notas
uses ShellApi;
...
ShellExecute(Handle, 'open',
'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
executar outros programas
shell "c:\nome_do_arquivo.exe /opcao1 /opcao2"
abrir sites
ShellExecute(Handle, 'open',
'https://www.forumweb.com.br/foruns',nil,nil, SW_SHOWNORMAL);
Enviar email com assunto e corpo semi-preenchidos
var em_subject, em_body, em_mail : string;
begin
em_subject := 'Assunto';
em_body := 'Corpo da mensagem';
em_mail := 'mailto:teste@forumweb.com.br?subject=' +
em_subject + '&body=' + em_body;
ShellExecute(Handle,'open',
PChar(em_mail), nil, nil, SW_SHOWNORMAL);
end;
*************************
minimizar janelas
Me.WindowState = 0, 1, 2.
0 = Normal
1 = Minimized
2 = Maximized
*****************************
carregar a combo box com itens da tabela
No Módulo do Projeto:
Public Function CarregaCombo(CmbCarg As Variant, DtList As Data, FldCampo As String)
Dim TextAnt As String
Dim RemItem As Integer
TextAnt = CmbCarg.Text
RemItem = CmbCarg.ListCount
If RemItem > 0 Then
Do While RemItem > 0
CmbCarg.RemoveItem (0)
RemItem = RemItem - 1
Loop
End If
DtList.Refresh
DtList.Recordset.MoveFirst
Do While DtList.Recordset.EOF <> True
CmbCarg.AddItem DtList.Recordset(FldCampo)
DtList.Recordset.MoveNext
Loop
CmbCarg.Text = TextAnt
End Function
No Evento GotFocus do ComboBox:
CarregaCombo NomedoCombo, NomedoDataControl, "Nome do Campo"
***************************************
modificar flex grid
MshFlexGrid1.SetFocus
MshFlexGrid1.Row = 4 ' Sendo 4 o número da linha
*****************************************
casas decimais arredondando
Levamos em consideração que em Text1 exista o número: 5,668
Com esse comando:
Label1.Caption = Format(Text1, "##0.00")
em label1 vai aparecer isso: 5,67
Célio 31/10/2006 03:06 Se quiser deixar com 2 casas sem arredondar, faça assim:
text1.text = int(text1.text * 100) / 100
Desse jeito, 10,999 vai ficar 10,99 , sem arredondar prá 11,00
************************************************
calculo de tempo
'Coloque no General Declarations:
Dim Tinício as variant, Tfim as variant
'Antes de iniciar a rotina:
Tinício = Time
'Após o término da rotina
Tfim = Time
'Mostre o tempo total de duração:
Text1.text = "Duração : " & Format(Tfim - Tinício,"hh:mm:ss")
io,"hh:mm:ss")
***********************************************
CEP's Brasil[https://www.megaupload.com/?d=65JJZPBM]
*************************************
carregar imagem na picture
image1.Picture = LoadPicture("c:\...\imagem.jpg")
*****************************
se for isso só veinculando esse texto com um data
e a um banco de dados
data.databaseName = C:\...\bd1.mdb
modifique a propriedade do text para
text1.datasource ===>data1
text1.datafield ===> campoda tabela
espero q tenha ajd ou pelo menos te dado outra dica..
vlw *********
*****************************
lucas
vi a figura ... teu programa ta maneiro mas pode encrementar colocando uma flexgrid mostrando todos os produtos clicando neles diretamente com o mouse e arruma-la na ordem q quiser.... ´pe só uma ideia vlw,,
parece q vc marcou o pesquisa de produto ...bom
ha 2 maneiras de fazer essa pesquisa
1ª ...devidamente indexada chave primaria por nome do produto
pesquisa de produto click
Data1.RecordSource = "select* from produto order by nome = (campo do produto)"
Data1.Refresh
'obs se parar a esquerda do sinal de "= a tabela fica em ordem alfabetica..
2ª...com propriedade recordset-Type em 0-table
pesquisa de produto click
Data1.Recordset.Index = "produto"
Data1.Recordset.Seek "=", campo nome do produto
quanto a soma dos valores ...
crie um campo temporario de total
a cada adição de produtos a lista
some o preço do produto ao campo de total
ex.:
total.Text = (preço.Text) + (Total.Text)
a cada add o total vai aumentando
*********************************************
seleção randomica
na busca de dados num banco
função Rnd()
***************************************
para emitir sons vc pode tentar usar as apis :
midiOutOpen, midiOutShortMsg, midiOutClose
**************************************
mandar e-mail pelo vb
cristiano 08/11/2006 18:51 mapi
microsoft mapi controls, ou winsock 6.0 pode utilizar algum desses dois, os os outros componentes geralmente são pagos, esses ja vem com o vb
cristiano 08/11/2006 20:25
microsoft mapi
inclui os dois controles no mapi e adicionar tres text box
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Compose
MAPIMessages1.RecipAddress = txtdestinaratio.text
MAPIMessages1.MsgSubject = txtassunto.text
MAPIMessages1.MsgNoteText = txtcorpo.text 'mensagem que vai escrita no email
MAPIMessages1.Send
MAPISession1.SignOff
********************************
arrastar figura p dentro do vb6
Private Sub Form_Load()
Picture1.OLEDropMode = vbAutomatic
End Sub
Private Sub Picture1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Picture = LoadPicture(Data.Files(1))
End Sub
******************************************************
capiturando imagem da web cam
Abra o formulário e no início digite as seguintes linhas de código:
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Private Const WM_CAP_DRIVER_CONNECT As Long = 1034
Private Const WM_CAP_DRIVER_DISCONNECT As Long = 1035
Private Const WM_CAP_GRAB_FRAME As Long = 1084
Private Const WM_CAP_EDIT_COPY As Long = 1054
Private Const WM_CAP_DLG_VIDEOFORMAT As Long = 1065
Private Const WM_CAP_DLG_VIDEOSOURCE As Long = 1066
Private Const WM_CLOSE = &H10
Private mCapHwnd As Long
Vamos usar as funções :
capCreateCaptureWindow - DLL avicap32.dll - Inicia a webCam;
SendMessage - biblioteca User32 - envia mensagem para uma janela do Windows;
ReleaseCapture - biblioteca User32 - libera a conexão com a webCam;
Todo o trabalho é feita pelas APIs do Windows que capturam a imagem da webCam e salvam na área de transferência do Windows (ClipBoard). Ao final basta obter a imagem do ClipBoard e exibir no controle PictureBox.
O código do botão que inicia a webCam é o seguinte :
Private Sub cmdIniciaWebCam_Click()
'Inicia a câmera
mCapHwnd = capCreateCaptureWindow("captura Janela", 0, 0, 0, 320, 240, Me.hwnd, 0)
SendMessage mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0
End Sub
O código do evento Timer do controle Timer é dado a seguir. Inicialmente o controle não esta ativo pois sua propriedade Enabled esta com o valor padrão igual a False;
Private Sub Timer1_Timer()
'Exibe imagem continua no pictubox
Clipboard.Clear
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
DoEvents
End Sub
Para ativar o vídeo contínuo capturando toda a operação realizada pela WebCam usamos o código abaixo do botão : Ativar Vídeo Contínuo;
Private Sub cmdAtivaVideoContinuo_Click()
Timer1.Enabled = True
Timer1.Interval = 50
End Sub
Para capturar a imagem da webCam e exibir no controle PictureBox usamos o seguinte código:
Private Sub cmdCapturaImagem_Click()
'Captura a imagem atual
Clipboard.Clear
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub
A seguir temos o código do botão que encerra a conexão com a webCam e o código que encerra a aplicação. Repetimos o código no evento Form_Terminate pois se o usuário encerrar o formulário a webCam também será desconectada:
Private Sub cmdEncerraWebCam_Click()
'Desliga a câmera
SendMessage mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
End Sub
Private Sub cmdSair_Click()
End
End Sub
Private Sub Form_Terminate()
'Desliga a câmera
SendMessage mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
End Sub
*************************************************************************
Dicas do GODOT
******************************************************
gravar pontuação num arquivo
# na declaração
var nome = ""
const ARQUIVO = "res://banco.tres" # cria o arquivo tres para banco de dados
# na hora de salvar
nome = text
var arquivo = File.new()
arquivo.open(ARQUIVO,File.WRITE)
var dados = {"nome" : nome}
arquivo.store_var(dados)
arquivo.close()
print("salvou com sucesso!!! ")
# na hora de carregar
var arquivo = File.new()
arquivo.open(ARQUIVO,File.READ)
var dados_salvos = arquivo.get_var()
arquivo.close()
text = dados_salvos["nome"]
print("carregou com sucesso!")
#outro metodo mas so funciona ao reiniciar
func _on_salvar2_pressed():
var save_file = SaveFile.new()
save_file.name = text
ResourceSaver.save("res://dados.tres",save_file) #salva e cria o arquivo dados .tres
func _on_carregar2_pressed():
var save_file = SaveFile.new()
var save = preload("res://dados.tres")
text = save.name
print("carregou")
********************************************************************
conversao de godot 2 para godot 3
get_node ===> $
get_pos =====> position
*********************************************************
botao de sair
func _on_sair_pressed():
get_tree().quit()
********************************************************************
botao de reiniciar
func _on_reinicio_button_pressed():# quando apertar reiniciar
get_tree().set_pause(false)# despausa
yield(get_tree(), "idle_frame")# aguarda o frame carregar
get_tree().reload_current_scene()# reinicia o jogo
******************************************************************************************
mover sozinho
func _process(delta):
position.y = position.y -10# velocidade do tiro
ou
func _process(delta):
var vel = 200
var move = Vector2()
move.y = vel
move.y = -vel
move.x = vel
move.x = -vel
position += move * delta
**************************************************************************************
limitar movimento
if get_pos().x> 620:# limita a direita
if get_pos().x< 10:# limita a esquerda
if get_pos().y> 460:# limita a baixo
if get_pos().y< 30:# limita a cima
***************************************************************************************************
tocar som
get_node("SamplePlayer2D").play("tiro") # som de tiro
rodar animação
get_node("AnimationPlayer").play("explode")
******************************************************************************
apagar objeto
queue_free() # apaga objeto e libera memoria
*****************************************************************************
modo aleatorio
interval = rand_range(10,20)# tempo aleatorio entre 10 e 20 segundos
power.set_pos(Vector2(rand_range(10,600),-10)) #define posição x = aleatoria entre 10 a 600 e y = -10
***************************************************************************************************************
playter 1 movimento
extends KinematicBody2D
var movimento = Vector2()
const UP = Vector2(0,-1)#indica onde começa o chao
const GRAVITY = 20
const SPEED = 300
const JUNP_HEIGHT = -550
func _physics_process(delta):
movimento.y += GRAVITY # simula gravidade
if Input.is_action_pressed("ui_right"):# usa o botao ja criado pela godot
movimento.x = SPEED# move p direita
$Sprite.play("correndo") # imagem correndo
$Sprite.flip_h = false# nao inverte a imagem
elif Input.is_action_pressed("ui_left"):
movimento.x = -SPEED# move p esquerda
$Sprite.play("correndo")
$Sprite.flip_h = true# inverte a imagem
else:
movimento.x = 0
$Sprite.play("parado")
if is_on_floor():# simula esta no chao
if Input.is_action_pressed("ui_up"):
movimento.y = JUNP_HEIGHT
else:# se nao estiver no chao
$Sprite.play("pulo") # roda animação pulo
movimento = move_and_slide(movimento, UP) # nao cai sobre o chao renicia a cada movimentp
*********************************************************************************************************************
movimento dos inimigos
extends Node2D
var speed = 200
var pos_inicial
var pos_final
func _ready():
set_process(true)
pos_inicial = true
pos_final = false
func _process(delta):
var move = Vector2()
if $".".position.x <= 700 && pos_inicial == true:
move.x = speed
if $".".position.x >= 700:
pos_inicial = false
pos_final = true
if $".".position.x >= 10 && pos_final == true:
move.x = -speed
if $".".position.x <= 10:
pos_inicial = true
pos_final = false
position += move * delta
*******************************************************
criar timer em tempo real
func _ready():
set_process(true)
var timer = Timer.new()# cria timer em tempo real
timer.set_wait_time(1)# tempo de espera
timer.start()# inicia
timer.connect("timeout",self,"executa_timer")# se conecta a função onde vai atuar
add_child(timer)# adiciona como nó filho
func executa_timer():
# função a ser executada
pass
*********************************************************************
kinematic Body segue o mouse
var target = Vector2()
var velocity = Vector2()
func _input(event):
#if event.is_action_pressed('click'):
target = get_global_mouse_position()
func _physics_process(delta):#segue o mouse
velocity = (target - position).normalized() * speed
if (target - position).length() > 10:
velocity = move_and_slide(velocity)
******************************************************************
função atirar
var Bullet = preload("res://scens/Bullet.tscn")
func process(delta):
shoot()
func shoot():
var b = Bullet.instance()
b.position = ($Muzzle.global_position)
get_parent().add_child(b)
***************************************************************
instanciar os tiros
var intervalo = .3# cadencia de tiros
var ultimo_tiro = 0
func process(delta):
if ultimo_tiro<= 0:# para nao ficar direto
ultimo_tiro = intervalo # cria uma cadencia de tiros
if ultimo_tiro > 0:
ultimo_tiro -= delta
shoot()
func shoot():
if ultimo_tiro<= 0:
var b = Bullet.instance()
tiro.position = ($position2D.global_position)
get_parent().add_child(tiro)
ultimo_tiro = intervalo
++++++****************************************************************
******************************************************
gravar pontuação num arquivo
# na declaração
var nome = ""
const ARQUIVO = "res://banco.tres" # cria o arquivo tres para banco de dados
# na hora de salvar
nome = text
var arquivo = File.new()
arquivo.open(ARQUIVO,File.WRITE)
var dados = {"nome" : nome}
arquivo.store_var(dados)
arquivo.close()
print("salvou com sucesso!!! ")
# na hora de carregar
var arquivo = File.new()
arquivo.open(ARQUIVO,File.READ)
var dados_salvos = arquivo.get_var()
arquivo.close()
text = dados_salvos["nome"]
print("carregou com sucesso!")
#outro metodo mas so funciona ao reiniciar
func _on_salvar2_pressed():
var save_file = SaveFile.new()
save_file.name = text
ResourceSaver.save("res://dados.tres",save_file) #salva e cria o arquivo dados .tres
func _on_carregar2_pressed():
var save_file = SaveFile.new()
var save = preload("res://dados.tres")
text = save.name
print("carregou")
********************************************************************
conversao de godot 2 para godot 3
get_node ===> $
get_pos =====> position
*********************************************************
botao de sair
func _on_sair_pressed():
get_tree().quit()
********************************************************************
botao de reiniciar
func _on_reinicio_button_pressed():# quando apertar reiniciar
get_tree().set_pause(false)# despausa
yield(get_tree(), "idle_frame")# aguarda o frame carregar
get_tree().reload_current_scene()# reinicia o jogo
******************************************************************************************
mover sozinho
func _process(delta):
position.y = position.y -10# velocidade do tiro
ou
func _process(delta):
var vel = 200
var move = Vector2()
move.y = vel
move.y = -vel
move.x = vel
move.x = -vel
position += move * delta
**************************************************************************************
limitar movimento
if get_pos().x> 620:# limita a direita
if get_pos().x< 10:# limita a esquerda
if get_pos().y> 460:# limita a baixo
if get_pos().y< 30:# limita a cima
***************************************************************************************************
tocar som
get_node("SamplePlayer2D").play("tiro") # som de tiro
rodar animação
get_node("AnimationPlayer").play("explode")
******************************************************************************
apagar objeto
queue_free() # apaga objeto e libera memoria
*****************************************************************************
modo aleatorio
interval = rand_range(10,20)# tempo aleatorio entre 10 e 20 segundos
power.set_pos(Vector2(rand_range(10,600),-10)) #define posição x = aleatoria entre 10 a 600 e y = -10
***************************************************************************************************************
playter 1 movimento
extends KinematicBody2D
var movimento = Vector2()
const UP = Vector2(0,-1)#indica onde começa o chao
const GRAVITY = 20
const SPEED = 300
const JUNP_HEIGHT = -550
func _physics_process(delta):
movimento.y += GRAVITY # simula gravidade
if Input.is_action_pressed("ui_right"):# usa o botao ja criado pela godot
movimento.x = SPEED# move p direita
$Sprite.play("correndo") # imagem correndo
$Sprite.flip_h = false# nao inverte a imagem
elif Input.is_action_pressed("ui_left"):
movimento.x = -SPEED# move p esquerda
$Sprite.play("correndo")
$Sprite.flip_h = true# inverte a imagem
else:
movimento.x = 0
$Sprite.play("parado")
if is_on_floor():# simula esta no chao
if Input.is_action_pressed("ui_up"):
movimento.y = JUNP_HEIGHT
else:# se nao estiver no chao
$Sprite.play("pulo") # roda animação pulo
movimento = move_and_slide(movimento, UP) # nao cai sobre o chao renicia a cada movimentp
*********************************************************************************************************************
movimento dos inimigos
extends Node2D
var speed = 200
var pos_inicial
var pos_final
func _ready():
set_process(true)
pos_inicial = true
pos_final = false
func _process(delta):
var move = Vector2()
if $".".position.x <= 700 && pos_inicial == true:
move.x = speed
if $".".position.x >= 700:
pos_inicial = false
pos_final = true
if $".".position.x >= 10 && pos_final == true:
move.x = -speed
if $".".position.x <= 10:
pos_inicial = true
pos_final = false
position += move * delta
*******************************************************
criar timer em tempo real
func _ready():
set_process(true)
var timer = Timer.new()# cria timer em tempo real
timer.set_wait_time(1)# tempo de espera
timer.start()# inicia
timer.connect("timeout",self,"executa_timer")# se conecta a função onde vai atuar
add_child(timer)# adiciona como nó filho
func executa_timer():
# função a ser executada
pass
*********************************************************************
kinematic Body segue o mouse
var target = Vector2()
var velocity = Vector2()
func _input(event):
#if event.is_action_pressed('click'):
target = get_global_mouse_position()
func _physics_process(delta):#segue o mouse
velocity = (target - position).normalized() * speed
if (target - position).length() > 10:
velocity = move_and_slide(velocity)
******************************************************************
função atirar
var Bullet = preload("res://scens/Bullet.tscn")
func process(delta):
shoot()
func shoot():
var b = Bullet.instance()
b.position = ($Muzzle.global_position)
get_parent().add_child(b)
***************************************************************
instanciar os tiros
var intervalo = .3# cadencia de tiros
var ultimo_tiro = 0
func process(delta):
if ultimo_tiro<= 0:# para nao ficar direto
ultimo_tiro = intervalo # cria uma cadencia de tiros
if ultimo_tiro > 0:
ultimo_tiro -= delta
shoot()
func shoot():
if ultimo_tiro<= 0:
var b = Bullet.instance()
tiro.position = ($position2D.global_position)
get_parent().add_child(tiro)
ultimo_tiro = intervalo
++++++****************************************************************