here comes code for the native Colorpicker and some Color conversions:
ColorValue to RGB
RGB to CMYK
CMYK to RGB
Code: Select all
Sub Pick_a_Color_and_give_info
initcolor=2940114
oColorVal = Colorpickerkai(initcolor)
oColorVal_to_RGB(oColorVal, iRed, iGreen, iBlue)
RGB_to_CMYK(iRed, iGreen, iBlue, iCyan, iMagenta, iYellow, iKey)
CMYK_to_RGB(iCyan, iMagenta, iYellow, iKey, iRed2, iGreen2, iBlue2 )
msgColorVal = "ColorVal: " & oColorVal & Chr$(10)
msgHex = "Hex: " & hex(oColorVal) & Chr$(10)
msgRGB = "RGB( " & iRed & " , " & iGreen & " , " & iBlue & " )" & Chr$(10)
msgCMYK = "CMYK:" & Chr$(10) & "Cyan: " & iCyan & "%" & chr(10) & "Magenta: " & iMagenta & "%" & chr(10) & "Yellow: " & iYellow & "%" & chr(10) & "Key " & iKey & "%" & Chr$(10)
msgBacktoRGB = "CMYKBacktoRGB: " & "RGB( " & iRed2 & " , " & iGreen2 & " , " & iBlue2 & " )"
oDisp = msgColorVal & msgHex & msgRGB & msgCMYK & msgBacktoRGB
msgbox oDisp
end sub
Sub Colorpickerkai (initcolor) as string
Dim oColorPick as Object
Dim oGetProps() as Object
Dim oProps(0) As New com.sun.star.beans.PropertyValue
Dim oColorVal as Long
oColorPick = CreateUnoService("com.sun.star.ui.dialogs.ColorPicker")
oGetProps = oColorPick.getPropertyValues()
oProps(0).Name = "Color"
oProps(0).Value = CLng(initcolor)
oColorPick.initialize(oProps)
oColorPick.setPropertyValues(oProps)
oColorPick.execute()
oGetProps = oColorPick.getPropertyValues()
oColorVal = oGetProps(0).Value
Colorpickerkai = oColorVal
End Sub
function oColorVal_to_RGB(oColorVal, iRed, iGreen, iBlue)
iRed=red(oColorVal)
iGreen=green(oColorVal)
iBlue=blue(oColorVal)
end function
rem--- alternative function
function oColorVal_to_RGB2(oColorVal, iRed, iGreen, iBlue)
Dim RGB As Long
RGB = oColorVal
x = RGB \ 256 ' use backslash (\) to drop the remainder instead of rounding
iRed = x \ 256 ' leftmost 8 digits show blue
iGreen = x - iRed * 256 ' middle 8 are green
iBlue = RGB - x * 256
end function
rem--- alternative function
function oColorVal_to_RGB3(oColorVal, iRed, iGreen, iBlue)
oHex=hex(oColorVal)
oHex=string(6-len(oHex),"0") & oHex
iRed = CLng("&H" & CStr(Left(oHex, 2)))
iGreen = CLng("&H" & CStr(mid(oHex,3,2)))
iBlue = CLng("&H" & CStr(Right(oHex,2)))
end function
function RGB_to_CMYK (iRed, iGreen, iBlue, iCyan, iMagenta, iYellow, iKey)
Dim dR as Double
Dim dG as Double
Dim dB as Double
dR = iRed/255
dG = iGreen/255
dB = iBlue/255
fCyan = 1 - dR
fMagenta = 1 - dG
fYellow = 1 - dB
'CMYK and CMY values from 0 to 1
fKey = 1.0
if ( fCyan < fKey ) then fKey = fCyan
if ( fMagenta < fKey ) then fKey = fMagenta
if ( fYellow < fKey ) then fKey = fYellow
if ( fKey >= 1 ) then
'Black
fCyan = 0.0
fMagenta = 0.0
fYellow = 0.0
else
fCyan = ( fCyan - fKey ) / ( 1.0 - fKey )
fMagenta = ( fMagenta - fKey ) / ( 1.0 - fKey )
fYellow = ( fYellow - fKey ) / ( 1.0 - fKey )
end if
iCyan=cint(fCyan*100)
iMagenta=cint(fMagenta*100)
iYellow=cint(fYellow*100)
iKey=cint(fKey*100)
end function
function CMYK_to_RGB(iCyan, iMagenta, iYellow, iKey, iRed, iGreen, iBlue )
Dim dR as Double
Dim dG as Double
Dim dB as Double
fCyan=iCyan/100
fMagenta=iMagenta/100
fYellow=iYellow/100
fKey=iKey/100
fCyan = (fCyan * ( 1.0 - fKey )) + fKey
fMagenta = (fMagenta * ( 1.0 - fKey )) + fKey
fYellow = (fYellow * ( 1.0 - fKey )) + fKey
dR = ( 1.0 - fCyan )
dG = ( 1.0 - fMagenta )
dB = ( 1.0 - fYellow )
if dR>=1 then dR=1
if dR<=0 then dR=0
if dG>=1 then dG=1
if dG<=0 then dG=0
if dB>=1 then dB=1
if dB<=0 then dB=0
iRed=cint(dR*255)
iGreen=cint(dG*255)
iBlue=cint(dB*255)
end function