【VB开源代码栏目提醒】：网学会员,鉴于大家对VB开源代码十分关注，论文会员在此为大家搜集整理了“fPreview.frm”一文，供大家参考学习!
VERSION 5.00
Begin VB.Form fPreview
BorderStyle = 4 'Fixed ToolWindow
Caption = "Filter preview"
ClientHeight = 4605
ClientLeft = 45
ClientTop = 285
ClientWidth = 5085
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "fPreview.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 307
ScaleMode = 3 'Pixel
ScaleWidth = 339
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Frame fraParam
BorderStyle = 0 'None
Height = 270
Index = 0
Left = 255
TabIndex = 8
Top = 3315
Width = 3330
Begin VB.HScrollBar sbParam
Height = 210
Index = 0
Left = 1035
TabIndex = 9
Top = 0
Width = 1590
End
Begin VB.Label lblParamName
Caption = "Param. 1"
Height = 195
Index = 0
Left = 0
TabIndex = 11
Top = 0
Width = 840
End
Begin VB.Label lblParamValue
Alignment = 1 'Right Justify
Caption = "Val. 1"
Height = 195
Index = 0
Left = 2715
TabIndex = 10
Top = 0
Width = 480
End
End
Begin VB.CommandButton cmdApply
Caption = "Apply"
Height = 375
Left = 3900
TabIndex = 5
Top = 3600
Width = 1050
End
Begin VB.ComboBox Combo1
Height = 315
Left = 570
TabIndex = 2
Text = "Combo1"
Top = 2640
Width = 3045
End
Begin VB.Frame fraParams
Height = 1395
Left = 120
TabIndex = 3
Top = 3060
Width = 3495
Begin VB.Frame fraParam
BorderStyle = 0 'None
Height = 270
Index = 2
Left = 135
TabIndex = 16
Top = 1005
Width = 3330
Begin VB.HScrollBar sbParam
Height = 210
Index = 2
Left = 1035
TabIndex = 17
Top = 0
Width = 1590
End
Begin VB.Label lblParamValue
Alignment = 1 'Right Justify
Caption = "Val. 1"
Height = 195
Index = 2
Left = 2715
TabIndex = 19
Top = 0
Width = 480
End
Begin VB.Label lblParamName
Caption = "Param. 1"
Height = 195
Index = 2
Left = 0
TabIndex = 18
Top = 0
Width = 840
End
End
Begin VB.Frame fraParam
BorderStyle = 0 'None
Height = 270
Index = 1
Left = 135
TabIndex = 12
Top = 630
Width = 3330
Begin VB.HScrollBar sbParam
Height = 210
Index = 1
Left = 1035
TabIndex = 13
Top = 0
Width = 1590
End
Begin VB.Label lblParamValue
Alignment = 1 'Right Justify
Caption = "Val. 1"
Height = 195
Index = 1
Left = 2715
TabIndex = 15
Top = 0
Width = 480
End
Begin VB.Label lblParamName
Caption = "Param. 1"
Height = 195
Index = 1
Left = 0
TabIndex = 14
Top = 0
Width = 840
End
End
End
Begin VB.CommandButton cmdPreview
Caption = "Preview"
Default = -1 'True
Height = 375
Left = 3900
TabIndex = 4
Top = 2640
Width = 1050
End
Begin VB.CommandButton cmdRestore
Cancel = -1 'True
Caption = "Restore"
Height = 375
Left = 3900
TabIndex = 6
Top = 4080
Width = 1050
End
Begin VB.PictureBox iDst
BackColor = &H8000000C&
ClipControls = 0 'False
Height = 2310
Left = 2640
ScaleHeight = 150
ScaleMode = 3 'Pixel
ScaleWidth = 150
TabIndex = 1
TabStop = 0 'False
Top = 120
Width = 2310
End
Begin VB.PictureBox iSrc
BackColor = &H8000000C&
ClipControls = 0 'False
Height = 2310
Left = 120
ScaleHeight = 150
ScaleMode = 3 'Pixel
ScaleWidth = 150
TabIndex = 0
TabStop = 0 'False
Top = 120
Width = 2310
End
Begin VB.Label Label1
Caption = "Filter"
Height = 240
Left = 135
TabIndex = 7
Top = 2685
Width = 585
End
End
Attribute VB_Name = "fPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'//
'// Filter preview form
'//
'// To add new filter:
'// 1. Add FilterID constant
'// 2. Add call in 'ApplyFilter' sub
'// 3. Define options in 'SetupFilter' function
'//
Option Explicit
Private DIBFilterPreview As New cDIBFilter
Public Enum fltIDCts
[fltColorize]
End Enum
Public FilterID As fltIDCts
Private SrcDIB As New cDIB
Private DstDIB As New cDIB
Private bfW As Long, bfH As Long
Private bfx As Long, bfy As Long
Private sbInitialized As Boolean
Public Sub Initialize(DIB As cDIB)
'-- Get dest. best fit dim. and pos.
DIB.GetBestFitInfo 150, 150, bfx, bfy, bfW, bfH
'-- Clear both previews
iSrc.Cls
iDst.Cls
'-- Create previews
SrcDIB.Create bfW, bfH
SrcDIB.LoadDIBBlt DIB
DstDIB.Create bfW, bfH
DstDIB.LoadBlt SrcDIB.hDIBDC
iSrc_Paint
iDst_Paint
End Sub
Private Sub iSrc_Paint()
SrcDIB.Paint iSrc.hdc, bfx, bfy
End Sub
Private Sub iDst_Paint()
DstDIB.Paint iDst.hdc, bfx, bfy
End Sub
Private Sub sbParam_Change(Index As Integer)
' fltOK = 0
' fltPreview = 0
' fltPreviewed = 0
DstDIB.LoadBlt SrcDIB.hDIBDC
pvApplyFilter FilterID, DstDIB
iDst_Paint
End Sub
Private Sub sbParam_Scroll(Index As Integer)
sbParam_Change 0
End Sub
Private Sub pvApplyFilter(ByVal fltID As Long, DIB As cDIB)
' If (fltOK) Then
' Hi
上一篇：
fPanView.frm
下一篇：
计算机毕业论文答辩2014年
2013-9-1
