fftfilter.frm

图像处理的压缩算法

VERSION 5.00
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Begin VB.Form FFTFilter 
   Caption         =   "Origin Automation FFTFiltering"
   ClientHeight    =   7596
   ClientLeft      =   192
   ClientTop       =   456
   ClientWidth     =   8604
   LinkTopic       =   "Form1"
   ScaleHeight     =   7596
   ScaleWidth      =   8604
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox HiCatoff 
      Height          =   375
      Left            =   5040
      TabIndex        =   23
      Text            =   "10"
      Top             =   1200
      Width           =   975
   End
   Begin VB.TextBox LoCatoff 
      Height          =   375
      Left            =   5040
      TabIndex        =   21
      Text            =   "3"
      Top             =   720
      Width           =   975
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Threshold"
      Height          =   495
      Index           =   4
      Left            =   2520
      TabIndex        =   20
      Top             =   2400
      Width           =   1095
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Bandblock"
      Height          =   495
      Index           =   3
      Left            =   2520
      TabIndex        =   19
      Top             =   1920
      Width           =   1095
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Lowpass"
      Height          =   495
      Index           =   0
      Left            =   2520
      TabIndex        =   18
      Top             =   480
      Width           =   1095
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Highpass"
      Height          =   495
      Index           =   1
      Left            =   2520
      TabIndex        =   17
      Top             =   960
      Width           =   1095
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Bandpass"
      Height          =   495
      Index           =   2
      Left            =   2520
      TabIndex        =   16
      Top             =   1440
      Width           =   1095
   End
   Begin MSChart20Lib.MSChart MSChart1 
      Height          =   4575
      Left            =   4680
      OleObjectBlob   =   "FFTFilter.frx":0000
      TabIndex        =   15
      Top             =   3000
      Width           =   3735
   End
   Begin VB.ListBox ListFilterResults 
      Height          =   3696
      Left            =   2520
      TabIndex        =   14
      Top             =   3600
      Width           =   1935
   End
   Begin VB.CommandButton FilterInOrigin 
      Caption         =   "Filter In Origin"
      Height          =   495
      Left            =   2520
      TabIndex        =   13
      Top             =   3000
      Width           =   1935
   End
   Begin VB.TextBox TextE 
      Height          =   375
      Left            =   720
      TabIndex        =   7
      Text            =   "0.0"
      Top             =   2400
      Width           =   1095
   End
   Begin VB.TextBox TextD 
      Height          =   375
      Left            =   720
      TabIndex        =   6
      Text            =   "1.0"
      Top             =   1920
      Width           =   1095
   End
   Begin VB.TextBox TextC 
      Height          =   375
      Left            =   720
      TabIndex        =   5
      Text            =   "0.5"
      Top             =   1440
      Width           =   1095
   End
   Begin VB.TextBox TextB 
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Text            =   "1.25"
      Top             =   960
      Width           =   1095
   End
   Begin VB.TextBox TextA 
      Height          =   375
      Left            =   720
      TabIndex        =   3
      Text            =   "10.0"
      Top             =   480
      Width           =   1095
   End
   Begin VB.ListBox ListSource 
      Height          =   3696
      ItemData        =   "FFTFilter.frx":236E
      Left            =   240
      List            =   "FFTFilter.frx":2375
      TabIndex        =   1
      Top             =   3600
      Width           =   1815
   End
   Begin VB.CommandButton Generate_Data 
      Caption         =   "Generate Data"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   3000
      Width           =   1815
   End
   Begin VB.Label MaxFreq 
      Caption         =   "Maximum frequency for data = 50 Hz"
      Height          =   255
      Left            =   3960
      TabIndex        =   25
      Top             =   480
      Width           =   3735
   End
   Begin VB.Label LbHiCutoff 
      Caption         =   "Higher Cutoff"
      Height          =   255
      Left            =   3960
      TabIndex        =   24
      Top             =   1320
      Width           =   1095
   End
   Begin VB.Label LbLoCutoff 
      Caption         =   "Lower Cutoff"
      Height          =   255
      Left            =   3960
      TabIndex        =   22
      Top             =   840
      Width           =   1095
   End
   Begin VB.Label LabelE 
      Caption         =   "E"
      Height          =   255
      Left            =   360
      TabIndex        =   12
      Top             =   2520
      Width           =   255
   End
   Begin VB.Label LabelD 
      Caption         =   "D"
      Height          =   255
      Left            =   360
      TabIndex        =   11
      Top             =   2040
      Width           =   255
   End
   Begin VB.Label LabelA 
      Caption         =   "A"
      Height          =   255
      Left            =   360
      TabIndex        =   10
      Top             =   600
      Width           =   255
   End
   Begin VB.Label LabelC 
      Caption         =   "C"
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   1560
      Width           =   255
   End
   Begin VB.Label LabelB 
      Caption         =   "B"
      Height          =   255
      Left            =   360
      TabIndex        =   8
      Top             =   1080
      Width           =   255
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Source data: f(x) = A * Exp(-(x - B) ^ 2 / C) + D * (E + Rnd())"
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   360
      TabIndex        =   2
      Top             =   120
      Width           =   4170
   End
End
Attribute VB_Name = "FFTFilter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Filter data in Origin using Automation
'Copyright OriginLab Corporation 2003.
'
Option Explicit
Private Const nPts = 250#
Private Const nParamLines = 3#
Private Const strOPJName = "Samples\AutomationServer\FFTFiltering.opj"
Private Const strOPJSavName = "Samples\AutomationServer\FFTFilteringVBClient.opj"
Private Const strWksName = "Data1"
Dim nFilteringType As Integer
Dim samprate As Double
'Dim Data(1 To nPts, 1 To 2) As Double
Dim Data(1 To nPts, 1 To 3) As Double
Dim bSourceReady As Boolean
Dim arrData(1 To nPts, 1 To 3)
'make sure Origin reference is checked (VB menu Project->References...)
Dim myobj As Origin.Application
'Dim myobj As Origin.ApplicationSI

Private Function f(x, A, B, C, D, E) As Double
    'f = A * Exp(-x / B) + C * (D - Rnd()) + E
    f = A * Exp(-(x - B) ^ 2 / C) + D * (E + Rnd())
End Function

Private Function FormatStringForList(i, src, opt) As String
    FormatStringForList = ""
    If 2# = opt Then FormatStringForList = src(i, 1) & vbTab & Format(src(i, 2), "####.0000")
    If 3# = opt Then FormatStringForList = src(i, 1) & vbTab & Format(src(i, 3), "####.00000")
End Function

Private Sub UpdateList(ListName, DataName, nEnd, opt)
    ListName.Clear
    Dim i As Integer
    For i = 1 To nEnd
        ListName.AddItem FormatStringForList(i, DataName, opt)
    Next i
End Sub

Private Function ErrorFound(variable As Variant) As Boolean
    ErrorFound = IsError(variable)
    If ErrorFound Then
        MsgBox "Error returned from " & _
            "GetWorksheet(''Data1''...): " & CStr(variable)
    End If
End Function

Private Function SessionControl(bStart As Boolean) As Boolean
    'use this function to reserve or release exclusive session with Origin
    'Next two lines of code:
    'Commented out for Origin.ApplicationSI.
    'Un-comment for Origin.Application. Gegin/End Session meaningless.
    SessionControl = True
    Exit Function
    
    SessionControl = False
    On Error Resume Next
    
    If bStart Then
        SessionControl = myobj.BeginSession()
    Else
        SessionControl = myobj.EndSession()
    End If
    
    If Not SessionControl Then
        MsgBox "SessionControl is unable to handle connection to Origin."
    End If
End Function
Private Function CutoffControl(bHiLo As Boolean)
    'handle parameters logic
    If bHiLo Then
        LbLoCutoff.Caption = "Lower Cutoff"
        HiCatoff.Visible = True
        HiCatoff.Enabled = True
        LbHiCutoff.Visible = True
    Else
        LbLoCutoff.Caption = "Cutoff"
        HiCatoff.Visible = False
        LbHiCutoff.Visible = False
    End If

End Function

Private Sub Form_Initialize()
    bSourceReady = False
    ListSource.Clear
    ListFilterResults.Clear
    
    samprate = 1# / 100#
    Call GenerateData
    'Display Max Frequency info
    MaxFreq.Caption = "Maximum frequency for data = " & 1# / (2# * samprate) & "Hz"
    
    'Initialize radio buttons
    Option1.Item(0).Value = True
    nFilteringType = 0
    HiCatoff.Visible = False
    
    'make a connection to Origin
    Set myobj = GetObject("", "Origin.Application")
    'Set myobj = GetObject("", "Origin.ApplicationSI")
End Sub

Private Sub Form_Unload(Cancel As Integer)
        'Note: Unomment the following lines to shutdown Origin when done.
    Dim bb As Boolean
    On Error Resume Next
    bb = myobj.Execute("exit")
End Sub

Private Sub Generate_Data_Click()
    Call GenerateData
End Sub
Private Sub GenerateData()
    Dim i As Integer
    Dim A As Double, B As Double, C As Double, D As Double, E As Double
    A = TextA.Text
    B = TextB.Text
    C = TextC.Text
    D = TextD.Text
    E = TextE.Text
    For i = 1 To nPts
        Dim x As Double
        x = i * samprate
        Data(i, 1) = x
        Data(i, 2) = f(x, A, B, C, D, E)
        arrData(i, 1) = Str(x)
        arrData(i, 2) = Data(i, 2)
        arrData(i, 3) = Empty
    Next i
    Call UpdateList(ListSource, Data, nPts, 2)
    
    MSChart1.ChartData = arrData
    bSourceReady = True
End Sub

Private Sub FilterInOrigin_Click()
    If Not bSourceReady Then Exit Sub
    
    'Reserve exclusive control over Origin session
    If Not SessionControl(True) Then Exit Sub
    
    'Open Origin sample project that filters data using FFT
    Dim strPath, strFile As String
    strPath = myobj.LTStr("system.path.program$")
    strFile = strPath + strOPJName
    Dim bb As Boolean
    bb = myobj.Load(strFile)
    
    'Prepare sample project to receive data
    bb = myobj.Reset()
    
    'Set filtering parameters in Origin
    Data(1, 3) = nFilteringType
    Data(2, 3) = CDbl(LoCatoff.Text)
    Data(3, 3) = CDbl(HiCatoff.Text)
        'Note: This will append zeroes to the rest of Data(*,3)
        'If that is undesired exchange above lines with:
        'Dim vFilterInfo(nParamLines) As Variant
        'vFilterInfo(0) = nFilteringType
        'vFilterInfo(1) = CDbc(HiCatoff.Text)
        'vFilterInfo(2) = CDbl(LoCatoff.Text)
        'bb = myobj.PutWorksheet(strWksName, vFilterInfo, 0, 2)


    'Send data to be filtered and parameters
    bb = myobj.PutWorksheet(strWksName, Data, 0, 0)
    
    'Wait for auto update to finish
    'myobj.Execute ("run -p au")
    bb = myobj.Run()
    
    'Get filtered data
    Dim vFilterResult As Variant
    vFilterResult = myobj.GetWorksheet(strWksName, 0, 3, nPts - 1, 3)
    If ErrorFound(vFilterResult) Then Exit Sub
    
    'Update chart
    Dim i As Integer
    For i = 1 To nPts
        arrData(i, 3) = vFilterResult(i, 1)
    Next i
    Call UpdateList(ListFilterResults, arrData, nPts, 3)
    MSChart1.ChartData = arrData
    
    'Save the results in Origin
    strFile = strPath + strOPJSavName
    bb = myobj.Save(strFile)
    
    'Release exclusive control over Origin session
    If Not SessionControl(False) Then Exit Sub
  
    bSourceReady = False
End Sub

Private Sub HiCatoff_Change()
    bSourceReady = True
End Sub

Private Sub LoCatoff_Change()
    bSourceReady = True
End Sub

Private Sub Option1_Click(Index As Integer)
    Select Case Index
    Case 0
        nFilteringType = 0  'perform lowpass filtering
        CutoffControl False
    Case 1
        nFilteringType = 1  'perform highpass filtering
        CutoffControl False
    Case 2
        nFilteringType = 2  'perform bandpass filtering
        CutoffControl True
    Case 3
        nFilteringType = 3  'perform bandblock filtering
        CutoffControl True
    Case 4
        nFilteringType = 4  'perform threshold filtering
        CutoffControl False
    Case Else
        Beep
        Exit Sub
    End Select
    'VB will enter here only if option is changed
    bSourceReady = True
End Sub