-
Notifications
You must be signed in to change notification settings - Fork 1
/
Theme.bas
68 lines (65 loc) · 2.24 KB
/
Theme.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Attribute VB_Name = "Theme"
Public Type Theme
MainColor As Long
ToolBar As Long
TabOnAct As Long
TabNoAct As Long
End Type
Public ThmClr As Theme
Public Sub LoadTheme()
On Error GoTo ThmErr
Dim ClrFile As String
ClrFile = MyPath & "Themes\" & ReadThm("Theme")
With ThmClr
.MainColor = ReadString("Clr", "Main", ClrFile)
.TabOnAct = ReadString("Clr", "TabAct", ClrFile)
.TabNoAct = ReadString("Clr", "TabNrm", ClrFile)
.ToolBar = ReadString("Clr", "ToolBar", ClrFile)
End With
With frmMain
.BackColor = ThmClr.ToolBar
.picCaption.BackColor = ThmClr.ToolBar
.picTabBar.BackColor = ThmClr.ToolBar
.picAddr.BackColor = ThmClr.ToolBar
.lstAddr.BackColor = ThmClr.MainColor
.lstAddr.SelColor = ThmClr.ToolBar
.picSta.BackColor = ThmClr.ToolBar
.txtPass.BackColor = ThmClr.ToolBar
.txtAddr.BackColor = ThmClr.MainColor
.picZoom.BackColor = ThmClr.MainColor
.picPass.BackColor = ThmClr.MainColor
.picPassCore.BackColor = .picPass.BackColor
.imgBtn(0).Picture = LoadPicture(GetThmFolder & "Lf.bmp")
.imgBtn(1).Picture = LoadPicture(GetThmFolder & "Rf.bmp")
.imgBtn(2).Picture = LoadPicture(GetThmFolder & "St.bmp")
.imgBtn(3).Picture = LoadPicture(GetThmFolder & "Wr.bmp")
.imgCtrl(0).Picture = LoadPicture(GetThmFolder & "Cl.bmp")
.imgCtrl(1).Picture = LoadPicture(GetThmFolder & "Mx.bmp")
.imgCtrl(2).Picture = LoadPicture(GetThmFolder & "Mn.bmp")
.imgCtrl(3).Picture = LoadPicture(GetThmFolder & "Ap.bmp")
.picAddr.Picture = LoadPicture(GetThmFolder & "Tx.bmp")
For i = 0 To 3
.imgBtn(i).Move .imgBtn(i).Left, (.picCaption.Height - .imgBtn(i).Height) / 2
.imgCtrl(i).Move .imgCtrl(i).Left, (.picCaption.Height - .imgCtrl(i).Height) / 2
Next i
If ReadString("Clr", "WhiteFont", ClrFile) = 1 Then
.lblShow(0).ForeColor = vbWhite
.lblShow(1).ForeColor = vbWhite
.lblZmVl.ForeColor = vbWhite
.lblPlMi(0).ForeColor = vbWhite
.lblPlMi(1).ForeColor = vbWhite
.lblSta.ForeColor = vbWhite
.txtAddr.ForeColor = vbWhite
.txtPass.ForeColor = vbWhite
.lstAddr.ForeColor = vbWhite
End If
End With
Exit Sub
ThmErr:
MsgBox "浏览器在加载主题时发生了一个错误，现在被迫关闭", 48, "非常抱歉"
End
End Sub
Public Function GetThmFolder() As String
On Error Resume Next
GetThmFolder = MyPath & "Themes\" & GetFileName(ReadThm("Theme")) & "\"
End Function