dotNETportal.cz

Nastaví se FormBorderStyle = None, přidá vlastní grafika a potom se musí ošetřit přesouvání okna (což ale úvodní okno aplikací Office nemá).

Kód pro přesouvání okna pomocí vlastního titulkového pruhu:

Public Class Form1
  'Definice konstant Windows API
  Private Const HTCAPTION As Integer = 2
  Private Const HTLEFT As Integer = 10
  Private Const HTRIGHT As Integer = 11
  Private Const HTTOP As Integer = 12
  Private Const HTTOPLEFT As Integer = 13
  Private Const HTTOPRIGHT As Integer = 14
  Private Const HTBOTTOM As Integer = 15
  Private Const HTBOTTOMLEFT As Integer = 16
  Private Const HTBOTTOMRIGHT As Integer = 17
  Private Const WM_NCHITTEST As Integer = &H84
  Private Const WM_NCLBUTTONDOWN As Integer = &HA1
  'Určuje, jak daleko od okraje formuláře se má zahájit změna velikosti
  Private Const resizeBorder As Integer = 5
  Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
    'Vlastní ošetření přesouvání a změny velikosti formuláře
    'pomocí odeslání Windows zprávy.
    If m.Msg = WM_NCHITTEST Then
      Dim pt As New Point(m.LParam.ToInt32)
      pt = Me.PointToClient(pt)
      If pt.X < resizeBorder AndAlso pt.Y < resizeBorder Then
        m.Result = New IntPtr(HTTOPLEFT)
      ElseIf pt.X > (Me.Width - resizeBorder) AndAlso pt.Y < resizeBorder Then
        m.Result = New IntPtr(HTTOPRIGHT)
      ElseIf pt.Y < resizeBorder Then
        m.Result = New IntPtr(HTTOP)
      ElseIf pt.X < resizeBorder AndAlso pt.Y > (Me.Height - resizeBorder) Then
        m.Result = New IntPtr(HTBOTTOMLEFT)
      ElseIf pt.X > (Me.Width - resizeBorder) AndAlso pt.Y > (Me.Height - resizeBorder) Then
        m.Result = New IntPtr(HTBOTTOMRIGHT)
      ElseIf pt.Y > (Me.Height - resizeBorder) Then
        m.Result = New IntPtr(HTBOTTOM)
      ElseIf pt.X < resizeBorder Then
        m.Result = New IntPtr(HTLEFT)
      ElseIf pt.X > (Me.Width - resizeBorder) Then
        m.Result = New IntPtr(HTRIGHT)
      Else
        MyBase.WndProc(m)
      End If
    Else
      MyBase.WndProc(m)
    End If
  End Sub
  Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseDown
    'Přesouvání pouze pomocí vlastního titulkového pruhu.
    'Pokud chcete formulář přesouvat tažením kdekoliv v klientské
    'oblasti formuláře, odstraňte podmínku.
    If e.Y <= 32 Then
      Me.Capture = False
      WndProc(Message.Create(Me.Handle, WM_NCLBUTTONDOWN, IntPtr.op_Explicit(HTCAPTION), IntPtr.Zero))
    End If
  End Sub
  Private Sub Form1_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles Me.Paint
    'Vykreslování vlastního titulkového pruhu (vysokého 32 pixelů).
    e.Graphics.FillRectangle(Brushes.Black, 0, 0, Me.Width, 32)
  End Sub
End Class