AddTilteText



Public Const COLOR_CAPTIONTEXT = 9
Public Const DT_CENTER = &H1' centre left to right
Public Const DT_VCENTER = &H4 ' centre top to bottom
Public Const DT_NOCLIP = &H100 ' fast draw
Public Const DT_SINGLELINE = &H20' single line only
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, _
ByVal lpStr As String, _
ByVal nCount As Long, _
lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Sub Form_Load()
Dim frameHeight As Long
Dim frameWidth As Long
Dim btnSize As Integer
Toolbar.ScaleMode = 3
'compute the width of the left and right dialog frame

frameHeight = GetSystemMetrics(SM_CYDLGFRAME) * 2
'compute the width of the top and bottom dialog frame

frameWidth = GetSystemMetrics(SM_CXDLGFRAME) * 2
'get the size of one of the square toolbar buttons

btnSize = SSCommand1(0).Width
'set the tool window size>

Toolbar.Height = ((btnSize * 4) + frameHeight + Picture1.Height + 1) * Screen.TwipsPerPixelY
Toolbar.Width = ((btnSize * 3) + frameWidth) * Screen.TwipsPerPixelX
'set the mock titlebar color to that of an active window

Picture1.BackColor = GetSysColor(COLOR_ACTIVECAPTION)
'Use active caption color for label's caption:

Picture1.ForeColor = GetSysColor(COLOR_CAPTIONTEXT)
'Choose a small font or whatever looks best on your system

Picture1.FontName = "Arial"
Picture1.FontSize = 7
Picture1.FontBold = False
Toolbar.ScaleMode = 1
End Sub

Private Sub Form_Resize()
'Change size of Picture1

Picture1.Width = Me.ScaleWidth
Toolbar.ScaleMode = 3
'Draw the word "Toolbar" into the fake picturebox titlebar

Dim r&, rc As RECT
rc.Left = Picture1.Left
rc.Top = Picture1.Top
rc.Right = rc.Left + Picture1.Width
rc.Bottom = rc.Top + Picture1.Height
Picture1.Cls
r& = DrawText(Picture1.hdc, "Toolbar", 7, rc, DT_FLAGS)
Toolbar.ScaleMode = 1
End Sub


(addtiltetext.html)- by Paolo Puglisi - Modifica del 25/3/2019