Tipp 0244 Überblendeffekte
Autor/Einsender:
Datum:		   Christian Lotmann
06.06.2002
Entwicklungsumgebung:   VB 5
Für Anwendungen, die mit Grafiken arbeiten, ist es von Vorteil wenn man mit einem Effekt von einer zur anderen Grafik überblenden kann. In diesem Tipp werden direkt 6 unterschiedliche Überblendmöglichkeiten gezeigt.
Weiterhin ist es möglich die Rastergröße sowie die Überblendzeit zu beeinflussen.
Hinweis
Auf Grund des Code-Umfangs wurde hier nur der Code von zwei Überblendeffekten, Kreis und Zufall, abgebildet. Im Download-Beispiel sind noch die Überblendeffekte Innen nach Außen, Vorhang, Mühle und Zeilen enthalten.
Code im Codebereich des Moduls
  
Option Explicit

Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Declare Function 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) As Long

Global Const SRCCOPY = &HCC0020
Global Const SRCAND = &H8800C6

Sub KreisBlende(ByVal ziel_bild As Long, ByVal quell_bild _
      As Long, ByVal breite As Integer, ByVal hoehe As Integer, _
      ByVal raster As Integer, ByVal zeit As Long, _
      ByVal maxzeit As Long)

  On Error GoTo err_log

  Dim i As Integer, k As Integer
  Dim startzeit As Long
  Dim startzeit2 As Long
  Dim stufen As Long
  Dim stufenzeit As Long

  Dim start_x As Integer, start_y As Integer
  Dim ziel_x As Integer, ziel_y As Integer
  Dim akt_x As Integer, akt_y As Integer
  Dim int_x As Integer, int_y As Integer
  Dim b1 As String, b2 As String

  ReDim stelle(5 + breite / raster, 5 + hoehe / raster) As Integer

  startzeit = GetTickCount()
  stufen = (2 * hoehe + 2 * breite) / raster
  stufenzeit = zeit / stufen

  For i = 0 To 5 + breite / raster
    For k = 0 To 5 + hoehe / raster
      stelle(i, k) = 0
    Next k
  Next i

  start_x = (breite / raster) / 2
  start_y = (hoehe / raster) / 2
  ziel_y = 0

  For ziel_x = (breite / raster) / 2 To (breite / raster)
    If GetTickCount() - startzeit > maxzeit Then
      Err = 10
    End If

    While GetTickCount() < startzeit + ziel_x * stufenzeit
    Wend

    For k = 0 To hoehe / 2
      int_x = start_x + (ziel_x - start_x) * k / (hoehe / 2)
      int_y = start_y + (ziel_y - start_y) * k / (hoehe / 2)

      If stelle(int_x, int_y) <> 1 Then
        BitBlt ziel_bild, int_x * raster, int_y * raster, _
              raster, raster, quell_bild, int_x * raster, _
              int_y * raster, SRCCOPY
        stelle(int_x, int_y) = 1
      End If
    Next k
  Next ziel_x

  start_x = (breite / raster) / 2
  start_y = (hoehe / raster) / 2
  ziel_x = (breite / raster)
  startzeit2 = GetTickCount()

  For ziel_y = 0 To (hoehe / raster)
    If GetTickCount() - startzeit > maxzeit Then Err = 10

    While GetTickCount() < startzeit2 + ziel_y * stufenzeit
    Wend

    For k = 0 To breite / 2
      int_x = start_x + (ziel_x - start_x) * k / (breite / 2)
      int_y = start_y + (ziel_y - start_y) * k / (breite / 2)

      If stelle(int_x, int_y) <> 1 Then
        BitBlt ziel_bild, int_x * raster, int_y * raster, _
              raster, raster, quell_bild, int_x * raster, _
              int_y * raster, SRCCOPY
        stelle(int_x, int_y) = 1
      End If
    Next k
  Next ziel_y

  start_x = (breite / raster) / 2
  start_y = (hoehe / raster) / 2
  ziel_y = (hoehe / raster)
  startzeit2 = GetTickCount()

  For ziel_x = (breite / raster) To 0 Step -1
    If GetTickCount() - startzeit > maxzeit Then Error 10
    While GetTickCount() < _
          startzeit2 + ((breite / raster) - ziel_x) * stufenzeit
    Wend

    For k = 0 To hoehe / 2
      int_x = start_x + (ziel_x - start_x) * k / (hoehe / 2)
      int_y = start_y + (ziel_y - start_y) * k / (hoehe / 2)

      If stelle(int_x, int_y) <> 1 Then
        BitBlt ziel_bild, int_x * raster, int_y * raster, _
              raster, raster, quell_bild, int_x * raster, _
              int_y * raster, SRCCOPY
        stelle(int_x, int_y) = 1
      End If
    Next k
  Next ziel_x

  start_x = (breite / raster) / 2
  start_y = (hoehe / raster) / 2
  ziel_x = 0
  startzeit2 = GetTickCount()

  For ziel_y = (hoehe / raster) To 0 Step -1
    If GetTickCount() - startzeit > maxzeit Then Err = 10

    While GetTickCount() < _
          startzeit2 + ((hoehe / raster) - ziel_y) * stufenzeit
    Wend

    For k = 0 To breite / 2
      int_x = start_x + (ziel_x - start_x) * k / (breite / 2)
      int_y = start_y + (ziel_y - start_y) * k / (breite / 2)

      If stelle(int_x, int_y) <> 1 Then
        BitBlt ziel_bild, int_x * raster, int_y * raster, _
              raster, raster, quell_bild, int_x * raster, _
              int_y * raster, SRCCOPY
        stelle(int_x, int_y) = 1
      End If
    Next k
  Next ziel_y

  start_x = (breite / raster) / 2
  start_y = (hoehe / raster) / 2
  ziel_y = 0
  startzeit2 = GetTickCount()

  For ziel_x = 0 To (breite / raster) / 2
    If GetTickCount() - startzeit > maxzeit Then Err = 10

    While GetTickCount() < startzeit2 + ziel_x * stufenzeit
    Wend

    For k = 0 To hoehe / 2
      int_x = start_x + (ziel_x - start_x) * k / (hoehe / 2)
      int_y = start_y + (ziel_y - start_y) * k / (hoehe / 2)

      If stelle(int_x, int_y) <> 1 Then
        BitBlt ziel_bild, int_x * raster, int_y * raster, _
              raster, raster, quell_bild, int_x * raster, _
              int_y * raster, SRCCOPY
        stelle(int_x, int_y) = 1
      End If
    Next k
  Next ziel_x

  Exit Sub

err_log:
  BitBlt ziel_bild, 0, 0, breite, hoehe, quell_bild, 0, 0, SRCCOPY
End Sub

Sub ZufallsBlende(ByVal ziel_bild As Long, ByVal quell_bild _
      As Long, ByVal breite As Integer, ByVal hoehe As Integer, _
      ByVal raster As Integer, ByVal zeit As Long, _
      ByVal maxzeit As Long)

  On Error GoTo raus
  Dim i As Integer, k As Integer
  Dim zaehler As Integer
  Dim int_x As Integer, int_y As Integer
  Dim max As Integer

  ReDim stelle(5 + breite / raster, 5 + hoehe / raster) As Integer

  Dim startzeit As Long
  Dim stufen As Long
  Dim stufenzeit As Long

  startzeit = GetTickCount()
  stufen = hoehe / raster
  stufenzeit = zeit / stufen

  For i = 0 To 5 + breite / raster
    For k = 0 To 5 + hoehe / raster
      stelle(i, k) = 0
    Next k
  Next i

  If breite > hoehe Then max = breite
  If hoehe > breite Then max = hoehe

  Randomize

  For i = 0 To hoehe / raster
    If GetTickCount() - startzeit > maxzeit Then Err = 10

    While GetTickCount() < startzeit + i * stufenzeit
    Wend

    For k = 0 To breite / raster
      int_x = k
      int_y = Int(Rnd * (hoehe / raster))
      zaehler = 0

      While stelle(int_x, int_y) = 1
        int_y = int_y + 1
        If int_y > hoehe / raster Then int_y = 0
        zaehler = zaehler + 1
        If zaehler > hoehe / raster Then Err = 10
      Wend

      BitBlt ziel_bild, int_x * raster, int_y * raster, _
            raster, raster, quell_bild, int_x * raster, _
            int_y * raster, SRCCOPY
      stelle(int_x, int_y) = 1
    Next k
  Next i

  Exit Sub

raus:
  BitBlt ziel_bild, 0, 0, breite, hoehe, quell_bild, 0, 0, SRCCOPY
End Sub
  
Code im Codebereich der Form
  
Option Explicit

Dim Bild1 As Integer
Dim zeit As Long
Dim raster As Long

Private Sub Form_Load()
  raster = 4
End Sub

Private Sub Command1_Click(Index As Integer)
  If IsNumeric(Text1.Text) Then
    raster = Val(Text1.Text)
  Else
    raster = 4
    Text1.Text = "4"
  End If

  If IsNumeric(Text2.Text) Then
    zeit = Val(Text2.Text)
  Else
    zeit = 1000
    Text2.Text = "1000"
  End If

  Bild1 = Bild1 Xor -1

  Select Case Index
    Case 0
      If Bild1 = 0 Then
        KreisBlende Picture2.hDC, Picture3.hDC, 320, 240, _
              raster, zeit, 2 * zeit
        Picture2.Picture = Picture3.Picture
      Else
        KreisBlende Picture2.hDC, Picture4.hDC, 320, 240, _
              raster, zeit, 2 * zeit
        Picture2.Picture = Picture4.Picture
      End If
    Case 1
      If Bild1 = 0 Then
        ZufallsBlende Picture2.hDC, Picture3.hDC, 320, 240, _
              raster, zeit, 2 * zeit
        Picture2.Picture = Picture3.Picture
      Else
        ZufallsBlende Picture2.hDC, Picture4.hDC, 320, 240, _
              raster, zeit, 2 * zeit
        Picture2.Picture = Picture4.Picture
      End If
    Case 2
      ' ...
      ' ...
  End Select
End Sub
  
Weitere Links zum Thema
Grafiken mit GetDIBits und SetDIBits drehen
Grafiken mit verschiedenen Filtern kopieren

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (82 kB) Downloads bisher: [ 3715 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum
Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 17. September 2011