Centrování titulku okna

Postup:
Založte nový projekt. V něm deklarujte následující proměnnou a zapište proceduru:

Dim oldsize As Long

Public Sub CenterC(frm As Form)
   Dim SpcF As Integer
'počítadlo mezer
    Dim clen As Integer 'délka titulku
   Dim oldc As String    'původní titulek
   Dim i As Integer

    'odstranění mezer ZA titulkem
   oldc = frm.Caption

    Do While Left(oldc, 1) = Space(1)
      DoEvents
      oldc = Right(oldc, Len(oldc) - 1)
    Loop

    Do While Right(oldc, 1) = Space(1)
      DoEvents
      oldc = Left(oldc, Len(oldc) - 1)
    Loop

    clen = Len(oldc)

    If InStr(oldc, "!") <> 0 Then
       If InStr(oldc, " ") <> 0 Then
          clen = clen * 1.5
       Else
          clen = clen * 1.4
       End If
   Else
       If InStr(oldc, " ") <> 0 Then
           clen = clen * 1.4
       Else
           clen = clen * 1.3
       End If
   End If

    'kolik se vejde znaků
    SpcF = frm.Width / 61.2244
    SpcF = SpcF - clen

  
If SpcF > 1 Then
        DoEvents
        frm.Caption = Space(Int(SpcF / 2)) + oldc
    Else
'pokud je formulář pro mezery příliš malý
      frm.Caption = oldc
    End If

End Sub

Na událost Form_Load zapište:

CenterC Me
oldsize = Me.Width

a na událost Form_Resize:

If Me.Width = oldsize Then
   
'nezměnila se velikost formuláře
    Exit Sub
Else
     CenterC Me
     oldsize = Me.Width
End If

Spusťte projekt. Titulek se jakž takž vycentruje, asi by to chtělo trochu lépe spočítat.

Zpět

Autor: The Bozena

iReklama.cz - nový reklamní systém
iReklama.cz - nový reklamní systém