Hakan Özdemir

CorelDraw VBA - Lens'den Bmp'ye Çevirmek

Geçtiğimiz derslerde; kod yaratma prensiplerini, bu kodları buton ile veya menü üzerine atadığımız ikonlarla tetiklemeyi öğrenmiştik. Bundan sonraki derslerde öğreneceğimiz kodları, bir form mu yoksa kendimize özel menümüz altından mı çalıştıracağımız konusunu artık sizlere bırakıyorum.

Evet kodlarımızı yazmaya başlayalım ve de açıklamalarını da karşılarına ekleyelim (' ile başlayan yerler tanımlar için, kod olarak işlemezler);
Dim d As Document ' Dökümanın tanımını yapıyoruz.
Dim s As Shape 'Aranacak Lensli nesneye bir tanım yapıyoruz.
d.Activate 'Dökümanı aktifleştiriyoruz ki bu çoğu zaman işimize yarayacak
d.ActivePage.Activate 'sayfaya aktif hale getiriyoruz.
For Each s In d.ActivePage.Shapes ' aktif sayfadaki tüm nesneler için bir döngü oluşturacağız. VBA biraz sonraki lens aramasında tek tek tarama yapacak.
If Not s.Effects.LensEffect Is Nothing Then 'döngüye giren nesneler içinde lensli olan var mı? aratıyoruz.
s.ConvertToBitmapEx cdrCMYKColorImage, False, True, 300, cdrNormalAntiAliasing, True 's olarak tanımladığımız nesne eğer lensli ise;

ConvertToBitmapEx: bmp'ye çevir
cdrCMYKColorImage: CMYK modunda olsun (baskı için varsayılan mod)
False: 1. false değeri dither tipinde olsun mu, olmasın mı?
False: 2. false değeri Transparent tipinde olsun mu, olmasın mı? Transparan bırakılmasını öneririm, yoksa altına beyaz bir zemin koyar.
300: bmp dpi değeri, ortalama 300 olması önerilir.
cdrNormalAntiAliasing: Antialis modu ne olsun, varsayılan normali kullanalım.
True: sondaki True değeri ise ColorProfile kullanalım mı anlamında, True diyerek ColorProfile kulanımını aktif ediyoruz.

End If 'Eğer koşulunu sonlandırıyoruz.
Next s 'döngü için bir sonraki nesneye yönlendiriyoruz.

Şimdi kodların normal yazılmış haline bir göz atalım.

Dim d As Document 
Dim s As Shape
d.Activate
d.ActivePage.Activate
    For Each s In d.ActivePage.Shapes
        If Not s.Effects.LensEffect Is Nothing Then
            s.ConvertToBitmapEx cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True
        End If
    Next s

Eğer birden fazla döküman açıksa ve de bunlar içindeki lenslerin de bmp'ye çevrilmesini istiyorsak, bu kodlarımıza bir de döküman için döngü eklemeliyiz.
Görünüm şu şekilde olur.

Dim d As Document 
Dim s As Shape
For Each d In Documents
d.Activate
d.ActivePage.Activate
    For Each s In d.ActivePage.Shapes
        ' Check to see if the object has a lens effect
        If Not s.Effects.LensEffect Is Nothing Then
            ' Convert it to a 300 dpi CMYK bitmap
            s.ConvertToBitmapEx cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True
        End If
    Next s
Next d

Evet birkaç bmp, yada çizim nesnesine lens efekti uygulayıp kodumuzu yukarıda bahsettiğim şekilde bir menü altında yada yaratacığınız bir form butonunun click olayı altında çalıştıralım. (Sub ve End Sub blokları arasına yapıştırabilirsiniz.)

İyi çalışmalar, başarılar...