Option Explicit 'メモリコピー Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) 'RGB値を保持する構造体 Private Type RGBQUAD R As Byte G As Byte B As Byte P As Byte End Type '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ' 機 能：RGB値を各方法でR、G、B、P に分解する ' 引 数：(i)RGBValue … RGB値 ' 返り値：なし '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Public Sub ExtractRGB(ByVal RGBValue As Long) Dim PtrRGBValue As Long Dim i As Long '構造体のポインタを取得 PtrRGBValue = VarPtr(RGBValue) '普通にビットシフトもどき処理でRGBを取得 … @ Dim udtRGB1 As RGBQUAD udtRGB1.R = RGBValue And &HFF udtRGB1.G = (RGBValue And &HFF00&) \ &H100& udtRGB1.B = (RGBValue And &HFF0000) \ &H10000 udtRGB1.P = (RGBValue And &HFF000000) \ &H1000000 Call PrintRGBQuad(udtRGB1) 'Byte型変数にメモリコピーする … A Dim R As Byte Dim G As Byte Dim B As Byte Dim P As Byte Call CopyMemory(ByVal VarPtr(R), ByVal PtrRGBValue, 1) Call CopyMemory(ByVal VarPtr(G), ByVal PtrRGBValue + 1, 1) Call CopyMemory(ByVal VarPtr(B), ByVal PtrRGBValue + 2, 1) Call CopyMemory(ByVal VarPtr(P), ByVal PtrRGBValue + 3, 1) Debug.Print R, G, B, P 'RGBQUAD構造体の各メンバ変数にメモリコピーする(ベタ) … B Dim udtRGB2 As RGBQUAD Call CopyMemory(ByVal VarPtr(udtRGB2.R), ByVal PtrRGBValue, 1) Call CopyMemory(ByVal VarPtr(udtRGB2.G), ByVal PtrRGBValue + 1, 1) Call CopyMemory(ByVal VarPtr(udtRGB2.B), ByVal PtrRGBValue + 2, 1) Call CopyMemory(ByVal VarPtr(udtRGB2.P), ByVal PtrRGBValue + 3, 1) Call PrintRGBQuad(udtRGB2) 'RGBQUAD構造体の各メンバ変数にメモリコピーする(回転) … C Dim udtRGB3 As RGBQUAD For i = 0 To Len(udtRGB3) - 1 Call CopyMemory(ByVal VarPtr(udtRGB3) + i, ByVal PtrRGBValue + i, 1) Next i Call PrintRGBQuad(udtRGB3) 'RGBQUAD構造体の変数にがっつりメモリコピーする … D Dim udtRGB4 As RGBQUAD Call CopyMemory(ByVal VarPtr(udtRGB4), ByVal PtrRGBValue, Len(udtRGB4)) Call PrintRGBQuad(udtRGB4) '再起関数を作成してメモリコピーする … E Dim udtRGB5 As RGBQUAD Call CopyRGB2Udt(RGBValue, udtRGB5) Call PrintRGBQuad(udtRGB5) End Sub '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ' 機 能：RGB値をRGBQUAD構造体に展開する ' 引 数：(i)RGBValue … RGB値 ' (i/o)udtRGB … RGBQUAD構造体 ' 返り値：なし '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Private Sub CopyRGB2Udt(ByVal RGBValue As Long, ByRef udtRGB As RGBQUAD, Optional ByVal mPos As Long = 0) If mPos >= Len(udtRGB) Then Exit Sub Call CopyMemory(ByVal VarPtr(udtRGB) + mPos, ByVal VarPtr(RGBValue) + mPos, 1) Call CopyRGB2Udt(RGBValue, udtRGB, mPos + 1) End Sub '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ' 機 能：RGBQUAD構造体のメンバをデバッグ窓に表示する ' 引 数：(i)udtRGB … RGBQUAD構造体 ' 返り値：なし '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Private Sub PrintRGBQuad(ByRef udtRGB As RGBQUAD) With udtRGB Debug.Print .R, .G, .B, .P End With End Sub '================================================================================== '================ おまけ おまけ おまけ おまけ おまけ おまけ おまけ ================ '================ おまけ おまけ おまけ おまけ おまけ おまけ おまけ ================ '================ おまけ おまけ おまけ おまけ おまけ おまけ おまけ ================ '================================================================================== 'Private Declare Function GetTickCount Lib "kernel32" () As Long ' '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ' 機 能：R、G、B、P に分解するRGB値の各処理時間を計測する ' 引 数：(i)RGBValue … RGB値 ' 返り値：なし ' 備 考：各処理100万回×100回 ' あたしの環境での計測時間(100回平均) → Dがダントツで速い ' @300.15ミリ秒 A380.94ミリ秒 B380.47ミリ秒 ' C648.12ミリ秒 D96.41ミリ秒 E1550.63ミリ秒 '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 'Public Sub TickTackExtractRGB(ByVal RGBValue As Long) ' Dim PtrRGBValue As Long ' Dim i As Long ' Dim x&, y As Long ' Dim StartTime&, EndTime As Long ' Dim Counter As Long ' ' '構造体のポインタを取得 ' PtrRGBValue = VarPtr(RGBValue) ' ' '普通にビットシフトもどき処理でRGBを取得 … @ ' Counter = 0 ' For x = 0 To 100 ' StartTime = GetTickCount ' For y = 0 To 1000000 ' Dim udtRGB1 As RGBQUAD ' udtRGB1.R = RGBValue And &HFF ' udtRGB1.G = (RGBValue And &HFF00&) \ &H100& ' udtRGB1.B = (RGBValue And &HFF0000) \ &H10000 ' udtRGB1.P = (RGBValue And &HFF000000) \ &H1000000 ' Next y ' EndTime = GetTickCount ' Counter = Counter + (EndTime - StartTime) ' Next x ' Debug.Print "@" & Counter / 100 ' ' 'Byte型変数にメモリコピーする … A ' Counter = 0 ' For x = 0 To 100 ' StartTime = GetTickCount ' For y = 0 To 1000000 ' Dim R As Byte ' Dim G As Byte ' Dim B As Byte ' Dim P As Byte ' Call CopyMemory(ByVal VarPtr(R), ByVal PtrRGBValue, 1) ' Call CopyMemory(ByVal VarPtr(G), ByVal PtrRGBValue + 1, 1) ' Call CopyMemory(ByVal VarPtr(B), ByVal PtrRGBValue + 2, 1) ' Call CopyMemory(ByVal VarPtr(P), ByVal PtrRGBValue + 3, 1) ' Next y ' EndTime = GetTickCount ' Counter = Counter + (EndTime - StartTime) ' Next x ' Debug.Print "A" & Counter / 100 ' ' 'RGBQUAD構造体の各メンバ変数にメモリコピーする(ベタ) … B ' Counter = 0 ' For x = 0 To 100 ' StartTime = GetTickCount ' For y = 0 To 1000000 ' Dim udtRGB2 As RGBQUAD ' Call CopyMemory(ByVal VarPtr(udtRGB2.R), ByVal PtrRGBValue, 1) ' Call CopyMemory(ByVal VarPtr(udtRGB2.G), ByVal PtrRGBValue + 1, 1) ' Call CopyMemory(ByVal VarPtr(udtRGB2.B), ByVal PtrRGBValue + 2, 1) ' Call CopyMemory(ByVal VarPtr(udtRGB2.P), ByVal PtrRGBValue + 3, 1) ' Next y ' EndTime = GetTickCount ' Counter = Counter + (EndTime - StartTime) ' Next x ' Debug.Print "B" & Counter / 100 ' ' 'RGBQUAD構造体の各メンバ変数にメモリコピーする(回転) … C ' Counter = 0 ' For x = 0 To 100 ' StartTime = GetTickCount ' For y = 0 To 1000000 ' Dim udtRGB3 As RGBQUAD ' For i = 0 To Len(udtRGB3) - 1 ' Call CopyMemory(ByVal VarPtr(udtRGB3) + i, ByVal PtrRGBValue + i, 1) ' Next i ' Next y ' EndTime = GetTickCount ' Counter = Counter + (EndTime - StartTime) ' Next x ' Debug.Print "C" & Counter / 100 ' ' 'RGBQUAD構造体の変数にがっつりメモリコピーする … D ' Counter = 0 ' For x = 0 To 100 ' StartTime = GetTickCount ' For y = 0 To 1000000 ' Dim udtRGB4 As RGBQUAD ' Call CopyMemory(ByVal VarPtr(udtRGB4), ByVal PtrRGBValue, Len(udtRGB4)) ' Next y ' EndTime = GetTickCount ' Counter = Counter + (EndTime - StartTime) ' Next x ' Debug.Print "D" & Counter / 100 ' ' '再起関数を作成してメモリコピーする … E ' Counter = 0 ' For x = 0 To 100 ' StartTime = GetTickCount ' For y = 0 To 1000000 ' Dim udtRGB5 As RGBQUAD ' Call CopyRGB2Udt(RGBValue, udtRGB5) ' Next y ' EndTime = GetTickCount ' Counter = Counter + (EndTime - StartTime) ' Next x ' Debug.Print "E" & Counter / 100 'End Sub