Страницы: 1
RSS
VBA. Плавное перемещение картинки на UserForm, Нужен цикл на плавное перемещение картинки за 3 секунды
 
Скрытый текст
Пробовал через Application.Wait - задержка. Работает не корректно.
Нашел похожее в просторах инета, но тут Loop на постоянную и по всей userform картинка передвигается. Переписать двигать из пункта А в пункт В мозгов не хватило:
Код
Private Sub CommandButton1_Click()
End
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Do
Label1 = Format(Date, "dddd, dd mmm yyyy")
Label2 = Format(Time, "hh:mm:ss AM/PM")
Label3.Left = Label3.Left - 2
If Label3.Left <= 0 - Label3.Width Then Label3.Left = Me.Width
For i = 1 To 8000000
Next
DoEvents
Loop
End Sub
Изменено: Sanja - 10.07.2024 15:32:41 (Изменил название темы)
 
Тут лучше конечно иметь файл-пример, для тестирования.
Согласие есть продукт при полном непротивлении сторон
 
Кнопка CommandButton4 двигает картинку
 
Так пункт А и пункт Б - это что/где на форме? Откуда и куда Вы хотите изображение двигать? Обозначьте какие-то объекты-якоря например, а тогда уже и о перемещении между пунктами говорить можно будет.
Что касается Вашего кода - добавьте в цикл DoEvents, и на форме картинка будет визуально перемещаться.
Изменено: VladZ - 10.07.2024 19:14:49
 
Пункт А объекта Image2.Left =-204, Пункт В объекта Image2.Left =12
 
Ну тогда DoEvents Вам будет достаточно. Для плавности можно еще небольшой цикл-задержку туда же вставить.
Изменено: VladZ - 11.07.2024 09:25:18
 
Попробовал такое, но картинка при движении все равно дергается (меняет цвет):
Код
Image5.Left = -204
For i = -204 To 12
DoEvents
i = i + 0.00000005
DoEvents
Image5.Left = i
DoEvents
Application.Wait Now + ((TimeValue("00:00:01") / 1000) * 200)
DoEvents
 
Мигания полностью никак не избежать - так криво сделана перерисовка картинки в Excel
Ради интереса потратил полчаса, что только не пробовал, мерцание полностью не убирается (и картинку менял, и все её свойства)
Иногда (с другой картинкой) помогает незначительное изменение высоты картинки, например, с 558 до 550 px

Код замените на такой:

Код
Private Sub CommandButton4_Click()
    Image2.Left = -204
    For i = -204 To 12 Step 3
        Image2.Left = i
        For j = 1 To 4000: DoEvents: Next
    Next
End Sub
 
Цитата
написал:
  Image2.Left = -204
   For i = -204 To 12 Step 3
       Image2.Left = i
       For j = 1 To 4000: DoEvents: Next
   Next
Спасибо, Игорь! Этот вариант лучше, чем с задержкой времени. Скорее всего от объема картинки много зависит. Попробую уменьшить качество.
 
Ещё помню на форме помогает Me.Repaint или репайнт конкретного фрейма
Цитата
Remarks
The Repaint method is useful if the contents or appearance of an object changes significantly, and you don't want to wait until the system automatically repaints the area.
Изменено: Hugo - 11.07.2024 16:18:11
 
я пробовал и Repaint (но он тут не в тему, - тут все перерисовывается и без того)
тут задача, скорее, отключать repaint этот (а такой возможности нет)
Можно ещё попробовать картинку другого формата (типа BMP под нужный размер), чтобы перерисовка выполнялась быстрее.

Пока писал ответ, придумал решение (Hugo подсказал словом фрейм) — стал пробовать вместо Image другие контролы (картинку-то вставить можно во что угодно, в Label например)
И внезапно решение нашлось — вместо элемента Image используем Frame (отключив рамку и очистив Caption, с виду всё будет как у контрола Image)
У Frame перерисовка не глючит, картинка плавно выплывает

Код будет такой: (поменять Image2 на Frame1, и тайминги с шагом)
Код
Private Sub CommandButton4_Click()
    Frame1.Left = -204
    For i = -204 To 200 Step 2
        Frame1.Left = i
        For j = 1 To 1000: DoEvents: Next
    Next
End Sub
Страницы: 1
Наверх