Userform Başlığını Ortalama

[volki_112]

Merhabalar A bilgisayarında alttaki kodları ile Userform İntialize içine yazarak userformun başlığını ortalayabiliyorum.

    Dim BoslukSayisi As Integer
    Dim Title As String

    ' Kullanılacak Başlık
    Title = "İŞLEM DURUMU"

   
    ' Kapat Button=30, Her karakter için yaklaşık 3 piksel kabul edelim
    BoslukSayisi = ((Me.Width - 30) - (Len(Title) * 3)) \ 6
   
    ' Başlığı ortala
    Me.Caption = Space(BoslukSayisi) & Title

yalnız bu kodu B bilgisayarında denediğimde başlığı ortalamıyor.
B bilgisayarında Me.Caption = "." & Space(BoslukSayisi) & Title
B bilgisayarında illa üstteki gibi space den önce bir karakter girersem başlığı ortalıyor. İki tırnak arasını boş bıraksam veya boşluk atsam dahi baştaki boşlukları siliyor başlık gösterirken. İlla başa bir karakter girmemi istiyor.

İki bilgisayarda office 2019 kurulu. A bilgisayarı Windows10Pro, B bilgisayarı Win11Home

Çözüm öneriniz var mı.

 

[volki_112]

Şöyle dener misiniz hocam;

Private Sub UserForm_Initialize()
    Dim BoslukSayisi As Integer
    Dim Title As String

    Title = "İŞLEM DURUMU"
   
    BoslukSayisi = ((Me.Width - 30) - (Len(Title) * 3)) \ 6
 
    Me.Caption = Chr(1) & Space(BoslukSayisi) & Title
End Sub

chr daki çoğu karekter ile denedim olmadı. ortlama yapmayan pc yi akşam kullanıyorum. akşam tekrar deneyeyim.

 

[volki_112]

Şöyle dener misiniz hocam;

Private Sub UserForm_Initialize()
    Dim BoslukSayisi As Integer
    Dim Title As String

    Title = "İŞLEM DURUMU"
   
    BoslukSayisi = ((Me.Width - 30) - (Len(Title) * 3)) \ 6
 
    Me.Caption = Chr(1) & Space(BoslukSayisi) & Title
End Sub

işe yaramadı hocam

 

[volki_112]

Şöyle dener misiniz hocam;

Private Sub UserForm_Initialize()
    Dim BoslukSayisi As Integer
    Dim Title As String

    Title = "İŞLEM DURUMU"
   
    BoslukSayisi = ((Me.Width - 30) - (Len(Title) * 3)) \ 6

    Me.Caption = ChrW(8203) & Space(BoslukSayisi) & Title
End Sub

benim isteidğim title ı dahi yazmadı sadece ? yazdı başlıkta

 

[volki_112]

Peki şunu dener misiniz hocam;

Me.Caption = ChrW(160) & Space(BoslukSayisi) & Title


İse yaramadi hocam

 

[Zeki Gürsoy]

Bence form başlığını ortalamak için uğraşmak yerine, form başlığını yok ederek çakma bir form başlığı yapın...
Dosyayı incelediğinizde anlayacaksınız...

Option Explicit

#If Win64 Then
    Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
#End If

Sub RemoveCaption(objForm As Object)

Dim lStyle              As Long
Dim hMenu               As Long
#If Win64 Then
    Dim mhWndForm       As LongPtr
#Else
    Dim mhWndForm       As Long
#End If

mhWndForm = FindWindow("ThunderDFrame", objForm.Caption)

lStyle = GetWindowLong(mhWndForm, -16)
lStyle = lStyle And Not &HC00000
SetWindowLong mhWndForm, -16, lStyle
DrawMenuBar mhWndForm

End Sub

Private Sub UserForm_Initialize()
    Call RemoveCaption(Me)
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

.

 

[volki_112]

Bence form başlığını ortalamak için uğraşmak yerine, form başlığını yok ederek çakma bir form başlığı yapın...
Dosyayı incelediğinizde anlayacaksınız...

Ekli dosyayı görüntüle 256951

Option Explicit

#If Win64 Then
    Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
#End If

Sub RemoveCaption(objForm As Object)

Dim lStyle              As Long
Dim hMenu               As Long
#If Win64 Then
    Dim mhWndForm       As LongPtr
#Else
    Dim mhWndForm       As Long
#End If

mhWndForm = FindWindow("ThunderDFrame", objForm.Caption)

lStyle = GetWindowLong(mhWndForm, -16)
lStyle = lStyle And Not &HC00000
SetWindowLong mhWndForm, -16, lStyle
DrawMenuBar mhWndForm

End Sub

Private Sub UserForm_Initialize()
    Call RemoveCaption(Me)
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

.

teşekkürler hocam.