Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0740: Schnelle Helligkeitsänderung eines Bildes per AlphaBlend

 von 

Beschreibung 

Dieser Tipp zeigt, wie mittels der API-Funktion GdiAlphaBlend schnelle Helligkeitsänderung eines Bildes vorgenommen werden können. Alternativ zu GdiAlphaBlend (gdi32) kann auch die API-Funktion AlphaBlend (msimg32) verwendet werden. Diese Funktion hat den Vorteil auch auf älteren Betiebssystemen, ab Win98, zu laufen. Dazu die Deklaration und den Aufruf von GdiAlphaBlend löschen und den auskommentierten Code wieder aktivieren.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GdiAlphaBlend

Download:

Download des Beispielprojektes [46,63 KB]

'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 Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Bildfeld-Steuerelement "Picture2"
' Steuerelement: Vertikale Scrollbar "VScroll1"

' Schnelle Helligkeitsänderung eines Bildes per AlphaBlend

' Copyright © 2007 by Zardoz

Option Explicit

' GdiAlphaBlend: Windows NT/2000/XP/Vista: Included in Windows 2000 and later.
Private Declare Function GdiAlphaBlend Lib "gdi32" (ByVal hdcDest As Long, _
  ByVal XDest As Long, ByVal YDest As Long, ByVal WidthDest As Long, _
  ByVal HeightDest As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, _
  ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, _
  ByVal Blendfunc As Long) As Long

' AlphaBlend: Windows NT/2000/XP/Vista: Included in Windows 2000 and later.
' AlphaBlend: Windows 95/98/Me: Included in Windows 98 and later.

' Private Declare Function AlphaBlend Lib "msimg32" (ByVal hdcDest As Long, ByVal XDest As Long, ByVal YDest As Long, _
    ByVal WidthDest As Long, ByVal HeightDest As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
    ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal Blendfunc As Long) As Long

Private SW As Long ' Bildbreite
Private SH As Long ' Bildhöhe

Private Sub Form_Load()
  Dim Dat1 As String
  Dim TmpPic As StdPicture
  
  Dat1 = App.Path & "\DemoPic1.jpeg" ' Pfad eines Bildes
  ' Pfad prüfen
  If Dir$(Dat1) = "" Then
    MsgBox "Datei nicht gefunden:" & vbCr & Dat1, vbExclamation + vbOKOnly
    Unload Me
    Exit Sub
  End If
  ' Einstellungen Form
  Me.ScaleMode = vbPixels
  Me.BackColor = RGB(100, 180, 255)

  Set TmpPic = LoadPicture(Dat1) ' Bild laden
  ' Einstellungen Picturebox2, dient als Bildspeicher
  With Picture2
    .Visible = False
    .BorderStyle = vbBSNone
    .ScaleMode = vbPixels
    SW = CLng(.ScaleX(TmpPic.Width, vbHimetric)) ' Bildbreite
    SH = CLng(.ScaleY(TmpPic.Height, vbHimetric)) ' Bildhöhe
    .Move 0, 0, SW, SH ' Größe anpassen
    .AutoRedraw = True
    .PaintPicture TmpPic, 0, 0
  End With
  Set TmpPic = LoadPicture() ' Speicher freigeben
  
  ' Einstellungen Picturebox1, dient zur Anzeige des Bildes
  With Picture1
    .ScaleMode = vbPixels
    .BorderStyle = vbBSNone
    .Move 8, 8, SW, SH
    .AutoRedraw = True
  End With
  ' Einstellungen für Scrollbar
  With VScroll1
    .Min = -255
    .Max = 255
    .SmallChange = 1
    .LargeChange = 30
    .TabStop = False
    .Value = 0
    .ZOrder vbBringToFront
  End With
  Call VScroll1_Scroll ' Startbild
End Sub

Private Sub Form_Resize()
  ' Scrollbar positionieren
  If Me.WindowState <> vbMinimized Then VScroll1.Move Me.ScaleWidth - 32, 0, 24, 550
End Sub

Private Sub VScroll1_Change()
  ' Event durchreichen
  Call VScroll1_Scroll
End Sub

Private Sub VScroll1_Scroll()
  ' Bild berechnen
  Dim Wert As Long
  
  Wert = VScroll1.Value
  With Picture1
    .BackColor = IIf(Wert < 0, vbWhite, vbBlack)
    Wert = 255 - Abs(Wert) ' Alpha-Wert errechnen
    
    ' Aufruf für GdiAlphaBlend:
    Call GdiAlphaBlend(.hDC, 0, 0, SW, SH, Picture2.hDC, 0, 0, SW, SH, &H10000 * Wert)
    
    ' Aufruf für AlphaBlend:
    ' Call AlphaBlend(.hDC, 0, 0, SW, SH, Picture2.hDC, 0, 0, SW, SH, &H10000 * Wert)
    
    .Refresh ' Auffrischen erzwingen
  End With
  ' Alpha-Wert ausgeben
  Me.Caption = Space$(5) & "Alpha = " & Wert
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.