' InkHin_ZhiZhuo ' Date :2019.2.18 ' E-mail lqx@tyningling.Top 'This function and Module is written because of the need to use Gdiplus. ' My English is limited. I hope youall don't laugh at me. ' The ARGB attribute obtained by inverse calculation. ' Em...... And... I love China.... emmm, yes, I like it very much. ' All right, Be is it. ' 装不下去了哈哈哈哈,本来想当一把外国友人过把瘾的。。 Option Explicit Public Type ARGB Alpha As String Red As String Green As String Blue As String End Type Private ARGB_a As ARGB Public Sub IFunction_Name_A(Color As String) If ARGB_FormColor(Color, ARGB_a) Then With ARGB_a MsgBox _ "A: " & .Alpha & " " & "Ten:" & Val("&H" & .Alpha) & vbCrLf _ & "R: " & .Red & " " & "Ten:" & Val("&H" & .Red) & vbCrLf _ & "G: " & .Green & " " & "Ten:" & Val("&H" & .Green) & vbCrLf _ & "B: " & .Blue & " " & "Ten:" & Val("&H" & .Blue), vbOKOnly, "InkHin_Yes" End With Else MsgBox "出现错误。", vbOKOnly, "InkHin_Error" End If End Sub Public Sub IFunction_Name_B(ByRef ARGB_a As ARGB) 'ARGB from Attribute Computing Dim Color As Long With ARGB_a .Alpha = 255 .Green = 255 End With If ARGB_FormValue(ARGB_a, Color) Then MsgBox Color, vbOKOnly, "InkHin_Yes" Else MsgBox "出现错误。", vbOKOnly, "InkHin_Error" End If End Sub Function ARGB_FormColor(ByVal ArgbColor As String, ByRef ARGB As ARGB) As Boolean ' ArgbColor belongs to decimal If Not IsNumeric(ArgbColor) Then Exit Function ' End Dim String_DecimalSystem As String ' var DecimalSystem String_DecimalSystem = Hex(CDbl(ArgbColor)) 'Coercive transformation 'Mid(string,start[,length]) With ARGB .Alpha = Mid(String_DecimalSystem, 1, 2) .Red = Mid(String_DecimalSystem, 3, 2) .Green = Mid(String_DecimalSystem, 5, 2) .Blue = Mid(String_DecimalSystem, 7, 2) End With ARGB_FormColor = True End Function Public Function ARGB_FormValue(ByRef ARGB As ARGB, ByRef Color As Long) As Boolean 'ARGB(alpha,red,green,blue) With ARGB If Val(.Alpha) > 255 Or Val(.Red) > 255 Or Val(.Green) > 255 Or Val(.Blue) > 255 Then Exit Function 'End If Val(.Alpha) < 0 Or Val(.Red) < 0 Or Val(.Green) < 0 Or Val(.Blue) < 0 Then Exit Function 'End Dim S_a As String, S_r As String, S_g As String, S_b As String, S_16 As String ' var add...... S_a = Hex(Val(.Alpha)): S_r = Hex(Val(.Red)): S_g = Hex(Val(.Green)): S_b = Hex(Val(.Blue)) 'Hex(var DecimalSystem = ) End With 'Because......十六进制ARGB is 两位为一个值的。 'if this 字数= 1 so 加0 ' 完了,我自己都看不下去了 If Len(S_a) < 2 Then S_a = "0" & S_a If Len(S_r) < 2 Then S_r = "0" & S_r If Len(S_g) < 2 Then S_g = "0" & S_g If Len(S_b) < 2 Then S_b = "0" & S_b S_16 = "&H" & S_a & S_r & S_g & S_b Color = Val(S_16) ARGB_FormValue = True End Function
贴上第二份代码:
2019.7.11更新:
'by 方程&Error404 Public Function argb(ByVal a As byte, ByVal r As byte, ByVal g As byte, ByVal b As byte) As Long Dim Color As Long If a = 0 And r = 0 And g = 0 And b = 0 Then r = 1 CopyMemory ByVal VarPtr(Color) + 3, a, 1 CopyMemory ByVal VarPtr(Color) + 2, r, 1 CopyMemory ByVal VarPtr(Color) + 1, g, 1 CopyMemory ByVal VarPtr(Color), b, 1 argb = Color End Function