module1.bas

计算面积公式源代码

Attribute VB_Name = "Module1"
Option Explicit
Public ImageIn() As Integer
Public WBiaoRead() As Integer
Public WSignArray() As Long
Const PI As Single = 3.141592654

'阈值计算2模块

Function WYuFuction2(Wimage() As Integer, ByVal WSW As Integer, WSH As Integer) As Integer
 Dim S1(255) As Long, S2(255) As Long
 Dim I As Integer, J As Integer
 Dim N1 As Integer, N2 As Integer
 Dim WImageHui() As Integer
 Dim Width As Integer, Height As Integer
 Dim Temp As Long
 Dim Wmax1 As Long, Wmax2 As Long
 Dim Position1 As Integer, Position2 As Integer

 Width = WSW - 1 + 2
 Height = WSH - 1 + 2
 ReDim WImageHui(Width, Height)
 
 For I = 0 To WSW - 1
   For J = 0 To WSH - 1
   WImageHui(I + 2, J + 2) = Wimage(I, J)
   Next J
 Next I
 
 For I = 1 To WSW - 1
  For J = 1 To WSH - 1
    For N1 = -1 To 1
     For N2 = -1 To 1
       Temp = WImageHui(I, J) - WImageHui(I + N1, J + N2)
       If Temp >= 0 Then
         S1(WImageHui(I, J)) = S1(WImageHui(I, J)) + Temp
       Else
         S2(WImageHui(I, J)) = S2(WImageHui(I, J)) + Temp
       End If
     Next N2
    Next N1
  Next J
 Next I
 
 Wmax1 = 0: Wmax2 = 0
 For I = 0 To 255
   If S1(I) > Wmax1 Then
      Wmax1 = S1(I)
      Position1 = I
   End If
   If Abs(S2(I)) > Wmax2 Then
      Wmax2 = Abs(S2(I))
      Position2 = I
   End If
 Next I
 
 WYuFuction2 = Int((Position1 + Position2) / 2)
 End Function


'一维FFT模块

Public Sub WFft(PixelR() As Double, PixelI() As Double, Wr() As Double, Wi() As Double, ByVal M As Integer, ByVal N As Integer) '一维傅立叶
  Dim Ip As Integer, K As Integer, KK As Integer, L As Integer, Iter As Integer, Incr As Integer, I As Integer, J As Integer
  Dim Tr As Double, Ti As Double
  
  Ip = 1: KK = N / 2: Incr = 2
  
  For Iter = 0 To M - 1
     For J = 0 To N - 1 Step Incr
       I = J + Ip
       Tr = PixelR(I): Ti = PixelI(I)
       PixelR(I) = PixelR(J) - Tr: PixelI(I) = PixelI(J) - Ti
       PixelR(J) = PixelR(J) + Tr: PixelI(J) = PixelI(J) + Ti
     Next J
     If (Iter <> 0) Then
       For K = 1 To Ip - 1
         L = K * KK - 1
         For J = K To N - 1 Step Incr
           I = J + Ip
           Tr = PixelR(I) * Wr(L) - PixelI(I) * Wi(L)
           Ti = PixelR(I) * Wi(L) + PixelI(I) * Wr(L)
          
           PixelR(I) = PixelR(J) - Tr: PixelI(I) = PixelI(J) - Ti
           PixelR(J) = PixelR(J) + Tr: PixelI(J) = PixelI(J) + Ti
         Next J
       Next K
     End If
     KK = KK / 2
     Ip = Ip * 2
     Incr = Incr * 2
   Next Iter
End Sub

'位倒序模块
 
Public Sub WBitRever(WL() As Long, ByVal M As Integer, ByVal N As Integer)
  Dim Mask As Long, C As Long, A As Long, J As Long, I As Long, K As Long
  Dim I1 As Long, I2 As Long
  
  For K = 0 To N - 1
     Mask = 1: C = 0
     J = M - 1
     For I = 0 To M - 1
       
       A = (K And Mask)
       For I1 = 1 To I
         A = A / 2
       Next I1
       
       For I2 = 1 To J
         A = A * 2
       Next
       
       C = C Or A
       Mask = Mask * 2
       
       J = J - 1
     Next I
     WL(K) = C
  Next K
End Sub

'计算卷积核模块

Public Sub WGlt(Wr() As Double, Wi() As Double, ByVal N As Integer, ByVal Sign As Integer) '复数的值
   Dim N2 As Integer, I As Integer
   Dim Theta As Double
      
   N2 = (N / 2) - 1
   Theta = 2# * PI / CDbl(N)   'pi/4
   For I = 0 To N2
    Wr(I) = CDbl(Cos(CDbl(I + 1) * Theta))
    Wi(I) = CDbl(Sin(CDbl(I + 1) * Theta))
    If Sign = -1 Then Wi(I) = -Wi(I)
   Next I
   
End Sub