OberonPlace.com Forums  

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

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 11-02-2004, 07:35
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
Default Progress Bar

I want to use the Progess Bar ActiveX Control v.6. I'm wondering if anyone knows how to use this. My original plan was to set up a new user form with the ActiveX Control in the form and call the form from my main code, but the only thing that seems to happen is I get the A-X Form and it just sits there until I dismiss it and then my other code continues.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #2  
Old 11-02-2004, 08:23
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Progress Bar

It's very difficult to do this in VBA because once you have a modal form (your main dialog) you cannot show another form as modeless. You can only show another modal form (a modal form means that it takes up the control until it is closed).

To work around it you either put the progress bar to your main form or move the actual processing code for to the secondary form.

By the way, in Draw 12 it is now possible to use CorelDRAW's status bar to show progress, which eliminates problem altogether:

Code:
Sub ShowProgress()
    Dim doc As Document
    Dim stat As AppStatus
    Dim n As Long
    
    Set doc = CreateDocument
    Set stat = Application.Status
    stat.BeginProgress CanAbort:=True
    For n = 1 To 1000
        doc.ActiveLayer.CreateRectangle2 Rnd() * 8, Rnd() * 11, Rnd() * 5, Rnd() * 5
        If (n Mod 10) = 0 Then
            stat.UpdateProgress
            If stat.Aborted Then Exit For
        End If
    Next n
    stat.EndProgress
End Sub
The above code creates 1000 random rectangles and shows the progress bar as it goes. The process also can be aborted by pressing Esc key.
Reply With Quote
  #3  
Old 11-02-2004, 08:42
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
Default

You've got me seriously thinking about upgrading to 12. Do you get a commission if I say you sent me? LOL
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #4  
Old 09-02-2005, 12:23
Mark
Guest
 
Posts: n/a
Default Losing Control

I have a script that imports files & that seems to take away my control of the progress bar as well as calling some outside functions to resize it & mess with the outline...so I just have this progress bar bouncing around. And if I'm importing multiple files and hit escape to abort the routine, the key usually gets intercepted to abort the import & the routine proceeds to resize & fails b/c the shape isn't there.

Can I keep control of the bar so it just proceeds for the overall routine & the escape button to abort as you've shown, or is it just not possible in this case?
Reply With Quote
  #5  
Old 10-02-2005, 10:22
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Losing Control

Mark,

I don't think it's possible, but I have to look closer to be sure...
Reply With Quote
  #6  
Old 10-02-2005, 11:26
Mark
Guest
 
Posts: n/a
Default Other Options

Do you have a good example of how to put a progress bar on the form?
Reply With Quote
  #7  
Old 10-02-2005, 13:22
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Other Options

Quote:
Originally Posted by Mark
Do you have a good example of how to put a progress bar on the form?
Mark,
There are a few ways to do this:


1. First, and the easiest one is to add the standard ProgressBar control to your form and use it. It works beautifully, except that it may not be installed on the user's machine, so you need to deal with the OCX control deployment, etc.

However if you use the macro on your own machine or you can ensure that the OCX control is installed on the user's machine, go ahead and use this approach.

Basically you just right-click on the toolbox and select "Additional Controls..." (see attachment 1). In the dialog, find the "Microsoft ProgressBar Control 6.0" in the list and check it. [Attachment 2] (You will see the full path to the OCX file providing this control, you will need to ensure this is installed on the clients machine - note, check Microsoft web site regarding legality of distributing this file, I don't know about that).

Once added you will see the new control in the toolbox [Attachment 3].

Create a simple form with the progress bar control, give it a name of "ProgressBar1" and a button named "cmStart". The form can look as shown in attachment 4. Then paste the following code in the form illustrating how to use the control:

Code:
Option Explicit

Private Const NumShapes As Long = 1000

Private Sub cmStart_Click()
    ProgressBar1.Min = 0
    ProgressBar1.Max = NumShapes
    ProgressBar1.Value = 0
    DoCreateShapes
End Sub

Private Sub DoCreateShapes()
    Dim doc As Document
    Dim x As Double, y As Double, sx As Double, sy As Double
    Dim n As Long
    
    Set doc = CreateDocument
    For n = 1 To NumShapes
        x = Rnd() * 8
        y = Rnd() * 11
        sx = Rnd() * 4
        sy = Rnd() * 4
        doc.ActiveLayer.CreateRectangle2 x, y, sx, sy
        ProgressBar1.Value = n
    Next n
    
    MsgBox "Done"
End Sub
Attached Images
    
Reply With Quote
  #8  
Old 10-02-2005, 13:30
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Other Options

Second method is not to use any progress bar at all but show a progress in some sort of a text form. Create a new form and add a text label "Creating Shape:" and another one "1 of 1" right next to it and give it a name "lblProgress" (I also made it bold so it sticks out more). Also add a button "cmStart" as before.

Each time you do an action, you update the caption of the lblProgress label. Unfortunately VBA forms do not update themselves until a painting message gets through. While a macro is executed, this doesn't happen, so you need to deal with it somehow.

The easiest way is to make sure the messages are processed while the macro runs. This is done by adding DoEvents instruction in your loop (or place it somewhere in the macro as soon as you update the progress). The downside is that CorelDRAW will also receive its painting events and this will slow down your macro considerably.

Another way to update the form during execution is to call UserForm.Repaint method. Unfortunately this repains the whole form and all the controls start to "flash" while macro runs.

Finally the approach I use myself - call Windows API function UpdateWindow for the form. Unfortunately (as usual, right?) VBA forms do not give the window handle for the form, so there is no easy way to do this. What I do is to call Windows API function FindWindow and knowing that all VBA forms have window class of ThunderDFrame and I know the caption of the form, I can find its handle.

The code that illustrates this second approach and the three ways of updating the form is shown below. You can call the subroutine "RefreshForm" with parameter of 1 to 3 to try out the three refresh approaches:

Code:
Option Explicit

Private Const NumShapes As Long = 1000

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Sub cmStart_Click()
    DoCreateShapes
End Sub

Private Sub DoCreateShapes()
    Dim doc As Document
    Dim x As Double, y As Double, sx As Double, sy As Double
    Dim n As Long
    
    Set doc = CreateDocument
    For n = 1 To NumShapes
        x = Rnd() * 8
        y = Rnd() * 11
        sx = Rnd() * 4
        sy = Rnd() * 4
        doc.ActiveLayer.CreateRectangle2 x, y, sx, sy
        lblProgress.Caption = n & " of " & NumShapes
        RefreshForm 3
    Next n
    
    MsgBox "Done"
End Sub

Private Sub RefreshForm(ByVal nMethod As Long)
    Select Case nMethod
        Case 1
            ' Just let the painting message come to the form
            ' This also slows down the macro as CorelDRAW repaints
            ' the document as it goes too
            DoEvents
            
        Case 2
            ' Force the form to repaint itself
            ' This will cause the whole form to flash...
            Me.Repaint
            
        Case 3
            ' Use Windows API to let the form update itself
            LowLevelRepaint
    End Select
End Sub

Private Sub LowLevelRepaint()
    Dim hWnd As Long
    
    hWnd = FindWindow("ThunderDFrame", Me.Caption)
    If hWnd <> 0 Then
        UpdateWindow hWnd
    End If
End Sub
Attached Images
 
Reply With Quote
  #9  
Old 10-02-2005, 13:38
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Other Options

Finally last point. You can simulate the progress bar by using, say, regular text labels on the form. Just remove the caption of the label and change the background color to blue (for example) to make the label to appear as a progress bar.

I usually put two empty labels on top of each other. The bottom one is a regular label with no text (and default gray background) which just shows the total width of the progress bar. The second one (the blue one) sits right on top of the first and is used to actually represent the slider of the progress bar. It's width changes from 0 to the full length of the background label.

So, to try out this approach, create a form, place a text label on it, give it a name of "lblBarBack", remove the caption. Then make a copy of it, rename it to "lblBarFront", make it smaller horizontally and change the background color to blue.

As usual, put the "cmStart" button (see the attachment 1 for example).

Code:
Option Explicit

Private Const NumShapes As Long = 1000

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Sub cmStart_Click()
    SetProgress 0
    DoCreateShapes
End Sub

Private Sub DoCreateShapes()
    Dim doc As Document
    Dim x As Double, y As Double, sx As Double, sy As Double
    Dim n As Long
    
    Set doc = CreateDocument
    For n = 1 To NumShapes
        x = Rnd() * 8
        y = Rnd() * 11
        sx = Rnd() * 4
        sy = Rnd() * 4
        doc.ActiveLayer.CreateRectangle2 x, y, sx, sy
        SetProgress n
    Next n
    
    MsgBox "Done"
End Sub

Private Sub SetProgress(ByVal nVal As Long)
    lblBarFront.Width = lblBarBack.Width * nVal / NumShapes
    LowLevelRepaint
End Sub

Private Sub LowLevelRepaint()
    Dim hWnd As Long
    
    hWnd = FindWindow("ThunderDFrame", Me.Caption)
    If hWnd <> 0 Then
        UpdateWindow hWnd
    End If
End Sub
When you change the width of the front bar, you also need to make sure the form repaints. I used the same (third) approach from the message above to do this.

The attachment 2 shows how the form looks at run time.
Attached Images
  
Reply With Quote
  #10  
Old 10-02-2005, 13:39
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Other Options

Here is a ready-made GMS file (inside the ZIP archive) that has all three forms in it for your reference.

Hope this helps
Attached Files
File Type: zip ProgressBar.zip (9.8 KB, 446 views)
Reply With Quote
Reply


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
Installer for GMS ssb CorelDRAW/Corel DESIGNER VBA 8 15-02-2005 02:22
An informational message box that doesn't stop the app? Rick Randall CorelDRAW/Corel DESIGNER VBA 2 15-03-2004 10:38


All times are GMT -5. The time now is 10:32.


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