Мигающий Image при перемещении и смене картнки - VB

Узнай цену своей работы

Формулировка задачи:

При перемещении картинки стрелками возникает "мигание" картинки. PictueBox - не вариант, нужно сохранить прозрачность.
Листинг программы
  1. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  2. If KeyCode = 37 Then
  3. Char.Left = Char.Left - 100
  4. Char.Picture = LoadPicture(App.Path & "\l.gif")
  5. End If
  6. If KeyCode = 39 Then
  7. Char.Left = Char.Left + 100
  8. Char.Picture = LoadPicture(App.Path & "\r.gif")
  9. End If
  10. If KeyCode = 40 Then
  11. Char.Top = Char.Top + 100
  12. Char.Picture = LoadPicture(App.Path & "\d.gif")
  13. End If
  14. If KeyCode = 38 Then
  15. Char.Top = Char.Top - 100
  16. Char.Picture = LoadPicture(App.Path & "\u.gif")
  17. End If
  18. End Sub
Пример прилагается.

Решение задачи: «Мигающий Image при перемещении и смене картнки»

textual
Листинг программы
  1. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  2. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  3. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  4. Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Long
  5.  
  6. Dim picL As StdPicture, picR As StdPicture, picU As StdPicture, picD As StdPicture, Dc As Long, x As Long, y As Long
  7.  
  8. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  9.     Select Case KeyCode
  10.     Case vbKeyLeft
  11.         x = x - 4
  12.         DrawTransparent picL
  13.         Me.Refresh
  14.     Case vbKeyRight
  15.         x = x + 4
  16.         DrawTransparent picR
  17.         Me.Refresh
  18.     Case vbKeyUp
  19.         y = y - 4
  20.         DrawTransparent picU
  21.         Me.Refresh
  22.     Case vbKeyDown
  23.         y = y + 4
  24.         DrawTransparent picD
  25.         Me.Refresh
  26.     End Select
  27. End Sub
  28.  
  29. Private Sub DrawTransparent(pic As StdPicture)
  30.     Dim oBmp As Long, w As Long, h As Long
  31.    
  32.     w = ScaleX(pic.Width, vbHimetric, vbPixels)
  33.     h = ScaleY(pic.Height, vbHimetric, vbPixels)
  34.    
  35.     oBmp = SelectObject(Dc, pic.Handle)
  36.     Me.Cls
  37.     TransparentBlt Me.hdc, x, y, w, h, Dc, 0, 0, w, h, vbMagenta
  38.     SelectObject Dc, oBmp
  39. End Sub
  40. Private Sub Form_Load()
  41.     Set picL = LoadPicture(App.Path & "\l.bmp")
  42.     Set picR = LoadPicture(App.Path & "\r.bmp")
  43.     Set picU = LoadPicture(App.Path & "\u.bmp")
  44.     Set picD = LoadPicture(App.Path & "\d.bmp")
  45.     Dc = CreateCompatibleDC(Me.hdc)
  46. End Sub
  47.  
  48. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  49.     DeleteDC Dc
  50. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

7   голосов , оценка 4 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы