VB 6.0 da pojeyi ekran çözünürlüğüne göre otomatik ayarlama

[NBATMAN]

Merhaba arkadaşlar ben aşağıdaki kodları siteden aldım fakat kendi uygulamamda çalıştıramadım.

Konu kısaca şu :

ben VB 6.0 da projemi hazırlıyorum, ekran çözünürlüğümde 1680x1050 ve user form ve nesneleride bu çözünürlüğe göre dizayn ediyorum fakat bu programım başka bilgisayarlarda ( çözünürlüklerde de ) çalışacak.Program har farklı çözünürlükte userform ve nesneleri otamatik olarak kendisine göre ayarlasın istiyorum bence doğrusuda budur.
Fakat aşağıdaki kodlarda hata mesajları alıyorum çalıştıramıyorum.
Daha önce bu konu ile ilgili sıkıntı çekmiş arkadaşlar veya uzman arkadaşlar yardım ve önerilerinizi bekliyorum.Saygılarımla...


Private Declare Function GetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" _
(ByVal nIndex As Long) As Long


"Private Sub Form_Load()
Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = 1680
Y1 = 1050
X2 = GetSystemMetrics32(0)
Y2 = GetSystemMetrics32(1)
CX = X2 / X1
CY = Y2 / Y1
Me.Width = Me.Width * CX
Me.Height = Me.Height * CY
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
End Sub"

 

[janveljan]

Userformun Zoom özelliğini kullanmanızı tavsiye ederim.

 

[Haluk]

MS Excel UserForm' ları için;

http://www.excel.web.tr/showpost.php?p=9218&postcount=13

.

 

[NBATMAN]

Haluk Bey,

öncelikle ilginiz için çok teşekkür ederim...

sizin verdiğiniz linke baktım zannedersem benim yukarda eklediğim ( formdan ) bulduğum kodlardan bir farkı yok.Ayrıca sizde belirtmişsiniz zaten bu kodlar VBA için VB 6.0 için değil.
Peki bu kodlarda hata veren

MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY

yukarıdaki satırlarda ne gibi bir problemden dolayı hata mesajı almış olabilirim sizce

 

[Haluk]

Merhaba;

Bende VB6 olmadığı için bir fikrim yok.

Demek ki, VB6' nın desteklemediği bir şeyler var...

İsterseniz, "Dim MyCtrl As Control" satırını silip de bir deneyin....

.

 

[ziya]

Sn NBATMAN
Korhan Ayhan 'ın bir çalışmasında kullandığı kodlar aşağıda. Umarım istediğiniz budur.

Dim Buton_Adı() As Variant
    Dim Sistem_Genişlik As Long, Sistem_Yükseklik As Long
    Dim Form_Genişlik As Long, Form_Yükseklik As Long
    Dim Genişlik_Oranı As Double, Yükseklik_Oranı As Double
    Dim Nesne As Control
 
 
    '1 - UserFormu sistem ekran ayarlarına göre ekranı kaplayacak şekilde açılması için gerekli genişlik ve yükseklik ayarlarını yapıyoruz.
 
    Sistem_Genişlik = Application.Width - 8
    Sistem_Yükseklik = Application.Height - 8
    Form_Genişlik = UserForm1.Width
    Form_Yükseklik = UserForm1.Height
    Genişlik_Oranı = Sistem_Genişlik / Form_Genişlik
    Yükseklik_Oranı = Sistem_Yükseklik / Form_Yükseklik
    UserForm1.Width = Sistem_Genişlik
    UserForm1.Height = Sistem_Yükseklik
 
    For Each Nesne In UserForm1.Controls
        Nesne.Top = Nesne.Top * Yükseklik_Oranı
        Nesne.Left = Nesne.Left * Genişlik_Oranı
        Nesne.Width = Nesne.Width * Genişlik_Oranı
        Nesne.Height = Nesne.Height * Yükseklik_Oranı
        On Error Resume Next
            Nesne.Font.Size = Nesne.Font.Size * Yükseklik_Oranı + 1
        On Error GoTo 0
    Next

 

[Haluk]

ziya bey;

Pardon da.... bu verdiğiniz kodların, benim verdiğim linktekilerden bir farkı var mı da (değişkenlerin isimleri haricinde) eklediniz acaba ?

.

 

[ziya]

Sn Haluk
Haklısınız, verdiğiniz linki incelememiştim.
Korhan beyden aldığım bu kodları kullandım ve sorun olmadı. Ani bir refleks sonucu da buraya ekledim.
Selamlar,

 

[modalı]

Haluk Bey,

öncelikle ilginiz için çok teşekkür ederim...

sizin verdiğiniz linke baktım zannedersem benim yukarda eklediğim ( formdan ) bulduğum kodlardan bir farkı yok.Ayrıca sizde belirtmişsiniz zaten bu kodlar VBA için VB 6.0 için değil.
Peki bu kodlarda hata veren

MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY

yukarıdaki satırlarda ne gibi bir problemden dolayı hata mesajı almış olabilirim sizce

Sayın NBATMAN,

Formunuzun yapısını bilemediğim için bir tahminde bulunayım. Ya taşınamayan bir kontrolünüz var yada kontrol taşınırken, en ve boyu daha sonra yarlandığından taşma oluyor ve hata üretiyor. Siz önce kontrolün enini boyunu yarlayıp sonra top ve left ile yerleştirmeye çalışın.


Veya bir de şu kodları deneyin:

Private List() As Control
Private curr_obj As Object
Private iHeight As Integer
Private iWidth As Integer
Private x_size As Double
Private y_size As Double

Private Type Control
    Index As Integer
    Name As String
    Left As Integer
    Top As Integer
    width As Integer
    height As Integer
End Type

Public Sub ResizeForm(frm As Form)
    'Set the forms height
    frm.height = Screen.height / 2
    'Set the forms width
    frm.width = Screen.width / 2
    'Resize all of the controls
    'based on the forms new size
    ResizeControls frm
End Sub

Public Sub ResizeControls(frm As Form)
Dim i As Integer
'   Get ratio of initial form size to current form size
x_size = frm.height / iHeight
y_size = frm.width / iWidth

'Loop though all the objects on the form
'Based on the upper bound of the # of controls
For i = 0 To UBound(List)
    'Grad each control individually
    For Each curr_obj In frm
        'Check to make sure its the right control
        If curr_obj.TabIndex = List(i).Index Then
            'Then resize the control
             With curr_obj
                .Left = List(i).Left * y_size
                .width = List(i).width * y_size
                .height = List(i).height * x_size
                .Top = List(i).Top * x_size
             End With
        End If
    'Get the next control
    Next curr_obj
Next i
End Sub

Public Sub GetLocation(frm As Form)
Dim i As Integer
'   Load the current positions of each object into a user defined type array.
'   This information will be used to rescale them in the Resize function.

'Loop through each control
For Each curr_obj In frm
'Resize the Array by 1, and preserve
'the original objects in the array
    ReDim Preserve List(i)
    With List(i)
        .Name = curr_obj
        .Index = curr_obj.TabIndex
        .Left = curr_obj.Left
        .Top = curr_obj.Top
        .width = curr_obj.width
        .height = curr_obj.height
    End With
    i = i + 1
Next curr_obj
    
'   This is what the object sizes will be compared to on rescaling.
    iHeight = frm.height
    iWidth = frm.width
End Sub

Public Function SetFontSize() As Integer
    'Make sure x_size is greater than 0
    If Int(x_size) > 0 Then
    'Set the font size
        SetFontSize = Int(x_size * 8)
    End If
End Function

Private Sub Form_Load()
    GetLocation Me
    CenterForm Me
    ResizeForm Me
    
    lblInstructions.Font = SetFontSize()
End Sub

Private Sub Form_Resize()
     ResizeControls Me
     lblInstructions.FontSize = SetFontSize()
End Sub

Uygulamayla ilgili küçük bir örnek ekliyorum.

İyi çalışmalar