Actually you can get VB to read strings from pointers returned by LCMS, I
have a VBA class that 100% supports LCMS - and also uses ICM2. (Yes in VBA -
no Joke!)
I found this code for converting Acsii and Unicode strings on the net a
while ago, I think it may have been on msdn.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As
Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal
lpString As Any) As Long
Public Function Ptr2StrU(ByVal pAddr As Long) As String
Dim lAddr As Long
lAddr = lstrlenW(pAddr)
Ptr2StrU = Space$(lAddr)
CopyMemory ByVal StrPtr(Ptr2StrU), ByVal pAddr, lAddr * 2
End Function
Public Function Ptr2StrA(ByVal pAddr As Long) As String
Dim lAddr As Long
Dim i
Dim x() As Byte
lAddr = lstrlen(pAddr)
ReDim x(lAddr)
CopyMemory ByVal VarPtr(x(0)), ByVal pAddr, lAddr ' copy char array to
byte array
Ptr2StrA = StrConv(x, vbUnicode) 'convert to byte array to unicode
End Function
Public Function Ptr2Long(ByVal pAddr As Long) As Long
Dim lAddr As Long
CopyMemory ByVal VarPtr(Ptr2Long), ByVal pAddr, 4
End Function
An example of how I use this is:
Public Function GetProfileInfo(filename, ByRef h As lcmsProfileHeadder) As
Boolean
Dim ProfileHandle As Long
cmsErrorAction 2
ProfileHandle = cmsOpenProfileFromFile(filename & vbNullChar, "r")
If ProfileHandle <> 0 Then
h.ColorSpace = GetColourSigName(cmsGetColorSpace(ProfileHandle))
h.Copyright = Ptr2StrA(cmsTakeCopyright(ProfileHandle))
h.DeviceClass = cmsGetDeviceClass(ProfileHandle)
h.Manufacturer = Ptr2StrA(cmsTakeManufacturer(ProfileHandle))
h.Model = Ptr2StrA(cmsTakeModel(ProfileHandle))
h.PCS = GetColourSigName(cmsGetPCS(ProfileHandle))
h.ProductDesc = Ptr2StrA(cmsTakeProductDesc(ProfileHandle))
h.ProductInfo = Ptr2StrA(cmsTakeProductInfo(ProfileHandle))
h.ProductName = Ptr2StrA(cmsTakeProductName(ProfileHandle))
h.ProfileICCversion = cmsGetProfileICCversion(ProfileHandle)
h.RenderingIntent = cmsTakeRenderingIntent(ProfileHandle)
GetProfileInfo = True
Else
GetProfileInfo = False
End If
End Function
Glenn Wilton
----- Original Message -----
From: "Marti" <[EMAIL PROTECTED]>
To: <[EMAIL PROTECTED]>; <lcms-user@lists.sourceforge.net>
Sent: Monday, September 12, 2005 8:23 PM
Subject: Re: [Lcms-user] RGB to CMYK transform in VB 6
Hi,
Hi there, I'm trying to create a small VB app to apply a color
transform fom RGB to CMYK between two different profiles.
Visual Basic is unsupported because there is no way to
implement some functions, like those returning strings.
But for the transform stuff, it works quite well.
You need something like that:
Private Const INTENT_PERCEPTUAL = 0
Private Const cmsFLAGS_NOTPRECALC = &H100
Private Const TYPE_CMYK_8 = &H60021
Private Const TYPE_RGB_8 = &H40019
Private Declare Function cmsOpenProfileFromFile Lib "lcms.dll" (ByVal
lpFileName As String, ByVal sAccess As String) As Long
Private Declare Function cmsCreateTransform Lib "lcms.dll" (ByVal
InputProfile As Long, ByVal InputFormat As Long, ByVal OutputProfile As
Long, ByVal OutputFormat As Long, ByVal Intent As Long, ByVal dwFlags As
Long) As Long
Private Declare Sub cmsCloseProfile Lib "lcms.dll" (ByVal hProfile As
Long)
Private Declare Sub cmsDeleteTransform Lib "lcms.dll" (ByVal hTransform As
Long)
Private Declare Sub cmsDoTransform Lib "lcms.dll" (ByVal Transform As
Long, InputBuffer As Any, OutputBuffer As Any, ByVal Size As Long)
Private Type RGBColorType
R As Byte
G As Byte
B As Byte
End Type
Private Type CMYKColorType
C As Byte
M As Byte
Y As Byte
K As Byte
End Type
...
Private hCMYK As Long, hRGB As Long, hXFORM As Long
Private rgb1 As RGBColorType
Private cmyk1 As CMYKColorType
...
hCMYK = cmsOpenProfileFromFile("cmyk.icm", "r")
hRGB = cmsOpenProfileFromFile("srgb color space profile.icm", "r")
hXFORM = cmsCreateTransform(hRGB, TYPE_RGB_8, hCMYK, TYPE_CMYK_8, ,
INTENT_PERCEPTUAL, 0)
...
cmsDoTransform hXFORM, rgb1, cmyk1, 1
...
cmsDeleteTransform hXFORM
cmsCloseProfile hCMYK
cmsCloseProfile hRGB
Hope this helps,
Regards
--
Marti Maria
The littlecms project.
www.littlecms.com
--
No virus found in this outgoing message.
Checked by AVG Anti-Virus.
Version: 7.0.344 / Virus Database: 267.10.21/96 - Release Date: 10/09/2005
-------------------------------------------------------
SF.Net email is Sponsored by the Better Software Conference & EXPO
September 19-22, 2005 * San Francisco, CA * Development Lifecycle
Practices
Agile & Plan-Driven Development * Managing Projects & Teams * Testing & QA
Security * Process Improvement & Measurement * http://www.sqe.com/bsce5sf
_______________________________________________
Lcms-user mailing list
Lcms-user@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/lcms-user
-------------------------------------------------------
SF.Net email is Sponsored by the Better Software Conference & EXPO
September 19-22, 2005 * San Francisco, CA * Development Lifecycle Practices
Agile & Plan-Driven Development * Managing Projects & Teams * Testing & QA
Security * Process Improvement & Measurement * http://www.sqe.com/bsce5sf
_______________________________________________
Lcms-user mailing list
Lcms-user@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/lcms-user
