vbAccelerator - Contents of code file: cCMYK.clsVERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cCMYK"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'
' vbAccelerator.com
' VB CMYK (Cyan, Magenta, Yellow, blacK) subtractive colour model.
' Copyright 2003 Steve McMahon for vbAccelerator.com
'
'
' http://www.neuro.sfc.keio.ac.jp/~aly/polygon/info/color-space-faq.html
'CMY -> CMYK | CMYK -> CMY
' Black=minimum(Cyan,Magenta,Yellow) | Cyan=minimum(1,Cyan*(1-Black)+Black)
' Cyan=(Cyan-Black)/(1-Black) |
Magenta=minimum(1,Magenta*(1-Black)+Black)
' Magenta=(Magenta-Black)/(1-Black) |
Yellow=minimum(1,Yellow*(1-Black)+Black)
' Yellow=(Yellow-Black)/(1-Black) |
'
' RGB -> CMYK | CMYK -> RGB
' Black=minimum(1-Red,1-Green,1-Blue) | Red=1-minimum(1,Cyan*(1-Black)+Black)
' Cyan=(1-Red-Black)/(1-Black) |
Green=1-minimum(1,Magenta*(1-Black)+Black)
' Magenta=(1-Green-Black)/(1-Black) |
Blue=1-minimum(1,Yellow*(1-Black)+Black)
' Yellow=(1-Blue-Black)/(1-Black) |
Private m_lR As Long
Private m_lG As Long
Private m_lB As Long
Private m_lC As Long
Private m_lM As Long
Private m_lY As Long
Private m_lK As Long
Public Property Get RGB() As Long
RGB = (m_lR And &HFF&) + (m_lG And &HFF&) * &H100& + (m_lB And &HFF&) *
&H10000
End Property
Public Property Let RGB(ByVal value As Long)
m_lR = value And &HFF&
m_lG = (value And &HFF00&) \ &H100&
m_lB = (value And &HFF0000) \ &H10000
calcCMYK
End Property
Public Property Get R() As Long
R = m_lR
End Property
Public Property Get G() As Long
G = m_lG
End Property
Public Property Get B() As Long
B = m_lB
End Property
Public Property Let R(ByVal value As Long)
m_lR = value And &HFF&
calcCMYK
End Property
Public Property Let G(ByVal value As Long)
m_lG = value And &HFF&
calcCMYK
End Property
Public Property Let B(ByVal value As Long)
m_lB = value And &HFF&
calcCMYK
End Property
Public Property Get C() As Long
C = m_lC
End Property
Public Property Get M() As Long
M = m_lM
End Property
Public Property Get y() As Long
y = m_lY
End Property
Public Property Get K() As Long
K = m_lK
End Property
Public Property Let C(ByVal value As Long)
m_lC = value And &HFF&
calcRGB
End Property
Public Property Let M(ByVal value As Long)
m_lM = value And &HFF&
calcRGB
End Property
Public Property Let y(ByVal value As Long)
m_lY = value And &HFF&
calcRGB
End Property
Public Property Let K(ByVal value As Long)
m_lK = value And &HFF&
calcRGB
End Property
Public Sub FromCMY(ByVal cValue As Long, ByVal mValue As Long, ByVal yValue As
Long)
m_lR = &HFF& - (cValue And &HFF&)
m_lG = &HFF& - (mValue And &HFF&)
m_lB = &HFF& - (yValue And &HFF&)
calcCMYK
End Sub
Public Function ToCMY() As cCMY
Dim cCMYCalc As New cCMY
cCMYCalc.RGB = RGB
Set ToCMY = cCMYCalc
End Function
Public Sub FromCMYK(ByVal cValue As Long, ByVal mValue As Long, ByVal yValue As
Long, ByVal kValue As Long)
m_lC = cValue And &HFF&
m_lM = mValue And &HFF&
m_lY = yValue And &HFF&
m_lK = kValue And &HFF&
calcRGB
End Sub
Private Sub calcRGB()
m_lR = m_lK + (m_lC * (&HFF& - m_lK)) / &HFF&
If (m_lR > &HFF&) Then
m_lR = &HFF&
End If
m_lR = &HFF& - m_lR
m_lG = m_lK + (m_lM * (&HFF& - m_lK)) / &HFF&
If (m_lG > &HFF&) Then
m_lG = &HFF&
End If
m_lG = &HFF& - m_lG
m_lB = m_lK + (m_lY * (&HFF& - m_lK)) / &HFF&
If (m_lB > &HFF&) Then
m_lB = &HFF&
End If
m_lB = &HFF& - m_lB
End Sub
Private Sub calcCMYK()
' Get CMY model colours:
m_lC = &HFF& - m_lR
m_lM = &HFF& - m_lG
m_lY = &HFF& - m_lB
' Choose minimum as black:
If (m_lC < m_lM) Then
If (m_lC < m_lY) Then
m_lK = m_lC
Else
m_lK = m_lY
End If
Else
If (m_lM < m_lY) Then
m_lK = m_lM
Else
m_lK = m_lY
End If
End If
' Set the CMY with black adjustment.
If (m_lK = &HFF&) Then
m_lC = &HFF&
m_lM = &HFF&
m_lY = &HFF&
Else
m_lC = ((&HFF& - m_lR - m_lK) * &HFF&) / (&HFF& - m_lK)
m_lM = ((&HFF& - m_lG - m_lK) * &HFF&) / (&HFF& - m_lK)
m_lY = ((&HFF& - m_lB - m_lK) * &HFF&) / (&HFF& - m_lK)
End If
End Sub
|
|