www.pudn.com > chap07.rar > frmOptions.frm
VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmOptions
BackColor = &H80000000&
BorderStyle = 3 'Fixed Dialog
Caption = "选项"
ClientHeight = 4275
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 6030
Icon = "frmOptions.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4275
ScaleWidth = 6030
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton cmdApply
Caption = "应用(&A)"
Enabled = 0 'False
Height = 375
Left = 4395
TabIndex = 3
Top = 3735
Width = 1215
End
Begin TabDlg.SSTab SSTab1
Height = 3525
Left = 60
TabIndex = 2
Top = 60
Width = 5895
_ExtentX = 10398
_ExtentY = 6218
_Version = 393216
Style = 1
Tabs = 1
TabHeight = 520
TabCaption(0) = "背景设置(&B)"
TabPicture(0) = "frmOptions.frx":000C
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "Image1"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "Label1"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).Control(2)= "List1"
Tab(0).Control(2).Enabled= 0 'False
Tab(0).Control(3)= "cmdBrowse"
Tab(0).Control(3).Enabled= 0 'False
Tab(0).Control(4)= "Combo1"
Tab(0).Control(4).Enabled= 0 'False
Tab(0).Control(5)= "cmdBackColor"
Tab(0).Control(5).Enabled= 0 'False
Tab(0).Control(6)= "File1"
Tab(0).Control(6).Enabled= 0 'False
Tab(0).Control(7)= "Picture1"
Tab(0).Control(7).Enabled= 0 'False
Tab(0).Control(8)= "CommonDialog1"
Tab(0).Control(8).Enabled= 0 'False
Tab(0).Control(9)= "Picture2"
Tab(0).Control(9).Enabled= 0 'False
Tab(0).Control(10)= "Command1"
Tab(0).Control(10).Enabled= 0 'False
Tab(0).Control(11)= "List2"
Tab(0).Control(11).Enabled= 0 'False
Tab(0).ControlCount= 12
Begin VB.ListBox List2
Height = 1860
Left = 1110
TabIndex = 11
Top = 570
Visible = 0 'False
Width = 885
End
Begin VB.CommandButton Command1
Caption = "默认值(&D)"
Height = 375
Left = 4680
TabIndex = 13
Top = 2955
Width = 1095
End
Begin VB.PictureBox Picture2
Height = 1035
Left = 225
ScaleHeight = 975
ScaleWidth = 2385
TabIndex = 12
Top = 1095
Visible = 0 'False
Width = 2445
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 2055
Top = 660
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H80000001&
Height = 1920
Left = 3525
ScaleHeight = 1860
ScaleWidth = 2145
TabIndex = 10
Top = 780
Width = 2205
End
Begin VB.FileListBox File1
Height = 450
Left = 210
TabIndex = 9
Top = 570
Visible = 0 'False
Width = 855
End
Begin VB.CommandButton cmdBackColor
Caption = "背景色(&T)..."
Height = 375
Left = 3360
TabIndex = 8
Top = 2955
Width = 1275
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "frmOptions.frx":0028
Left = 1995
List = "frmOptions.frx":0035
Style = 2 'Dropdown List
TabIndex = 7
Top = 2985
Width = 1275
End
Begin VB.CommandButton cmdBrowse
Caption = "浏览(&B)..."
Height = 375
Left = 105
TabIndex = 5
Top = 2955
Width = 1080
End
Begin VB.ListBox List1
Height = 2400
ItemData = "frmOptions.frx":004B
Left = 105
List = "frmOptions.frx":004D
TabIndex = 4
Top = 420
Width = 2685
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "显示方式"
Height = 180
Left = 1230
TabIndex = 6
Top = 3045
Width = 720
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 2400
Left = 2835
Picture = "frmOptions.frx":004F
Stretch = -1 'True
Top = 420
Width = 2940
End
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 2880
TabIndex = 1
Top = 3735
Width = 1215
End
Begin VB.CommandButton cmdOK
Caption = "确定(&O)"
Default = -1 'True
Height = 375
Left = 1380
TabIndex = 0
Top = 3735
Width = 1215
End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private msPictures() As String '用于记录背景图片
Private moSrcPicture As PictureBox
Private Sub cmdApply_Click()
Dim idx As Long
Dim sFn As String '图片文件名
On Error Resume Next
Me.Show
moSrcPicture.BackColor = Picture1.BackColor
'取得图片文件名
idx = List1.ListIndex
If idx = 0 Then
moSrcPicture.Picture = LoadPicture()
Picture2.Picture = LoadPicture()
SetModified False
'保存设置
Call SaveOptionsSettings
Exit Sub
Else
sFn = List2.List(idx) '
Picture2.Picture = LoadPicture(sFn)
End If
'画图
Call PaintImage(moSrcPicture.ScaleWidth, moSrcPicture.ScaleHeight, Picture2, moSrcPicture, Combo1.ListIndex)
'-----------------------------
SetModified False
'保存设置
Call SaveOptionsSettings
End Sub
Private Sub cmdBackColor_Click()
On Error GoTo ErrHandler
'Display the Open dialog box
CommonDialog1.CancelError = True
CommonDialog1.ShowColor
Picture1.BackColor = CommonDialog1.Color
Call List1_Click
SetModified True
Exit Sub
ErrHandler:
'按了"取消"按钮
End Sub
Private Sub cmdBrowse_Click()
Dim pfn As String '路径及文件名
Dim fn As String '纯文件名
'
On Error GoTo ErrHandler
CommonDialog1.CancelError = True
CommonDialog1.DialogTitle = "选择图片文件"
CommonDialog1.Filter = "所有图片文件|*.bmp;*.dib;*.gif;*.jpg;*.wmf;*.emf;*.ico;*.cur|" & _
"位图(*.bmp,*.dib)|*.bmp;*.dib|" & _
"GIF图像(*.gif)|*.gif|" & _
"JPEG图像(*.jpg)|*.jpg|" & _
"图元文件(*.wmf,*.emf)|*.wmf;*.emf|" & _
"Icons(*.ico,*.cur)|*.ico;*.cur"
CommonDialog1.FilterIndex = 1
'Display the Open dialog box
CommonDialog1.ShowOpen
pfn = CommonDialog1.FileName
fn = CommonDialog1.FileTitle
If List1.ItemData(List1.ListCount - 1) = -1 Then
List1.List(List1.ListCount - 1) = fn
List2.List(List1.ListCount - 1) = pfn
Else
List1.AddItem fn
List2.AddItem pfn
List1.ItemData(List1.ListCount - 1) = -1
End If
'----------------------------------------------------------------
List1.ListIndex = List1.ListCount - 1
'-------------------------------------------------------------------
Call List1_Click
SetModified True
Exit Sub
ErrHandler:
'按了"取消"按钮
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
If cmdApply.Enabled = True Then
Call cmdApply_Click
End If
'-----------------------------------------
Unload Me
End Sub
Private Sub Combo1_Click()
Dim idx As Long
idx = Combo1.ListIndex
Select Case idx
Case 0 '居中
cmdBackColor.Enabled = True
Case 1 '平铺
cmdBackColor.Enabled = False
Case 2 '拉伸
cmdBackColor.Enabled = False
End Select
'刷新画面
Call List1_Click
'-------------------------
SetModified True
End Sub
Private Sub Command1_Click()
List1.ListIndex = 0
Combo1.ListIndex = 0
Picture1.BackColor = &H80000001
'-------------------------------------------
SetModified True
End Sub
Private Sub Form_Load()
Dim idx As Long
Dim ct As Long
Dim sPath As String
On Error Resume Next
'设置模式
File1.Pattern = "*.bmp;*.jpg"
sPath = GetWindowsPath()
File1.Path = GetWindowsPath()
'list1用来存储文件名，而list2用来存储全路径及文件名
List1.AddItem "<无>"
List2.AddItem "<无>"
ct = File1.ListCount
For idx = 1 To ct
List1.AddItem File1.List(idx - 1), idx
List1.ItemData(idx) = idx
File1.ListIndex = idx - 1
List2.AddItem sPath & File1.FileName
Next
'获取系统设置
Call GetOptionsSettings
'
SetModified False
End Sub
Private Sub List1_Click()
Dim idx As Long
Dim sFn As String '图片文件名
On Error Resume Next
'取得图片文件名
idx = List1.ListIndex
Picture1.Picture = LoadPicture()
If idx = 0 Then
Picture2.Picture = LoadPicture()
cmdBackColor.Enabled = True
SetModified True
Exit Sub
Else
sFn = List2.List(idx)
cmdBackColor.Enabled = False
'
Picture2.Picture = LoadPicture(sFn)
End If
'画图
Select Case Combo1.ListIndex
Case 0 'GL_DISPLAY_CENTER
Call PaintImage(moSrcPicture.ScaleWidth, moSrcPicture.ScaleHeight, Picture2, Picture1, GL_DISPLAY_CENTER)
Case 1 'GL_DISPLAY_TILE
Call PaintImage(moSrcPicture.ScaleWidth, moSrcPicture.ScaleHeight, Picture2, Picture1, GL_DISPLAY_TILE)
Case 2 'GL_DISPLAY_STRETCH
Call PaintImage(moSrcPicture.ScaleWidth, moSrcPicture.ScaleHeight, Picture2, Picture1, GL_DISPLAY_STRETCH)
End Select
'----------------------------------------
SetModified True
End Sub
'获取背景图片控件
Public Property Let SourcePicture(vNewValue As PictureBox)
Set moSrcPicture = vNewValue
End Property
Private Sub SetModified(ByVal bModified As Boolean)
cmdApply.Enabled = bModified
End Sub
'保存设置
Private Sub SaveOptionsSettings()
Dim idx As Long '选则的背景图片的索引
Dim sLastFile As String '最后一个文件名,表示
Dim sLastFilePath As String '最后一个文件名及路径
On Error Resume Next
idx = List1.ListIndex
If List1.ItemData(List1.ListCount - 1) = -1 Then
sLastFile = List1.List(List1.ListCount - 1)
sLastFilePath = List2.List(List1.ListCount - 1)
Else
sLastFile = ""
sLastFilePath = ""
End If
'保存设置
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "ListIndex", CStr(List1.ListIndex)
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "BackgroundFileName", List2.List(List1.ListIndex)
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "LastFile", CStr(sLastFile)
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "LastFilePath", CStr(sLastFilePath)
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "DisplayStyle", CStr(Combo1.ListIndex)
SaveSetting GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "BackColor", CStr(Picture1.BackColor)
End Sub
'获取选项设置
Private Sub GetOptionsSettings()
Dim idx As Long '选则的背景图片的索引
Dim sLastFile As String '最后一个文件名,表示
Dim sLastFilePath As String '最后一个文件名及路径
On Error Resume Next
'获取设置
Picture1.BackColor = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "BackColor", &H80000001)
'获取用户自定义的图片
sLastFile = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "LastFile", "")
sLastFilePath = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "LastFilePath", "")
If sLastFile <> "" Then
List1.AddItem sLastFile
List2.AddItem sLastFilePath
List1.ItemData(List1.ListCount - 1) = -1
End If
List1.ListIndex = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "ListIndex", 0)
Combo1.ListIndex = GetSetting(GS_REGISTRY_APPNAME, GS_REGISTRY_SECTION_OPTIONS, "DisplayStyle", 1)
End Sub