Startseite / Tipps / VB 5/6-Tipp 0113: Grafik flackerfrei animieren und bewegen

VB 5/6-Tipp 0113: Grafik flackerfrei animieren und bewegen

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Horizontale Scrollbar "HScroll1"
' Steuerelement: Bildfeld-Steuerelement "Picture5"
' Steuerelement: Bildfeld-Steuerelement "Picture4"
' Steuerelement: Bildfeld-Steuerelement "Picture3"
' Steuerelement: Bildfeld-Steuerelement "Picture2"
' Steuerelement: Bildfeld-Steuerelement "Picture1" (Index von 0 bis 0)

Option Explicit

Private Declare Sub BitBlt Lib "gdi32" (ByVal hDestDC _
        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 dwRop As Long)

Const SRCCOPY = &HCC0020
Const SRCINVERT = &H660046
Const SRCAND = &H8800C6

Dim W&, H&, Running As Boolean
Dim hDCfore&, hDCback&
Dim hDCmask1&, hDCmask2&
Dim hDCbuffer1&, hDCbuffer2&

Private Sub Form_Load()
  'Bild zur Hintergrundspeicherung generieren
  Load Picture1(1)
  
  'Nötige Einstellungen vornehmen
  Picture1(1).AutoRedraw = True
  Picture2.AutoRedraw = True
  Picture3.AutoRedraw = True
  Picture4.AutoRedraw = True
  Picture5.AutoRedraw = True
  
  Picture2.ScaleMode = vbPixels
  Picture3.ScaleMode = vbPixels
  
  W = Picture2.ScaleWidth
  H = Picture2.ScaleHeight
  
  'hDCs zwecks einfacheren Handlings in Variablen merken
  hDCfore = Picture1(0).hDC
  hDCback = Picture1(1).hDC
  
  hDCmask1 = Picture2.hDC
  hDCmask2 = Picture3.hDC
  
  hDCbuffer1 = Picture4.hDC
  hDCbuffer2 = Picture5.hDC
  
  'Scrollbars vordefinieren
  HScroll1.Min = 50
  HScroll1.Max = 1000
  HScroll1.Value = 500
End Sub

Private Sub Command1_Click()
  If Running Then Exit Sub
  Running = True
  Call MovePics
End Sub

Private Sub Command2_Click()
  Running = False
End Sub

Private Sub MovePics()
  Dim Z&
  Static x&, Y&
    
    Y = 50
    Do While Running
      'Päuschen mit DoEvents
      For Z = 0 To HScroll1.Value
        DoEvents
      Next Z
    
      'Irgendeine neue Position berechnen
      x = x + 1
      If x > Picture1(0).ScaleWidth Then x = -Picture2.ScaleWidth
      Y = Sin(6 * 3.141 / Picture1(0).ScaleWidth * x) * 30
    
      'Neue Position setzen
      Call SetPicMet_1(x, Y + 32)
      Call SetPicMet_2(x, Y + 155)
    Loop
End Sub

Private Sub SetPicMet_1(pX&, pY&)
  Static OldX%, OldY%, Start As Boolean
    
    'Kopie beim ersten Start nicht sichtbar platzieren
    If Not Start Then
      Start = True
      OldX = -W
      OldY = -H
    End If
    
    'Alten Hintergrundausschnitt zurückkopieren
    BitBlt hDCfore, OldX, OldY, W, H, hDCbuffer1, 0, 0, SRCCOPY
   
    'Neuen Hintergrundausschnitt speichern
    BitBlt hDCbuffer1, 0, 0, W, H, hDCfore, pX, pY, SRCCOPY
   
    'Bild einsetzen
    BitBlt hDCfore, pX, pY, W, H, hDCmask1, 0, 0, SRCAND
    BitBlt hDCfore, pX, pY, W, H, hDCmask2, 0, 0, SRCINVERT
    
    'Alte Position speichern
    OldX = pX
    OldY = pY
End Sub

Private Sub SetPicMet_2(pX&, pY&)
  
  'Hintergrund in den Puffer (+/- 2 Pixel als Rahmen)
  BitBlt hDCbuffer2, 0, 0, W + 4, H + 4, _
         hDCback, pX - 2, pY - 2, SRCCOPY
  
  'Bild im Puffer erstellen
  BitBlt hDCbuffer2, 2, 2, W, H, hDCmask1, 0, 0, SRCAND
  BitBlt hDCbuffer2, 2, 2, W, H, hDCmask2, 0, 0, SRCINVERT
  
  'Puffer in den Vordergrund (+/-2 Pixel als Rahmen)
  BitBlt hDCfore, pX - 2, pY - 2, W + 4, H + 4, _
         hDCbuffer2, 0, 0, SRCCOPY
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 9 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.