Membuat Color Swatch Pantone (kumpulan kotak warna pantone otomatis) di Coreldraw 2017 64 Bit

Baca Juga

Sebuah Sistem Pencocokan Warna atau Color Matching System (CMS) adalah metode yang digunakan untuk memastikan konsistensi warna dalam proses design hingga produksi terlepas dari perangkat / media yang digunakan untuk menampilkan warna. Menjaga keakuratan dan konsistensi warna dari berbagai di media sangat sulit, bukan hanya karena warna sangat subjektif hingga batas tertentu, tetapi juga karena perangkat yang digunakan untuk menampilkan warna sangat banyak dan luas, serta teknologi yang digunakan berbeda-beda.

Ada berbagai Color Matching System (CMS) yang tersedia hingga hari ini, tapi sejauh ini yang populer  dalam industry percetakan adalah Pantone Matching System, atau PMS. PMS adalah sebuah sistem pencocokan “warna-solid”. Dimana warna solid ini digunakan untuk patokan warna apa yang akan dipilih untuk mencocokan warna gambar yang akan dicetak.

Biasanya warna yang tampil di Komputer dan hasil cetakan akan berbeda karena perbedaan pengaturan di windows dengan printer, media kertas atau kain yang digunakan memiliki kekhususan/kelebihan warna CMYK (Cyan, Magenta, Yellow, Black) sehingga warna yang dicetak bercampur dengan warna media tersebut. Untuk mengatasi hal itu kita harus mencetak terlebih dahulu warna-warna pantone kedalam media yang dibutuhkan agar proses pencocokan warna cukup dengan media tersebut tidak perlu melihat warna yang tampil di Komputer.

Membuat kotak-kotak warna seperti diatas tidaklah memakan cukup waktu banyak, caranya cukup mudah,

Pertama, Buka Coreldraw terlebih dahulu. Jika belum download Coreldraw Terbaru disini.

Kedua, Aktifkan Profiles Color Pantone Solid Coated dengan cara buka menu 

Windows>Color Palettes dan pilih salah jenis color profile Pantone ® Solid Coated.

Ketiga, Biasanya untuk Coreldraw 2017 form untuk color swatch belum tersedia namun untuk Coreldraw dibawahnya sudah ada. Oleh karena itu admin akan membagikan file Form Color Swatch untuk Coreldraw 2017. Maka dari itu bukalah menu Tool>Macros>Macro Editor.

Keempat, Sekarang insert filenya dengan cara klik pada GlobalMacros pada Toolbars Project lalu klk menu File>Import file. Dan file yang harus di import adalah frmColorSwatch.frm dan CorelMacros.bas.

Download Color Swatch CorelDraw2017 dan CorelMacros.bas

Kelima,  Sekarang kita uji apakah file-file vb macro tersebut dapat dijalankan pada Macros CorelDraw 2017. Buka menu Tool>Macros>Run Macros. Pilih GlobalMacros.GMS > CorelMacros.CreateColorSwatch pada dialog Run Macros. Lalu pilih warna yang akan ditampilkan yaitu Pantone ® Solid Coated dan atur spacing = 2 , dan gunakan outline. Klik OK

Keenam, Hasilnya akan menampilkan 16 Page Coreldraw 2017 tergantung lebar dan tingginya halaman pada tiap page.

Selesai.

Semoga Bermanfaat

Terima kasih telah berkunjung ke https://agungpanduan.blogspot.co.id

Kode VB Macros Soler Swatch

Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmColorSwatch 

   Caption         =   "Create ColorSwatch"

   ClientHeight    =   4815

   ClientLeft      =   45

   ClientTop       =   330

   ClientWidth     =   4080

   OleObjectBlob   =   "frmColorSwatch.frx":0000

   StartUpPosition =   1  'CenterOwner

End

Attribute VB_Name = "frmColorSwatch"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Explicit

' **********************

' PARAMETERS

' **********************

Dim CSPalette As Palette

Dim PrinterName, DatePrinted As String

Dim TileSpaceW, TileSpaceH As Double

Dim CSOutline As cdrOutlineType

' **********************

' DEFAULTs and CONSTANTS

' **********************

Private Const DEF_TILESPACE = 20#

Private Const TEXTFONT = "Arial"

Private Const TEXTSPACING = 3#

Private Const LEGENDWIDTH = 20#

Private Const LEGENDHEIGHT = 10#

Private Const THUMBNAILHEIGHT = 20#

Private Const THUMBNAILWIDTH = 20#

' ********************

' OPEN DIALOG

' ********************

'API declarations

Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

#If Win64 Then

Private Type OPENFILENAME

        lStructSize As Long

        Padding1 As Long

        hwndOwner As LongPtr

        hInstance As LongPtr

        lpstrFilter As String

        lpstrCustomFilter As String

        nMaxCustFilter As Long

        nFilterIndex As Long

        lpstrFile As String

        nMaxFile As Long

        Padding2 As Long

        lpstrFileTitle As String

        nMaxFileTitle As Long

        Padding3 As Long

        lpstrInitialDir As String

        lpstrTitle As String

        flags As Long

        nFileOffset As Integer

        nFileExtension As Integer

        lpstrDefExt As String

        lCustData As LongPtr

        lpfnHook As LongPtr

        lpTemplateName As String

End Type

#Else

Private Type OPENFILENAME

        lStructSize As Long

        hwndOwner As LongPtr

        hInstance As LongPtr

        lpstrFilter As String

        lpstrCustomFilter As String

        nMaxCustFilter As Long

        nFilterIndex As Long

        lpstrFile As String

        nMaxFile As Long

        lpstrFileTitle As String

        nMaxFileTitle As Long

        lpstrInitialDir As String

        lpstrTitle As String

        flags As Long

        nFileOffset As Integer

        nFileExtension As Integer

        lpstrDefExt As String

        lCustData As LongPtr

        lpfnHook As LongPtr

        lpTemplateName As String

End Type

#End If

'Open file dialog flag

Private Const OFN_HIDEREADONLY = &H4

'as VBA has no Hwnd(window handle) property, this function will find the Hwnd

Private Function getHwnd() As LongPtr

getHwnd = FindWindow("ThunderDFrame", "Common Open Dialog Example")

End Function

' ******************

' COLORSWATCH DIALOG

' ******************

Private Sub UserForm_Initialize()

    UpdatePaletteList

    If ComboBoxPalette.ListCount > 0 Then

         ComboBoxPalette.ListIndex = 0

    End If

    BoxSpace.Value = DEF_TILESPACE

    ButtonOK.SetFocus

End Sub

Private Sub ButtonOK_Click()

    If ValidateParams Then

        frmColorSwatch.Hide

        CreateColorSwatchFromPalette

    End If

End Sub

Private Sub ButtonCancel_Click()

    End

End Sub

Private Sub ButtonNow_Click()

    BoxDate.Value = Date

End Sub

Private Sub ButtonSelectFile_Click()

    'Ask user for the palette file

    Dim PaletteFileName As String

    Dim OpenPalette As Palette

    Dim ofn As OPENFILENAME

    Dim strFilter As String

    Dim lngApiReturn As Long

    

    'set up filter

    strFilter = "CPL - Palette Files" & Chr(0) & "*.cpl" & Chr(0) & "All Files (*.*)" & Chr(0) & "*.*"

    

    'initialize the ofn structure

    ofn.lStructSize = Len(ofn)

    ofn.flags = OFN_HIDEREADONLY

    ofn.hwndOwner = getHwnd

    ofn.lpstrFilter = strFilter

    ofn.nFilterIndex = 1

    ofn.lpstrFile = String(257, 0)

    ofn.nMaxFile = Len(ofn.lpstrFile) - 1

    ofn.lpstrFileTitle = ofn.lpstrFile

    ofn.nMaxFileTitle = ofn.nMaxFile

    ofn.lpstrTitle = "Open Palette File"

    ofn.lpstrInitialDir = CurDir

    

    'call the API function

    lngApiReturn = GetOpenFileName(ofn)

    If lngApiReturn <> 0 Then

        PaletteFileName = ofn.lpstrFile

        On Error GoTo ErrorOpenFile

        Set OpenPalette = Application.Palettes.Open(PaletteFileName)

        UpdatePaletteList

        ComboBoxPalette.Text = OpenPalette.Name

    End If

    Exit Sub

ErrorOpenFile:

    MsgBox "Unable to open " & PaletteFileName

End Sub

Private Sub CheckDate_Click()

    BoxDate.Enabled = CheckDate.Value

    ButtonNow.Enabled = CheckDate.Value

End Sub

Private Sub CheckPrinter_Click()

    BoxPrinter.Enabled = CheckPrinter.Value

End Sub

Private Sub BoxSpace_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

  If Not ((Chr(KeyAscii) >= 0 And Chr(KeyAscii) <= 9) Or (Chr(KeyAscii) = ".")) Then

    KeyAscii = 0

  End If

End Sub

Private Sub UpdatePaletteList()

    ComboBoxPalette.Clear

    Dim CSPalette As Palette

    For Each CSPalette In Application.Palettes

        ComboBoxPalette.AddItem CSPalette.Name

    Next CSPalette

End Sub

' ********************

' COLORSWATCH CREATION

' ********************

Private Function ValidateParams() As Boolean

    ValidateParams = True

    

    PrinterName = BoxPrinter.Value

    DatePrinted = BoxDate.Value

    If CheckOutline.Value = True Then

        CSOutline = cdrOutline

    Else

        CSOutline = cdrNoOutline

    End If

    

    If (IsNumeric(BoxSpace.Text) = False) Then GoTo ErrNumSpace

    TileSpaceW = Val(BoxSpace.Text)

    TileSpaceH = Val(BoxSpace.Text)

    If TileSpaceH < LEGENDHEIGHT Then TileSpaceH = LEGENDHEIGHT

    

    If ComboBoxPalette.TextLength = 0 Then GoTo ErrNoSelect

    On Error GoTo ErrPaletteName

    Set CSPalette = Application.Palettes(ComboBoxPalette.Text)

    

    Exit Function

    

ErrNoSelect:

    MsgBox "No palette selected"

    ComboBoxPalette.SetFocus

    ValidateParams = False

    Exit Function

ErrPaletteName:

    MsgBox "Invalid palette name : " & ComboBoxPalette.Text

    ComboBoxPalette.SetFocus

    ValidateParams = False

    Exit Function

ErrNumSpace:

    MsgBox "Spacing not numeric : " & BoxSpace.Text

    BoxSpace.SetFocus

    ValidateParams = False

    Exit Function

End Function

Private Sub CreateColorSwatchFromPalette()

    ' Create a new document

    Dim CSDocument As Document

    Dim CSPage As Page

    Set CSDocument = Application.CreateDocument

    Set CSPage = CSDocument.ActivePage

    CSDocument.Unit = cdrMillimeter

    ' Set working values

    

    Dim PageWidth, PageHeight As Double

    PageHeight = CSDocument.ActivePage.SizeHeight

    PageWidth = CSDocument.ActivePage.SizeWidth

    

    Dim TileH, TileW As Double

    Dim ThumbnailH, ThumbnailW As Double

    ThumbnailH = THUMBNAILHEIGHT

    ThumbnailW = THUMBNAILWIDTH

    TileH = ThumbnailH + TileSpaceH

    TileW = ThumbnailW + TileSpaceW

    If TileH > PageHeight Then TileH = PageHeight - 1

    If TileW > PageWidth Then TileW = PageWidth - 1

    If TileW < LEGENDWIDTH Then TileW = LEGENDWIDTH

    

    Dim LineLength As Long, ColumnLength As Long, PageSize As Long

    LineLength = PageWidth \ TileW

    ColumnLength = (PageHeight \ TileH) - 1 ' Save room for header

    PageSize = LineLength * ColumnLength

    

    If LineLength < 1 Or ColumnLength < 1 Then

        MsgBox "Failed to create the colorswatch. Reduce thumbnail spacing or change the page size."

        Exit Sub

    End If

    

    Dim MarginLeft, MarginBottom As Double

    MarginLeft = (PageWidth Mod TileW) / 2

    MarginBottom = (PageHeight Mod TileH) / 2

    

    CSDocument.DrawingOriginX = MarginLeft - (PageWidth / 2)

    CSDocument.DrawingOriginY = MarginBottom + (ColumnLength * TileH) - (PageHeight / 2)

    

    ' Initialize variables

    Dim CSColor As Color

    Dim CSLayer As Layer

    Dim CSShape As Shape

    'zpos penomoran halaman

    Dim XPos As Long, YPos As Long, ZPos As Long

    Dim ShapeLeft As Double, ShapeBottom As Double

    Dim RefCenter As Double

    Dim CSText As String

    XPos = -1   ' column

    YPos = -1   ' line

    ZPos = 0    ' page

    Application.Optimization = True

    ' Create tiles

    For Each CSColor In CSPalette.Colors

        ' Set the new position

        XPos = (XPos + 1) Mod LineLength

        If XPos = 0 Then

            ' Start a new line

            YPos = (YPos + 1) Mod ColumnLength

            If YPos = 0 Then

                ' Start a new page

                ZPos = ZPos + 1

                If CSDocument.Pages.Count < ZPos Then

                    Set CSPage = CSDocument.AddPages(1)

                End If

                Set CSLayer = CSPage.ActiveLayer

                

                ' Create the page header

                ShapeLeft = 0

                RefCenter = (PageWidth / 2) - MarginLeft

                ' page number

                ShapeBottom = MarginBottom + TEXTSPACING

                CSText = "page " & ZPos

                Set CSShape = CSLayer.CreateArtisticText(RefCenter, ShapeBottom, CSText, , , TEXTFONT, 10, Alignment:=cdrCenterAlignment)

                ' palette name

                ShapeBottom = ShapeBottom + CSShape.SizeHeight + TEXTSPACING

                CSText = CSPalette.Name

                If Len(CSText) > 0 Then

                    Set CSShape = CSLayer.CreateArtisticText(RefCenter, ShapeBottom, CSText, , , TEXTFONT, 20, Alignment:=cdrCenterAlignment)

                End If

                End If

            End If

        ' Create the tile

        RefCenter = (XPos + 0.5) * TileW

        

        ' Create thumbnail

        ShapeLeft = RefCenter - ThumbnailW / 2

        ShapeBottom = -(YPos * TileH) - ThumbnailH

        Set CSShape = CSLayer.CreateRectangle2(ShapeLeft, ShapeBottom, ThumbnailW, ThumbnailH)

        CSShape.Outline.Type = CSOutline

        CSShape.Fill.UniformColor = CSColor

'        AlignHorizontal CSShape, RefCenter, CSDocument

        ' Create color components

        ShapeBottom = ShapeBottom - TEXTSPACING

        MakeColorComponentsString CSText, CSColor

        If Len(CSText) > 0 Then

            Set CSShape = CSLayer.CreateArtisticText(RefCenter, ShapeBottom, CSText, , , TEXTFONT, 6, Alignment:=cdrCenterAlignment)

        End If

        ' Create color name

        ShapeBottom = ShapeBottom - TEXTSPACING

        CSText = CSColor.Name(False)

        If Len(CSText) > 0 Then

            Set CSShape = CSLayer.CreateArtisticText(RefCenter, ShapeBottom, CSText, , , TEXTFONT, 6, Alignment:=cdrCenterAlignment)

        End If

    

    Next CSColor

    ' Create the ColorSwatch tag

    Set CSLayer = CSDocument.Pages(1).ActiveLayer

    ShapeLeft = MarginLeft

    ShapeBottom = MarginBottom + TEXTSPACING

    ' Printer Name

    If frmColorSwatch.CheckPrinter.Value = True Then

        Set CSShape = CSLayer.CreateArtisticText(ShapeLeft, ShapeBottom, "Printer : " & PrinterName, , , TEXTFONT, 10)

        ShapeBottom = ShapeBottom + CSShape.SizeHeight + TEXTSPACING

    End If

    ' Date Printed

    If frmColorSwatch.CheckDate.Value = True Then

        Set CSShape = CSLayer.CreateArtisticText(ShapeLeft, ShapeBottom, "Date : " & DatePrinted, , , TEXTFONT, 10)

    End If

    

    Set CSColor = Nothing

    Set CSShape = Nothing

    Set CSLayer = Nothing

    Set CSPage = Nothing

    Set CSDocument = Nothing

    

    Application.Optimization = False

    ActiveWindow.Refresh

    Application.Refresh

End Sub

Private Sub AlignHorizontal(ShapeObj As Shape, Ref As Double, Doc As Document)

    Doc.ReferencePoint = cdrBottomLeft

    Dim ShapeCenter As Double

    ShapeCenter = ShapeObj.PositionX + (ShapeObj.SizeWidth / 2)

    ShapeObj.Move (Ref - ShapeCenter), 0

End Sub

Private Sub MakeColorComponentsString(ByRef StrColor As String, ClrColor As Color)

    Dim PantoneFindPos As Long

    

    If Len(StrColor) = 0 Then

        StrColor = "-"

    ElseIf ClrColor.Type = cdrColorSpot Or ClrColor.Type = cdrColorPantone Then

        StrColor = "Tint:" & ClrColor.Tint

    Else

        StrColor = ClrColor.Name(True)

        PantoneFindPos = InStr(1, StrColor, " Density:", vbTextCompare)

        If PantoneFindPos > 0 Then

            StrColor = "Tint:" & Mid(StrColor, PantoneFindPos + 9)

        End If

    End If

End Sub