VB6.0中的抗锯齿算法

1、采用SetPixel函数

抗锯齿算法,采用的是SetPixel函数,效率相对来说比较低下,应用DIB可以提高绘图效率,但在画少量的曲线时是看不出来差距的。(大部分代码是参考别人的)


Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long


'*************************************************************************
'**    作    者 :    Unknown
'**    函 数 名 :    PutPixelGP
'**    输    入 :    hDC(Long)        -   设备场景
'**             :    x(String)        -   点坐标
'**             :    y(Long)          -   点坐标
'**             :    Strength(Long)   -   长度
'**             :    Red(Long)        -   红色值
'**             :    Green(Long)      -   绿色值
'**             :    Blue(Long)       -   蓝色值
'**    输    出 :    无
'**    功能描述 :    画一个点
'**    日    期 :    2005-10-26 22.12.31
'**    修 改 人 :    laviewpbt
'**    日    期 :    2005-10-26 22.13.54
'**    版    本 :    Version 1.2.1
'*************************************************************************
Private Sub PutPixelGP(hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal Strength As Long, Red As Long, Green As Long, Blue As Long)
    Dim Color            As Long
    Dim bgColor          As Long
    Dim Rbg              As Long
    Dim Gbg              As Long
    Dim Bbg              As Long
    Dim Rblend           As Long
    Dim Gblend           As Long
    Dim Bblend           As Long
    Dim StrengthI        As Long
    If Strength > 252 Then
        SetPixelV hDC, X, Y, m_Color
    Else
        bgColor = GetPixel(hDC, X, Y)
        If bgColor Then
            Rbg = bgColor And &HFF&
            Gbg = (bgColor And &HFF00&) / &H100&
            Bbg = (bgColor And &HFF0000) / &H10000
        End If
        StrengthI = 255 - Strength
        Rblend = StrengthI * Rbg + Strength * Red
        Gblend = StrengthI * Gbg + Strength * Green
        Bblend = StrengthI * Bbg + Strength * Blue
        Color = RGB(Rblend / 256, Gblend / 256, Bblend / 256)
        SetPixelV hDC, X, Y, Color
    End If
End Sub

'*************************************************************************
'**    作    者 :    Unknown
'**    函 数 名 :    TranslateColour
'**    输    入 :    color(OLE_COLOR)  -   颜色值
'**             :    Red(Long)        -   红色值
'**             :    Green(Long)      -   绿色值
'**             :    Blue(Long)       -   蓝色值
'**    输    出 :    无
'**    功能描述 :    得到颜色分量
'**    日    期 :    2005-10-26 22.16.31
'**    修 改 人 :    laviewpbt
'**    日    期 :    2005-10-26 22.17.28
'**    版    本 :    Version 1.2.1
'*************************************************************************
Public Sub SetRGBComponents(ByVal Color As OLE_COLOR, Red As Long, Green As Long, Blue As Long)
    Color = TranslateColour(Color)
    m_Color = Color
   If Color Then
      Red = Color And &HFF&
      Green = Color / 256 And &HFF
      Blue = Color / 65536
   Else
      Red = 0
      Green = 0
      Blue = 0
   End If
End Sub

'*************************************************************************
'**    作    者 :    Unknown
'**    函 数 名 :    TranslateColour
'**    输    入 :    color(OLE_COLOR)  -   颜色值
'**             :    hPal(Long)        -   0
'**    输    出 :    无
'**    功能描述 :    颜色转换
'**    日    期 :    2005-10-26 22.15.23
'**    修 改 人 :    laviewpbt
'**    日    期 :    2005-10-26 22.16.54
'**    版    本 :    Version 1.2.1
'*************************************************************************
Private Function TranslateColour(ByVal clr As OLE_COLOR, Optional hPal As Long = 0) As Long
   If OleTranslateColor(clr, hPal, TranslateColour) Then
      TranslateColour = vbBlack
   End If
End Function

'*************************************************************************
'**    作    者 :    Unknown
'**    函 数 名 :    LineGP
'**    输    入 :    hDC(Long)        -   设备场景
'**             :    x1(String)       -   起始坐标(以象素为单位)
'**             :    y1(Integer)      -   起始坐标
'**             :    x2(Integer)      -   终点坐标
'**             :    y2(Integer)      -   终点坐标
'**             :    color(OLE_COLOR) -   颜色值
'**    输    出 :    无
'**    功能描述 :    抗锯齿算法划线
'**    日    期 :    2005-10-26 22.10.23
'**    修 改 人 :    laviewpbt
'**    日    期 :    2005-10-26 22.10.56
'**    版    本 :    Version 1.2.1
'*************************************************************************
Public Sub LineGP(ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As OLE_COLOR)
    Dim Red              As Long
    Dim Green            As Long
    Dim Blue             As Long
    Dim XScope           As Long
    Dim YScope           As Long
    Dim XDir             As Long
    Dim YDir             As Long
    Dim LinearDeviance   As Long
    Dim Counter          As Long
    Dim AntiAliasStrength As Long
    Dim EndPointIntensity As Long
    Const HalfIntensity As Long = 127
    m_Color = Color
    XScope = X2 - X1
    YScope = Y2 - Y1
    If XScope < 0 Then
        XScope = Abs(XScope)
        XDir = -1
    Else
        XDir = 1
    End If
    If YScope < 0 Then
        YScope = Abs(YScope)
        YDir = -1
    Else
        YDir = 1
    End If
    If XScope + YScope = 0 Then   '如果长度为0,则退出
    Exit Sub
        End If
    SetRGBComponents Color, Red, Green, Blue
    If XScope > YScope Then
        EndPointIntensity = (85 * YScope) / XScope
        PutPixelGP hDC, X1 - XDir, Y1 - YDir, EndPointIntensity, Red, Green, Blue
        PutPixelGP hDC, X1 - XDir, Y1, HalfIntensity, Red, Green, Blue
        PutPixelGP hDC, X2 + XDir, Y2 + YDir, EndPointIntensity, Red, Green, Blue
        PutPixelGP hDC, X2 + XDir, Y2, HalfIntensity, Red, Green, Blue
        LinearDeviance = XScope / 2
        For Counter = 0 To XScope
            SetPixelV hDC, X1, Y1, m_Color
            AntiAliasStrength = (LinearDeviance * 255) / XScope
            PutPixelGP hDC, X1, Y1 - YDir, 255 - AntiAliasStrength, Red, Green, Blue
            PutPixelGP hDC, X1, Y1 + YDir, AntiAliasStrength, Red, Green, Blue
            LinearDeviance = (LinearDeviance + YScope)
            If LinearDeviance >= XScope Then
                LinearDeviance = LinearDeviance - XScope
                Y1 = Y1 + YDir
            End If
            X1 = X1 + XDir
        Next
    Else
        EndPointIntensity = (85 * XScope) / YScope
        PutPixelGP hDC, X1 - XDir, Y1 - YDir, EndPointIntensity, Red, Green, Blue
        PutPixelGP hDC, X1, Y1 - YDir, HalfIntensity, Red, Green, Blue
        PutPixelGP hDC, X2 + XDir, Y2 + YDir, EndPointIntensity, Red, Green, Blue
        PutPixelGP hDC, X2, Y2 + YDir, HalfIntensity, Red, Green, Blue
        LinearDeviance = YScope / 2
        For Counter = 0 To YScope
            SetPixelV hDC, X1, Y1, m_Color
            AntiAliasStrength = (LinearDeviance * 255) / YScope
            PutPixelGP hDC, X1 - XDir, Y1, 255 - AntiAliasStrength, Red, Green, Blue
            PutPixelGP hDC, X1 + XDir, Y1, AntiAliasStrength, Red, Green, Blue
            LinearDeviance = LinearDeviance + XScope
            If (LinearDeviance >= YScope) Then
                LinearDeviance = LinearDeviance - YScope
                X1 = X1 + XDir
            End If
            Y1 = Y1 + YDir
        Next
    End If

End Sub

 

2、采用GetDIBits


Public Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Type BITMAPINFOHEADER
    biSize               As Long
    biWidth              As Long
    biHeight             As Long
    biPlanes             As Integer
    biBitCount           As Integer
    biCompression        As Long
    biSizeImage          As Long
    biXPelsPerMeter      As Long
    biYPelsPerMeter      As Long
    biClrUsed            As Long
    biClrImportant       As Long
End Type

Public Type BITMAPINFO
    bmiHeader            As BITMAPINFOHEADER
End Type

 


'*************************************************************************
'**    作    者 :    unknown
'**    函 数 名 :    LineDIB
'**    输    入 :    x1(String)           -   起始坐标
'**             :    y1(Integer)          -   起始坐标
'**             :    x2(Integer)          -   终点坐标
'**             :    y2(Integer)          -   终点坐标
'**             :    Color(OLE_COLOR) -   前景颜色
'**    输    出 :    无
'**    功能描述 :    DIB插值
'**    日    期 :    2005-10-26 23.57.12
'**    修 改 人 :    laviewpbt
'**    日    期 :    2005-10-26 23.57.45
'**    版    本 :    Version 1.2.1
'*************************************************************************
Public Sub LineDIB(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As OLE_COLOR)
    If Not InDIBits Then
        MsgBox "You must create a DIB array before calling LineDIB."
        Exit Sub
    End If
    Dim Red As Long
    Dim Green As Long
    Dim Blue As Long
    Dim XScope           As Long
    Dim YScope           As Long
    Dim XDir             As Long
    Dim YDir             As Long
    Dim LinearDeviance   As Long
    Dim Counter          As Long
    Dim AntiAliasStrength As Long
    Dim EndPointIntensity As Long
    Const HalfIntensity As Long = 127
    XScope = X2 - X1
    YScope = Y2 - Y1
    If XScope < 0 Then
        XScope = Abs(XScope)
        XDir = -1
    Else
        XDir = 1
    End If
   
    If YScope < 0 Then
        YScope = Abs(YScope)
        YDir = -1
    Else
        YDir = 1
    End If
    If XScope + YScope = 0 Then
        Exit Sub
    End If
    SetRGBComponents Color, Red, Green, Blue
    If XScope > YScope Then
        EndPointIntensity = (85 * YScope) / XScope
        PutPixelDIB X1 - XDir, Y1 - YDir, EndPointIntensity, Red, Green, Blue
        PutPixelDIB X1 - XDir, Y1, HalfIntensity, Red, Green, Blue
        PutPixelDIB X2 + XDir, Y2 + YDir, EndPointIntensity, Red, Green, Blue
        PutPixelDIB X2 + XDir, Y2, HalfIntensity, Red, Green, Blue
        LinearDeviance = XScope / 2
        For Counter = 0 To XScope
            PutPixelDIB X1, Y1, 255, Red, Green, Blue
            AntiAliasStrength = (LinearDeviance * 255) / XScope
            PutPixelDIB X1, Y1 - YDir, 255 - AntiAliasStrength, Red, Green, Blue
            PutPixelDIB X1, Y1 + YDir, AntiAliasStrength, Red, Green, Blue
            LinearDeviance = (LinearDeviance + YScope)
            If LinearDeviance >= XScope Then
                LinearDeviance = LinearDeviance - XScope
                Y1 = Y1 + YDir
            End If
            X1 = X1 + XDir
        Next
    Else
        EndPointIntensity = (85 * XScope) / YScope
        PutPixelDIB X1 - XDir, Y1 - YDir, EndPointIntensity, Red, Green, Blue
        PutPixelDIB X1, Y1 - YDir, HalfIntensity, Red, Green, Blue
        PutPixelDIB X2 + XDir, Y2 + YDir, EndPointIntensity, Red, Green, Blue
        PutPixelDIB X2, Y2 + YDir, HalfIntensity, Red, Green, Blue
        LinearDeviance = YScope / 2
        For Counter = 0 To YScope
            PutPixelDIB X1, Y1, 255, Red, Green, Blue
            AntiAliasStrength = (LinearDeviance * 255) / YScope
            PutPixelDIB X1 - XDir, Y1, 255 - AntiAliasStrength, Red, Green, Blue
            PutPixelDIB X1 + XDir, Y1, AntiAliasStrength, Red, Green, Blue
            LinearDeviance = LinearDeviance + XScope
            If (LinearDeviance >= YScope) Then
                LinearDeviance = LinearDeviance - YScope
                X1 = X1 + XDir
            End If
            Y1 = Y1 + YDir
        Next
    End If
   
End Sub

 

 
 
'*************************************************************************
'**    作    者 :    unknown
'**    函 数 名 :    PutPixelDIB
'**    输    入 :    x(String)        -   点坐标
'**             :    y(Long)          -   点坐标
'**             :    Strength(Long)   -   长度
'**             :    Red(Long)        -   红色值
'**             :    Green(Long)      -   绿色值
'**             :    Blue(Long)       -   蓝色值
'**    输    出 :    无
'**    功能描述 :    DIB画一个点
'**    日    期 :    2005-10-26 22.12.31
'**    修 改 人 :    laviewpbt
'**    日    期 :    2005-10-26 22.13.54
'**    版    本 :    Version 1.2.1
'*************************************************************************
Private Sub PutPixelDIB(ByVal X As Long, ByVal Y As Long, ByVal Strength As Long, Red As Long, Green As Long, Blue As Long)
    Dim Rbg              As Long
    Dim Gbg              As Long
    Dim Bbg              As Long
    Dim StrengthI        As Long
    If X < 0 Or X >= m_W1 Or Y < 0 Or Y > m_H1 Then
        Exit Sub
    End If
    If Strength > 252 Then
        buf(X, Y).Blue = Blue
        buf(X, Y).Green = Green
        buf(X, Y).Red = Red
    Else
        Bbg = buf(X, Y).Blue
        Gbg = buf(X, Y).Green
        Rbg = buf(X, Y).Red
        StrengthI = 255 - Strength
        buf(X, Y).Red = (StrengthI * Rbg + Strength * Red) / 256
        buf(X, Y).Green = (StrengthI * Gbg + Strength * Green) / 256
        buf(X, Y).Blue = (StrengthI * Bbg + Strength * Blue) / 256
    End If
End Sub

 

'*************************************************************************
'**    作    者 :    unknown
'**    函 数 名 :    DIB
'**    输    入 :    hdc(Long)      -   设备句柄
'**             :    Handle(Long)   -   位图句柄
'**             :    W1(Long)       -   宽度
'**             :    H1(Long)       -   高度
'**    输    出 :    无
'**    功能描述 :    初试化一个DIB
'**    日    期 :    2005-10-26 0.03.25
'**    修 改 人 :
'**    日    期 :
'**    版    本 :    Version 1.2.1
'*************************************************************************

Public Sub DIB(ByVal hDC As Long, ByVal Handle As Long, ByVal W1 As Long, ByVal H1 As Long)
   m_hDC = hDC
   m_Handle = Handle
   m_W1 = W1
   m_H1 = H1
   Pic2Array
End Sub


'*************************************************************************
'**    作    者 :    unknown
'**    函 数 名 :    Pic2Array
'**    输    入 :    无
'**    输    出 :    无
'**    功能描述 :    得到DIB数据
'**    日    期 :    2005-10-26 0.00.00
'**    修 改 人 :
'**    日    期 :
'**    版    本 :    Version 1.2.1
'*************************************************************************
Private Sub Pic2Array()
   ReDim buf(0 To (m_W1 - 1), m_H1 - 1) As RGBQUAD
   With Binfo.bmiHeader
      .biSize = 40
      .biWidth = m_W1
      .biHeight = -m_H1
      .biPlanes = 1
      .biBitCount = 32
      .biCompression = 0
      .biClrUsed = 0
      .biClrImportant = 0
      .biSizeImage = m_W1 * m_H1
   End With
   GetDIBits m_hDC, m_Handle, 0, m_H1, buf(0, 0), Binfo, DIB_RGB_COLORS
   InDIBits = True
End Sub

'*************************************************************************
'**    作    者 :    unknown
'**    函 数 名 :    Array2Pic
'**    输    入 :    无
'**    输    出 :    无
'**    功能描述 :    显示并释放资源
'**    日    期 :    2005-10-26 0.00.50
'**    修 改 人 :
'**    日    期 :
'**    版    本 :    Version 1.2.1
'*************************************************************************
Public Sub Array2Pic()
    If InDIBits Then
        SetDIBits m_hDC, m_Handle, 0, m_H1, buf(0, 0), Binfo, DIB_RGB_COLORS
        InDIBits = False
        Erase buf()
    End If
End Sub

 
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值