gray.frm

GDI 图形处理

    'G = G And Graykval
    'If G < 0 Then G = 0
    Grayval(Grayinx) = G
    Tmp = Grayinx * 3
    Tmpbytes(Tmp) = G
    Tmpbytes(Tmp - 1) = G
    Tmpbytes(Tmp - 2) = G
Next Grayinx
    Enc = SetDIBitsToDevice(PicFrm.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, Tmpbytes(1), bi24BitInfo, DIB_RGB_COLORS)
    If Enc = 0 Then GoTo err
PicFrm.Refresh
Tmp = GetTickCount
Tmp = Tmp - T
Text2.Text = Tmp & " ms"
Working = False
Exit Sub
err:
Working = False
MsgBox "error" & Error

End Sub

Private Sub Command7_Click()
Dim Xinx As Long, Yinx As Long, Inx As Long
Dim XSt As Long, YSt As Long
Dim Tmp As Long, Tmp1 As Long, Tmp2 As Long, Tmp3 As Long, Tmp4 As Long
Dim TmpAdd As Long
ReDim tmppoint(BmpWidth * BmpHeight) As POINTAPI
ReDim tmppoint2(BmpWidth, BmpHeight) As POINTAPI

'On Error GoTo err
TmpAdd = 0
'该段程序用于搜索X方向连续污点小于设定值的点的座标
For Yinx = 1 To BmpHeight
   For Xinx = 1 To BmpWidth
        Tmp1 = Blot(Xinx, Yinx)
        If Tmp1 > 0 And XSt = 0 Then
            XSt = Xinx
        End If
        If XSt > 0 And Tmp1 = 0 Then
            If Xinx - XSt < BlotSize(0) Then    '污点X方向小于设定值
                    tmppoint(TmpAdd).Y = Yinx
                    tmppoint(TmpAdd).X = XSt
                    'tmppoint2(Xinx, Yinx).Y = Yinx
                    'tmppoint2(Xinx, Yinx).X = XSt
                    TmpAdd = TmpAdd + 1
            End If
            XSt = 0
        End If
    Next Xinx
Next Yinx
'Tmppoint() as pointapi 存储了X方向连续污点小于设定值的点的座标

For Inx = 0 To TmpAdd - 2
    Tmp1 = tmppoint(Inx).X
    Tmp2 = tmppoint(Inx).Y
    
    Yinx = Tmp2 + BlotSize(1)
    Tmp = 0
    For Xinx = Tmp1 To Tmp1 + BlotSize(0)
        For Yinx = Tmp2 To Tmp2 + BlotSize(1)
            Tmp = Tmp + Blot(Xinx, Yinx)
        Next Yinx
    Next Xinx
    If Tmp < BlotSize(2) Then
        For Xinx = Tmp1 To Tmp1 + BlotSize(0)
            If Xinx > BmpWidth Then
                GoTo XinxE
            End If
            For Yinx = Tmp2 To Tmp2 + BlotSize(1)
            If Yinx > BmpHeight Then GoTo XinxE
                Tmp = (Yinx - 1) * BmpWidth + Xinx
                Tmp = Tmp * 3
                Tmpbytes(Tmp) = 0 ' 255
                Tmpbytes(Tmp - 1) = 0 '255
                Tmpbytes(Tmp - 2) = 0 '
            Next Yinx
XinxE:
        Next Xinx
    End If
Next Inx 'Tmp = (Tmp2 - 1) * BmpWidth + Tmp1
    'Tmp = Tmp * 3
    'Tmpbytes(Tmp) = 0 ' 255
    'Tmpbytes(Tmp - 1) = 0 '255
    'Tmpbytes(Tmp - 2) = 0 '

SetDIBitsToDevice PicFrm.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, _
        0, 0, 0, bi24BitInfo.bmiHeader.biHeight, Tmpbytes(1), bi24BitInfo, DIB_RGB_COLORS
PicFrm.Refresh

End Sub

Private Sub Command8_Click()
VScroll2(0).Value = 50
VScroll2(1).Value = 15
VScroll2(2).Value = 116
End Sub

Private Sub Form_Initialize()
Dim ABD As APPBARDATA, ret As Long
Dim Rec As RECT
Rec = Displayset
m_DisplayW = Rec.Right
m_DisplayH = Rec.Bottom
GetWindowRect Me.hwnd, Rec
m_GrayW = Rec.Right - Rec.Left
m_GrayH = Rec.Bottom - Rec.Top

    'Get the taskbar's position
    SHAppBarMessage ABM_GETTASKBARPOS, ABD
    m_TaskbarRec.Top = ABD.rc.Top
    m_TaskbarRec.Left = ABD.rc.Left
    
    'Get the taskbar's state
    ret = SHAppBarMessage(ABM_GETSTATE, ABD)
    SetWindowPos m_GrayHwnd, HWND_TOPMOST, m_DisplayW - m_GrayW, ABD.rc.Top - m_GrayH, m_GrayW, m_GrayH, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_DRAWFRAME  'Or SWP_NOSIZE Or SWP_NOMOVE
    
End Sub


Private Sub Form_Load()
Dim Enc As Long
m_Grayshow = True
m_GrayHwnd = Me.hwnd
SetWindowPos Me.hwnd, HWND_TOPMOST, m_DisplayW - m_GrayW, m_DisplayH - m_GrayH, 10, 20, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_DRAWFRAME Or SWP_NOSIZE 'Or SWP_NOMOVE
Enc = m_DisplayW * m_DisplayH
ReDim bBytes(1 To Enc * 3)
ReDim Grayval(0 To Enc - 1)
BlotSize(0) = 2: BlotSize(1) = 2
LogS(0) = 50: LogS(1) = 15: LogS(2) = 116
PowS(0) = 120: PowS(1) = 130: PowS(2) = 40
Kval = 128: Graykval = 255: ZoomV = 1#
dfCA.caIlluminantIndex = 0  'CA.caIlluminantIndex
dfCA.caRedGamma = 10000  'CA.caRedGamma \ 100
dfCA.caGreenGamma = 10000 'CA.caGreenGamma \ 100
dfCA.caBlueGamma = 10000  'CA.caBlueGamma \ 100
dfCA.caReferenceBlack = 0  'CA.caReferenceBlack \ 10
dfCA.caReferenceWhite = 10000  'CA.caReferenceWhite \ 10
dfCA.caContrast = 0 'CA.caContrast
dfCA.caBrightness = 0  'CA.caBrightness
dfCA.caColorfulness = 0  'CA.caColorfulness
dfCA.caRedGreenTint = 0  'CA.caRedGreenTint
dfCA.caFlags = True  '(CA.caFlags).Value = True
CA = dfCA
Capfrm.Show
PicFrm.Show
Adj.Show
m_hDc = PicFrm.hdc
PicFrm.AutoRedraw = True
End Sub


Private Sub SobelFun()
If Working = True Then Exit Sub Else Working = True
' Sobe算子  GM＝|G+2*H+I-A-2*B-C|+|A+2*D+G-C-2*F-I|
Dim Winx As Long, Hinx As Long
Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long, G As Long, H As Long, I As Long
Dim Tmp As Long, Tmp1 As Long, Tmp2 As Long, Tmp3 As Long, Gm As Byte, T As Long
On Error GoTo err
ReDim Tmpbytes(bBytesAryMax)
ReDim Graytmp(GrayAryMax) As Byte
Tmp = GrayAryMax
T = GetTickCount
If Tmp <> BmpWidth * BmpHeight Then GoTo err
BlotCnt = 0
For Hinx = 1 To BmpHeight - 3
    For Winx = 1 To BmpWidth
        
        Tmp1 = (Hinx - 1) * BmpWidth + Winx
        A = Grayval(Tmp1 - 1)
        B = Grayval(Tmp1)
        C = Grayval(Tmp1 + 1)
        
        Tmp2 = Hinx * BmpWidth + Winx
        D = Grayval(Tmp2 - 1)
        E = Grayval(Tmp2)
        F = Grayval(Tmp2 + 1)
        
        Tmp3 = (Hinx + 1) * BmpWidth + Winx
        G = Grayval(Tmp3 - 1)
        H = Grayval(Tmp3)
        I = Grayval(Tmp3 + 1)
        
        Tmp2 = Abs(G + H * 2 + I - A - B * 2 - C)
        Tmp3 = Abs(A + D * 2 + G - C - F * 2 - I)
        Tmp = Abs(Tmp2 + Tmp3)
        
        If Tmp > Kval Then
            Tmp = 255
            Blot(Winx, Hinx) = 1
            BlotCnt = BlotCnt + 1
        Else
            'Tmp = 0
            Blot(Winx, Hinx) = 0
        End If
        Graytmp(Tmp2) = Tmp
        Tmp2 = Tmp1 * 3
        Tmpbytes(Tmp2 - 2) = Tmp
        Tmpbytes(Tmp2 - 1) = Tmp
        Tmpbytes(Tmp2) = Tmp
        If Winx = BmpWidth - 1 Then Winx = BmpWidth
    Next Winx
Next Hinx
 
 CopyMemory ByVal VarPtr(Grayval(0)), ByVal VarPtr(Graytmp(0)), GrayAryMax
 
     SetDIBitsToDevice PicFrm.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, _
            0, 0, 0, bi24BitInfo.bmiHeader.biHeight, Tmpbytes(1), bi24BitInfo, DIB_RGB_COLORS
    PicFrm.Refresh
Tmp = GetTickCount
Tmp = Tmp - T
Text2.Text = Tmp & " ms"
Working = False
Exit Sub
err:
Working = False
MsgBox "error" & Error
End Sub

Private Sub RobertsFun()
If Working = True Then Exit Sub Else Working = True
'Roberts算子 GM=|E-G|+|F-H|
Dim Winx As Long, Hinx As Long
Dim bBlue As Long, bRed As Long, bGreen As Long
Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long, G As Long, H As Long, I As Long
Dim Tmp As Long, Tmp1 As Long, Tmp2 As Long, Tmp3 As Long, Gm As Byte, T As Long
ReDim Tmpbytes(bBytesAryMax) As Byte
On Error GoTo err
Tmp = GrayAryMax
T = GetTickCount
If Tmp <> BmpWidth * BmpHeight Then Exit Sub
For Hinx = 1 To BmpHeight - 3
    For Winx = 1 To BmpWidth - 2
        Tmp1 = (Hinx - 1) * BmpWidth + Winx
        
        
        Tmp2 = Hinx * BmpWidth + Winx
        E = Grayval(Tmp2)
        F = Grayval(Tmp2 + 1)
        
        Tmp3 = (Hinx + 1) * BmpWidth + Winx
        G = Grayval(Tmp3 - 1)
        H = Grayval(Tmp3)
        
        Tmp = Abs(E - G) + Abs(F - H)
        
        If Tmp > Kval Then
            Tmp = 255
        'Else
           ' Tmp = 0
        End If
        'Gm = Tmp
        Tmp2 = Tmp1 * 3
        'Tmp2 = Grayval(Tmp)
Tmpbytes(Tmp2 - 2) = Tmp
        Tmpbytes(Tmp2 - 1) = Tmp
        Tmpbytes(Tmp2) = Tmp
    Next Winx
Next Hinx
 
    SetDIBitsToDevice PicFrm.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, _
            0, 0, 0, bi24BitInfo.bmiHeader.biHeight, Tmpbytes(1), bi24BitInfo, DIB_RGB_COLORS
    
    PicFrm.Refresh
Tmp = GetTickCount
Tmp = Tmp - T
Text2.Text = Tmp & " ms"
err:
Working = False
End Sub

Private Sub LaplaclanFun()
If Working = True Then Exit Sub Else Working = True
' 拉普拉斯算子  GM＝|F+D+H+B-4*E|
Dim Winx As Long, Hinx As Long
Dim bBlue As Long, bRed As Long, bGreen As Long
Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long, G As Long, H As Long, I As Long
Dim Tmp As Long, Tmp1 As Long, Tmp2 As Long, Tmp3 As Long, Gm As Byte, T As Long
On Error GoTo err
ReDim Tmpbytes(bBytesAryMax) As Byte
Tmp = GrayAryMax
T = GetTickCount
If Tmp <> BmpWidth * BmpHeight Then Exit Sub
For Hinx = 1 To BmpHeight - 3
    For Winx = 1 To BmpWidth - 2
        Tmp1 = (Hinx - 1) * BmpWidth + Winx
        B = Grayval(Tmp1)
        
        Tmp2 = Hinx * BmpWidth + Winx
        D = Grayval(Tmp2 - 1)
        E = Grayval(Tmp2)
        F = Grayval(Tmp2 + 1)
        
        Tmp3 = (Hinx + 1) * BmpWidth + Winx
        H = Grayval(Tmp3)
        
        Tmp = Abs(F + D + H + B - 4 * E)
        
        If Tmp > 255 Then
            Tmp = 255
        Else
            Tmp = 0
        End If
        'Gm = Tmp
        Tmp2 = Tmp1 * 3
        'Tmp2 = Grayval(Tmp)
        Tmpbytes(Tmp2 - 2) = Tmp
        Tmpbytes(Tmp2 - 1) = Tmp
        Tmpbytes(Tmp2) = Tmp
    Next Winx
Next Hinx
 
   
     SetDIBitsToDevice PicFrm.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, _
            0, 0, 0, bi24BitInfo.bmiHeader.biHeight, Tmpbytes(1), bi24BitInfo, DIB_RGB_COLORS
    PicFrm.Refresh
Tmp = GetTickCount
Tmp = Tmp - T
Text2.Text = Tmp & " ms"
err:
Working = False
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Interval = 200
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Adj
Unload PicFrm
Unload Capfrm
m_Grayshow = False
End Sub

Private Sub Gray_Click()
If Working = True Then Exit Sub Else Working = True
Dim iBitmap As Long, iDC As Long
Dim bBlue As Long, bRed As Long, bGreen As Long
Dim Tmp As Single, Tmp1 As Long, T As Long
Dim Tmpbytes() As Byte
On Error GoTo err
Dim Enc As Long
Dim CS As CREATESTRUCT
T = GetTickCount

'\\\\\\\\\\\\\\

If BmpWidth = 0 Or BmpHeight = 0 Then GoTo err
If BmpWidth < 30 Then GoTo err
PixelTotal = BmpWidth * BmpHeight
Text3.Text = BmpWidth & "×" & BmpHeight
    
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = BmpWidth
        .biHeight = BmpHeight
    End With
    iDC = CreateCompatibleDC(Capfrm.hdc)
    If iDC = 0 Then GoTo err
    iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
    If iBitmap = 0 Then GoTo err
    Enc = SelectObject(iDC, iBitmap)
    If Enc = 0 Then GoTo err
    Enc = BitBlt(iDC, 0, 0, BmpWidth, BmpHeight, PicFrm.hdc, 0, 0, vbSrcCopy)
    If Enc = 0 Then GoTo err
    Enc = GetDIBits(iDC, iBitmap, 0, BmpHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS)
    If Enc = 0 Then GoTo err
   
    Enc = DeleteDC(iDC)
    If Enc = 0 Then GoTo err
    Enc = DeleteObject(iBitmap)
    If Enc = 0 Then GoTo err
        
'\\\\\\\\\\\\\\\
ReDim Tmpbytes(bBytesAryMax) As Byte

Grayinx = 0
GrayMax = 0: GrayMin = 255

  For Cnt = 1 To bBytesAryMax - 2 Step 3
        
        bRed = bBytes(Cnt)
        bGreen = bBytes(Cnt + 1)
        'bBlue = bBytes(Cnt + 2)
        Tmp = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768
        Tmp = Tmp * ZoomV
        If Tmp > 255 Then
            Tmp = 255
        End If
        If GrayMax < Tmp Then GrayMax = Tmp
        If GrayMin > Tmp And Tmp > 0 Then GrayMin = Tmp
      
        Tmp = Tmp And Graykval
        Grayval(Grayinx) = Tmp
        Grayinx = Grayinx + 1
        Tmpbytes(Cnt) = Tmp
        Tmpbytes(Cnt + 1) = Tmp
        Tmpbytes(Cnt + 2) = Tmp
        
    Next Cnt
    
'PicFrm.AutoRedraw = True
    Enc = SetDIBitsToDevice(PicFrm.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24B