Color, AlphaBlending, Transparant, Limited API Usage

Category:

Screen/Graphics

Type:

Modules

Difficulty:

Intermediate

Author:

Michael A. Seel

Version Compatibility: Visual Basic 6

More information:

Using very few APIs to do things otherwise code-heavy... set of function for working with colors, transparent bitmaps, and alpha transparency

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Public Type RGB Red As Byte Green As Byte Blue As Byte End Type Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Code:

Public Function NewRGB(Red As Byte, Green As Byte, Blue As Byte) As RGB
    ' Red, Green, Blue -> RGB Structure
    With NewRGB
        .Red = CByte(Red)
        .Green = CByte(Green)
        .Blue = CByte(Blue)
    End With
End Function

Public Function UniColor(ColorVal As Long) As Long
    ' Returns Color as long, accepts SystemColorConstants
    UniColor = ColorVal
    If ColorVal > &HFFFFFF Or ColorVal < 0 Then UniColor = GetSysColor(ColorVal And &HFFFFFF)
End Function

Public Function Alpha(SrcRGB As RGB, DstRGB As RGB, Level As Byte) As RGB
    ' Alpha-blends Source Color to Destination Color by Level
    With Alpha
        .Red = CByte(CInt(DstRGB.Red) + ((CInt(SrcRGB.Red) - CInt(DstRGB.Red)) * (CInt(Level) / 255)))
        .Green = CByte(CInt(DstRGB.Green) + ((CInt(SrcRGB.Green) - CInt(DstRGB.Green)) * (CInt(Level) / 255)))
        .Blue = CByte(CInt(DstRGB.Blue) + ((CInt(SrcRGB.Blue) - CInt(DstRGB.Blue)) * (CInt(Level) / 255)))
    End With
End Function

Public Sub Blend(SrcHDC As Long, DstHDC As Long, ByVal X As Long, ByVal Y As Long, Level As Byte)
    ' Alpha-blends one existing pixel to another by Level
    Dim SrcRGB As RGB, DstRGB As RGB, AlphaRGB As RGB
    SrcRGB = LongToRGB(GetPixel(SrcHDC, X, Y))
    DstRGB = LongToRGB(GetPixel(DstHDC, X, Y))
    AlphaRGB = Alpha(SrcRGB, DstRGB, Level)
    SetPixel DstHDC, X, Y, RGBToLong(AlphaRGB)
End Sub

Public Function RGBToLong(ColorRGB As RGB) As Long

RGBToLong = RGB(ColorRGB.Red, ColorRGB.Green, ColorRGB.Blue)
End Function

Public Function LongToRGB(ColorVal As Long) As RGB
    If ColorVal >= 0 Then
        With LongToRGB
            .Red = CByte(Int(ColorVal And &HFF))
            .Green = CByte(Int((ColorVal And &HFF00) / &H100))
            .Blue = CByte(Int((ColorVal And &HFF0000) / &H10000))
        End With
    End If
End Function

Public Sub CopyTrans(SrcHDC As Long, DstHDC As Long, Width As Long, Height As Long, TransColor As Long)
    Dim lngPoint As Long
    For X = 0 To Width - 1
    For Y = 1 To Height - 1
        lngPoint = GetPixel(SrcHDC, X, Y)
        If lngPoint <> TransColor Then SetPixel DstHDC, X, Y, lngPoint
    Next
    Next
End Sub

Public Function AlphaAverage(FromRGB As RGB) As Byte
    AlphaAverage = CByte(Int((CInt(FromRGB.Red) + CInt(FromRGB.Green) + CInt(FromRGB.Blue)) / 3))
End Function