一種簡單而快速的灰階圖處理法

來源:互聯網
上載者:User

因自己的程式中需對一個表單地區頻繁進行彩色轉灰階處理,為此專門寫了個函數。處理對象是一塊經常變化的動態地區,且是一系列繪圖中的一部分,速度要求較高,演算法上力求簡單,所以採用以下兩步方案:

1、基於DDB來寫,雖然轉入DIB,可不必面對各種色深,會統一演算法,但轉換過程會讓速度上慢很多,再者這隻是針對螢幕位元影像的函數,並無儲存需要。
考慮實際情況,我唯寫了16、24、32位三種色深下的演算法,其實4、8兩種位元影像是最快的了,不管多大的圖只需處理16與256次運算,可是現在哪有人的螢幕,還使用這兩種顯示模式呢?想想就沒這個必要了。
相比之下,32位時最快,16位時最慢,心裡有點不滿意,但好在速度都不慢。差距也不超過50%。

2、灰階演算法本來就不複雜,但我還是做了簡化,正常處理時一般需對RGB做加權平均,取個值來統一三基色,但這需涉及浮點運算,速度上不去,效果卻不見得有多好。
我的方法很簡單,就是取三基色之一的值,統一起來,考慮人眼對綠色最敏感,所以演算法就成RGB轉GGG了。嚴格的說,這不叫彩轉灰,叫綠轉灰更合適。RGB的排列G是在中間的,想利用高速Long運算,用B值最快的,但已經夠簡化了,再簡下去,自己都過意不去。(用B值時32位下,速度還可快1/3)
這種演算法當然有缺陷,主要是對一些偏色圖效果不好,但好在這種情況在色彩豐富的介面中不存在。

C2.4G 256M WinXP SP2下的測試情況
IDE環境下
1024 X 768的位元影像
32位螢幕 219毫秒
16位螢幕 314毫秒

N代碼編譯,全部最佳化開啟
1024 X 768的位元影像
32位螢幕 62毫秒
16位螢幕 75毫秒

註:沒有24位環境,所以也就沒測了

Option Explicit
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Type MemHdc
    hdc As Long
    Bmp As Long
    obm As Long
End Type
Private Declare Function GetObj Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private 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

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
'平時常做圖形處理,自己的兩個公用函數也就用上了
Private Function NewMyHdc(dHdc As Long, w As Long, h As Long, Optional Bm As Long) As MemHdc
    With NewMyHdc
        .hdc = CreateCompatibleDC(dHdc)
        If Bm = 0 Then
            .Bmp = CreateCompatibleBitmap(dHdc, w, h)
        Else
            .Bmp = Bm
        End If
        .obm = SelectObject(.hdc, .Bmp)
    End With
End Function

Private Function DelMyHdc(MyHdc As MemHdc, Optional nobmp As Boolean) As MemHdc
    With MyHdc
        If .hdc <> 0 And .obm <> 0 Then SelectObject .hdc, .obm
        If nobmp = False And .Bmp <> 0 Then DeleteObject .Bmp
        If .hdc <> 0 Then DeleteDC .hdc
    End With
End Function

'灰階處理主函數
Private Function GrayBmp(dHdc As Long, x As Long, y As Long, w As Long, h As Long) As Long
    Dim tmpdc As MemHdc
    Dim i As Long, j As Long, m As Long, k As Byte, l As Long
    Dim Bm As BITMAP, AllBytes As Long, LineBytes As Long
    Dim dBits() As Byte
    Dim dBits1() As Integer
    Dim dBits2() As Long
    On Error GoTo last
    With tmpdc
        tmpdc = NewMyHdc(dHdc, w, h)
        GetObj .Bmp, Len(Bm), Bm
        If Bm.bmBitsPixel < 16 Then GoTo last
        BitBlt .hdc, 0, 0, w, h, dHdc, x, y, vbSrcCopy
        LineBytes = Bm.bmWidthBytes
        AllBytes = LineBytes * h
        Select Case Bm.bmBitsPixel
        Case 32
            ReDim dBits2(AllBytes \ 4 - 1)
            GetBitmapBits .Bmp, AllBytes, dBits2(0)
            For i = 0 To AllBytes \ 4 - 1
                dBits2(i) = ((dBits2(i) And &HFF00&) \ &H100) * &H10101
                'dBits2(i) = (dBits2(i) And &HFF) * &H10101'用B值運算
            Next
            SetBitmapBits .Bmp, AllBytes, dBits2(0)
            GrayBmp = 32
        Case 24
            ReDim dBits(AllBytes - 1)
            GetBitmapBits .Bmp, AllBytes, dBits(0)
            For j = 0 To h - 1
                m = j * LineBytes
                For i = m To m + w * 3 - 1 Step 3
                    dBits(i) = dBits(i + 1)
                    dBits(i + 2) = dBits(i)
                Next
            Next
            SetBitmapBits .Bmp, AllBytes, dBits(0)
            GrayBmp = 24
        Case 16
            '按565格式運算
            ReDim dBits1(AllBytes \ 2 - 1)
            GetBitmapBits .Bmp, AllBytes, dBits1(0)
            For j = 0 To h - 1
                m = j * LineBytes \ 2
                For i = m To m + w - 1
                    l = dBits1(i) And &H7C0&
                    l = l * 32 + l + l \ 64
                    CopyMemory dBits1(i), l, 2  '這句沒辦法,不用CopyMemory,會溢出,低效源於此
                Next
            Next
            SetBitmapBits .Bmp, AllBytes, dBits1(0)
            GrayBmp = 16
        End Select
        BitBlt dHdc, x, y, w, h, .hdc, 0, 0, vbSrcCopy
    End With
last:
    DelMyHdc tmpdc
End Function
Private Sub Form_Load()
    ScaleMode = 3
    AutoRedraw = True
    Picture = LoadPicture("f:\1.jpg")
    Command1.Caption = "測試"
End Sub

'測試用代碼
Private Sub Form_Resize()
    PaintPicture Picture, 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Command1_Click()
    Dim t As Long, s As String, s1 As String, i As Long
    t = GetTickCount
    GrayBmp hdc, 0, 0, ScaleWidth, ScaleHeight
    Refresh
    MsgBox GetTickCount - t & s
End Sub


相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

11.11 Big Sale for Cloud

Get Unbeatable Offers with up to 90% Off,Oct.24-Nov.13 (UTC+8)

Get It Now >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。