HomeMade Title Bar [Resolved]

[Nove]

I'd like to implement a title bar using only a picturebox, how can I go about doing this? I've tried moving the form invoking the picturebox_mousemove event, but it gives a weird lag and kind of smears the form across the screen. The mousemove event also doesn't appear to be totally consistent either. I'm sure this has been done before, any pointers?

[dglienna]

I would use the MID() statement, like this.

Option Explicit
  Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
  Dim titlebar%
  Dim title$
  Dim z As Long
  Dim ichange
  Dim stitle$
  Dim istart%, iend%
  Dim endflag As Boolean
 
Private Sub Command1_Click()
  If endflag = True Then
    endflag = False
  Else
    endflag = True
  End If
  If endflag = False Then
    istart = 1
    Do While endflag = False
      If istart + titlebar < Len(title) + 1 Then
        stitle = Mid(title, istart, titlebar)
      Else
        ichange = Len(title) - istart
        stitle = Mid(title, istart, ichange) & Mid(title, 1, titlebar - ichange)
      End If
      Label1.Caption = stitle
      DoEvents
      If istart < Len(title) Then istart = istart + 1 Else istart = 1
      Sleep 200
     Loop
  End If
    
  
End Sub
 
Private Sub Form_Load()
 endflag = True
 title = "This is a test.  This is only a test..." ' Bar is 10 characters
 titlebar = 10
End Sub

It can be improved slightly, I just whipped it up.

[RhinoBull]

I'd like to implement a title bar using only a picturebox, how can I go about doing this? I've tried moving the form invoking the picturebox_mousemove event, but it gives a weird lag and kind of smears the form across the screen. The mousemove event also doesn't appear to be totally consistent either. I'm sure this has been done before, any pointers?

If you're talking about moving borderless form then here is a sample:

Option Explicit
 
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
 
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
 
Private Sub pctTitlebar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        ReleaseCapture
        SendMessageLong Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
End Sub

[Nove]

Thanks RhinoBull, works perfectly, and alot easier than I would've thought.

Dglienna, I'm not quite sure what you were trying to do...

[ZeBula8]

Private Sub Form_Load()
Picture1.BackColor = vbBlue
Picture1.Move Me.ScaleLeft, Me.ScaleTop, Me.Width, 320
End Sub

and then use RhinoBulls's code to move it around

[RhinoBull]

Thanks RhinoBull, works perfectly, and alot easier than I would've thought. ...

Sounds good to me.

[dglienna]

Somehow I got a scrolling marquee type thing out of that. It must be Friday, or something!