Blurring& glassing a vfp form background
vfp9 have not functions to make aero theme or blur the form background as made by modern OS (vista and latest).
Then instead of blurring really the form background,i replace this effect with a built form.picture,cloning exactly whatever is behind (or before) the form and blurring.These two operations are made with the rescue of gdiplusX.
but this is dont enough and the work is not perfect.
Its a problem not yet solved ...maybe someone can investigate on the project...I share this idea for this goal.
Here the capture of the form.picture goes with hiding, capturing and showing the form and this introduces an unwanted flicker.the capture is not instantaneously and make a certain time also.
After capturing the desktop zone (form.picture) , then apply procedure to blur the bitmap as desired.
i use bindevent to detect if the desktop background have changed (i have a wallpaper changing periodically).
The form is movable by mousedown and its redrawn after the dragging event or if the wallpaper have changed.
Can adjust the blur factor and set transparency
System.app (gdiplusX) must be in same folder to make the yblur method working.
All tests on windows10 pro.
This work is not yet finished....
In the second part i remember how to build a basic form glass
Added a code for aero os Vista and Windows7 below on 16 september 2015.this in principe works on windows vista and win7 (to test),but dont work on win10 pro !
Click on code to select [then copy] -click outside to deselect
Publi yform
yform=Newobject("yblur_window")
yform.Show
Read Events
Retu
*
Define Class yblur_window As Form
Top = 15
Left = 81
Height = 480
Width = 791
ShowWindow = 2
MaxButton=.F.
BorderStyle=2
ShowTips = .T.
Caption = "yblur_form"
AlwaysOnBottom=.T.
TitleBar=1
hWindow=0
hOrigProc=0
yno=.F.
Name = "Form1"
Add Object shape1 As Shape With ;
Top = 326, ;
Left = 180, ;
Height = 120, ;
Width = 253, ;
BackStyle = 0, ;
BorderWidth = 3, ;
BorderColor = Rgb(192,192,192), ;
Name = "Shape1"
Add Object timer1 As Timer With ;
Top = 12, ;
Left = 648, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 30000, ;
Name = "Timer1"
Add Object grid1 As Grid With ;
Height = 252, ;
Left = 252, ;
Top = 60, ;
Width = 468, ;
Name = "Grid1"
Add Object image1 As Image With ;
Picture = home(1)+"graphics\icons\misc\face03.ico", ;
backstyle=0,;
Stretch = 2, ;
Height = 121, ;
Left = 36, ;
Top = 48, ;
Width = 133, ;
Name = "Image1"
Add Object command1 As CommandButton With ;
Top = 333, ;
Left = 204, ;
Height = 73, ;
Width = 204, ;
FontSize = 14, ;
Caption = "Blur !", ;
MousePointer = 15, ;
BackColor = Rgb(0,255,0), ;
Name = "Command1"
Add Object spinner1 As Spinner With ;
Height = 29, ;
InputMask = "99", ;
KeyboardHighValue = 30, ;
KeyboardLowValue = 0, ;
Left = 337, ;
SpinnerHighValue = 30.00, ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Blur factor", ;
Top = 405, ;
Width = 69, ;
Value = 5, ;
Name = "Spinner1"
Add Object check1 As Checkbox With ;
Top = 408, ;
Left = 216, ;
Height = 17, ;
Width = 113, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Transparent form", ;
Name = "Check1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Webdings", ;
FontSize = 14, ;
BackStyle = 0, ;
Caption = "0", ;
Height = 21, ;
Left = 0, ;
MousePointer = 15, ;
Top = 0, ;
Width = 19, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label2"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Arial", ;
FontSize = 14, ;
BackStyle = 0, ;
Caption = "X", ;
Height = 22, ;
Left = 28, ;
MousePointer = 15, ;
Top = 2, ;
Width = 13, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label3"
Procedure label2.Click
Thisform.WindowState=1
Endproc
Procedure label3.Click
Thisform.Release
Endproc
Procedure yblur
If Thisform.WindowState=1
Return .F.
Endi
Thisform.LockScreen=.T.
Try
Dele File Addbs(Sys(2023))+[yblur_*.jpg]
Local lnWidth, lnHeight,delta,w,h,xpict
Local loBMP0,loBMP ,thumbnail As xfcBitmap
Local m.yrep
m.yrep=Addbs(Sys(2023))
With _Screen.System.Drawing
Local xleft,xtop,xwidth,xheight
m.xleft=Thisform.Left &&+Sysmetric(3)
m.xtop=Thisform.Top &&+Sysmetric(9)+Sysmetric(4)
m.xwidth=Thisform.Width
m.xheight=Thisform.Height
*the form must mandatory stay inside the desktop area(otherwise gdiplusX cannot capture it...error)
If m.xtop<0
m.xtop=1
Thisform.Top=m.xtop
Endi
If m.xleft<0
m.xleft=1
Thisform.Left=m.xleft
Endi
If m.xleft+m.xwidth>Sysmetric(1)
m.xleft=(Sysmetric(1)-Thisform.Width)/2
m.xtop =(Sysmetric(2)-Thisform.Height)/2
Thisform.Left=m.xleft
Thisform.Top=m.xtop
Endi
If m.xtop+m.xheight>Sysmetric(2)
m.xleft=(Sysmetric(1)-Thisform.Width)/2
m.xtop =(Sysmetric(2)-Thisform.Height)/2
Thisform.Left=m.xleft
Thisform.Top=m.xtop
Endi
Thisform.Hide
sleep(100)
loBMP=.Bitmap.fromscreen(0,m.xleft,m.xtop,m.xwidth,m.xheight)
sleep(100)
Local m.lcdest
m.lcdest=m.yrep+"yblur_"+Sys(2015)+".jpg" &&unique image file
loBMP.Save(m.lcdest,.imaging.imageformat.jpeg)
*blur image with variable factor
m.w=loBMP.Width
m.h=loBMP.Height
loBMP0=.Bitmap.New(m.w,m.h)
loGfx0=.graphics.fromImage(loBMP0)
m.factor=Thisform.spinner1.Value
lnWidth =loBMP.Width/m.factor
lnHeight=loBMP.Height/m.factor
* Get the thumbnail with the desired size
Local loThumbnail As xfcImage
loThumbnail = loBMP.GetThumbnailImage(lnWidth, lnHeight)
loGfx0.Clear(.Color.transparent)
*redraw the thumb but with the original source size (to blur it)
loGfx0.drawimage(loThumbnail, 0,0,w,h)
m.lcdest=m.yrep+"yblur_"+Sys(2015)+".jpg" &&unique image file
loBMP0.Save(m.lcdest, .imaging.imageformat.jpeg)
Endwith
If File(Thisform.Picture)
Clea Resource(Thisform.Picture) &&vfp store resouce form picture in cache.this clears it.
Endi
sleep(10)
Thisform.Picture=m.lcdest
Thisform.Refresh
sleep(100)
Thisform.Show
Catch
Endtry
locap=Null
loBMP=Null
loThumbnail=Null
loBMP0=Null
Thisform.LockScreen=.F.
Return
Endproc
Procedure handlewinmsg
Lparameters HWnd, Msg, wParam, Lparam
#Define WM_SETTINGCHANGE 0x001A
#Define WM_MOVE 0x0003
Local nReturn
nReturn=0
Do Case
Case Msg = WM_SETTINGCHANGE &&desktop wallpaper have changed (if the case)
Thisform.yblur()
Otherwise
* pass control to the original window procedure
nReturn = CallWindowProc(This.hOrigProc, This.hWindow,Msg, wParam, Lparam)
Endcase
Return
Endproc
Procedure Destroy
Dele File Addbs(Sys(2023))+"yblur*.jpg"
Clea Events
Endproc
Procedure Load
Declare Integer CallWindowProc In user32;
INTEGER lpPrevWndFunc, Integer hWindow, Long Msg,;
INTEGER wParam, Integer Lparam
Declare Integer GetWindowLong In user32;
INTEGER hWindow, Integer nIndex
Declare Integer Sleep In kernel32 Integer
Declare SetWindowLong In Win32Api As _Sol_SetWindowLong Integer, Integer, Integer
Declare SetLayeredWindowAttributes In Win32Api As ;
_Sol_SetLayeredWindowAttributes Integer, String, Integer, Integer
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
Set Safe Off
Do Locfile("System.App","app")
Endproc
Procedure Init
_Screen.WindowState=1
With Thisform
.TitleBar=0
.label2.Left=.Width-40
.label3.Left=.label2.Left+.label2.Width+2
.AddObject("ylabel1","ylabel")
.ylabel1.Visible=.T.
.BackColor=0
.yblur()
.timer1.Enabled=.T.
Endwith
#Define GWL_WNDPROC -4
Thisform.hWindow = Thisform.HWnd
Thisform.hOrigProc = GetWindowLong(This.hWindow, GWL_WNDPROC)
#Define WM_SETTINGCHANGE 0x001A
Bindevent(0, WM_SETTINGCHANGE, This, "handlewinmsg")
Endproc
Procedure timer1.Timer
Thisform.yblur()
Endproc
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer.dbf" Into Cursor ycurs
With This
.RecordSource="ycurs"
Locate
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(196,197,198) , RGB(0,255,0))", "Column")
Endwith
Endproc
Procedure command1.Click
Thisform.yblur()
Endproc
Procedure spinner1.DblClick
Thisform.yblur()
Endproc
Procedure check1.Click
_Sol_SetWindowLong(Thisform.HWnd, -20, 0x00080000)
If This.Value=1
_Sol_SetLayeredWindowAttributes(Thisform.HWnd, 0,210, 2)
Else
_Sol_SetLayeredWindowAttributes(Thisform.HWnd, 0,255, 2)
Endi
Thisform.yblur()
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
Thisform.yno=.T.
lnHandle = Thisform.HWnd
param1 = 274
param2 = 0xF012
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
If Thisform.yno=.T.
Thisform.MousePointer=0
Thisform.yno=.F.
Thisform.yblur()
Endi
Endproc
Enddefine
*
*-- EndDefine: yblur_window
Define Class ylabel As Label
Caption = "Label1"
Height = 18
Left = 468
Top = 324
Width = 120
MousePointer=15
BackColor = Rgb(0,0,0)
WordWrap=.T.
ForeColor=Rgb(255,255,255)
Name = "Label1"
Procedure Init
TEXT to this.caption noshow
"WM_ACTIVATE..."
Sent to both the window being activated and the window being deactivated.
If the windows use the same input queue, the message is sent synchronously,
first to the window procedure of the top-level window being deactivated..
ENDTEXT
Endproc
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
With This
Do While .Width<250 And .Height<130
.Width=.Width+1
.Height=.Height+1
sleep(5)
Enddo
.Width=250
.Height=130
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.Width=120
.Height=18
Endwith
Endproc
Enddefine
*
*-- EndDefine: ylabel
Click on code to select [then copy] -click outside to deselect
*2*
*this is a basic glass form with alpha transparency
*movable by mousedown,ESC to release
*can adapt the traansparency from 0-255 (pratically 100-255)
Publi yform
yform=Newobject("yglass")
yform.Show
Read Events
Return
*the form class here
Define Class yglass As Form
Top = 49
Left = 188
Height = 353
Width = 589
ShowWindow = 2
Caption = "Form1"
AlwaysOnTop = .T.
BackColor = Rgb(0,0,0)
Name = "Form1"
Add Object label1 As Label With ;
BackStyle = 0, ;
BorderStyle = 1, ;
Caption = "Label1", ;
Height = 121, ;
Left = 60, ;
Top = 48, ;
Width = 289, ;
ForeColor = Rgb(255,255,255), ;
Name = "Label1"
Procedure Destroy
Clea Events
Endproc
Procedure Init
_Screen.WindowState=1
Thisform.TitleBar=0
Thisform.BorderStyle=3
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
Local nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
= SetLayeredWindowAttributes(Thisform.HWnd, 0,185,LWA_ALPHA) &&LWA_COLORKEY+
Endproc
Procedure Load
Declare Integer Sleep In kernel32 Integer
Declare Integer GetWindowLong In user32;
INTEGER HWnd, Integer nIndex
Declare Integer SetWindowLong In user32;
INTEGER HWnd, Integer nIndex, Integer dwNewLong
Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release
Endi
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
lnHandle = Thisform.HWnd
param1 = 274
param2 = 0xF012
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
Thisform.MousePointer=0
Endproc
Procedure label1.Init
TEXT to this.caption noshow
*A glass form
-top level form with no titlebar and resizable by mouse
-press ESC to release the form
-press mousedown to move anywhere the form on screen
ENDTEXT
With This
.ForeColor=Rgb(255,255,255)
.BackStyle=0
.BorderStyle=1
.WordWrap=.T.
.FontBold=.T.
.FontSize=12
Endwith
Endproc
Enddefine
*
*-- EndDefine: yglass
**************************************************
Click on code to select [then copy] -click outside to deselect
*aeroglass avec l'APi DwmExtendFrameIntoClientArea(deprecated on win10 ?)
*Added aero os Vista and Windows7 below on 16 september 2015 .
*https://msdn.microsoft.com/en-us/library/windows/desktop/aa969512%28v=vs.85%29.aspx
*DwmExtendFrameIntoClientArea function:Extends the window frame into the client area.works on top level forms only.
*this API makes aero effect on client area(originally for Vista).
*When you extending window frame you must set its hbrBackground to the BLACK_BRUSH (form.backcolor=0 mandatory)
*a part of code snipped is from SPS weblog(broken).
*If you will not set it, the inner edge of the frame will not be drawn
*this works on Vista and win7 (to test).
*unfortunatly dont work on my windows10 pro.....to follow!
Publi yform
yform=Newobject("yaero")
yform.Show
Read Events
Return
*
Define Class yaero As Form
BorderStyle = 0
Top = 82
Left = 79
Height = 426
Width = 830
ShowWindow = 2
Caption = "Aero"
BackColor = Rgb(0,0,0)
Themes = .F.
Name = "Form1"
Add Object shape1 As Shape With ;
Top = 38, ;
Left = 45, ;
Height = 339, ;
Width = 711, ;
BackStyle = 1, ;
Curvature = 50, ;
MousePointer = 15, ;
BackColor = Rgb(0,255,0), ;
Name = "Shape1"
Add Object command1 As CommandButton With ;
Top = 300, ;
Left = 144, ;
Height = 49, ;
Width = 145, ;
Caption = "Command1", ;
Name = "Command1"
Add Object combo1 As ComboBox With ;
Height = 37, ;
Left = 312, ;
Top = 303, ;
Width = 133, ;
Name = "Combo1"
Add Object pageframe1 As PageFrame With ;
ErasePage = .T., ;
PageCount = 5, ;
Top = 84, ;
Left = 96, ;
Width = 553, ;
Height = 197, ;
Name = "Pageframe1", ;
Page1.Caption = "Page1", ;
Page1.Name = "Page1", ;
Page2.Caption = "Page2", ;
Page2.Name = "Page2", ;
Page3.Caption = "Page3", ;
Page3.Name = "Page3", ;
Page4.Caption = "Page4", ;
Page4.Name = "Page4", ;
Page5.Caption = "Page5", ;
Page5.Name = "Page5"
Procedure Destroy
Clea Events
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
_Screen.WindowState=1
Endproc
Procedure Init
Thisform.BackColor=Rgb(0,0,0) &&mandatory
Local lnHwnd, lcMargin, lnGlassLeft, lnGlassRight, lnGlassTop, lnGlassBottom
m.lnHwnd = Thisform.HWnd
m.lnGlassLeft =Thisform.shape1.Left
m.lnGlassRight = Thisform.shape1.Top
m.lnGlassTop = Thisform.shape1.Left+Thisform.shape1.Width
m.lnGlassBottom =Thisform.shape1.Top+Thisform.shape1.Height
m.lcMargin = BinToC(m.lnGlassLeft, '4RS') ;
+ BinToC(m.lnGlassRight, '4RS') ;
+ BinToC(m.lnGlassTop, '4RS') ;
+ BinToC(m.lnGlassBottom, '4RS')
Local s_ok
s_ok=DwmExtendFrameIntoClientArea(m.lnHwnd, @m.lcMargin)
*s_ok=0 success
Endproc
Procedure shape1.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
lnHandle = Thisform.HWnd
param1 = 274
param2 = 0xF012
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
Thisform.MousePointer=0
Endproc
Enddefine
*
*-- EndDefine: yaero
comment and uncomment the DwmExtendFrameIntoClientArea line in code (form.init) to see the 2 forms on windows7 as above.
Click on code to select [then copy] -click outside to deselect
*this is an example adapted from Calvin Hsias weblog
*http://blogs.msdn.com/b/calvin_hsia/archive/2007/05/02/fun-with-vista-aero-using-the-dwmextendframeintoclientarea.aspx
*must work on windows vista (maybe win7)--not tested.
* dont work at all in win10 pro.
publi m.x
m.x=CREATEOBJECT("myForm")
m.x.show()
read events
retu
retu
DEFINE CLASS MyForm AS Form
ShowWindow= 2 && top level form
width=640
height=480
PROCEDURE Init
DECLARE integer DwmExtendFrameIntoClientArea IN dwmapi integer hWnd, string @ daMargins
cStr=REPLICATE(BINTOC(100,"4rs"),4)
this.BackColor=0
this.ForeColor=-1
DwmExtendFrameIntoClientArea (this.HWnd, @cStr)
endproc
procedure destroy
clea events
endproc
ENDDEFINE
Click on code to select [then copy] -click outside to deselect
*-Added on 29 september 2015 14h25
*this is a basic glass form with alpha transparency and aero
*maybe aeroworks as expected only on vista and win7 (not tested).
*aero dont work as expected on win10
*movable by mousedown,ESC or "X" to release
*can adapt the transparency from 0-255 (pratically 100-255) on spinner.
Set Cursor Off
Publi yform
yform=Newobject("yglass")
yform.Show
Read Events
Return
*the form class here
Define Class yglass As Form
Top = 49
Left = 188
Height = 353
Width = 589
ShowWindow = 2
ShowTips=.T.
Caption = "Form1"
AlwaysOnTop = .T.
BackColor = Rgb(0,0,0)
Name = "Form1"
Add Object label2 As Label With ;
BackStyle = 0, ;
BorderStyle = 0, ;
Caption = "Demo of form glass+aero in vista & win7 (only)-to test?", ;
Height = 18, ;
Left = 60, ;
Top = 1, ;
fontsize=14,;
autosize=.T., ;
ForeColor = Rgb(255,255,255), ;
Name = "Label2"
Add Object label1 As Label With ;
BackStyle = 0, ;
BorderStyle = 1, ;
Caption = "Label1", ;
Height = 121, ;
Left = 60, ;
Top = 48, ;
Width = 289, ;
ForeColor = Rgb(255,255,255), ;
Name = "Label1"
Add Object command1 As CommandButton With ;
Caption = "ytransparencies", ;
Height = 121, ;
Left =260, ;
Top =178, ;
fontsize=16,;
forecolor=255,;
Width = 289, ;
backColor = Rgb(0,255,0), ;
Name = "command1"
Add Object ylab As Label With ;
anchor=768,;
BackStyle = 0, ;
BorderStyle = 0, ;
fontsize=16,;
Caption = "X", ;
autosize=.T., ;
Left = 550, ;
Top = 5, ;
mousepointer=15,;
ForeColor = 255, ;
fontbold=.T., ;
Name = "ylab"
Add Object spinner1 As Spinner With ;
fontsize=11,;
Caption = "X", ;
Left = 420, ;
Top = 48, ;
mousepointer=15,;
ForeColor = 255, ;
SpinnerLowvalue=100,;
spinnerHighValue=255,;
KeyboardLowvalue=100,;
keyBoardHighValue=255,;
value=200,;
mousepointer=15,;
tooltiptext="Set opacity 0-255",;
Name = "spinner1"
Procedure spinner1.InteractiveChange
Thisform.ytranspa(This.Value)
Endproc
Procedure ylab.Click
Thisform.Release
Endproc
Procedure Destroy
Set Curs On
Clea Events
Endproc
Procedure Init
_Screen.WindowState=1
Thisform.TitleBar=0
Thisform.BorderStyle=3
m.x=200 &&opacity 0-255
Thisform.ytranspa(x)
Endproc
Procedure ytranspa
Lparameters x
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
Local nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
*= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
SetWindowLong(Thisform.HWnd, -20, 524288 )
= SetLayeredWindowAttributes(Thisform.HWnd, 0,m.x,LWA_ALPHA) &&+LWA_COLORKEY)
******APi DwmExtendFrameIntoClientArea for vista
Declare Integer DwmExtendFrameIntoClientArea In dwmapi Integer HWnd, String @ daMargins
m.lcMargin = BinToC(10, '4RS') ;
+ BinToC(10, '4RS') ;
+ BinToC(32, '4RS') ;
+ BinToC(10, '4RS')
Thisform.BackColor=0
Thisform.ForeColor=-1
DwmExtendFrameIntoClientArea (Thisform.HWnd, @lcMargin)
*********
Procedure Load
Declare Integer Sleep In kernel32 Integer
Declare Integer GetWindowLong In user32;
INTEGER HWnd, Integer nIndex
Declare Integer SetWindowLong In user32;
INTEGER HWnd, Integer nIndex, Integer dwNewLong
Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release
Endi
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
lnHandle = Thisform.HWnd
param1 = 274
param2 = 0xF012
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
Thisform.MousePointer=0
Endproc
Procedure label1.Init
TEXT to this.caption noshow
*A glass form
-top level form with no titlebar and resizable by mouse
-press ESC to release the form
-press mousedown to move anywhere the form on screen
ENDTEXT
With This
.ForeColor=Rgb(255,255,255)
.BackStyle=0
.BorderStyle=1
.WordWrap=.T.
.FontBold=.T.
.FontSize=12
Endwith
Endproc
Enddefine
*
*-- EndDefine: yglass
***************************
The titlebar id hidden but the vista aero effect draw borders as original form on win10.on visat & win7 aero takes effect in principe: to test.
*Important: Codes above are tested on visual foxpro 9 SP2 under windows 10 pro