📄 frmoptions.frm
字号:
Top = 240
Width = 510
End
Begin VB.Label LblBackGround
Appearance = 0 'Flat
BackColor = &H00808080&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 375
Left = 6960
TabIndex = 28
Top = 1680
Width = 495
End
Begin VB.Shape Shape2
BorderColor = &H0000FFFF&
BorderWidth = 2
Height = 1695
Left = 5760
Top = 600
Width = 4815
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "偏移量 X Y"
Height = 180
Left = 7980
TabIndex = 27
Top = 3705
Width = 2250
End
Begin VB.Shape Shape1
BorderColor = &H0080FFFF&
BorderWidth = 2
Height = 1335
Left = 5760
Top = 2880
Width = 4815
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文字颜色"
Height = 180
Left = 5880
TabIndex = 24
Top = 3720
Width = 720
End
Begin VB.Label LblFontColor
Appearance = 0 'Flat
BackColor = &H0000FF00&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 375
Left = 6840
TabIndex = 23
Top = 3600
Width = 495
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "收藏夹路径"
Height = 180
Left = 360
TabIndex = 22
Top = 240
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "光盘烧录路径"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 360
TabIndex = 21
Top = 960
Width = 1080
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "开始文件路径"
Height = 180
Index = 0
Left = 360
TabIndex = 20
Top = 1680
Width = 1080
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "插件"
Height = 180
Left = 360
TabIndex = 19
Top = 3120
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "常用图片路径"
Height = 180
Index = 1
Left = 360
TabIndex = 18
Top = 2400
Width = 1080
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "打印日期"
Height = 180
Left = 5880
TabIndex = 17
Top = 3000
Width = 720
End
Begin VB.Image Image1
Height = 5160
Left = 135
Picture = "frmOptions.frx":0010
Stretch = -1 'True
Top = 0
Width = 10905
End
End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/10/12
'描 述：极速数码照片查看播放工具 Ver 2.02
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Dim Apply As Boolean
Private Sub ChkDate_Click()
ChkDateAttach = ChkDate.Value
End Sub
Private Sub DTPicker1_Change()
DateAttach = DTPicker1.Value
End Sub
Private Sub LblBackGround_DblClick()
dlg1.ShowColor
If dlg1.CancelError <> 32755 Then
WallBackColor = dlg1.Color
LblBackGround.BackColor = dlg1.Color
End If
End Sub
Private Sub LblFontColor_DblClick()
dlg1.ShowColor
If dlg1.CancelError <> 32755 Then
DFontColor = dlg1.Color
LblFontColor.BackColor = dlg1.Color
End If
End Sub
Private Sub TMcmdAdd_Click()
Dim Pluginstr As String
Pluginstr = BrowseForFolderDlg("", "选择插件", Me.hwnd, True)
LstPlugIn.AddItem Pluginstr
End Sub
Private Sub TMcmdApply_Click()
OffsetX = TxtOffsetX.Text
OffsetY = TxtOffsetY.Text
If ChkBorder.Value = 1 Then
Shadow = "True"
Else
Shadow = "False"
End If
ThumbnailSize = TxtThumbnailSize.Text
SlideTimer = TxtSlideTimer.Text
SmartPath = TxtFolder(3)
StartPath = TxtFolder(2)
CDBurnPath = TxtFolder(1)
FavoritePath = TxtFolder(0)
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Control\Picture", "ThumbnailSize", ThumbnailSize, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Control\Picture", "ThumbnailShadow", Shadow, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Control\Picture", "SlideTimer", SlideTimer, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder", "FavoritePath", FavoritePath, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder", "CDBurnPath", CDBurnPath, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder", "StartPath", StartPath, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Folder", "SmartPath", SmartPath, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach", "Date", DateAttach, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach", "Check", ChkDateAttach, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach\Font", "Name", DFontName, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach\Font", "Size", DFontSize, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach\Font", "Color", DFontColor, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach\Offset", "x", OffsetX, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach\Offset", "y", OffsetY, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Attach", "Format", "ff", REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Control\WallPaper", "Filename", WallFileName, REG_SZ
'WallTiles = QueryValue(HKEY_CURRENT_USER, "XPViewer\Control\WallPaper\Tiles", "Tiles")
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Control\WallPaper", "BackColor", WallBackColor, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "XPViewer\Control\WallPaper", "BackPicture", WallBackPicture, REG_SZ
SavePlugInsLst
If ChkDateAttach = "1" Then
FrmMdi.MnuAddExifDate.Caption = "添加提起 :" & Format$(DateAttach, "yyyy-mm-dd")
Else
FrmMdi.MnuAddExifDate.Caption = "添加可交换图形日期"
End If
Apply = True
End Sub
Private Sub TMcmdCancel_Click()
Unload Me
End Sub
Private Sub TMcmdDelete_Click()
On Error Resume Next
If LstPlugIn.ListCount > 0 Then
LstPlugIn.RemoveItem LstPlugIn.ListIndex
End If
End Sub
Private Sub TMcmdOK_Click()
If Not Apply Then
TMcmdApply_Click
End If
Unload Me
End Sub
Private Sub Form_Load()
LoadPlugInsLst
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
ChkDate.Value = Val(IIf(ChkDateAttach = "1", 1, 0))
LblFontColor.BackColor = Val(DFontColor)
LblBackGround.BackColor = Val(WallBackColor)
TxtFolder(4).Text = WallFileName
TxtOffsetX.Text = OffsetX
TxtOffsetY.Text = OffsetY
ChkBorder.Value = 0
If Shadow = "True" Then ChkBorder.Value = 1
' DTPicker1.Value = DateAttach
Apply = False
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then DragForm Me
End Sub
Private Sub TMcmdOpen_Click(index As Integer)
Dim Folder As String
If index = 4 Then
Folder = BrowseForFolderDlg(TxtFolder(index).Text, "选择 " & TMcmdOpen(index).Tag, Me.hwnd, True)
Else
Folder = BrowseForFolderDlg(TxtFolder(index).Text, "选择 " & TMcmdOpen(index).Tag, Me.hwnd)
End If
If Folder <> "" Then TxtFolder(index).Text = Folder
Select Case index
Case 0
FavoritePath = TxtFolder(0).Text
Case 1
CDBurnPath = TxtFolder(1).Text
Case 2
StartPath = TxtFolder(2).Text
End Select
End Sub
Sub LoadPlugInsLst()
On Error Resume Next
Dim i%
PluginCount = Val(QueryValue(HKEY_CURRENT_USER, "XPViewer\PlugIn", "PlugInCount"))
If PluginCount > 0 Then
For i% = 1 To PluginCount
LstPlugIn.AddItem QueryValue(HKEY_CURRENT_USER, "XPViewer\PlugIn", "PlugIn " & Trim$(i%))
Next i%
End If
End Sub
Sub SavePlugInsLst()
On Error Resume Next
Dim i%, PluginCount%
PluginCount = LstPlugIn.ListCount
SetKeyValue HKEY_CURRENT_USER, "XPViewer\PlugIn", "PlugInCount", PluginCount, REG_SZ
If PluginCount > 0 Then
For i% = 1 To PluginCount
SetKeyValue HKEY_CURRENT_USER, "XPViewer\PlugIn", "PlugIn " & Trim$(i%), LstPlugIn.List(i% - 1), REG_SZ
Next i%
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -