OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > Code Critique

Thread Tools Search this Thread Display Modes
Old 23-10-2005, 03:18
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,790
Blog Entries: 13
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default ApplyPatternFill Full Color Bitmaps

I am working on a program that applys full color bitmap fills to several objects, I am trying to get it to run as fast as possible, so I created a little speed test. It seems from my testing the CorelScript method for ApplyPatternFills is faster than the VBA commands.

On my machine the VBA version takes about 16 sec. to complete while the CorelScript completes in about 8 seconds. Also the CorelScript method you only have one line of code vs. the several with VBA.

Just looking for thoughts and ideas about optimizing the code to run even faster or better. Thanks.

Here is my sample code:

Sub BitmapFillSpeedTest()

Dim x As Double, y As Double, Height As Double, Width As Double
Dim MaxX As Double, MaxY As Double, MaxHeight As Double, MaxWidth As Double
Dim tm As Double
Dim s As Shape

MaxX = ActivePage.SizeWidth
MaxY = ActivePage.SizeHeight
MaxHeight = 3
MaxWidth = 3
tm = Timer

Optimization = True

For i = 1 To 250
    x = Rnd() * MaxX
    y = Rnd() * MaxY
    Height = Rnd() * MaxHeight
    Width = Rnd() * MaxWidth
    Set s = ActiveLayer.CreateRectangle2(x, y, Width, Height)
    With s.Fill.ApplyPatternFill(cdrBitmapPattern, "C:\Program Files\Corel\Corel Graphics 12\Custom Data\Tiles\wood23m.cpt")
        .TileHeight = 2 / s.AbsoluteVScale
        .TileWidth = 2 / s.AbsoluteHScale
        .TransformWithShape = True
    End With
    'Application.CorelScript.ApplyFullColorFill "C:\Program Files\Corel\Corel Graphics 12\Custom Data\Tiles\wood23m.cpt", ConvertUnits(2, cdrInch, cdrTenthMicron), ConvertUnits(2, cdrInch, cdrTenthMicron), 0, 0, False, 0, 0, True, 0, 0, 0, 0, 0, 0
Next i

Optimization = False

MsgBox Round((Timer - tm), 2) & " Seconds"

End Sub

Last edited by shelbym; 23-10-2005 at 03:31.
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
How to get a full list of keyboard shortcuts? Alex FAQ 2 10-05-2006 19:13
ApplyPatternFill shelbym CorelDRAW/Corel DESIGNER VBA 2 26-03-2004 12:29

All times are GMT -5. The time now is 18:15.

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