Corel has not integrated VBA into PhotoPaint to the degree that it has in CorelDraw.
Unfortunately you cannot record a VBA macro in PhotoPaint, you have to write them from scratch.
You can record script and copy and paste the script functions into VBA but the script requires minor modification for it to work in VBA.
Each script function must be preceded with "Application.CorelScript." or at least "CorelScript."
There are many CorelScript functions that have no VBA equivalent.
When typing CorelScript functions in VBA there are no prompts as you type.
There are NO event procedures available for ThisDocument.
UserForm has some event procedures.
Located in GlobalMacroStorage are the following events.
For a new document
Private Sub GlobalMacroStorage_NewDocument(ByVal Document As IPaintDocument)
When a document opens.
Private Sub GlobalMacroStorage_OpenDocument(ByVal Document As IPaintDocument)
As you close PhotoPaint
Private Sub GlobalMacroStorage_Quit()
Just after PhotoPaint opens.
Private Sub GlobalMacroStorage_Start()
To get these to run as PhotoPaint opens you need to have previously set in Tools/Options/Workspace/VBA
Ticked "Trust all installed GMS modules".
Removed the tick from "Delay load VBA".
Conversion of Script to VBA
Many procedures can be recorded as a script.
Go to Windows, Dockers and select Recorder.
Press the red button to commence recording and naturally press the stop button to cease recording.
The commands show in the script window are only a summary of the full script.
You must save the script to somewhere convenient such as the desktop.
It will save as a ".csc" file.
Change the file type to a text file by changing the extension to ".txt" and open it in a text editor such as Notebook.
Now the full detailed script commands are revealed.
The first 2 lines start with "REM" and are comment lines so they can be deleted if desired.
The 3rd and 4th lines of text are the following where the 15 is replaced by your version of PhotoPaint.
WITHOBJECT "CorelPHOTOPAINT.Automation.15".
.SetDocumentInfo 1000, 10000
Change the 3rd line to a With statement;
With ActiveDocument.Application.CorelScript
ActiveDocument can be replaced by ThisDocument, Documents(<NUMBER>).
PhotoPaint does not allow you to refer to an open document by its name such as Documents("<NAME>").
Remember you can only use ThisDocument command when your VBA code is inside the "ThisDocument" module.
The script line ".SetDocumentInfo....." shows the pixel width and height of the document. VBA does not need this line so delete it.
The very last line of script code is;
END WITHOBJECT
Replace this last line with a With closure statement;
End With
Place the revised code inside a VBA procedure and your conversion is complete.
ou final code, if you used a BrushTool, will be something like this.
Sub TEST()
With ActiveDocument.Application.CorelScript
.BrushTool ..................................
. ..................................
. ..................................
.EndDraw
End With
End Sub
Many script commands end with ".EndDraw" but those that create shapes they may end with ".EndObject".
There may be duplication of many commands such as;
.ContinueDraw 227899, 2302595, 0, 10000, 0, 0
.ContinueDraw 228147, 2302533, 0, 10000, 0, 0
.ContinueDraw 228395, 2302471, 0, 10000, 0, 0
The repeated use of commands such as ".ContinueDraw ...." can be left.
Alternatively it will require some experimentation to see if you can delete any of these.
Those in the middle surrounded by other ContinueDraw statements can often be deleted.
ContinueDraw has the following definition.
ContinueDraw(x As Long,
y As Long,
Timer As Long,
Pressure As Long,
Tilt As Long,
Rotate As Long)
x = position measured in pixels * document width in pixels * 0.256
y = position measured in pixels * document height in pixels * 0.256
Why I do not know. To make matters worse StartCloneDraw use a combination of pixels position and pixel position * document size * .256
e.g.
.StartCloneDraw 342, 162, 87936, 80512, 0, 10000, 0, 0
StartCloneDraw(SrcPtX As Long in pixels,
SrcPtY As Long in pixels,
DestPtX As Long in pixel position * 0.256 * document width in pixels,
DestPtY As Long in pixel position * 0.256 * document height in pixels,
Timer As Long What does this do?,
Pressure As Long,
Tilt As Long,
Rotate As Long)
Referring to Open Documents
As stated above PhotoPaint does not allow you to refer to an open document as Documents("<Files Name>").
You can use ActiveDocument if it is active or ThisDocument if your code is within the "ThisDocument" module of the document.
Note that you cannot save code within any document unless it is a cpt file not jpg, tif etc.
If you only have one document open then it is automatically active.
If for any reason you have more than 1 PhotoPaint documents open then they will be numbered from 1 the earliest open to 2 the next oldest and so on.
Alternatively you could use the code below.
You probably will not need this code but it does look at a couple of methods that you can use.
1. For Each method.
2. Handling Errors.
3. Assigning names to documents using Set.
4. End Statements
5. Use of vbCr in Message boxes.
I strongly suggest you run this code and place a break point on the "End" line of code.
Then place a Watch on "objOPEN_DOC".
Then run the code.
Provide you have a file open called PICT0003.JPG the code will halt at "End".
Then expand the plus sign beside "objOPEN_DOC" in the Watches window and you will see many if not all of objOPEN_DOC's properties and objects.
It is here that you can learn the names of the properties and objects.
This enables you to target particular objects & properties in the code you write.
Sub SEARCH_FOR_OPEN_DOCTEST()
'The following code searches for open document PICT0003JPG.
Dim objOPEN_DOC As Document
Dim intCOUNTER As Integer
Dim FILE_No As Integer
'If the file is not present the code would normally stop at the error.
'To prevent the code from stopping and to notify the file is not present the next line is inserted.
On Error GoTo 10
'Look at each open document in turn and examine its file name.
For Each objOPEN_DOC In Documents
intCOUNTER = intCOUNTER + 1
'Unusually the string name is case sensitive. So JPG is different to jpg.
If objOPEN_DOC.FileName = "PICT0003.JPG" Then FILE_No = intCOUNTER
Next objOPEN_DOC
'You can now refer to the particular open document by number. ie Documents(FILE_No)
'Alternatively refer to it as objOPEN_DOC
Set objOPEN_DOC = Documents(FILE_No)
'The next line of code stops the code if there have been no errors.
'Otherwise an unnecessary message box would be created.
End
10 'This next line of code creates a 2 line message box.
'The use of vbCr between strings creates the 2 lines.
MsgBox "There has been an error." & vbCr & "File not found"
End Sub
Layer Rotation
Thank you José G. Moya Y., Madrid, Spain who found and solved this problem.
There is an error in the VBA command Rotate when you want to rotate a layer. VBA help gives
Rotate(Angle in degrees, CenterX in document units, CenterY in document units , [AntiAlias As Boolean = True])
This is not correct! It is actually
Rotate(Angle in 10 degree units, CenterX in pixels from the left edge ot the page, CenterY in pixels from the bottom edge ot the page, [AntiAlias As Boolean = True])
It is strange the the rotation angle is in 10 degree units. Fortunately you can enter fractions but negative numbers are not permitted.
CentreX the horintal position of the axis of rotation is measured from the left of the page as is normal but it is in pixels.
CentreY the vertical position of the axis of rotation is measured from the bottom of the page not the top as is normal. It also is in pixels.
Below is some sample code showing how to use rotate the first layer 90o about its middle or corner. You can of course rotate about any point even a point outside the page.
'Rotate about the middle of the layer.
ThisDocument.Layers(1).Rotate 90 / 10, _
ThisDocument.Layers(1).PositionX + ThisDocument.Layers(1).SizeWidth / 2, _
ThisDocument.SizeHeight - ThisDocument.Layers(1).PositionY - ThisDocument.Layers(1).SizeHeight / 2
'Rotate about top left corner of the layer.
ThisDocument.Layers(1).Rotate 90 / 10, _
ThisDocument.Layers(1).PositionX, ThisDocument.SizeHeight - ThisDocument.Layers(1).PositionY
'Rotate about bottom left corner of the layer.
ThisDocument.Layers(1).Rotate 90 / 10, _
ThisDocument.Layers(1).PositionX, _
ThisDocument.SizeHeight - ThisDocument.Layers(1).PositionY - ThisDocument.Layers(1).SizeHeight
'Rotate about top right corner of the layer.
ThisDocument.Layers(1).Rotate 90 / 10, _
ThisDocument.Layers(1).PositionX + ThisDocument.Layers(1).SizeWidth, _
ThisDocument.SizeHeight - ThisDocument.Layers(1).PositionY
'Rotate about bottom right corner of the layer.
ThisDocument.Layers(1).Rotate 90 / 10, _
ThisDocument.Layers(1).PositionX + ThisDocument.Layers(1).SizeWidth, _
ThisDocument.SizeHeight - ThisDocument.Layers(1).PositionY - ThisDocument.Layers(1).SizeHeight
Auto Adjust
There is not much point using a macro to auto adjust the brightness, contrast & intensity of 1 or a couple of images but if you want to auto adjust 50 or more images this code will make it easier.
I wrote this code to adjust in excess of 4,000 images taken by a trail camera of work performed by contractors at my house to make a time lapse movie.
The code here needs the VBA code Folders.bas found in the section Miscellaneous VBA to to be imported preferably into GlobalMacros to find the source & destination files.
However you can rewrite the code and add the full path to the source & destination folders yourself there by avoiding the code Folders.
Download Auto_Adjust.bas and import it into GlobalMacros. Then run Auto_Adjust.
The reason you save VBA code to GlobalMacros is because unless you are saving to .cpt then all macros you use will be lost when you close.
Automatic Cropping
I had 86 photos of different sized objects on a white background.
I wanted to crop each and resave the files.
To do this I used the CorelScript version of Magic Wand Mask which is a bit different from the Magic Wand Mask tool.
In effect the program selects the common surround color as a mask.
It then inverts the mask so only the object is masked.
By reading the mask position and size it then knows the size of the object. The mask is then discarded and the image cropped.
Here is the code. Copy and paste it into either "ThisDocument" or a Module in any opened PhotoPaint document.
The document can be a blank cpt image. The code has been written for a folder, containing the images, on the desktop.
Note that you must insert your User Name in the 3 highlighted areas. Alternatively rewrite the code for images at other locations and folders.
The surround color must be uniform otherwise dis-colorations in the background will give the incorrect size of the object to crop.
To overcome this you can fiddle with the Hue, Saturation and Brightness settings of MagicMaskWand.
Dim ACTIVE_DOC As Document
Sub START_THIS_MACRO()
Dim FOLDER_OBJECT As Object
Dim MAIN_FOLDER As Object
Dim FILES_ALL As Object
Dim FILE_NAME As Object
Dim FILE_TO_SAVE As Object
Set FOLDER_OBJECT = Interaction.CreateObject("Scripting.FileSystemObject")
Set MAIN_FOLDER = FOLDER_OBJECT.GetFolder("C:\Documents and Settings\<YOUR NAME>\Desktop\Photos")
Set FILES_ALL = MAIN_FOLDER.Files
'Now open each file in the folder in turn.
For Each FILE_NAME In FILES_ALL
Set ACTIVE_DOC = Application.OpenDocument("C:\Documents and Settings\<YOUR NAME>\Desktop\Photos\" & FILE_NAME.Name)
'Go to CROPP macro.
CROPP
'Save each file.
Set FILE_TO_SAVE = ACTIVE_DOC.SaveAs(FileName:="C:\Documents and Settings\<YOUR NAME>\Desktop\Photos\" _
&Left(FILE_NAME.Name, Len(FILE_NAME.Name) - 3) & "jpg", Filter:=cdrJPEG)
'Save file with these properties.
With FILE_TO_SAVE
.Progressive = False
.Optimized = False
'SubFormat Value
'Standard (4:2:2) 0
'Optional (4:4:4) 1
.SubFormat = 0
.Compression = 20
.Smoothing = 10
'Complete the SaveAs
.Finish
End With
ACTIVE_DOC.Close
Next
End Sub
Sub CROPP()
Dim MASK_X As Long
Dim MASK_Y As Long
Dim MASK_W As Long
Dim MASK_H As Long
'Create a Magic Mask around the object. The background must be a uniform color.
'The mask will enable the measuring of the object to crop.
'MaskMagicWand(x As Long, y As Long, DrawMode As Long, AntiAlias As Boolean,
' MaskVisible As Boolean, ToleranceMode As Long, Normal As Long, Hue As Long,
' Saturation As Long, Brightness As Long)
'x & y are the starting position of the color wand in pixels.
'DrawMode Value
'pntMaskNormal 0
'pntMaskAdd 1
'pntMaskSubtract 2
'pntMaskXOR 3
'AntiAlias
'Set to True (-1), applies anti-aliasing
'Set to False (0), disables anti-aliasing.
'MaskVisible
'Set to True (-1), affects all visible objects
'Set to False (0), affects the active object only
'ToleranceMode
'Specifies the tolerance mode:
'0 = Normal, which uses the Normal parameter to set the tolerance level
'1 = HSB, which uses the HSB parameters to set the tolerance level
'Normal
'Specifies the Normal tolerance level.
'Valid values range from 0 to 100%.
'Hue
'Specifies the hue tolerance.
'In the HSB color model,
'Hue is the main attribute in a color that distinguishes it from other colors.
'Blue, green and red, for example, are all hues. Valid values range from 0 to 100%.
'Saturation
'Specifies the saturation tolerance.
'Saturation is the purity of a color.
'The more colors used to mix a color, the duller the color looks.
'Valid values range from 0 to 100%.
'Brightness
'Specifies the brightness tolerance.
'In the HSB color model, the component that determines the amount of black in a color.
'Valid values range from 0 to 100%.
Application.CorelScript.MaskMagicWand 1, 1, 0, True, True, 0, 10, 10, 10, 10
ACTIVE_DOC.Mask.Invert
'The size of the object is now the size of the mask.
MASK_X = ACTIVE_DOC.Mask.PositionX
MASK_Y = ACTIVE_DOC.Mask.PositionY
MASK_W = ACTIVE_DOC.Mask.SizeWidth
MASK_H = ACTIVE_DOC.Mask.SizeHeight
ACTIVE_DOC.Mask.Delete
'MaskRectangle(Left As Long, Top As Long, Right As Long, Bottom As Long,
' DrawMode As Long, Feather As Long)
'Add 10 pixels all around the object.
'Application.ActiveDocument.Crop Left, Top, Width, Height
ACTIVE_DOC.CROP MASK_X - 10, MASK_Y - 10, MASK_W + 20, MASK_H + 20
End Sub
Zoom to Fit
You can select the Zoom drop-down box then To Fit.
Alternatively you can add this command button to the toolbar by selecting Tools, Options, Customizations, Commands, then View in the drop-down box.
With a mouse select Fit in Window and drag into a toolbar at the top of he screen.
The button will attach itself and you will have the Fit in Window button in a Toolbar.
If ever you want to remove any button from a Toolbar select Tools, Options, Customizations, Commands the drag the button from the Toolbar.
The button will then be removed.
Another alternative is to use VBA.
There does not seem to be any easy command.
There is for instant
ActiveDocument.ActiveWindow.Zoom = 20
This reduces the image to 20% but there is not Fit to Window.
Instead you can use the following.
Sub TURN_AND_FIT()
Dim HEIGHT_PERCENT As Double
Dim WIDTH_PERCENT As Double
Dim ZOOM_PERCENT As Double
Dim CLEARANCE As Double
'CLEARANCE is the gap in pixels around the image.
CLEARANCE = 40
'Maximise the window size. This step can be deleted if you wish.
ActiveWindow.WindowState = cdrWindowMaximized
'Make the rulers visible. This step can be deleted if you wish.
ActiveDocument.ActiveWindow.RulersVisible = True
'Turn the image 90 degree counter-clockwise. This step can be deleted if you wish.
ActiveDocument.Rotate 90, False, False
HEIGHT_PERCENT = ((Application.AppWindow.ClientHeight - CLEARANCE) * 100) / ActiveDocument.SizeHeight
WIDTH_PERCENT = ((Application.AppWindow.ClientWidth - CLEARANCE) * 100) / ActiveDocument.SizeWidth
'Now base the Zoom Percentage on the largest Zoom the get both the width & height to fit.
If HEIGHT_PERCENT < WIDTH_PERCENT Then
ZOOM_PERCENT = HEIGHT_PERCENT
Else
ZOOM_PERCENT = WIDTH_PERCENT
End If
ActiveDocument.ActiveWindow.Zoom = ZOOM_PERCENT
End Sub
Brightness, Contrast & Intensity Adjustment
This is not supported by VBA but instead you must use a script command, BitmapEffect, within the VBA code.
BitmapEffect does not seem to be full controllable by VBA, at least not in PhotoPaint X5.
You seem to have to use corelscript to open the file within VBA not open the file directly with VBA or use activedocument etc.
Dim FULL_FILE_PATH As String 'Image name and path
Dim BCI_EXPRESSION As String
Dim IMAG_BRIGHT As Long ' Image Brightness adjustment
Dim IMAG_CONTRAST As Long ' Image Contrast adjustment
Dim IMAG_INTENSITY As Long ' Image Intensity adjustment
IMAG_BRIGHT = 40 ' (-100 to 100)
IMAG_CONTRAST = 80 ' (-100 to 100)
IMAG_INTENSITY = 0 ' (-100 to 100)
'The script does not appear to run unless CorelScript has opened the file.
'So record the full file name & address that it currently open assuming it is open.
FULL_FILE_PATH = ActiveDocument.FullFileName
'Save the file otherwise close the file.
'If you have made changes you will want to save the file.
'The close command does not check to see if changes have been made.
ActiveDocument.Close
'Now open the same file again with CorelScript.
CorelScript.FileOpen FULL_FILE_PATH, 0, 0, 0, 0, 0, 1, 1 ' Open image
BCI_EXPRESSION = "BCIEffect BCIBrightness=" & IMAG_BRIGHT & ",BCIContrast=" & IMAG_CONTRAST & ",BCIIntensity=" & IMAG_INTENSITY
CorelScript.BitmapEffect "Brightness-Contrast-Intensity", BCI_EXPRESSION
A Detailed But Valuable Exercise
Recently I can across some code that although it was free for PhotoPaint the code was hidden by a password.
I cannot understand why someone would provide some free code but not provide the code so that users can learn.
The code was from http://www.corelvba.com/index.php?get=macros_paint and it was called SetOrigin_PP.
Here is their file.
Here is my version of the code.
There is no protection on my code so you can read and learn.
I hope it proves useful.
|