treedef.frm
来自「OA编程 源代码」· FRM 代码 · 共 442 行
FRM
442 行
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmTreeDef
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "栏目风格"
ClientHeight = 4635
ClientLeft = 45
ClientTop = 330
ClientWidth = 4950
Icon = "TreeDef.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4912.483
ScaleMode = 0 'User
ScaleWidth = 5000
Begin VB.CommandButton CmdUpdDefTree
Caption = "替 换"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2880
TabIndex = 12
Top = 4080
Width = 1215
End
Begin VB.CommandButton CmdSetDefTree
Caption = "确 认"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 960
TabIndex = 13
Top = 4080
Width = 1215
End
Begin VB.Timer TimeInfo
Enabled = 0 'False
Interval = 2000
Left = 2280
Top = 4080
End
Begin VB.Frame FraDef
BackColor = &H00E0E0E0&
Caption = "栏目风格"
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 3495
Left = 120
TabIndex = 0
Top = 120
Width = 4695
Begin VB.TextBox TxtDefDynamicColor
Appearance = 0 'Flat
Height = 375
Left = 1080
Locked = -1 'True
TabIndex = 7
TabStop = 0 'False
Top = 1560
Width = 3015
End
Begin VB.TextBox TxtDefFontSize
Appearance = 0 'Flat
Height = 375
Left = 3360
Locked = -1 'True
TabIndex = 6
TabStop = 0 'False
Top = 360
Width = 735
End
Begin VB.TextBox TxtDefStaticColor
Appearance = 0 'Flat
Height = 375
Left = 1080
Locked = -1 'True
TabIndex = 5
TabStop = 0 'False
Top = 960
Width = 3015
End
Begin VB.TextBox TxtDefFont
Appearance = 0 'Flat
Height = 375
Left = 1080
Locked = -1 'True
TabIndex = 4
TabStop = 0 'False
Top = 360
Width = 1575
End
Begin VB.CommandButton CmdSetDefFont
Caption = "..."
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4200
TabIndex = 3
Top = 480
Width = 360
End
Begin VB.CommandButton CmdSelDefSColor
Caption = "..."
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4200
TabIndex = 2
Top = 1080
Width = 360
End
Begin VB.CommandButton CmdSelDefDColor
Caption = "..."
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4200
TabIndex = 1
Top = 1680
Width = 360
End
Begin VB.Label PanDefPreview
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "预览缺省"
Height = 1215
Left = 360
TabIndex = 14
Top = 2160
Width = 3975
End
Begin VB.Label LabDefDynamicColor
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "动态颜色："
Height = 180
Left = 120
TabIndex = 11
Top = 1680
Width = 900
End
Begin VB.Label LabDefFontSize
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "字号："
Height = 180
Left = 2760
TabIndex = 10
Top = 480
Width = 540
End
Begin VB.Label LabDefStaticColor
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "静态颜色："
Height = 180
Left = 120
TabIndex = 9
Top = 1080
Width = 900
End
Begin VB.Label LabDefFont
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "显示字体："
Height = 180
Left = 120
TabIndex = 8
Top = 480
Width = 900
End
End
Begin MSComDlg.CommonDialog DlgSelDefColor
Left = 4320
Top = 3720
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComDlg.CommonDialog DlgSetDefFont
Left = 120
Top = 3720
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label LabRight
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "设置成功！"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 315
Left = 1680
TabIndex = 15
Top = 3720
Visible = 0 'False
Width = 1650
End
Begin VB.Menu TreePopMenu
Caption = "栏目"
Visible = 0 'False
Begin VB.Menu AddNext
Caption = "添加同级栏目"
HelpContextID = 1
End
Begin VB.Menu AddChild
Caption = "添加子栏目"
HelpContextID = 2
End
Begin VB.Menu ChangeItem
Caption = "修改栏目名称"
HelpContextID = 3
End
Begin VB.Menu DeleteItem
Caption = "删除当前栏目"
HelpContextID = 4
End
End
End
Attribute VB_Name = "FrmTreeDef"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub DispTreeDefault()
TxtDefFont.Text = Trim(DefFont)
TxtDefFontSize.Text = Trim(str(DefFontSize))
TxtDefStaticColor = Trim(DefStaticColor)
TxtDefDynamicColor = Trim(DefDynamicColor)
TxtDefStaticColor.ForeColor = Val(Trim(DefStaticColor))
TxtDefDynamicColor.ForeColor = Val(Trim(DefDynamicColor))
PanDefPreview.ForeColor = Val(Trim(DefStaticColor))
PanDefPreview.Font = Trim(DefFont)
PanDefPreview.FontSize = DefFontSize
End Sub
Private Sub CmdSelDefDColor_Click()
On Error GoTo CancelClick
DlgSelDefColor.DialogTitle = "选择缺省动态颜色"
If Len(TxtDefDynamicColor.Text) = 0 Then
DlgSelDefColor.Color = Val(Trim(DefDynamicColor))
Else
DlgSelDefColor.Color = Val(Trim(TxtDefDynamicColor.Text))
End If
DlgSelDefColor.Flags = cdlCCPreventFullOpen + cdlCCRGBInit
DlgSelDefColor.ShowColor
TxtDefDynamicColor.Text = TenToSix(DlgSelDefColor.Color)
TxtDefDynamicColor.ForeColor = DlgSelDefColor.Color
Exit Sub
CancelClick:
End Sub
Private Sub CmdSelDefSColor_Click()
On Error GoTo CancelClick
DlgSelDefColor.DialogTitle = "选择缺省静态颜色"
If Len(TxtDefStaticColor.Text) = 0 Then
DlgSelDefColor.Color = Val(Trim(DefStaticColor))
Else
DlgSelDefColor.Color = Val(Trim(TxtDefStaticColor.Text))
End If
DlgSelDefColor.Flags = cdlCCPreventFullOpen + cdlCCRGBInit
DlgSelDefColor.ShowColor
TxtDefStaticColor.Text = TenToSix(DlgSelDefColor.Color)
TxtDefStaticColor.ForeColor = DlgSelDefColor.Color
PanDefPreview.ForeColor = Val(Trim(TxtDefStaticColor.Text))
Exit Sub
CancelClick:
End Sub
Private Sub CmdSetDefFont_Click()
On Error GoTo CancelClick
DlgSetDefFont.DialogTitle = "设置缺省字体及字体大小"
If Len(TxtDefFont.Text) = 0 Then
DlgSetDefFont.FontName = Trim(DefFont)
Else
DlgSetDefFont.FontName = Trim(TxtDefFont.Text)
End If
If Val(Trim(TxtDefFontSize.Text)) = 0 Then
DlgSetDefFont.FontSize = DefFontSize
Else
DlgSetDefFont.FontSize = Val(Trim(TxtDefFontSize.Text))
End If
DlgSetDefFont.Flags = cdlCFBoth
DlgSetDefFont.ShowFont
TxtDefFont.Text = DlgSetDefFont.FontName
TxtDefFontSize.Text = DlgSetDefFont.FontSize
PanDefPreview.Font = Trim(TxtDefFont.Text)
PanDefPreview.FontSize = Val(Trim(TxtDefFontSize.Text))
Exit Sub
CancelClick:
End Sub
Private Sub CmdSetDefTree_Click()
On Error GoTo DatabaseError
sql = "DELETE FROM treedefault"
Return_Var = gclsDatabase.RDODelete(sql)
sql = "INSERT INTO treedefault VALUES("
sql = sql & "'" & Trim(TxtDefFont.Text) & "',"
sql = sql & Trim(TxtDefFontSize.Text) & ","
sql = sql & "'" & Trim(TxtDefStaticColor.Text) & "',"
sql = sql & "'" & Trim(TxtDefDynamicColor.Text) & "')"
Return_Var = gclsDatabase.RDOInsert(sql)
If Return_Var = 0 Then GoTo DatabaseError
DefFont = Trim(TxtDefFont.Text)
DefFontSize = Val(Trim(TxtDefFontSize.Text))
DefStaticColor = Trim(TxtDefStaticColor.Text)
DefDynamicColor = Trim(TxtDefDynamicColor.Text)
'MsgBox "栏目缺省信息设置成功！", vbInformation, "系统信息"
LabRight.Visible = True
TimeInfo.Enabled = True
Exit Sub
DatabaseError:
Call ManageQuit
End Sub
Private Sub CmdUpdDefTree_Click()
On Error GoTo DatabaseError
sql = "UPDATE treebase SET "
sql = sql & "font='" & Trim(TxtDefFont) & "',"
sql = sql & "fontsize=" & Trim(TxtDefFontSize) & ","
sql = sql & "staticcolor='" & Trim(TxtDefStaticColor) & "',"
sql = sql & "dynamiccolor='" & Trim(TxtDefDynamicColor) & "'"
'SQL = SQL & " WHERE ALL"
Return_Var = gclsDatabase.RDOUpdate(sql)
'MsgBox "栏目应用成功！", vbInformation, "系统信息"
LabRight.Visible = True
TimeInfo.Enabled = True
Exit Sub
DatabaseError:
Call ManageQuit
End Sub
Private Sub Form_Load()
On Error GoTo DatabaseError
FrmTreeDef.ScaleHeight = FrmTreeDef.Height
FrmTreeDef.ScaleWidth = FrmTreeDef.Width
FrmTreeDef.Top = (Screen.Height - FrmTreeDef.Height - TitleHeight) / 2
FrmTreeDef.Left = (Screen.Width - FrmTreeDef.Width) / 2
Call DispTreeDefault
'换皮肤
Call LoadSkin(Me)
Exit Sub
DatabaseError:
Call ManageQuit
End Sub
Private Sub FraDef_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
PanDefPreview.ForeColor = Val(Trim(TxtDefStaticColor.Text))
End Sub
Private Sub PanDefPreview_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
PanDefPreview.ForeColor = Val(Trim(TxtDefDynamicColor.Text))
End Sub
Private Sub TimeInfo_Timer()
LabRight.Visible = False
TimeInfo.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?