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

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

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

При перемещении картинки стрелками возникает "мигание" картинки. PictueBox - не вариант, нужно сохранить прозрачность.
Пример прилагается.

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

textual
Листинг программы
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
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
 
Dim picL As StdPicture, picR As StdPicture, picU As StdPicture, picD As StdPicture, Dc As Long, x As Long, y As Long
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyLeft
        x = x - 4
        DrawTransparent picL
        Me.Refresh
    Case vbKeyRight
        x = x + 4
        DrawTransparent picR
        Me.Refresh
    Case vbKeyUp
        y = y - 4
        DrawTransparent picU
        Me.Refresh
    Case vbKeyDown
        y = y + 4
        DrawTransparent picD
        Me.Refresh
    End Select
End Sub
 
Private Sub DrawTransparent(pic As StdPicture)
    Dim oBmp As Long, w As Long, h As Long
    
    w = ScaleX(pic.Width, vbHimetric, vbPixels)
    h = ScaleY(pic.Height, vbHimetric, vbPixels)
    
    oBmp = SelectObject(Dc, pic.Handle)
    Me.Cls
    TransparentBlt Me.hdc, x, y, w, h, Dc, 0, 0, w, h, vbMagenta
    SelectObject Dc, oBmp
End Sub
Private Sub Form_Load()
    Set picL = LoadPicture(App.Path & "\l.bmp")
    Set picR = LoadPicture(App.Path & "\r.bmp")
    Set picU = LoadPicture(App.Path & "\u.bmp")
    Set picD = LoadPicture(App.Path & "\d.bmp")
    Dc = CreateCompatibleDC(Me.hdc)
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    DeleteDC Dc
End Sub

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


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

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

7   голосов , оценка 4 из 5
Похожие ответы