📄 frmbuttontest.frm
字号:
IconAlign = 1
iNonThemeStyle = 0
USeCustomColors = -1 'True
BackColor = 16777215
HighlightColor = 16777215
Tooltiptitle = ""
ToolTipIcon = 0
ToolTipType = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Shape Shape1
BackColor = &H8000000F&
BackStyle = 1 'Opaque
BorderStyle = 0 'Transparent
Height = 4935
Left = 0
Top = 0
Width = 2055
End
Begin VB.Label lblDescription
BackColor = &H80000005&
Caption = "Style Description"
Height = 615
Left = 5400
TabIndex = 24
Top = 1920
Width = 3495
End
Begin VB.Label lblVersion
BackStyle = 0 'Transparent
Caption = "Version 3.0"
Height = 255
Left = 5880
TabIndex = 23
Top = 720
Width = 2295
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "By Fred.cpp"
BeginProperty Font
Name = "Verdana"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2640
TabIndex = 22
Top = 720
Width = 2415
End
Begin VB.Line Line4
BorderColor = &H80000010&
BorderWidth = 2
X1 = 144
X2 = 560
Y1 = 172
Y2 = 172
End
Begin VB.Line Line3
BorderColor = &H80000010&
BorderWidth = 2
X1 = 144
X2 = 592
Y1 = 120
Y2 = 120
End
Begin VB.Label lblProperties
BackStyle = 0 'Transparent
Caption = "Properties"
BeginProperty Font
Name = "Verdana"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 2280
TabIndex = 21
Top = 2040
Width = 1575
End
Begin VB.Line Line2
BorderColor = &H80000010&
BorderWidth = 2
X1 = 144
X2 = 592
Y1 = 72
Y2 = 72
End
Begin VB.Line Line1
BorderColor = &H80000010&
BorderWidth = 2
X1 = 144
X2 = 144
Y1 = 8
Y2 = 312
End
Begin VB.Label lblProperties
BackStyle = 0 'Transparent
Caption = "Properties"
BeginProperty Font
Name = "Verdana"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000010&
Height = 375
Index = 1
Left = 2295
TabIndex = 25
Top = 2055
Width = 1560
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "isButton - Demo App"
BeginProperty Font
Name = "Verdana"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 2520
TabIndex = 26
Top = 120
Width = 5415
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "isButton - Demo App"
BeginProperty Font
Name = "Verdana"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000010&
Height = 495
Index = 0
Left = 2535
TabIndex = 20
Top = 135
Width = 5415
End
End
Attribute VB_Name = "frmButtonTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************
'
' Project Name: isButton Test
'
' Author: Fred.cpp
' fred_cpp@msn.com
'
' Page: http://mx.geocities.com/fred_cpp/
'
'
' Description: This form and Exe File is created to show some
' features of the Multy Style Command Button isButton
' I hope you like It And If you find It useful
' please vote and leave comments and suggestions,
' Everything Is wellcome.
' Best Regards.
Option Explicit
Dim strStyleDescription(10) As String
Const strLinkAndUpdates As String = "http://www.planetsourcecode.com/vb/scripts/BrowseCategoryOrSearchResults.asp?optSort=Alphabetical&blnWorldDropDownUsed=TRUE&txtMaxNumberOfEntriesPerPage=10&blnResetAllVariables=TRUE&txtCriteria=isbutton&lngWId=1&B1=Quick+Search"
Private Function GetColor() As OLE_COLOR
On Error GoTo Cancelled
dlgColor.CancelError = True
dlgColor.ShowColor
GetColor = dlgColor.Color
Exit Function
Cancelled:
GetColor = -1
End Function
Private Sub chkEnabled_Click()
cmdArray(0).Enabled = chkEnabled.Value
End Sub
Private Sub chkUseCustomColors_Click()
cmdArray(0).UseCustomColors = chkUseCustomColors.Value
End Sub
Private Sub cmdAbout_Click()
cmdAbout.About
cmdAbout.About
End Sub
Private Sub cmdArray_Click(Index As Integer)
Dim ni As Integer
If Index Then Exit Sub
For ni = 1 To 8
cmdArray(ni).Style = ni + 2
Next ni
End Sub
Private Sub cmdBackColor_Click()
Dim lcolor As Long
lcolor = GetColor
If lcolor <> -1 Then
shpBack.BackColor = lcolor
cmdArray(0).BackColor = lcolor
End If
End Sub
Private Sub cmdButtonType_Click()
If cmdButtonType.Value Then
cmdArray(0).ButtonType = isbCheckBox
Else
cmdArray(0).ButtonType = isbButton
End If
End Sub
Private Sub cmdFontColor_Click()
Dim lcolor As Long
lcolor = GetColor
If lcolor <> -1 Then
Me.shpFont.BackColor = lcolor
cmdArray(0).FontColor = lcolor
End If
End Sub
Private Sub cmdFontHighLight_Click()
Dim lcolor As Long
lcolor = GetColor
If lcolor <> -1 Then
shpFontHighlight.BackColor = lcolor
cmdArray(0).FontHighlightColor = lcolor
End If
End Sub
Private Sub cmdHighLighColor_Click()
Dim lcolor As Long
lcolor = GetColor
If lcolor <> -1 Then
shpHighlight.BackColor = lcolor
cmdArray(0).HighlightColor = lcolor
End If
End Sub
Private Sub cmdSetFont_Click()
On Error GoTo Cancelled
With dlgColor
.FontBold = cmdArray(0).Font.Bold
.FontItalic = cmdArray(0).Font.Italic
.FontName = cmdArray(0).Font.Name
.FontSize = cmdArray(0).Font.SIZE
.FontStrikethru = cmdArray(0).Font.Strikethrough
.FontUnderline = cmdArray(0).Font.Underline
.Flags = cdlCFScreenFonts
.ShowFont
cmdArray(0).Font.Bold = .FontBold
cmdArray(0).Font.Italic = .FontItalic
cmdArray(0).Font.Name = .FontName
cmdArray(0).Font.SIZE = .FontSize
cmdArray(0).Font.Strikethrough = .FontStrikethru
cmdArray(0).Font.Underline = .FontUnderline
End With
cmdArray(0).Refresh
Exit Sub
Cancelled:
MsgBox "UPS!"
End Sub
Private Sub cmdStyle_Click(Index As Integer)
Dim ni As Long
For ni = 0 To cmdArray.Count - 1
cmdArray(ni).Style = Index
Next ni
lblDescription.Caption = strStyleDescription(Index)
End Sub
Private Sub cmdTab_Click(Index As Integer)
Dim ni As Integer
For ni = 0 To 3
pProps(ni).Visible = False
Next ni
pProps(Index).Visible = True
End Sub
Private Sub cmdTTBackColor_Click()
Dim lcolor As Long
lcolor = GetColor
If lcolor <> -1 Then
shpTTBackColor.BackColor = lcolor
cmdArray(0).ToolTipBackColor = lcolor
End If
End Sub
Private Sub cmdTTForeColor_Click()
Dim lcolor As Long
lcolor = GetColor
If lcolor <> -1 Then
shpTTForeColor.BackColor = lcolor
cmdArray(0).ToolTipForeColor = lcolor
End If
End Sub
Private Sub cmdVote_Click()
cmdVote.OpenLink strLinkAndUpdates
End Sub
Private Sub comCaptionAlign_Click()
cmdArray(0).CaptionAlign = comCaptionAlign.ListIndex
End Sub
Private Sub comIconAlign_Click()
cmdArray(0).IconAlign = comIconAlign.ListIndex
End Sub
Private Sub comNonThemeStyle_Change()
Me.cmdArray(0).NonThemeStyle = comNonThemeStyle.ListIndex
End Sub
Private Sub comNonThemeStyle_Click()
comNonThemeStyle_Change
End Sub
Private Sub comTTIcon_Change()
cmdArray(0).ToolTipIcon = comTTIcon.ListIndex
End Sub
Private Sub comTTIcon_Click()
comTTIcon_Change
End Sub
Private Sub comTTStyle_Change()
cmdArray(0).ToolTipType = comTTStyle.ListIndex
End Sub
Private Sub comTTStyle_Click()
comTTStyle_Change
End Sub
Private Sub Form_Load()
Dim ni As Long
'add some elements to the app demo.
'Caption Align Options
comCaptionAlign.AddItem "Center", 0
comCaptionAlign.AddItem "Left", 1
comCaptionAlign.AddItem "Right", 2
comCaptionAlign.AddItem "Top", 3
comCaptionAlign.AddItem "Bottom", 4
'Text align Options
comIconAlign.AddItem "Center", 0
comIconAlign.AddItem "Left", 1
comIconAlign.AddItem "Right", 2
comIconAlign.AddItem "Top", 3
comIconAlign.AddItem "Bottom", 4
'Style Options
comNonThemeStyle.AddItem "Normal", 0
comNonThemeStyle.AddItem "Soft", 1
comNonThemeStyle.AddItem "Flat", 2
comNonThemeStyle.AddItem "Java", 3
comNonThemeStyle.AddItem "[Office XP]", 4
comNonThemeStyle.AddItem "[Windows XP]", 5
comNonThemeStyle.AddItem "[Windows Theme]", 6
comNonThemeStyle.AddItem "Plastik", 7
comNonThemeStyle.AddItem "Galaxy", 8
comNonThemeStyle.AddItem "Keramik", 9
comNonThemeStyle.AddItem "[Mac OSX]", 10
'Style Description
strStyleDescription(0) = "Classic Win9X/ME Button Style, Default VB Style"
strStyleDescription(1) = "Soft Style, I've seen this somewhere..."
strStyleDescription(2) = "Flat Style, like the Win Me Toolbars"
strStyleDescription(3) = "Sun Java Style, also uses system colors"
strStyleDescription(4) = "MSOffice XP, Include the shadows,uses system colors"
strStyleDescription(5) = "Windows XP, I think this is the best emulation for XP Luna"
strStyleDescription(6) = "Windows Themed, use the current Installed Theme, or a default style can be set"
strStyleDescription(7) = "Plastik, the Style of a very popular Linux Look and Feel for KDE"
strStyleDescription(8) = "Mandrake Galaxy, the default style for Mandrake Linux 10.0"
strStyleDescription(9) = "Keramik, the default Style for KDE 3.2"
strStyleDescription(10) = "My favorite one, Mac OSX Style, " & vbCrLf & "the first one mimic drawn by code"
For ni = 1 To 8
cmdArray(ni).ToolTipText = strStyleDescription(ni + 2)
Next ni
Dim x As ttStyleEnum
'Add tooltip icon options
comTTIcon.AddItem "TTNoIcon", TTNoIcon
comTTIcon.AddItem "TTIconInfo", TTIconInfo
comTTIcon.AddItem "TTIconWarning", TTIconWarning
comTTIcon.AddItem "TTIconError", TTIconError
'add tooltip icon types
comTTStyle.AddItem "TTStandard", TTStandard
comTTStyle.AddItem "TTBalloon", TTBalloon
lblVersion.Caption = "Version " & cmdArray(0).Version
txtToolTipText.Text = "Version " & cmdArray(0).Version
''Setup properties for the demo button
cmdArray(0).ToolTipText = "isButton " & lblVersion.Caption
cmdArray(0).ToolTipType = TTBalloon
cmdArray(0).BackColor = shpBack.BackColor
cmdArray(0).HighlightColor = shpHighlight.BackColor
cmdArray(0).FontColor = shpFont.BackColor
cmdArray(0).FontHighlightColor = shpFontHighlight.BackColor
End Sub
Private Sub txtCaption_Change()
cmdArray(0).Caption = txtCaption.Text
End Sub
Private Sub txtToolTipText_Change()
cmdArray(0).ToolTip = txtToolTipText.Text
End Sub
Private Sub txtTTTitle_Change()
cmdArray(0).ToolTipTitle = txtTTTitle.Text
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -