A new VFP top level form titlebar

Published on by Yousfi Benameur


this is a new vfp titlebar available on top level form (only).its available for desktop apps.
-one solution is to cut the form titlebar and subclass it (by a container...)
thats was done in http://yousfi.over-blog.com/2015/02/subclassing-the-form-titlebar-other-stuffs.html

-another solution is to traverse the native titlebar and add controls on it.In my knowledge,its not done with vfp9 at this time..

-And this is an hybrid solution with native titlebar+an extension as container ( two in one ).
its an extension to actual form titlebar painted with API DwmExtendFrameIntoClientArea (initially destined to vista aero-Infortunatly this aero effect  dont works in windows 10).
can build a container under the form titlebar and fill it with vfp controls wanted(each control with PEM...)
it preserves the native window titlebar and extends it to other area and other functionalities.

Added API to move the form by mousedown on this container (same as titlebar).

problems: when show or when another window is activated  the form is entierly disabled (its a normal behavior in win10 ? needs some message to refresh?).at start i activated it with firing windowstate :(1,0)
It seems the API applies also some transparency on the form & embeded controls.
the container.BackColor must be black Rgb(0,0,0),mandatory to have unique color for titlebar+container even if windows themes changed (see images below when win themes change).
 IMPORTANT: When you extending window frame you must set its hbrBackground to the BLACK_BRUSH.If you will not set it, the inner edge of the frame will not be drawn (see the msdn link below)

the controls inserted in container are for demo only.click image to have summary help.

*warning: the code works only if win10 themes installés in particular title bars can be colorized(win10 setting parameters)
it works also on the latest  win10 professionnal version 1703.

*Important: code tested under windows10 pro & VFP9SP2

 

 

 

Click on code to select [then copy] -click outside to deselect


set date long
IF VAL(OS(3)) < 6  
messagebox("this code is for os=Vista and above !",16+4096,"Error",1300)
  RETURN .F.
 ENDIF
publi yform
yform=newObject("ytitlebar")
yform.show
read events
retu
*
DEFINE CLASS ytitlebar AS form
Top = 6
Left = 97
Height = 430
Width = 781
Autocenter=.t.
ShowWindow = 2
Caption = "This is a new titlebar on top level form"
BackColor = RGB(146,136,116)
Themes = .f.
Name = "Form1"

ADD OBJECT ycont AS ycontainer WITH ;
    Top = 0, ;
	Left = 0, ;
	Width = 781, ;
	Height = 48, ;
	BackStyle = 1, ;
	BorderWidth = 0, ;
	SpecialEffect = 2, ;
	MousePointer = 15, ;
	BackColor = RGB(0,0,0), ;
	Name = "yCont"


ADD OBJECT grid1 AS grid WITH ;
	FontBold = .T., ;
	Anchor = 15, ;
	Height = 356, ;
	Left = 20, ;
	Top = 58, ;
	Width = 732, ;
	Name = "Grid1"

PROCEDURE Destroy
	clea events
ENDPROC


PROCEDURE Activate
	*only one way to activate the form troubleshoted with api !
	thisform.windowstate=1
	sleep(30)
	thisform.windowstate=0
ENDPROC


PROCEDURE Resize
	with thisform.ycont
	.left=0
	.top=0
	.width=.parent.width
	.height=48
	.zorder(0)
	endwith
	doevent
ENDPROC

PROCEDURE Init
	*Thisform.BackColor=Rgb(0,0,0)  &&mandatory to have unique color for titlebar+container even if windows themes changed
	Local lnHwnd, lcMargin, lnGlassLeft, lnGlassRight, lnGlassTop, lnGlassBottom

		m.lnHwnd = Thisform.HWnd
		m.lnGlassLeft =Thisform.ycont.Left
		m.lnGlassRight = Thisform.ycont.Top
		m.lnGlassTop = Thisform.ycont.Left+Thisform.ycont.Width
		m.lnGlassBottom =Thisform.ycont.Top+Thisform.ycont.Height

		m.lcMargin = BinToC(m.lnGlassLeft, '4RS') ;
			+ BinToC(m.lnGlassRight, '4RS') ;
			+ BinToC(m.lnGlassTop, '4RS') ;
			+ BinToC(m.lnGlassBottom, '4RS')
		Local lnResult
		lnResult=DwmExtendFrameIntoClientArea(m.lnHwnd, @m.lcMargin)
	thisform.resize
ENDPROC

PROCEDURE Load
    	Declare Long DwmExtendFrameIntoClientArea In dwmapi.Dll Long HWnd, String @ pMarInset
		Declare Integer ReleaseCapture In WIN32API
		Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
		Declare integer BringWindowToTop in user32 integer
		Declare integer Sleep in kernel32 integer
        DECLARE INTEGER MessageBox IN user32 As MessageBoxA;
    INTEGER hwnd,;
    STRING  lpText,;
	STRING  lpCaption,;
	INTEGER wType

		_Screen.WindowState=1
ENDPROC


PROCEDURE grid1.Init
	sele * from home(1)+"samples\data\customer" into cursor ycurs
	with this
	.recordsource="ycurs"
	.recordsourceType=2
	.deletemark=.f.
	.gridlines=0
	.themes=.f.
	.setall("backcolor",0,"header")
	.setall("forecolor",rgb(0,255,0),"header")
	.setall("fontbold",.t.,"header")
	.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(205,155,200), RGB(140,255,100))", "Column")
	locate
	endwith
ENDPROC

ENDDEFINE
*
*-- EndDefine: ytitlebar

Define class ycontainer as container
ADD OBJECT image1 AS image WITH ;
	Picture = home(1)+"graphics\icons\win95\entirnet.ico", ;
	Stretch = 2, ;
	BackStyle = 0, ;
	Height = 41, ;
	Left = 3, ;
	MousePointer = 15, ;
	Top = 3, ;
	Width = 49, ;
	Name = "Image1"
    
ADD OBJECT ydate AS label with ;
    AutoSize = .T., ;
	FontSize = 8, ;
	Caption = "Label1", ;
	Height = 16, ;
	Left = 70, ;
	Top = 33 , ;
	Width = 34 , ;
	Name = "ydate"	

ADD OBJECT command1 AS commandbutton WITH ;
	Top = 7, ;
	Left = 245, ;
	Height = 25, ;
	Width = 72, ;
	FontBold = .T., ;
	FontSize = 10, ;
	Caption = "Menu", ;
	SpecialEffect = 2, ;
	BackColor = RGB(128,255,0), ;
	Name = "Command1"


ADD OBJECT combo1 AS combobox WITH ;
	FontBold = .T., ;
	RowSourceType = 1, ;
	RowSource = "1,2,3,4,5", ;
	Height = 25, ;
	Left = 329, ;
	SpecialEffect = 2, ;
	Top = 7, ;
	Width = 85, ;
	Name = "Combo1"


ADD OBJECT spinner1 AS spinner WITH ;
	FontBold = .T., ;
	Height = 24, ;
	Left = 516, ;
	SpecialEffect = 2, ;
	Top = 7, ;
	Width = 43, ;
	Name = "Spinner1"
	
ADD OBJECT optiongroup1 AS optiongroup WITH ;
	AutoSize = .T., ;
	ButtonCount = 1, ;
	BackStyle = 0, ;
	Value = 1, ;
	Height = 27, ;
	Left = 436, ;
	SpecialEffect = 0, ;
	Top = 7, ;
	Width = 72, ;
	Name = "Optiongroup1", ;
	Option1.FontBold = .T., ;
	Option1.BackStyle = 0, ;
	Option1.Caption = "Option1", ;
	Option1.Value = 1, ;
	Option1.Height = 17, ;
	Option1.Left = 5, ;
	Option1.Top = 5, ;
	Option1.Width = 62, ;
	Option1.AutoSize = .T., ;
	Option1.ForeColor = RGB(0,255,255), ;
	Option1.Name = "Option1"

ADD OBJECT text1 AS textbox WITH ;
	FontBold = .T., ;
	FontSize = 10, ;
	BackStyle = 0, ;
	Enabled = .F., ;
	Height = 25, ;
	Left = 103, ;
	Top = 7, ;
	Width = 70, ;
	ForeColor = RGB(0,255,0), ;
	BackColor = RGB(0,0,0), ;
	DisabledBackColor = RGB(0,0,0), ;
	DisabledForeColor = RGB(0,255,0), ;
	Name = "Text1"

ADD OBJECT timer1 AS timer WITH ;
	Top = 9, ;
	Left = 81, ;
	Height = 23, ;
	Width = 23, ;
	Interval = 1000, ;
	Name = "Timer1"

ADD OBJECT list1 AS listbox WITH ;
	FontBold = .T., ;
	FontSize = 8, ;
	RowSourceType = 2, ;
	Height = 36, ;
	Left = 564, ;
	Top = 3, ;
	Width = 192, ;
	Name = "List1"
    
PROCEDURE ydate.Init
    	with this
		.autosize=.t.
		.backstyle=0
		.forecolor=255
		.fontname="segoe script"
		.fontbold=.t.
		.caption=dtoc(date())
		.anchor=768
		endwith
ENDPROC	    
	
PROCEDURE MouseDown
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	lnHandle = THISFORM.HWND
	param1 = 274
	param2 = 0xF012
	DECLARE INTEGER ReleaseCapture IN WIN32API
	DECLARE INTEGER SendMessage IN WIN32API INTEGER, INTEGER, INTEGER, INTEGER
	bb=ReleaseCapture()
	bb=SendMessage(lnHandle, param1, param2,0)
ENDPROC

PROCEDURE image1.Click
	text to m.myvar noshow
this is a new vfp titlebar available on top level form (only).
-one solution is to cut the form titlebar and subclass it (by a container...)
thats was done in http://yousfi.over-blog.com/2015/02/subclassing-the-form-titlebar-other-stuffs.html

-another solution is to traverse the native titlebar and add controls on it.its not done with vfp9 at
this time

-And this is an hybrid solution with native titlebar+an extension as container.
its an extension to actual form titlebar painted with API DwmExtendFrameIntoClientArea
(initially destined to vista aero-Infortunatly this aero effect  dont works in windows 10).
can build a container under the form titlebar and fill it with vfp controls wanted(each control with PEM...)
it preserves the native window titlebar and extends it to other area and other functionalities.

Added API to move the form by mousedown on this container (same as titlebar).
problems: when show or when another window is activated  the form is disabled (its not a normal behavior in win10? miss some message?).at start i activated it with firing windowstate :(1,0)
The API applies also some transparency on the form & embeded controls.
the form.BackColor must be black Rgb(0,0,0),mandatory to have unique color for titlebar+container even if windows themes changed (see images below when win themes change)

endtext

#define MB_ICONINFORMATION 0x00000040
#define MB_OK 0x00000000
#define MB_APPLMODAL 0x00000000
#define  MB_DEFBUTTON1 0x00000000

MessageBoxA(thisform.hwnd,m.myvar,"Summary Help",MB_APPLMODAL+MB_OK +MB_ICONINFORMATION +MB_DEFBUTTON1 )

ENDPROC

PROCEDURE IMAGE1.MOUSEENTER
LPARAMETERS nButton, nShift, nXCoord, nYCoord
with this
.left=.left-2
.TOP=.TOP-2
endwith
endproc

PROCEDURE IMAGE1.MOUSELEAVE
LPARAMETERS nButton, nShift, nXCoord, nYCoord
with this
.left=.left+2
.top=.top+2
endwith
endproc

PROCEDURE command1.Click
	DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
	DEFINE BAR _med_slcta OF raccourci PROMPT "Sélectionner tout" ;
		KEY CTRL+A, "Ctrl+A" ;
		PICTRES _med_slcta ;
		MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
	DEFINE BAR _med_paste OF raccourci PROMPT "Coller" ;
		KEY CTRL+V, "Ctrl+V" ;
		PICTRES _med_paste ;
		MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
	DEFINE BAR _med_copy OF raccourci PROMPT "Copier" ;
		KEY CTRL+C, "Ctrl+C" ;
		PICTRES _med_copy ;
		MESSAGE "Copie la sélection et la place dans le Presse-papiers"
	DEFINE BAR _med_cut OF raccourci PROMPT "Couper" ;
		KEY CTRL+X, "Ctrl+X" ;
		PICTRES _med_cut ;
		MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
	DEFINE BAR _med_redo OF raccourci PROMPT "Rétablir" ;
		KEY CTRL+R, "Ctrl+R" ;
		PICTRES _med_redo
	DEFINE BAR _med_undo OF raccourci PROMPT "Annuler" ;
		KEY CTRL+Z, "Ctrl+Z" ;
		PICTRES _med_undo ;
		MESSAGE "Annule la dernière modification"
	ACTIVATE POPUP raccourci
ENDPROC

PROCEDURE combo1.Init
	this.listindex=1
ENDPROC

PROCEDURE text1.Init
	this.value=time()
ENDPROC

PROCEDURE timer1.Timer
	this.parent.text1.value=time()
ENDPROC

PROCEDURE list1.Init
	Sele company From Home(1)+"samples\data\customer" Into Cursor ycurs

	With This
	   .RowSource = "ycurs.company"
	   .RowSourceType=2
	   .Visible=.T.
	   .SelectedItemBackColor=Rgb(70,60,50)
	   .SelectedItemForeColor=Rgb(10,191,160)
	   .SpecialEffect=1
	   .FontSize=8
	   .ItemBackColor=Rgb(40,40,40)
	   .ItemForeColor=Rgb(255,204,153)
	   .BorderColor=Rgb(235,132,0)
	   .ItemTips=.T.
	    .MousePointer=15
  Endwith
ENDPROC
	
	
endDefine		



SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.
SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.
SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.
SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.
SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.
SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.
SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.
SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.

SCreenshots obtained with changing windows10 pro themes.If set another color than black on the container code works but changing windows themes have no effect on this new color.

To be informed of the latest articles, subscribe:
Comment on this post