OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Thread Tools Search this Thread Display Modes
Old 16-01-2008, 14:42
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
Join Date: Mar 2005
Posts: 836
Default ActivePalette switching via code

AFAIK CorelDRAW has no means of programmatic setting of the active palette, so here's the code (tested in X3) to do so.
The goal of the code is to have a hotkey-invokable macros to switch the default palette of CorelDRAW in order to easily switch dropdown palettes in Contour tool and other similar tools.
The code should reside in normal code module, not the object/form's.
The highlighted SUBs are the examples of using the code.
Option Explicit

Private Const sPalAfx$ = "Afx:62210000:8:00010011:00000010:00000000"

Private Declare Function FindWindowExW& Lib "user32" (ByVal hParent&, ByVal hChildAfter&, ByVal lpClassW&, ByVal lpTitleW&)
Private Declare Function SendMessageW& Lib "user32" (ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
Private Declare Function GetClassNameW Lib "user32" (ByVal hwnd&, ByVal lpClass&, ByVal maxLen%) As Integer
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd&) As Integer
Private Declare Function GetWindowTextW Lib "user32" (ByVal hwnd&, ByVal lpText&, ByVal maxLen%) As Integer
Private Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId&, ByVal lpfn&, ByVal lParam&) As Integer
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private p_sClass$, p_sTitle$, p_hWnd&

Sub Pal_cSuns()
   p_palswitcher Palettes.Open(LanguagePath & "\Custom Data\Palettes\CMYK\Misc\cSuns.cpl").Name
   End Sub

Sub Pal_CDR()
   p_palswitcher Palettes.Open(UserDataPath & "\Palettes\coreldrw.cpl").Name
   End Sub

Sub Pal_MyCustom1()
   p_palswitcher Palettes.Open("c:\myFolder\MyCustomPalette1.cpl").Name
   End Sub

Sub Pal_PANTONE_Coated()
   p_palswitcher Palettes.OpenFixed(cdrPANTONECoated).Name
   End Sub

Private Sub p_palswitcher(sName$)
   Dim s$, h&
   On Error Resume Next
   h = FindWindowExW(AppWindow.Handle, 0, StrPtr(sPalAfx), StrPtr(sName)): If h = 0 Then Beep: Exit Sub
   h = FindWindowExW(h, 0, 0, 0)
   If h = 0 Then
      h = FindThreadWindow(sPalAfx, sName): If h = 0 Then Beep: Exit Sub
      h = FindWindowExW(h, 0, 0, 0): If h = 0 Then Beep: Exit Sub
   End If
   SendMessageW h, &H111, 55906, 0
End Sub

Private Function FindThreadWindow&(sClass$, sTitle$)
   p_sClass = sClass: p_sTitle = sTitle: p_hWnd = 0
   EnumThreadWindows GetCurrentThreadId, AddressOf EnumThreadWndProc, 0
   FindThreadWindow = p_hWnd
   End Function
Private Function EnumThreadWndProc&(ByVal hwnd&, ByVal lParam&)
   Dim s$, i&
   If IsWindowVisible(hwnd) Then
      s = Space$(200): i = GetClassNameW(hwnd, StrPtr(s), 200): s = Left$(s, i)
      If s = p_sClass Then
         s = Space$(200): i = GetWindowTextW(hwnd, StrPtr(s), 200): s = Left$(s, i)
         If s = p_sTitle Then p_hWnd = hwnd: Exit Function
      End If
   End If
   EnumThreadWndProc = True
   End Function

Last edited by wOxxOm; 18-01-2008 at 02:19.
Reply With Quote
Old 17-01-2008, 07:14
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe

wOxxOm, this is a super cool idea. As always, you have come out on top. Sheer genius.
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Simple Bar code generator Webster Code Critique 2 06-09-2010 01:41
CDR12: TTF Font exporting - specify character code zlatev CorelDRAW/Corel DESIGNER VBA 0 03-12-2005 05:54
Text ENCODE Craig Tucker CorelDRAW/Corel DESIGNER VBA 10 26-01-2005 13:59
How to use events from CorelDRAW.Document in my code? me CorelDRAW/Corel DESIGNER VBA 2 30-10-2004 02:49
How can I extract a piece of a bitmap object using VBA code oswaldon Corel Photo-Paint VBA 2 25-04-2004 19:37

All times are GMT -5. The time now is 00:45.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com