GDI+_从Bitmap里得到的Color数组值解决方案

' 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
原文地址:https://www.cnblogs.com/lingqingxue/p/10398710.html