LABEL SEGUIR TRAJETORIA DE UMA LINHA

MARCOSCAMPOS 05/12/2013 18:49:57
#431825
boa noite pessoal!

será que é possivel durante a execuçao eu criar ou chamar uma linha ( line ) e fazer com que um label durante seu movimento siga a trajetoria desta linha do começo ao fim?
ja vi isto no Flash, mais no VB6 ainda nao consegui achar um meio.
FILMAN 06/12/2013 00:48:06
#431837
Não entendi muito bem!

Você quer fazer tipo um progressbar?

Ou o label será uma legenda do line?
MARCELO.TREZE 06/12/2013 09:45:25
#431846
filman o que eu entendi é que ele quer colocar um line no form, seja ele a posição que for, e movimentar o label, pelas propriedades top e left, seguindo este Line do começo ao fim.

Eu sei que tem como fazer isso, que é através de seno e cosseno, onde se colocaria a posição (x,y) inicial e (x,y) final, como se faz no line, mas não tenho a formula pra isso, rs, confesso que to curioso, caso alguém saiba a resposta.



GANDA.NICK 06/12/2013 18:18:22
#431880
fiz aqui um code que permite mover a label em um determinado grau, não sei se será a melhor maneira para fazer o que pretende se é o que o Marcelo disse que queria fazer..

coloque um timer e uma label no form:
Option Explicit

Const PI As Double = 3.14159265359

Private Function GetRadianos(ByVal Graus As Double) As Double
    GetRadianos = Graus / (180 / PI)
End Function

Private Sub Form_Load()
    Me.ScaleMode = vbPixels
    Me.ScaleWidth = 500
    Me.ScaleHeight = 500
    Me.Label1.Move Me.ScaleWidth / 2, Me.ScaleHeight / 2
    Me.Timer1.Interval = 15
End Sub

Private Sub Timer1_Timer()

    Dim Graus As Double: Graus = 45
    Dim Deslocamento As Double: Deslocamento = 3

    Me.Label1.Left = Me.Label1.Left + Cos(GetRadianos(Graus)) * Deslocamento
    Me.Label1.Top = Me.Label1.Top + Sin(GetRadianos(Graus)) * -Deslocamento [ô] o menos deslocamento é para ir para cima porque o ponto 0,0 é no canto superior esquerdo

End Sub



Agora falta-lhe achar o grau de inclinação da linha...
podes usar o de teorema de pitágoras para saber qual o tamanho da hipotenusa (que é a linha)
o cateto adjacente e o cateto oposto será a diferença entre o X1 e X2 e entre o Y1 e Y2

depois para achar o angulo usas o arco cosseno ou o arco seno:

arco seno:
o valor é o racio do cateto oposto pela hipotenusa
dRes = Atn(dValor / Sqr(-dValor * dValor + 1))


arco cosseno:
o valor é o racio do cateto adjacente pela hipotenusa
dRes = Atn(-dValor / Sqr(-dValor * dValor + 1)) + 2 * Atn(1)


como disse, não sei se será o melhor jeito de fazer isso...
GANDA.NICK 07/12/2013 17:57:08
#431897
é mais simples usar o arco tangente para achar o angulo...

tem uma sub para dar uma pausa...

pelo que testei parece-me estar ok

coloque uma label um line e o um botao
Option Explicit

Const PI As Double = 3.14159265359

Private Declare Function GetTickCount Lib [Ô]kernel32[Ô] () As Long
Dim lngTickStore As Long

Private Sub SlowDown(Delay)
    lngTickStore = GetTickCount()
    Do While lngTickStore + Delay > GetTickCount()
        DoEvents
    Loop
End Sub

Private Sub Command1_Click()
    Call MoverObj(Me.Label1, Me.Line1.X1, Me.Line1.X2, Me.Line1.Y1, Me.Line1.Y2)
End Sub

Private Sub Form_Load()
    Me.ScaleMode = vbPixels
End Sub

Private Sub MoverObj(ByVal obj As Object, ByVal X1 As Long, ByVal X2 As Long, ByVal Y1 As Long, ByVal Y2 As Long, Optional deslocamento As Double = 5)
    Dim ArcoTan As Double: ArcoTan = Round(Atn((Y2 - Y1) / (X2 - X1)), 3)
    Dim hipotenusa As Double: hipotenusa = Sqr(((Y2 - Y1) ^ 2) + ((X2 - X1) ^ 2))
    
    [ô]MsgBox ArcoTan & [Ô] # [Ô] & hipotenusa
    
    obj.Left = X1
    obj.Top = Y1
    
    If X1 > X2 Then deslocamento = -deslocamento
    
    Dim i As Long
    For i = 1 To hipotenusa / Abs(deslocamento)
        Call SlowDown(30)
        obj.Left = obj.Left + Cos(ArcoTan) * deslocamento
        obj.Top = obj.Top + Sin(ArcoTan) * deslocamento
    Next

End Sub
MARCELO.TREZE 09/12/2013 10:18:22
#431917
Ganda arrebentou, meu você foi o cara, ótimo código envolvendo álgebra, é sério colega to impressionado com a simplicidade do código e a sua funcionalidade.

E eu achei que sabia alguma coisa, sou peixinho perto destes tubarões, rss



.
SINCLAIR 09/12/2013 12:09:21
#431922
Ganda deu de 10!
Faça seu login para responder
Voltar