withevents
调色板 (The palette)
Windows Phone sports a very tight but distinct and carefully balanced color palette. This palette is, however, well suited for many other applications where you need a modern appearance with the typical flat design introduced with Windows 8.
Windows Phone具有非常紧密但又鲜明且精心平衡的调色板。 但是，此调色板非常适合需要其他外观的其他应用程序，这些应用程序具有Windows 8引入的典型平面设计，需要具有现代外观。
The palette may be somewhat familiar to you, as I have previously used it in another article:
您可能对调色板有些熟悉，因为我之前在另一篇文章中曾使用它：
Modern/Metro style message box and input box for Microsoft Access 2013
Microsoft Access 2013的现代/地铁样式消息框和输入框
特征 (Features)
If you plan to use the palette for an application, you soon get tired of converting the color values back and forth. So, to ease this task, I've created a single-form application where you can:
如果计划将调色板用于应用程序，则很快就会厌倦了来回转换颜色值。 因此，为了简化此任务，我创建了一个单窗体应用程序，您可以在其中：
- Watch the colors 观看颜色
- Read the color values in the three commonly used representations 阅读三种常用表示形式的颜色值
- Click any of these values and have it copied to the clipboard 单击这些值中的任何一个并将其复制到剪贴板
As you may expect, the layout is extremely simple:
如您所料，布局非常简单：
If all you need is exactly this - select and pick a color - just run the application and go ahead.
如果您只需要这个-选择并选择一种颜色-只需运行该应用程序并继续即可。
That said, the construction of the palette could be applied to other areas, so read on.
也就是说，调色板的构造可以应用于其他区域，因此请继续阅读。
幕后花絮 (Behind the scene)
The source of the palette is the enumeration:
调色板的来源是枚举：
' Windows Phone colour enumeration.
Public Enum wpThemeColor
' Official colour names from WP8.
Lime = &HC4A4&
Green = &H17A960
Emerald = &H8A00&
Teal = &HA9AB00
Cyan = &HE2A11B
Cobalt = &HEF5000
Indigo = &HFF006A
Violet = &HFF00AA
Pink = &HD072F4
Magenta = &H7300D8
Crimson = &H2500A2
Red = &H14E5&
Orange = &H68FA&
Amber = &HAA3F0
Yellow = &HC8E3&
Brown = &H2C5A82
Olive = &H64876D
Steel = &H87766D
Mauve = &H8A6076
Sienna = &H2D52A0
' Colour name aliases from WP7.5
Viridian = &HA9AB00
Blue = &HE2A11B
Purple = &HFF00AA
Mango = &H68FA&
' Used for black in popups.
Darken = &H1D1D1D
' Additional must-have names for grey scale.
Black = &H0&
DarkGrey = &H3F3F3F
Grey = &H7F7F7F
LightGrey = &HBFBFBF
White = &HFFFFFF
End Enum
However, this is of little use as is because, for any practical use in Access and VBA, other formats are required.
但是，这几乎没有什么用，因为对于Access和VBA中的任何实际使用，都需要其他格式。
For example, by default, Access uses the #AABBCC format in the Format property of the Property sheet.
例如，默认情况下，Access在“属性”表的“格式”属性中使用#AABBCC格式。
Also, in VBA you cannot list the values of an enumeration other than from lowest to highest. Thus, as these values cover from Black to White, all possible color values will be tested. While this can easily be done:
另外，在VBA中，除了从最低到最高之外，您不能列出枚举的值。 因此，当这些值从黑色到白色覆盖时，将测试所有可能的颜色值。 尽管这很容易做到：
' Loops all(!) possible color values and prints those of the
' Windows Phone Theme Colors.
' This will take nearly 30 seconds.
'
' 2017-04-21. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ListColors()
Dim Color As wpThemeColor
For Color = wpThemeColor.Black To wpThemeColor.White
If IsWpThemeColor(Color) Then
Debug.Print Color, LiteralWpThemeColor(Color)
End If
Next
End Function
it takes about 30 seconds! Far too long to wait for a palette to show up.
大约需要30秒！ 等待调色板出现太长时间。
设置彩色显示 (Setting the color display)
To speed it up, another method is used that fills an array with the color values:
为了加快速度，使用了另一种方法来用颜色值填充数组：
' Fill array ColorPalette with the values of wpThemeColor.
'
' 2017-04-21. Gustav Brock, Cactus Data ApS, CPH.
'
Private Sub LoadColors()
Dim Colors(0 To 29) As Long
Dim Index As Long
If IsEmpty(ColorPalette) Then
For Index = LBound(Colors) To UBound(Colors)
Select Case Index
Case 0
Colors(Index) = wpThemeColor.Lime
Case 1
Colors(Index) = wpThemeColor.Green
Case 2
Colors(Index) = wpThemeColor.Emerald
Case 3
Colors(Index) = wpThemeColor.Teal
Case 4
Colors(Index) = wpThemeColor.Cyan
Case 5
Colors(Index) = wpThemeColor.Cobalt
Case 6
Colors(Index) = wpThemeColor.Indigo
Case 7
Colors(Index) = wpThemeColor.Violet
Case 8
Colors(Index) = wpThemeColor.Pink
Case 9
Colors(Index) = wpThemeColor.Magenta
Case 10
Colors(Index) = wpThemeColor.Crimson
Case 11
Colors(Index) = wpThemeColor.Red
Case 12
Colors(Index) = wpThemeColor.Orange
Case 13
Colors(Index) = wpThemeColor.Amber
Case 14
Colors(Index) = wpThemeColor.Yellow
Case 15
Colors(Index) = wpThemeColor.Brown
Case 16
Colors(Index) = wpThemeColor.Olive
Case 17
Colors(Index) = wpThemeColor.Steel
Case 18
Colors(Index) = wpThemeColor.Mauve
Case 19
Colors(Index) = wpThemeColor.Sienna
Case 20
Colors(Index) = wpThemeColor.Darken
Case 21
Colors(Index) = wpThemeColor.Viridian
Case 22
Colors(Index) = wpThemeColor.Blue
Case 23
Colors(Index) = wpThemeColor.Purple
Case 24
Colors(Index) = wpThemeColor.Mango
Case 25
Colors(Index) = wpThemeColor.Black
Case 26
Colors(Index) = wpThemeColor.DarkGrey
Case 27
Colors(Index) = wpThemeColor.Grey
Case 28
Colors(Index) = wpThemeColor.LightGrey
Case 29
Colors(Index) = wpThemeColor.White
End Select
Next
End If
ColorPalette = Colors()
End Sub
Now, with a tiny helper function, PaletteColor, a simple loop can set the BackGround of the color rectangles ("Box1" etc.) in a snap:
现在，通过一个微小的辅助函数PaletteColor ，一个简单的循环即可快速设置颜色矩形的BackGround（“ Box1”等）：
' Returns the color value of Index from array ColorPalette
' which holds the Windows Phone Theme Colors.
' If ColorPalette is empty, LoadColors is called to fill it.
'
' 2017-04-21. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function PaletteColor( _
ByVal Index As Integer) _
As Long
If IsEmpty(ColorPalette) Then
' Fill array ColorPalette.
LoadColors
End If
PaletteColor = ColorPalette(Index)
End Function
Private Sub Form_Open(Cancel As Integer)
Dim Index As Integer
' Set colour palette.
For Index = 0 To 20
Me("Box" & CStr(Index + 1)).BackColor = PaletteColor(Index)
Me("Name" & CStr(Index + 1)).Value = LiteralWpThemeColor(PaletteColor(Index))
Me("Css" & CStr(Index + 1)).Value = RGBHex(PaletteColor(Index))
Me("Vba" & CStr(Index + 1)).Value = PaletteColor(Index)
Me("Hex" & CStr(Index + 1)).Value = "&H" & Hex(PaletteColor(Index))
Next
End Sub
The same loop is used to set the color name and the different value formats. These values are derived from two helper functions:
相同的循环用于设置颜色名称和不同的值格式。 这些值来自两个帮助器函数：
' Returns the literal name of the passed colour value if
' it is one of the Windows Phone Theme Colors.
'
' 2017-04-21. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function LiteralWpThemeColor( _
ByVal Color As wpThemeColor) _
As String
Dim Name As String
Select Case Color
Case wpThemeColor.Lime
Name = "Lime"
Case wpThemeColor.Green
Name = "Green"
Case wpThemeColor.Emerald
Name = "Emerald"
Case wpThemeColor.Teal
Name = "Teal"
Case wpThemeColor.Cyan
Name = "Cyan"
Case wpThemeColor.Cobalt
Name = "Cobalt"
Case wpThemeColor.Indigo
Name = "Indigo"
Case wpThemeColor.Violet
Name = "Violet"
Case wpThemeColor.Pink
Name = "Pink"
Case wpThemeColor.Magenta
Name = "Magenta"
Case wpThemeColor.Crimson
Name = "Crimson"
Case wpThemeColor.Red
Name = "Red"
Case wpThemeColor.Orange
Name = "Orange"
Case wpThemeColor.Amber
Name = "Amber"
Case wpThemeColor.Yellow
Name = "Yellow"
Case wpThemeColor.Brown
Name = "Brown"
Case wpThemeColor.Olive
Name = "Olive"
Case wpThemeColor.Steel
Name = "Steel"
Case wpThemeColor.Mauve
Name = "Mauve"
Case wpThemeColor.Sienna
Name = "Sienna"
Case wpThemeColor.Viridian
Name = "Viridian"
Case wpThemeColor.Blue
Name = "Blue"
Case wpThemeColor.Purple
Name = "Purple"
Case wpThemeColor.Mango
Name = "Mango"
Case wpThemeColor.Darken
Name = "Darken"
Case wpThemeColor.Black
Name = "Black"
Case wpThemeColor.DarkGrey
Name = "DarkGrey"
Case wpThemeColor.Grey
Name = "Grey"
Case wpThemeColor.LightGrey
Name = "LightGrey"
Case wpThemeColor.White
Name = "White"
End Select
LiteralWpThemeColor = Name
End Function
' Returns the CSS hex representation of a decimal RGB value
' with or without a leading octothorpe.
'
' Example:
' CSSValue = RGBHex(813466)
' ' CSSValue = "#9A690C"
' CSSValue = RGBHex(813466, True)
' ' CSSValue = "9A690C"
'
' 2017-03-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function RGBHex( _
ByVal Color As Long, _
Optional ByVal NoPrefix As Boolean) _
As String
' Format of RGB hex strings.
Const RGBPrefix As String = "#"
Dim Red As Integer
Dim Green As Integer
Dim Blue As Integer
Dim HexRGB As String
RGBComponent Color, , Red, Green, Blue
If Not NoPrefix Then
' Set prefix.
HexRGB = RGBPrefix
End If
' Assemble compound string with leading zeroes for small values.
HexRGB = HexRGB & _
Right("0" & Hex(Red), 2) & _
Right("0" & Hex(Green), 2) & _
Right("0" & Hex(Blue), 2)
RGBHex = HexRGB
End Function
Nothing fancy here.
这里没什么好看的。
(
)
点击复制 (Click-n-copy)
Neither does it take much to select and copy a value of a TextBox to the clipboard:
选择并将 TextBox的值复制到剪贴板也不需要很多：
' Select full content.
TextBox.SelStart = 0
TextBox.SelLength = Len(TextBox.Value)
' Display the clicked value.
TextBox.Parent!CopyClicked.Value = TextBox.Value
' Copy the clicked value to the clipboard.
DoCmd.RunCommand acCmdCopy
However, we have 3 x 20 textboxes so you would have to write 60 calls to such a helper function. A nightmare.
但是，我们有3 x 20的文本框，因此您将不得不编写60个此类辅助函数的调用。 一个噩梦。
Now is the time to call for WithEvents
现在是时候调用WithEvents了
If the purpose and usage of WithEvents is new to you, sadly the official documentation is poor and sparse, nearly missing; but a good intro by John Colby can be found here: Object wrappers and Event sinks
如果WithEvents的目的和用法对您来说是新的，那么可悲的是，官方文档不多且稀疏，几乎缺失； 但是可以在这里找到John Colby的精彩介绍： 对象包装器和事件接收器
Here we have too many controls to write them up one by one as in JCs' demo, so a collection is used to get hold of them.
在这里，我们有太多控件无法像JCs的演示中一样逐一编写，因此使用了一个集合来掌握它们。
This adds up in this class module:
这将添加到该类模块中：
Option Explicit
' Helper class for form Palette for event handling of textboxes.
' 2017-04-19. Gustav Brock, Cactus Data ApS, CPH.
' Version 1.0.0
' License: MIT.
' *
Private Const EventProcedure As String = "[Event Procedure]"
Private WithEvents ClassTextBox As Access.TextBox
Public Sub Initialize(ByRef TextBox As Access.TextBox)
Set ClassTextBox = TextBox
ClassTextBox.OnClick = EventProcedure
End Sub
Public Sub Terminate()
Set ClassTextBox = Nothing
End Sub
Private Sub ClassTextBox_Click()
' Select full content.
ClassTextBox.SelStart = 0
ClassTextBox.SelLength = Len(ClassTextBox.Value)
' Display the clicked value.
ClassTextBox.Parent!CopyClicked.Value = ClassTextBox.Value
' Copy the clicked value to the clipboard.
DoCmd.RunCommand acCmdCopy
End Sub
Yes, that is the complete module.
是的，那是完整的模块 。
And to load and unload the class module in the form, this is the code:
并以表单的形式加载和卸载类模块，这是代码：
Option Explicit
' Form to display the Windows Phone 7.5/8.0 colour theme.
' Also works as a basic example of implementing WithEvents for a form.
' 2017-04-19. Gustav Brock, Cactus Data ApS, CPH.
' Version 1.0.0
' License: MIT.
' *
Private ControlCollection As Collection
Private Sub Form_Load()
' Load events for all colour value textboxes.
Dim EventProcedure As ClassTextboxSelect
Dim Control As Access.Control
Set ControlCollection = New Collection
For Each Control In Me.Controls
If Control.ControlType = acTextBox Then
Set EventProcedure = New ClassTextboxSelect
EventProcedure.Initialize Control
ControlCollection.Add EventProcedure, Control.Name
End If
Next
Set EventProcedure = Nothing
Set Control = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Unload events for all colour value textboxes.
Dim EventProcedure As ClassTextboxSelect
For Each EventProcedure In ControlCollection
EventProcedure.Terminate
Next
Set EventProcedure = Nothing
Set ControlCollection = Nothing
End Sub
Again, this is the full code.
同样，这是完整的代码。
Compare that to write 60 times a set of code lines.
比较一下，以编写一组代码行60次 。
看看这个 (Check it out)
The form is now ready for use. Open it and click any value - and that value will be copied to the clipboard and also displayed in the textbox in the lower right corner.
现在可以使用该表格了。 打开它并单击任何值 -该值将被复制到剪贴板，并显示在右下角的文本框中。
附加功能 (Extras)
The attached file and its code modules also contains a couple of helper functions that can prove useful, though not used here.
附件及其代码模块还包含一些辅助功能，尽管在此未使用，但它们可能被证明是有用的。
First, this function will check if a color value is equal to one of the palette colors:
首先，此功能将检查颜色值是否等于调色板颜色之一：
' Returns True if the passed colour value is one of the
' Windows Phone Theme Colors.
'
' 2017-04-21. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function IsWpThemeColor(ByVal Color As Long) As Boolean
Dim Item As Integer
Dim IsColor As Boolean
If IsEmpty(ColorPalette) Then
' Fill public array ColorPalette.
LoadColors
End If
For Item = LBound(ColorPalette) To UBound(ColorPalette)
If Color = ColorPalette(Item) Then
IsColor = True
Exit For
End If
Next
IsWpThemeColor = IsColor
End Function
And the first of these two functions will convert a CSS color value of the format #AABBCC to a color value of VBA, while the other will split a VBA color value into its R, G, and B components.
这两个函数中的第一个会将格式为#AABBCC的CSS颜色值转换为VBA的颜色值，而另一个函数会将VBA颜色值分为R，G和B分量 。
Please study the in-line comments for typical usage:
请研究在线注释的典型用法：
' Returns the numeric RGB value from an CSS RGB hex representation.
' Will accept strings with or without a leading octothorpe.
'
' Examples:
' Color = RGBCompound("#9A690C")
' ' Color = 813466
' Color = RGBCompound("9A690C")
' ' Color = 813466
'
' 2017-03-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function RGBCompound( _
ByVal HexRGB As String) _
As Long
' Format of RGB hex strings.
Const RGBPrefix As String = "#"
Const Length As Integer = 6
' Format of Hex values.
Const HexPrefix As String = "&H"
Dim Start As Integer
Dim Color As Long
If Mid(HexRGB, 1, 1) = RGBPrefix Then
Start = 1
End If
If Len(HexRGB) = Start + Length Then
Color = RGB( _
HexPrefix & Mid(HexRGB, Start + 1, 2), _
HexPrefix & Mid(HexRGB, Start + 3, 2), _
HexPrefix & Mid(HexRGB, Start + 5, 2))
End If
RGBCompound = Color
End Function
' Calculate discrete RGB colours from a composite colour value and
' return one component.
' Also, by reference, return all components.
'
' Examples:
' Simple print of the components:
'
' SomeColor = 813466
' RGBComponent SomeColor
' ' Debug Print:
' ' 154 105 12
'
' Get one component from a colour value:
'
' Dim SomeColor As Long
' Dim Green As Integer
' SomeColor = 13466
' Green = RGBComponent(SomeColor, vbGreen)
' ' Green -> 52
'
' Get all components from a colour value:
'
' Dim SomeColor As Long
' Dim Red As Integer
' Dim Green As Integer
' Dim Blue As Integer
' SomeColor = 813466
' RGBComponent SomeColor, , Red, Green, Blue
' ' Red -> 154
' ' Green -> 105
' ' Green -> 12
'
' 2017-03-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function RGBComponent( _
ByVal RGB As Long, _
Optional ByVal Component As Long, _
Optional ByRef Red As Integer, _
Optional ByRef Green As Integer, _
Optional ByRef Blue As Integer) _
As Integer
Dim Color As Long
If RGB <= 0 Then
' Return Black.
Red = 0
Green = 0
Blue = 0
Else
' Extract the discrete colours from the composite RGB.
Red = RGB And vbRed
Green = (RGB And vbGreen) / &H100
Blue = (RGB And vbBlue) / &H10000
' Return chosen colour component.
Select Case Component
Case vbRed
Color = Red
Case vbGreen
Color = Green
Case vbBlue
Color = Blue
Case Else
Color = vbBlack
End Select
End If
' Debug.Print Red, Green, Blue
RGBComponent = Color
End Function
资料下载 (Downloads)
The current code can be found at GitHub: VBA.ModernTheme
当前代码可以在GitHub上找到： VBA.ModernTheme
It contains the separate modules and also the Access 2016 accdb-file.
它包含单独的模块以及Access 2016 accdb文件。
The full code and the Access application is attached here: ModernTheme 1.0.1.zip
完整的代码和Access应用程序附在此处： ModernTheme 1.0.1.zip
I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.
希望本文对您有所帮助。 鼓励您在下面提出问题，报告任何错误或对此作出任何其他评论。
Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts.
注意 ：如果您需要有关此主题的更多“支持”，请考虑使用Experts Exchange 的“提问”功能。 我会监督提出的问题，并很高兴与其他电子工程师一起为以这种方式提出的问题提供所需的任何其他支持。
Please do not forget to press the "Thumbs Up" button if you think this article was helpful and valuable for EE members.
如果您认为本文对EE成员有用且有价值，请不要忘记按下“竖起大拇指”按钮。
withevents
651
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
