You find this example project in your Plugins Download as a Xojo project file within the examples folder: /DynaPDF/PDF Color Analyze
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Function CellBackgroundPaint(g As Graphics, row As Integer, column As Integer) As Boolean
//
if _
column <> 1 or _
row > me.ListCount - 1 or _
me.CellTag( row, 0 ) = Nil _
then
//
Return( False )
end if
//
g.ForeColor = me.CellTag( row, 0 )
g.FillRect( 0, 0, g.Width, g.Height )
//
Return( False )
End EventHandler
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action()
//
dim f As FolderItem = GetOpenFolderItem( FileTypes1.PDF )
//
if f = Nil or f.Exists = False then
//
Return
end if
//
Call Analyze( f )
End EventHandler
End Control
Control Pop_Encoding Inherits PopupMenu
ControlInstance Pop_Encoding Inherits PopupMenu
End Control
Function Analyze(f As FolderItem) As Boolean
//
List.DeleteAllRows
List.ScrollPosition = 0
//
if f = Nil or f.Exists = False then
//
GoTo myReturn_False
end if
//
dim pdf As New MyDynapdfMBS
pdf.SetLicenseKey "Pro" // For this example you can use a Pro or Enterprise License
if Not pdf.CreateNewPDF( Nil ) then
//
MsgBox( "ERROR: Out of Memory!" )
//
GoTo myReturn_False
end if
//
if pdf.OpenImportFile( f, pdf.kptopen, "" ) <> 0 then
//
MsgBox( "ERROR: Wrong 'Type / PWD / etc'?" )
//
GoTo myReturn_False
end if
call pdf.SetImportFlags(pdf.kifImportAsPage + pdf.kifImportAll)
call pdf.ImportPDFFile(1, 1, 1)
//
for iCs As Integer = 0 to pdf.GetColorSpaceCount - 1
//
dim cp As DynapdfColorSpaceMBS = pdf.GetColorSpaceObj( iCs)
if cp<>nil then
//
List.AddRow ""
List.AddRow "##### New Color: (" +Str( iCs ) + ") ##########"
//
List.AddRow "Type: " + Str( cp.Type ) + ": " + ColorSpaceType_Get_Name( cp.Type )
List.AddRow " Colorants: " + Colorants_Get( cp )
List.AddRow " Attributes: " + Attributes_Get( cp )
List.AddRow " Alternate: " + Str( cp.AlternateType ) + ": " + ColorSpaceType_Get_Name( cp.AlternateType )
List.AddRow " NumInComponents: " + Str( cp.NumInComponents )
List.AddRow " NumOutComponents: " + Str( cp.NumOutComponents )
// Is separation colorspace
if cp.Type = DynapdfMBS.kesSeparation then
//
dim c1( -1 ) As Double = Array( 1.00 )
dim c2 As Integer = pdf.ConvColor( c1, cp.Handle, DynapdfMBS.kesDeviceCMYK )
List.AddRow " Color Value (CMYK): " + Str( c2 )
// Show the colors
List.CellTag( List.LastIndex, 0 ) = CMYK_Color_Get_RbColor( c2 )
// Add the color values
dim dColors( -1 ) As Double = CMYK_Color_Get_Values( c2 )
dim sColor( -1 ) As String
for iCount As Integer = 0 to UBound( dColors )
sColor.Append Str( dColors( iCount ) )
next
List.Cell( List.LastIndex, 0 ) = List.Cell( List.LastIndex, 0 ) + " - " + Join( sColor, ", " )
end if
// Has an alternate handle
dim cp2 As DynapdfColorSpaceMBS = cp.Alternate
if cp2<>Nil then
List.AddRow " Type: " + Str( cp2.Type ) + ": " + ColorSpaceType_Get_Name( cp2.type )
List.AddRow " Colorants: " + Colorants_Get( cp2 )
List.AddRow " Attributes: " + Attributes_Get( cp2 )
List.AddRow " Alternate: " + Str( cp2.AlternateType ) + ": " + ColorSpaceType_Get_Name( cp2.AlternateType )
List.AddRow " NumInComponents: " + Str( cp2.NumInComponents )
List.AddRow " NumOutComponents: " + Str( cp2.NumOutComponents )
end if
end if
next // Next colorspace
// Clean up
Call pdf.CloseImportFile
Call pdf.CloseFile
Call pdf.FreePDF
//
Return( True )
//
myReturn_False:
//
Return( False )
End Function
Function Attributes_Get(cp As DynapdfColorSpaceMBS) As string
dim d As DynaPDFDeviceNAttributesMBS = cp.DeviceNAttributes
if d <> Nil then
//
dim ss( -1 ) As string
dim cc As integer = d.SeparationsCount - 1
//
for ii As integer = 0 to cc
ss.Append d.Separations( ii ).Name
next
//
dim tt( -1 ) As string
cc = d.ProcessColorantsCount - 1
//
for ii As integer = 0 to cc
tt.Append d.ProcessColorants( ii )
next
//
Return( "Separations: " + Join( ss,", " ) + ", ProcessColorants: " + Join( tt,", " ) )
end if
//
Return( "none" )
End Function
Function CMYK_Color_Get_RbColor(i As Integer) As Color
//
dim dFakt As Double = 1 / 255
//
dim c, m, y, k As Double
//
c = dFakt * DynapdfMBS.CofCMYK( i )
m =dFakt * DynapdfMBS.MofCMYK( i )
y = dFakt * DynapdfMBS.YofCMYK( i )
k = dFakt * DynapdfMBS.KofCMYK( i )
// add black 'dirty'
c = Min( c + k, 1 )
m = Min( m + k, 1 )
Y = Min( y + k, 1 )
//
Return( CMY( c, m, y ) )
End Function
Function CMYK_Color_Get_Values(i As Integer) As Double()
//
dim d( -1 ) As Double
//
d.Append DynapdfMBS.CofCMYK( i )
d.Append DynapdfMBS.MofCMYK( i )
d.Append DynapdfMBS.YofCMYK( i )
d.Append DynapdfMBS.KofCMYK( i )
//
Return( d )
End Function
Function ColorSpaceType_Get_Name(kesN As integer) As string
//
dim s As string
//
Select Case kesN
Case DynaPDFMBS.kesDeviceRGB // Device color space
s = "DeviceRGB"
Case DynaPDFMBS.kesDeviceCMYK // Device color space
s = "DeviceCMYK"
Case DynaPDFMBS.kesDeviceGray // Device color space
s = "DeviceGray"
Case DynaPDFMBS.kesCalGray // CIE-based color space
s = "CalGray"
Case DynaPDFMBS.kesCalRGB // CIE-based color space
s = "CalRGB"
Case DynaPDFMBS.kesLab // CIE-based color space
s = "Lab"
Case DynaPDFMBS.kesICCBased // ICC-based color space -> contains an ICC profile
s = "ICCBased "
Case DynaPDFMBS.kesPattern // Special color space
s = "Pattern"
Case DynaPDFMBS.kesIndexed // Special color space
s = "Indexed "
Case DynaPDFMBS.kesSeparation // Special color space
s = "Separation"
Case DynaPDFMBS.kesDeviceN // Special color space
s = "DeviceN"
Case DynaPDFMBS.kesNChannel // Special color space
s = "NChannel"
else
s = "?"
end Select
//
Return( s )
End Function
Function Colorants_Clean(s As String) As String
//
dim sBack As String
//
Select Case Pop_Encoding.ListIndex
Case 0
sBack = DefineEncoding( s, Encodings.UTF8 )
Case 1
sBack = DefineEncoding( s, Encodings.MacRoman )
Case 2
sBack = DefineEncoding( s, Encodings.WindowsANSI )
Case 3
sBack = DefineEncoding( s, Encodings.ASCII )
End Select
//
for i As Integer = 0 to 31
if InStr( sBack, Chr( i ) ) > 0 then
sBack = ReplaceAll( sBack, Chr( i ), "?" )
end if
next
//
Return( sBack )
End Function
Function Colorants_Get(cp As DynapdfColorSpaceMBS) As string
//
dim c As Integer = cp.ColorantsCount - 1
//
dim lines( -1 ) As string
//
for i As Integer = 0 to c
lines.Append Colorants_Clean( cp.Colorants( i ) )
next
//
Return( Join( lines,", " ) )
End Function
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
Class MyDynaPDFMBS Inherits DynaPDFMBS
EventHandler Function Error(ErrorCode as integer, ErrorMessage as string, ErrorType as integer) As integer
// output all messages on the console:
System.DebugLog str(ErrorCode)+": "+ErrorMessage
// and display dialog:
Dim d as New MessageDialog //declare the MessageDialog object
Dim b as MessageDialogButton //for handling the result
d.icon=MessageDialog.GraphicCaution //display warning icon
d.ActionButton.Caption="Continue"
d.CancelButton.Visible=True //show the Cancel button
// a warning or an error?
if BitAnd(ErrorType, me.kE_WARNING) = me.kE_WARNING then
// if user decided to ignore, we'll ignore
if IgnoreWarnings then Return 0
d.Message="A warning occurred while processing your PDF code."
// we add a third button to display all warnings
d.AlternateActionButton.Caption = "Ignore warnings"
d.AlternateActionButton.Visible = true
else
d.Message="An error occurred while processing your PDF code."
end if
d.Explanation = str(ErrorCode)+": "+ErrorMessage
b=d.ShowModal //display the dialog
Select Case b //determine which button was pressed.
Case d.ActionButton
Return 0 // ignore
Case d.AlternateActionButton
IgnoreWarnings = true
Return 0 // ignore
Case d.CancelButton
Return -1 // stop
End select
End EventHandler
Property IgnoreWarnings As Boolean
End Class