frmvideoprop.frm

VB6.0编写的医院影像系统

         Width           =   1275
      End
      Begin VB.CommandButton cmdApply 
         Caption         =   "应用 [F3]"
         Height          =   390
         Left            =   3075
         TabIndex        =   1
         Tag             =   "应用(&A)"
         Top             =   0
         Width           =   1275
      End
   End
End
Attribute VB_Name = "frmVideoProp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub cboStillStandardSize_Click()
    Select Case cboStillStandardSize.ListIndex
        Case 0
            txtStillWidth = "160": txtStillHeight = "120"
        Case 1
            txtStillWidth = "176": txtStillHeight = "144"
        Case 2
            txtStillWidth = "320": txtStillHeight = "240"
        Case 3
            txtStillWidth = "352": txtStillHeight = "288"
        Case 4
            txtStillWidth = "640": txtStillHeight = "480"
        Case 5
            txtStillWidth = "704": txtStillHeight = "576"
    End Select
End Sub


Private Sub cboVideoCodec_Click()
    
    '----------------------
    '决定是否显示调节框
    '----------------------
    Select Case cboVideoCodec.Text
        Case "WNV1", "WINX"
            scrRate.Visible = True
            Label14.Visible = True
            lblRate.Visible = True
            Select Case cboVideoCodec.Text
                Case "WNV1"
                    scrRate.Min = 1
                    scrRate.Max = 12
                    If gintVideoCompressRate > 12 Then gintVideoCompressRate = 12
                    scrRate.Value = gintVideoCompressRate
                Case "WINX"
                    scrRate.Min = 16
                    scrRate.Max = 48
                    If gintVideoCompressRate < 16 Then gintVideoCompressRate = 16
                    scrRate.Value = gintVideoCompressRate
            End Select
            
        Case Else
            scrRate.Visible = False
            Label14.Visible = False
            lblRate.Visible = False
    End Select

End Sub

Private Sub cboVideoStandardSize_Click()

    Select Case cboVideoStandardSize.ListIndex
        Case 0
            txtVideoWidth = "160": txtVideoHeight = "120"
        Case 1
            txtVideoWidth = "176": txtVideoHeight = "144"
        Case 2
            txtVideoWidth = "320": txtVideoHeight = "240"
        Case 3
            txtVideoWidth = "352": txtVideoHeight = "288"
        Case 4
            txtVideoWidth = "640": txtVideoHeight = "480"
        Case 5
            txtVideoWidth = "704": txtVideoHeight = "576"
    End Select

End Sub

Private Sub cmdApply_Click()
    ApplyChange
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    ApplyChange
    Unload Me
End Sub

Private Sub ApplyChange()
    
    '------------------------------------
    '运用设置
    '首先将数据保存到INI文件 中,然后调用
    'frmVideoCapture的SetVideoProp过程
    '------------------------------------
    SetVideoProp
    SaveVideoProp
    
    If frmVideoCapture.Loaded Then
        frmVideoCapture.SetVideoProp
    End If
    
End Sub

Private Sub Form_Load()
    
    Dim i As Integer
    
    '根据版本判断是否应该加载窗体
    If USV.AllowCapture = False Then
        Unload Me
        Exit Sub
    End If
    
    '------------
    '读取设置值
    '------------
    
    ReadVideoProp
    
    '设置是标准尺寸还是自定义尺寸
    If IniUS.GetString("Video", "StillSizeStandard", False) Then
        optStillSize(0).Value = True
        cboStillStandardSize.ListIndex = IniUS.GetString("Video", "StandardStillSizeIndex", 3)
    Else
        optStillSize(1).Value = True
    End If
    
    If IniUS.GetString("Video", "VideoSizeStandard", False) Then
        optVideoSize(0).Value = True
        cboVideoStandardSize.ListIndex = IniUS.GetString("Video", "StandardVideoSizeIndex", 3)
    Else
        optVideoSize(1).Value = True
    End If
    
    
    '设置图像来源
    For i = 0 To cboVideoSource.ListCount - 1
        If Left(cboVideoSource.List(i), 1) = gintVideoSource Then
            cboVideoSource.ListIndex = i
            Exit For
        End If
    Next i
    
    
End Sub

Public Sub ReadVideoProp()
    
    '------------
    '读取设置值
    '------------
    
    On Error Resume Next
    
    With Me
        .txtPreviewFrameRate = gintPreviewFrameRate
        .txtFrameRate = gintFrameRate
        .txtFrameLimit = glngFrameLimit
        .txtTimeLimit = glngTimeLimit
        .txtVideoHeight = gintVideoHeight
        .txtVideoWidth = gintVideoWidth
        .txtStillHeight = gintStillHeight
        .txtStillWidth = gintStillWidth
        .sldBrightness = gintBrightness
        .sldContrast = gintContrast
        .sldHue = gintHue
        .sldSaturation = gintSaturation
        .cboVideoCodec.Text = gstrVideoCodec
         cboVideoCodec_Click
        .scrRate = gintVideoCompressRate
        .cboStillImageType.ListIndex = gintStillImageType
        .cboStillImageFormat.ListIndex = gintStillImageFormat
        
        'AboutAudio
        chkAudioOn.Value = Abs(gbAudioCaptureOn)
        optAudioStereo(Abs(gbAudioCaptureStereo)).Value = True
        optAudio8Bit(Abs(gbAudioCapture8Bit)).Value = True
        cboAudioRate.Text = gintAudioCaptureSampleRate
        
    End With
    
End Sub

Public Sub SetVideoProp()
    
    '--------------
    '设置视频属性
    '--------------
    
    With Me
        gintPreviewFrameRate = .txtPreviewFrameRate
        gintFrameRate = .txtFrameRate
        glngFrameLimit = .txtFrameLimit
        glngTimeLimit = .txtTimeLimit
        gintVideoWidth = .txtVideoWidth
        gintVideoHeight = .txtVideoHeight
        gintStillWidth = .txtStillWidth
        gintStillHeight = .txtStillHeight
        gintBrightness = .sldBrightness.Value
        gintContrast = .sldContrast.Value
        gintHue = .sldHue.Value
        gintSaturation = .sldSaturation.Value
        gstrVideoCodec = .cboVideoCodec.Text
        gintVideoCompressRate = .scrRate.Value
        gintStillImageType = .cboStillImageType.ListIndex
        gintStillImageFormat = cboStillImageFormat.ListIndex
        gintVideoSource = Left(.cboVideoSource.Text, 1)
        
        'AboutAudio
        gbAudioCaptureOn = (chkAudioOn.Value = 1)
        gbAudioCaptureStereo = optAudioStereo(1).Value
        gbAudioCapture8Bit = optAudio8Bit(1).Value
        gintAudioCaptureSampleRate = cboAudioRate.Text
        
   End With
    
End Sub

Public Sub SaveVideoProp()
    
    '----------------------
    '保存在初始化文件中
    '----------------------
    
    Call IniUS.PutString("Video", "PreviewFrameRate", gintPreviewFrameRate)
    Call IniUS.PutString("Video", "FrameRate", gintFrameRate)
    Call IniUS.PutString("Video", "FrameLimit", glngFrameLimit)
    Call IniUS.PutString("Video", "TimeLimit", glngTimeLimit)
    Call IniUS.PutString("Video", "VideoWidth", gintVideoWidth)
    Call IniUS.PutString("Video", "VideoHeight", gintVideoHeight)
    Call IniUS.PutString("Video", "StillWidth", gintStillWidth)
    Call IniUS.PutString("Video", "StillHeight", gintStillHeight)
    Call IniUS.PutString("Video", "Brightness", gintBrightness)
    Call IniUS.PutString("Video", "Contrast", gintContrast)
    Call IniUS.PutString("Video", "Hue", gintHue)
    Call IniUS.PutString("Video", "Saturation", gintSaturation)
    Call IniUS.PutString("Video", "VideoCodec", gstrVideoCodec)
    Call IniUS.PutString("Video", "VideoCompressRate", gintVideoCompressRate)
    Call IniUS.PutString("Video", "StillimageType", gintStillImageType)
    Call IniUS.PutString("Video", "StillimageFormat", gintStillImageFormat)
    Call IniUS.PutString("Video", "VideoSource", gintVideoSource)
    
    
    '保存关于图像尺寸的选择
    If optStillSize(0).Value Then
        Call IniUS.PutString("Video", "StillSizeStandard", True)
        Call IniUS.PutString("Video", "StandardStillSizeIndex", Me.cboStillStandardSize.ListIndex)
    Else
        Call IniUS.PutString("Video", "StillSizeStandard", False)
    End If
    
    If optVideoSize(0).Value Then
        Call IniUS.PutString("Video", "VideoSizeStandard", True)
        Call IniUS.PutString("Video", "StandardVideoSizeIndex", Me.cboVideoStandardSize.ListIndex)
    Else
        Call IniUS.PutString("Video", "VideoSizeStandard", False)
    End If
    
    'About Audio
    Call IniUS.PutString("Audio", "AudioCaptureOn", gbAudioCaptureOn)
    Call IniUS.PutString("Audio", "AudioCaptureStereo", gbAudioCaptureStereo)
    Call IniUS.PutString("Audio", "AudioCapture8Bit", gbAudioCapture8Bit)
    Call IniUS.PutString("Audio", "AudioCaptureSampleRate", gintAudioCaptureSampleRate)
    
    
End Sub

Private Sub optStillSize_Click(Index As Integer)
    
    '---------------------------
    '根据选择决定使用的尺寸类型
    '---------------------------
    
    Select Case Index
        Case 0      '标准
            cboStillStandardSize.Enabled = True
            txtStillWidth.Enabled = False
            txtStillHeight.Enabled = False
            cboStillStandardSize_Click
            
        Case 1      '自定义
            cboStillStandardSize.Enabled = False
            txtStillWidth.Enabled = True
            txtStillHeight.Enabled = True
            
    End Select
    
End Sub

Private Sub optVideoSize_Click(Index As Integer)
    
    '---------------------------
    '根据选择决定使用的尺寸类型
    '---------------------------
    
    Select Case Index
        Case 0      '标准
            cboVideoStandardSize.Enabled = True
            txtVideoWidth.Enabled = False
            txtVideoHeight.Enabled = False
            cboVideoStandardSize_Click
            
        Case 1      '自定义
            cboVideoStandardSize.Enabled = False
            txtVideoWidth.Enabled = True
            txtVideoHeight.Enabled = True
            
    End Select

End Sub


Private Sub scrRate_Change()
    
    scrRate.ToolTipText = "压缩比例 " & scrRate.Value & ":1"
    Me.lblRate.Caption = scrRate.Value & ":1"

End Sub

Private Sub sldBrightness_Change()
    lblBrightNess = sldBrightness.Value & "%"
End Sub

Private Sub sldContrast_Change()
    lblContrast = sldContrast.Value & "%"
End Sub

Private Sub sldHue_Change()
    lblHue = sldHue.Value & "%"
End Sub

Private Sub sldSaturation_Change()
    lblSaturation = sldSaturation.Value & "%"
End Sub