GDG Code Chunks, Discussion, VBA Snippets for CorelDRAW, Simple Macro Helpers!

Option Explicit

Const VK_SHIFT = &H10
Const VK_CTRL = &H11
Const VK_ESCAPE = &H1B
Const VK_ALT = &H12

#If VBA7 Then
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As LongPtr) As Integer
#Else
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Sub contourQuickRound()
contourQuickGo 1
End Sub
Sub contourQuickStandard()
contourQuickGo 0
End Sub
Sub contourQuickGo(c As Integer)
Dim s As Shape, sr As ShapeRange
Dim e As Effect
Dim d#, dDefault#
Dim eCapType As cdrContourEndCapType
Dim eCornerType As cdrContourCornerType
Dim strInput$, strMacroName$
Dim strMessage1$, bShown As Boolean

strMacroName = "GDG ContourQuick"
dDefault = 0.008

bShown = CBool(GetSetting(strMacroName, "Pref_" & VersionMajor, "msg_shown", False))
If Not bShown Then
strMessage1 = "Run either macro with SHIFT AND CTRL pressed to change contour distance." & vbCrLf & vbCrLf & _
"Running either of the macros with SHIFT pressed will double the contour distance." & vbCrLf & vbCrLf & _
"Running either of the macros with CTRL pressed will half the contour distance." & vbCrLf & vbCrLf & _
"This message will not appear again, ever. Read carefully."
MsgBox strMessage1, , strMacroName
SaveSetting strMacroName, "Pref_" & VersionMajor, "msg_shown", True
Exit Sub
End If

If c = 1 Then
eCornerType = cdrContourCornerRound '2
eCapType = cdrContourRoundCap '1
End If

ActiveDocument.Unit = cdrInch 'your document units < you set!
d = Val(CDbl(GetSetting(strMacroName, "Pref_" & VersionMajor, "contour_distance", 0.008))) 'use saved value or MY DEFAULT
'd = 0.008 'your medium distance < you set!

ResetKeyStatus
'multipliers for running macro with either shift or ctrl pressed, adjust as desired...
If isShiftPressed Then d = d * 2
If isCtrlPressed Then d = d / 2

If isShiftPressed And isCtrlPressed Then
strInput = InputBox("Enter a value for contour thickness.", strMacroName, d)
strInput = Trim(strInput)
If Len(strInput) = 0 Then MsgBox "No value entered, Exiting...", vbCritical, strMacroName: Exit Sub
If Not IsNumeric(strInput) Then MsgBox "Not a numeric value, Exiting...", vbCritical, strMacroName: Exit Sub
SaveSetting strMacroName, "Pref_" & VersionMajor, "contour_distance", strInput
Exit Sub
End If

Set sr = ActiveSelectionRange
If sr.count = 0 Then Exit Sub

ActiveDocument.BeginCommandGroup
If sr.Shapes.count > 1 Then
Set s = sr.Group
Else
Set s = sr(1)
End If

Set e = s.CreateContour(1, d, 1)
If c = 1 Then
e.Contour.CornerType = eCornerType
e.Contour.EndCapType = eCapType
End If

Set sr = e.Separate()
Set s = sr(1)
If c = 1 Then
s.Fill.UniformColor.RGBAssign 0, 153, 51 ' green contour is made with square corners
Else
s.Fill.UniformColor.RGBAssign 0, 0, 255 ' blue contour is made with round corners
End If
s.Outline.SetNoOutline 'of contour shape
s.CreateSelection 'select contour shape last
ActiveDocument.EndCommandGroup

End Sub

'modifier keys begin ##############################################
Public Function ResetKeyStatus(Optional nada As Boolean) As Boolean
GetAsyncKeyState VK_SHIFT
GetAsyncKeyState VK_CTRL
GetAsyncKeyState VK_ESCAPE
ResetKeyStatus = True
End Function
Public Function isShiftPressed() As Boolean
isShiftPressed = (GetAsyncKeyState(VK_SHIFT) <> 0)
End Function
Public Function isCtrlPressed() As Boolean
isCtrlPressed = (GetAsyncKeyState(VK_CTRL) <> 0)
End Function
Public Function isEscPressed() As Boolean
isEscPressed = (GetAsyncKeyState(VK_ESCAPE) <> 0)
End Function
Public Function isAltPressed() As Boolean
isAltPressed = (GetAsyncKeyState(VK_ALT) <> 0)
End Function
'modifier keys begin ##############################################

HI. Make sure to have an item selected then run. See my videos on the YouTube for GDG Macros or the getting started with macros link on the left main menu above for info about where to place the code.

Hi!

I do I get this macro to work for CorelDraw X4?
I tried adding it to the Global Macros, but it gives an error when trying to run the macro.

Thanks!

SUBSCRIBE to Email List

My Account

Policy
and
Terms

Upgrades?

Need a Custom Macro?
NO LONGER AVAILABLE