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 08-10-2013, 23:51
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434
Default Size of Exported PNG

The code below is part of a form that allows me to save objects on a specified layer as PNG. Everything works as expected except the final size is slightly off. When making the page a 1000 pixel square I expect the object to be either 700 pixels tall or wide (whichever is the larger). But I'm seeing numbers ranging from 702 - 709. Why is that. Is it because of some rounding that I have forgot to take into account. For the project I'm working on it is critical that I get exact results. Thanks

Code:
Private Sub cmdPath_Click()


    Dim sFolder As String
    Dim sMask As String
    Dim col As Collection
    
    sFolder = cmdPath.Caption
    sFolder = BrowseForFolder(AppWindow.Handle, "Select the folder to process", sFolder)
       
    If sFolder <> "" Then
    
        cmdPath.Caption = sFolder
        Open "K:\Z Modifications\_Settings\Corel Draw\zzPNG.txt" For Output As #1
        Write #1, sFolder
        Write #1, pageB.Value
        Write #1, pageT.Value
        Write #1, SaveType.ListIndex
        Close #1
        
    End If
    
    SetPathFont
    
    Me.Hide
    Me.Show
   
End Sub


Private Sub cmdOK_Click()

    ActiveDocument.Unit = cdrPixel
    ActiveDocument.Resolution = 300

    Dim sp As Integer, ep As Integer, pags As Integer
    Dim sr As ShapeRange
    Dim expfltPNG As ExportFilter
    Dim wid As Long, hgt As Long
        

    If pageT.Value > ActiveDocument.pages.Count Or pageT.Value < pageB.Value Or pageB.Value < 1 Then
    MsgBox "Oops!", vbExclamation, "Check your page ranges!"
    Exit Sub
    End If
    
'    If SaveType.Value = "Export To Square" Then frmSetDimensions.Show vbModal
    
'    MsgBox SaveType.ListIndex
'    Exit Sub
       
    PIX = 700
    QUL = 72
       
    Optimization = True

    pags = sp

    For pags = pageB To pageT

        ActiveDocument.ClearSelection

        For i = 0 To ListToExp.ListCount - 1
        If ListToExp.Selected(i) = True Then
            nam = ListToExp.list(i)
            ActiveDocument.pages(pags).Layers(nam).Shapes.All.AddToSelection
        End If
        Next i

        If ActiveSelection.Shapes.Count > 0 Then


            ActiveSelection.Duplicate
            Set sr = ActiveSelectionRange
            
            If SaveType.Value = "Export To Square" Then wid = 1000: hgt = 1000: DPI = QUL
            If SaveType.Value = "Export WideScreen 1:1" Then wid = 873: hgt = 480: DPI = 300
            If SaveType.Value = "Export WideScreen 2:1" Then wid = 1746: hgt = 960: DPI = 300
            If SaveType.Value = "Export WideScreen 4:1" Then wid = 3492: hgt = 1920: DPI = 300
            If SaveType.Value = "Export Full Page" Then
                wid = ActiveDocument.pages(pags).SizeWidth
                hgt = ActiveDocument.pages(pags).SizeHeight
                DPI = 300
            End If
            
            Set s = ActiveDocument.pages(pags).ActiveLayer.CreateRectangle(0, 0, wid, hgt)
            s.Fill.ApplyNoFill
            s.Outline.SetNoOutline
            
            
            If wid > hgt Then
                If ActiveDocument.pages(pags).SizeWidth >= wid Then pRatio = wid / ActiveDocument.pages(pags).SizeWidth
                If ActiveDocument.pages(pags).SizeWidth < wid Then pRatio = ActiveDocument.pages(pags).SizeWidth / wid
            Else
                If ActiveDocument.pages(pags).SizeHeight >= hgt Then pRatio = hgt / ActiveDocument.pages(pags).SizeHeight
                If ActiveDocument.pages(pags).SizeHeight < hgt Then pRatio = ActiveDocument.pages(pags).SizeHeight / hgt
            End If
            

            If SaveType.Value = "Export To Square" Then
            
                If sr.SizeHeight > sr.SizeWidth Then
                
                    sRatio = sr.SizeWidth / sr.SizeHeight
                    sr.SetSize PIX * sRatio, PIX
                
                Else
                
                    sRatio = sr.SizeHeight / sr.SizeWidth
                    sr.SetSize PIX, PIX * sRatio
                                  
                End If
                
            Else
            
                sr.Stretch pRatio, pRatio
                
            End If

            sr.AlignRangeToShape cdrAlignHCenter, s
            sr.AlignRangeToShape cdrAlignVCenter, s
            sr.CreateSelection
            s.AddToSelection
                     
            
            Set sr = ActiveSelectionRange

            FilePth = cmdPath.Caption
            strName = ActiveDocument.pages(pags).name

            Set expfltPNG = ActiveDocument.ExportBitmap(FilePth + "\" + strName + ".png", cdrPNG, cdrSelection, cdrRGBColorImage, wid, hgt, _
            DPI, DPI, cdrNormalAntiAliasing, True, True, False, False, cdrCompressionNone)

             With expfltPNG
                .Interlaced = True
                .InvertMask = False
                .Finish
            End With

            Set expfltPNG = Nothing

            sr.Delete

        End If

    Next pags

    Optimization = False
    
    cmdClose_Click

End Sub
Reply With Quote
  #2  
Old 09-10-2013, 00:21
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
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 AntiAliasing

My guess is that it is the cdrNormalAntiAliasing, try turning this off and see if you get the dimensions you are looking for.

-Shelby
Reply With Quote
  #3  
Old 09-10-2013, 02:32
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434
Default

Thanks for the suggestion, Shelby. I changed it to cdrNoAntiAliasing but it made no difference - objects are still ending up larger than 700 pixels.
Reply With Quote
  #4  
Old 09-10-2013, 17:42
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434
Default

It seems the fault is with CorelDraw export. I've confirmed that the dimensions of the object and background are correct before saving. When I try to save them manually CorelDraw increases the size of the background from 1000 to 1001 pixels. The annoying thing is that I had to use a disk image because of a bad program install (unrelated). Before going back in time I had got it working perfectly but I don't know how. I had to recreate the code and now it's not working as it should.
Reply With Quote
  #5  
Old 09-10-2013, 17:53
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434
Default

Back again - I just found out what is happening - I hadn't got it working correctly before. The problem is caused by outlines. These aren't taken into account so the larger the outline the mor the final image is larger than it should be. I now need an approach to deal with this. Convert all the outlines to objects before saving or convert the whole object to a bitmap. Not sure which is better.
Reply With Quote
  #6  
Old 10-10-2013, 19:28
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434
Default How to Select a Bitmap?

I decide to convert the objects into bitmaps but am having a hard time selecting them:

Code:
            Set s = ActiveSelection.Duplicate
            
            If SaveType.Value = "Export To Square" Then
          
                    Set s = s.ConvertToBitmapEx(cdrRGBColorImage, , True)
'                    s.Selected = True
                    s.CreateSelection
                
                End If
This fails with the code above if I deal with more than one page at a time. The same goes for s.selected = true. It works with single pages but not with multiple pages. I can't figure out why. How can I convert a selection to a bitmap and keep the bitmap selected?
Reply With Quote
  #7  
Old 11-10-2013, 19:38
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434
Default

I found the problem - when dealing with bitmaps it is necessary to activate each page first.
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
unwanted margin/border around exported objects michael_maberly General 5 28-05-2007 18:38
PDF size Dave General 1 08-11-2006 08:42
auto naming exported file to specific path vindaa Macros/Add-ons 0 18-08-2006 16:50
Draw X3: bug in "Font Size Next Combo Size" wOxxOm General 3 31-01-2006 12:49
How sets size form same as size images ? woycek21 Corel Photo-Paint VBA 0 09-07-2005 12:30


All times are GMT -5. The time now is 01:47.


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