[Resolvido]Pausa em Gif através de VBA

é possível isso?

Vi alguns soft em VB utilizando esta função.. mas não encontrei código em aberto na net sobre isso


Se puderem elucidar.. fico grato...

Desconheço, o que não significa que não seja possível. Se já tentas-te na net e nada, então é mau sinal....

Não estudei tal artifício ainda, mas talvez seja possível ler os quadros do gif e então colocar um desses quadros estático.

Tem alguns ocx na net que fazem isto.. mas não são livres.. e como sabe amigo vieira.. encontro algumas dificuldades para adiquiri-los.. não por falta de din din... tu o sabes...

Bem..
o que pretendo em realidade é representar através de um gig da lua que tenho comigo.. as suas fases de acordo com um código que tenho que mostra o percentual de iluminação da mesma...


Grato por enquanto

Bastante interessante o exemplo Amigo Jungli... eu estava aplicando codigo semelhante no timer...

agora...

1 - como adaptá-lo para que no fim do registro ele sempre volte novamante ao primeiro e assim sucessivamente em um loop constante
4 - Como criar uma variável ou algo semelhante no meio do código para que ao clique do botão ele pare em um dos registros
3 - e se é possivel em outro botão direcionar a imagem para um registro específico..

Razões:

Estou utilizando imagens do movimento da lua (1 a 50)
e em determinado código tenho o percentual diário de iluminação da lua (Assim se determina suas fases)

Na tabela tenho a divisão do percentual total pela quantidade de registros...
Então supondo que hoje o percentual seja 50% de iluminação...
Os registros que tem esse percentual seja de numero 20 a 25..

preciso que em outro código ao abri cheque quais registros tenham este percentual de 50% e abra a imagem com este caminho..


Espero ter conseguido explicar..

Grato

Você pode atrelar isso à fase da lua, por exemplo. Se for cheia, vai de 1 a 50. Se for uma fase de 50 por cento, vai de 1 a 25 ou de 25 a 50. No código que eu passei ontem, por exemplo, bastaria trocar os números mínimo e/ou máximo.

Entendi amigão...
Criquio.. o exemplo do Jungli está quase perto do que quero.. nele tem uma funçao... ExitLoop que a principio atende a um dos objetivos pretendido...

So preciso que o código me remeta a um loop Constante...

Se puder me ajudar fico grato

Mas não é isso que o código que eu passei ontem no outro tópico faz? Naquele código tem uma instrução que diz para mudar a imagem até chegar no MaxCode. Pois bem, para mudar a imagem de início e de fim conforme me pareceu que você quer, uma forma seria colocar uma coluna na tabela para indicar à qual fase da lua a imagem se refere e então passar isso como parâmetro na instrução.

Eu entendo amigão e sua solução é perfeita... mas no caso que estou pretendendo creio que talvez esta outra me sirva mais ao que pretendo...

So preciso de pequenas alterações.. se puder me ajudar..

AMigos.. ajudem-me a corrigir este código.. no loop não está adicionado +1


Do Until inti > n_Reg Or fExitLoop
'If Me.txtI Mod 1 = 0 Then
DoEvents
'End If
inti = inti + 1
'......................
pi_Gifo = Application.CurrentProject.Path & "\jpg\" & Left(inti, 1) & ".jpg"
Me.ctlImgLua.Picture = pi_Gifo
MsgBox pi_Gifo
'...............................

'frm.lb_MsgAguarde.Caption = "Por favor, aguarde: processando... " & inti & " cidade(s) registrada(s)"
Loop


Grato

A questão está nesta linha

Do Until inti > n_Reg Or fExitLoop

pois o n_reg checa registros em uma tabela, no meu caso não tenho isto..

Como fazer para retirá-lo deixando apenas a fExitLoop?

O que fExitLoop faz?

Pausa o loop ao pressionar o botão do mouse

On Error GoTo Proc_Err

Dim inti As Integer
Dim pi_Gifo

frm.lblEscape.Visible = True
frm.lblAbort.Visible = False

Screen.MousePointer = 11

frm.lb_MsgAguarde.Caption = "Por favor, aguarde: processando..." & _
inti & " cidade(s) registrada(s)"

fInLoop = True
fExitLoop = False

Do Until inti > n_Reg Or fExitLoop
'If Me.txtI Mod 1 = 0 Then
DoEvents
'End If
inti = inti + 1
'......................
pi_Gifo = Application.CurrentProject.Path & "\Imagens\gjr" & Right(inti, 1) & ".gjr"
Me.pi_gif.Picture = pi_Gifo
'...............................
frm.lb_MsgAguarde.Caption = "Por favor, aguarde: processando... " & inti & " cidade(s) registrada(s)"
Loop

fInLoop = False
frm.lblEscape.Visible = False
Screen.MousePointer = 0
frm.lb_MsgAguarde.Caption = "Concluído em: " & inti & " cidade(s) registrada(s)"
vFrmProgresso.Show
DoCmd.Close acForm, "frmProgresso2"
Proc_Exit:
Exit Function

Proc_Err:
Select Case Err.Number
Case Else
Select Case ErrorDisplay(Err.Number, Error$, mcStrModule, "Barra", Erl())
Case errContinue
Resume Next
Case errexit
Resume Proc_Exit
End Select
End Select
End Function

Criquio consegui assim... mas preciso que ao chega no 50 volte ao 1

do jeito que esta ele continua... 51...

Do ' '> fExitLoop
'If Me.txtI Mod 1 = 0 Then
DoEvents
'End If
inti = inti + 1
MsgBox inti
'......................
pi_Gifo = Application.CurrentProject.Path & "\jpg\" & inti & ".jpg"
Me.ctlImgLua.Picture = pi_Gifo
'MsgBox pi_Gifo
'...............................

' CurrentProject.Path & "\jpg\01.jpg"
'frm.lb_MsgAguarde.Caption = "Por favor, aguarde: processando... " & inti & " cidade(s) registrada(s)"
Loop

Tente colocar como passei ontem:

If < 50 Then
Var = Var + 1
Else
Var = 1
End if

Amigo Criquio.. Consegui assim.. so preciso de uma coisa...
No seu código no timer ele diminuia a velocidade de navegação pelos registros da tabela..

no entanto este apenas atrasa o inicio do código.. mas depois de iniciado a não tenho como controlar a velocidade
se aumento o timer apenas atraza começo do loop.. como fazer neste caso?


Private Sub Form_Timer()
' Description:
' 01/25/02 S Cleaned with Total Visual CodeTools 2000
' 20/11/2010 GLICÉRIO JÚNIOR (Jungli)_jungli@ibest.com.br
' 20/07/2011 HARYSOHN PINA (Piloto) Harysohn@hotmail.com
'--------------------------------------------------------

On Error GoTo TrataErro
Dim frm As Form
Dim inti As Integer
Dim pi_Gifo

fInLoop = True
fExitLoop = False

Do Until inti = 50 Or fExitLoop
DoEvents

inti = inti + 1
'..............................
pi_Gifo = Application.CurrentProject.Path & "\jpg\" & inti & ".jpg"
Me.ctlImgLua.Picture = pi_Gifo
'...............................

Me.lb_MsgAguarde.Caption = "Por favor, aguarde: processando... " & inti & " Imagens(s) registrada(s)"
Loop

fInLoop = False
frm.lblEscape.Visible = False
frm.lb_MsgAguarde.Caption = "Concluído em: " & inti & " Imagens(s) registrada(s)"

TrataErro:
If err.Number = 2220 Then
MsgBox "XXXXX"
Else
Resume Next
End If

Criquio.. depois de dar voltas,, conclui que o código do Amigo glicério é muito bom.. mas no meu caso, voltarei a utilizar o que me havia passado... pois ele da certo quanto ao horario no timer...

Bem estarei trabalhando aqui.. e nova duvida sobre isso posto aqui... tentarei fazer agora a visualização quanto a porcentagem de iluminaçào

Grato

Boa tarde,

Harysohn, separa essa parte do banco de dados e posta aqui pra gente dar uma olhada,
pode ser que vendo aparaça uma solução.

Caro jungli.. vou terminar o que pretento e posto com os dois códigos..

mas adiantando.. os dois códigos estão rotacionando as imagens, porem o do críquio se altero o intervalo de tempo.. ele percorre as imagens ou lento ou rápido de acordo com o timer

Ja no do Jungli.. a alteração no intervalo do timer apenas atrasa o inicio do loop, mas quando incia a velocidade é uma só, não importando qual o intervalo aplicado


>>>>> Solução Criquio (usamos numa tabela para percorrer ida e volta os 50 registros)
>>>>> o Botão abaixo dá o start no timer

Private Sub btnPlay_Click()
If Me.btnPlay.Caption = "PLAY" Then
Me.btnPlay.Caption = ">>>>"
Me.btnPlay.ForeColor = vbRed
Me.TimerInterval = 250
'Barra Me
Exit Sub
End If
If Me.btnPlay.Caption = ">>>>" Then
Me.btnPlay.Caption = "PLAY"
Me.btnPlay.ForeColor = vbBlack
Me.TimerInterval = 0
End If
End Sub


Private Sub Form_Timer()
If NumImagem < DMax("IDGiF", "tblGIF") Then
NumImagem = NumImagem + 1
Else
NumImagem = 1
End If
Me.ctlImgLua.Picture = DLookup("CaminhoGif", "tblGIF", "IDGif=" & NumImagem)
End Sub



>>>>> Solução Jungli (usamos os arquivos contidos numa pasta no BD para percorrer ida e volta os 50 registros)
>>>>> o Botão abaixo dá o start no timer

Private Sub btnPlay_Click()
If Me.btnPlay.Caption = "PLAY" Then
Me.btnPlay.Caption = ">>>>"
Me.btnPlay.ForeColor = vbRed
Me.TimerInterval = 250
'Barra Me
Exit Sub
End If
If Me.btnPlay.Caption = ">>>>" Then
Me.btnPlay.Caption = "PLAY"
Me.btnPlay.ForeColor = vbBlack
Me.TimerInterval = 0
End If
End Sub


Private Sub Form_Timer()
' Description:
' 01/25/02 S Cleaned with Total Visual CodeTools 2000
' 20/11/2010 GLICÉRIO JÚNIOR (Jungli)_jungli@ibest.com.br
' 20/07/2011 HARYSOHN PINA (Piloto) Harysohn@hotmail.com
'--------------------------------------------------------

On Error GoTo TrataErro
Dim frm As Form
Dim inti As Integer
Dim pi_Gifo

'fInLoop = True
'fExitLoop = False

Do Until inti = 50 Or fExitLoop
DoEvents

inti = inti + 1
'..............................
pi_Gifo = Application.CurrentProject.Path & "\jpg\" & inti & ".jpg"
Me.ctlImgLua.Picture = pi_Gifo
'...............................

Me.lb_MsgAguarde.Caption = "Por favor, aguarde: processando... " & inti & " Imagens(s) registrada(s)"
Loop

fInLoop = False
frm.lblEscape.Visible = False
frm.lb_MsgAguarde.Caption = "Concluído em: " & inti & " Imagens(s) registrada(s)"

TrataErro:
If err.Number = 2220 Then
MsgBox "XXXXX"
Else
Resume Next
End If

End Sub

Amigos.. alguma novidade por aqui?

Grato

Resolvido da seguinte maneira...



Function OpenFormGiLua(frm As Form)
On Error GoTo TrataErro
Dim inti As Integer
Dim pi_Gifo


fInLoop = True
fExitLoop = False

Do Until inti > 30 Or fExitLoop

DoEvents

inti = inti + 1
'..............................
pi_Gifo = Application.CurrentProject.Path & "\jpg\" & inti & ".jpg"
Me.ctlImgLua.Picture = pi_Gifo
'...............................
Me.lb_MsgAguarde.Caption = "" & inti & " Imagens(s) registrada(s)"
Me.lblNumImg.Caption = "" & inti & ""
Loop

Depois do último loop seto o timer interval para 0
fInLoop = False
Me.TimerInterval = 0

TrataErro:
If err.Number = 2220 Then
MsgBox "XXXXX"
Else
Resume Next
End If
End Function


Grato amigos