Мигающий Image при перемещении и смене картнки - VB
Формулировка задачи:
При перемещении картинки стрелками возникает "мигание" картинки.
PictueBox - не вариант, нужно сохранить прозрачность.
Пример прилагается.
Листинг программы
- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
- If KeyCode = 37 Then
- Char.Left = Char.Left - 100
- Char.Picture = LoadPicture(App.Path & "\l.gif")
- End If
- If KeyCode = 39 Then
- Char.Left = Char.Left + 100
- Char.Picture = LoadPicture(App.Path & "\r.gif")
- End If
- If KeyCode = 40 Then
- Char.Top = Char.Top + 100
- Char.Picture = LoadPicture(App.Path & "\d.gif")
- End If
- If KeyCode = 38 Then
- Char.Top = Char.Top - 100
- Char.Picture = LoadPicture(App.Path & "\u.gif")
- End If
- End Sub
Решение задачи: «Мигающий 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д