Yarıçap ölçüsü

[barışD34]

Selam,

Aşağıdaki kodda basit bir çember çizimi var.

Bir butona atayınca yarıçap değeri isteniyor.
Herhangi bir rakam yazıyorsunuz çiziyor fakat ölçüt nedir ?

Mesela 54 girişi yaptıysanız , çizilen çemberde sağ tık , boyut ve özelliklerde 3,81 cm değeri görünüyor.
Yani 54 nedir ve neden 3,81 cm'ye denk geliyor.
Bunu belli bir standart halinde yapamaz mıyız?
İnç yada cm gibi.

Olursa gösterimi nasıl olur?

Radius = InputBox("Please enter the radius of the circle")

    With ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, Radius * 2, Radius * 2)
        .Name = "CIRCLE1"
        .Fill.ForeColor.RGB = vbWhite
        .Line.Transparency = 0
        .Placement = 1
    End With

 

[muhasebeciyiz]

Sub DrawCircle()
Dim Radius_cm As Double
Dim Radius_px As Double

Radius_cm = InputBox("Please enter the radius of the circle in centimeters")
Radius_px = Radius_cm * 37.7953

DrawCircleInPixels Radius_px
End Sub

Sub DrawCircleInPixels(Radius_px As Double)
Dim CircleShape As Shape

Set CircleShape = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, Radius_px * 2, Radius_px * 2)

With CircleShape
.Name = "CIRCLE1"
.Fill.ForeColor.RGB = vbWhite
.Line.Transparency = 0
.Placement = 1
End With
End Sub

54, çemberin yarıçapıdır. Kullanıcıdan gelen bu değer, çemberin yarıçapının santimetre cinsinden uzunluğunu ifade eder. Örneğin, kullanıcı 54 santimetrelik bir çember çizmek istediğini belirttiğinde, bu değer çemberin yarıçapıdır.

Ancak, piksel cinsinden çemberi çizmek için, santimetre cinsinden yarıçap değerini piksel değerine dönüştürmemiz gerekiyor. Bu nedenle, kullanıcının girdiği santimetre cinsinden yarıçap değerini belirli bir oranla çarparak piksel cinsinden yarıçap değerini elde ediyoruz. Bu piksel cinsinden yarıçap değeriyle çemberi çiziyoruz.

Yani, 54 santimetrelik bir çemberin çizilmesi için kullanıcı 54 değerini girdiğinde, bu değeri piksel cinsine dönüştürüp çizim yapıyoruz. Çemberin görüntüsü, kullanıcının girdiği santimetre değerine göre belirlenir, ancak gerçek çember piksel cinsinden çizilir.

 

[barışD34]

Sub DrawCircle()
Dim Radius_cm As Double
Dim Radius_px As Double

Radius_cm = InputBox("Please enter the radius of the circle in centimeters")
Radius_px = Radius_cm * 37.7953

DrawCircleInPixels Radius_px
End Sub

Sub DrawCircleInPixels(Radius_px As Double)
Dim CircleShape As Shape

Set CircleShape = ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, Radius_px * 2, Radius_px * 2)

With CircleShape
.Name = "CIRCLE1"
.Fill.ForeColor.RGB = vbWhite
.Line.Transparency = 0
.Placement = 1
End With
End Sub

54, çemberin yarıçapıdır. Kullanıcıdan gelen bu değer, çemberin yarıçapının santimetre cinsinden uzunluğunu ifade eder. Örneğin, kullanıcı 54 santimetrelik bir çember çizmek istediğini belirttiğinde, bu değer çemberin yarıçapıdır.

Ancak, piksel cinsinden çemberi çizmek için, santimetre cinsinden yarıçap değerini piksel değerine dönüştürmemiz gerekiyor. Bu nedenle, kullanıcının girdiği santimetre cinsinden yarıçap değerini belirli bir oranla çarparak piksel cinsinden yarıçap değerini elde ediyoruz. Bu piksel cinsinden yarıçap değeriyle çemberi çiziyoruz.

Yani, 54 santimetrelik bir çemberin çizilmesi için kullanıcı 54 değerini girdiğinde, bu değeri piksel cinsine dönüştürüp çizim yapıyoruz. Çemberin görüntüsü, kullanıcının girdiği santimetre değerine göre belirlenir, ancak gerçek çember piksel cinsinden çizilir.

Öncelikle cevabınız için teşekkür ederim.
Oldukça büyük bir çizim yapıyor , yani 3 girildiğinde 8cm olarak çiziyor .

Piksel olarak mı bir karşılı buluyor diye düşünüyorum.
Ama net bir bilgim yok tabi

 

[DoğanD]

Merhaba,

Microsoft'un sitesinde Point hesaplaması 1/72 olarak yapılmış. Sizin kodunuza uygulayacak olursak, önce girilen cm değerini inch'e çevirip, 72 ile çarparak sonuca ulaşabiliriz.

Radius = (InputBox("Please enter the radius of the circle") / 2.54) * 72

 

[barışD34]

Merhaba,

Microsoft'un sitesinde Point hesaplaması 1/72 olarak yapılmış. Sizin kodunuza uygulayacak olursak, önce girilen cm değerini inch'e çevirip, 72 ile çarparak sonuca ulaşabiliriz.

Radius = (InputBox("Please enter the radius of the circle") / 2.54) * 72

Ekli dosyayı görüntüle 251342

Bende şimdi cevap girecektim belki faydalı olur diye.
Oranlama yapılınca 0.07 değeri sabite ulaşıyor.
Kod üzerinde /0.07 girince doğal olarak cm cinsi çıkıyor.

Yanıtınız için de teşekkür ederim , bunu da deneyeceğim.

 

[Zeki Gürsoy]

Ekran için DPI değeri çoğu zaman (hatta her zaman) 96 olabilir ancak, örneğin farklı DPI değeri olan resimlerde pixel değeri değişebilir. Bunu da DPI değeri 96 dan farklı olan bir JPG dosyasını "GetImageResolution" fonksiyonu test edebilirsiniz.

#If Win64 Then
    Private Declare PtrSafe Function GetDpiForWindow Lib "user32" (ByVal hWnd As LongLong) As Long
#Else
        Private Declare Function GetDpiForWindow Lib "user32" (ByVal hWnd As Long) As Long
#End If

Private Const INCH_CM    As Double = 2.54
Private Const INCH_POINT As Double = INCH_CM / 72

Sub Test()
    Dim lDpi As Long
    
    lDpi = GetDpiForWindow(Application.hWnd) 'genellikle 96 px
    
    Debug.Print "1 cm: " & CM_To_PX(1, lDpi) & " px"
    Debug.Print "1 cm: " & CM_To_PT(1) & " pt"
End Sub

Private Function CM_To_PX(ByVal inCM As Double, ByVal inDPI As Long) As Double
    CM_To_PX = WorksheetFunction.Round(inDPI / INCH_CM * inCM, 3)
End Function

Private Function CM_To_PT(ByVal inCM As Double) As Double
    CM_To_PT = WorksheetFunction.Round(inCM / INCH_POINT, 3)
End Function

Private Function GetImageResolution(ByVal imagePath As String) As Double
    Dim wia As Object
    
    Set wia = CreateObject("WIA.ImageFile")
    wia.LoadFile imagePath
    GetImageResolution = wia.VerticalResolution
End Function

.

 

[barışD34]

Ekran için DPI değeri çoğu zaman (hatta her zaman) 96 olabilir ancak, örneğin farklı DPI değeri olan resimlerde pixel değeri değişebilir. Bunu da DPI değeri 96 dan farklı olan bir JPG dosyasını "GetImageResolution" fonksiyonu test edebilirsiniz.

#If Win64 Then
    Private Declare PtrSafe Function GetDpiForWindow Lib "user32" (ByVal hWnd As LongLong) As Long
#Else
        Private Declare Function GetDpiForWindow Lib "user32" (ByVal hWnd As Long) As Long
#End If

Private Const INCH_CM    As Double = 2.54
Private Const INCH_POINT As Double = INCH_CM / 72

Sub Test()
    Dim lDpi As Long
   
    lDpi = GetDpiForWindow(Application.hWnd) 'genellikle 96 px
   
    Debug.Print "1 cm: " & CM_To_PX(1, lDpi) & " px"
    Debug.Print "1 cm: " & CM_To_PT(1) & " pt"
End Sub

Private Function CM_To_PX(ByVal inCM As Double, ByVal inDPI As Long) As Double
    CM_To_PX = WorksheetFunction.Round(inDPI / INCH_CM * inCM, 3)
End Function

Private Function CM_To_PT(ByVal inCM As Double) As Double
    CM_To_PT = WorksheetFunction.Round(inCM / INCH_POINT, 3)
End Function

Private Function GetImageResolution(ByVal imagePath As String) As Double
    Dim wia As Object
   
    Set wia = CreateObject("WIA.ImageFile")
    wia.LoadFile imagePath
    GetImageResolution = wia.VerticalResolution
End Function

.

Evet haklısınız. Kusura bakmayın geç cevap yazabildim. çok faydalı bir yanıt olduğunu düşünüyorum umarım diğer arkadaşlar için de öyle olacaktır.
Birçok konuda yeni başlık açmadan araştırıyorum , sunduğunuz çözüm niteliğinde bir yaklaşım göremedim.
Tekrar teşekkür ederim.