View Single Post
Old 30-01-2004, 12:25
Posts: n/a

Thanks for your fast and (so helpfully) reply.

I think i've got it, or at least i've got something that works:

Sub Example()
    Dim shBM As Shape   'bitmap
    Dim shBMclone As Shape   'bitmap
    Dim shRC As Shape   'clipping rectangle
    Dim shPW As Shape   'bitmap inside the rectangle (by powerclipping)
    Dim x1 As Double, y1 As Double
    Dim x2 As Double, y2 As Double
    Dim w1 As Double, w2 As Double
    Dim h1 As Double, h2 As Double
    'Suppose you've got selected one bitmap
    Set shBM = ActiveShape: If shBM Is Nothing Then Exit Sub
    'Bitmap size and position
    shBM.GetSize w1, h1:    shBM.GetPosition x1, y1
    'Create one clipping rectangle
    Set shRC = ActiveLayer.CreateRectangle(4, 4, 12, 12)
    'Rectangle size and position
    shRC.GetSize w2, h2:    shRC.GetPosition x2, y2 'a bit stupid, i knew but maybe useful for somebody
    'We make a clon
    Set shBMclone = shBM.Clone  
    'Comment '.Clone' if you want to delete the original bitmap
    'Insert the bitmap inside the rectangle
    shBMclone.AddToPowerClip shRC
    'Get the bitmap (shape) that is inside the rectangle
    Set shPW = shRC.PowerClip.Shapes.Item(1)
    shPW.Move ((w1 - w2) / 2) + (x1 - x2), ((h1 - h2) / 2) + ((y1 - h1) - (y2 - h2))
    'PD: If you want clone the bitmap,  all the "clones" will be deleted
    '    by deleting the original bitmap. Be careful!
End Sub
VMC for ApiaXXI SA
Reply With Quote