Modify native form skin with windows eventhandlers
this code is a windows eventhandler as the sample shipped in vfp9.
it uses gdiplus to paint & skin the titlebar and the form borders with a bi color gradient.
it write also the form titlebar with a choosen color, fontnamenfontsize.
the capabilities are:
can choose the form caption color and fontname and fontsize
show or hide the form caption
change the form caption in textbox
press (enable t)he checkbox to refresh
can change the 2 gradient colors (theme)-colors are as vfp9 native gdiplus formats.choose one color for the gradient if wanting one color skin.
press (enable) the checkbox to refresh
can show windows eventhandler constants in a txt file (editable but not affect result...).Also can extract just the cosntants needed in demo.
read the summary help on vfp wineventhandler in the form browser.its appliable to all windows events captured
if you remember the vfp9 evenhadler sample the titlebar was painted on a portion excluding 4 system buttons !i think the problem never solved by vfp9 team!
Of course this work is a try and not yet perfect,its a first QUICK try and there is some problems..its to continue and solve the points in ypb button.
feel free to continue this project . Any contribution is welcome !
Click on code to select [then copy] -click outside to deselect
*1*
Clea All
Set Safe Off
Publi m.yrep,m.ylog
m.yrep=Addbs(Justpath(Sys(16,1)))
m.ylog=Addbs(Sys(2023))+"ylog.txt" &&if want to record windows events in log file...
=Strtofile("",m.ylog,.F.)
If ! File(m.yrep+"wmhandler.h")
=ycreate_winhandlerh()
Endi
Inke(2)
#include "wmhandler.h"
Publi yform
yform=Newobject("oform")
yform.Show
Publi m.oo
m.oo=Newobject("gdititlebar")
m.oo.releaseevent
m.oo.loadEvent() &&set monitoring windows messages
Read Events
Define Class oform As Form
ShowWindow=0 &&1 not 2
Width=850
Height=570
Caption=""
AutoCenter=.T.
BackColor=Rgb(212,208,200)
realHWND=0
xc1=Rgb(254,254,254)
xc2=0
xc3=Rgb(0,255,0)
xc4=14
xc5="Segoe script"
Name="yform"
Add Object olecontrol1 As OleControl With ;
oleclass="shell.explorer.2",;
anchor=0,;
left=5,;
top=50,;
width=798-20,;
height=300-10
Name="olecontrol1"
Add Object ysh As Shape With;
anchor=0,;
left=1,;
top=45,;
width=798-10,;
height=300,;
curvature=15,;
backcolor=Rgb(128,0,64),;
borderwidth=3,;
name="ysh"
Add Object chkCaption As Checkbox With ;
Top = 500 - 25,;
Left = 2,;
Caption = "Show titlebar caption",;
mousepointer=15,;
forecolor=255, ;
fontbold=.T.,;
FontName = 'Tahoma',;
FontSize = 9,;
AutoSize = .T.,;
Value = .F.,;
Anchor = 0,;
name= "chkCaption"
Add Object yconst As CommandButton With ;
Top = 500- 30,;
Left = 154,;
Caption = "Show constants",;
FontName = 'Tahoma',;
FontSize = 9,;
width=100,;
height=25,;
fontbold=.T.,;
forecolor=255,;
mousepointer=15,;
backcolor=Rgb(0,255,0),;
Anchor = 0,;
name="yconst"
Add Object ypb As CommandButton With ;
Top = 500- 30,;
Left = 255,;
Caption = "Problems",;
FontName = 'Tahoma',;
FontSize = 9,;
width=100,;
height=25,;
fontbold=.T.,;
forecolor=255,;
mousepointer=15,;
backcolor=Rgb(0,255,0),;
Anchor = 0,;
name="ypb"
Add Object ycol1 As ycol With ;
Anchor=0 ,;
Top=5 ,;
Left=5 ,;
Name="ycol1"
Add Object yhelp As Label With ;
Anchor=0 ,;
top=1,;
left=280,;
autosize=.T.,;
backstyle=0,;
caption="?",;
fontsize=18,;
fontbold=.T.,;
forecolor=255,;
mousepointer=15,;
name="yhelp"
Add Object ycont1 As ycont
Anchor=0
Left=10
Top=455
Width = 747
Height = 153
Name="ycont1"
Add Object chkGrad As Checkbox With ;
Top = 500 - 25,;
Caption = "Display new titlebar gradient/theme",;
FontName = 'Tahoma',;
forecolor=255, ;
fontbold=.T.,;
FontSize = 9,;
AutoSize = .T.,;
Left = 800 - 210,;
mousepointer=15,;
Value = .F.,;
Anchor = 0,;
name="chkGrad"
Add Object yfontsize1 As yfontsize With ;
Top = 500 +27,;
Left = 2,;
fontbold=.T.,;
forecolor=Rgb(0,0,255),;
mousepointer=15,;
name="yfontsize1"
Add Object ycaption As TextBox With ;
Top = 500 +27,;
Left = 80,;
width=450,;
fontbold=.T.,;
forecolor=Rgb(0,0,255),;
mousepointer=0,;
value="this is the new form caption/SKIN drawn with VFP9 gdiplus !",;
name="ycaption"
Add Object yfonts1 As yfonts With ;
Top = 500+5,;
Left = 357,;
height=20,;
name="yfonts"
Procedure vfpRefresh
With Thisform
.Width=.Width +1
.Width=.Width -1
Endwith
Endproc
Procedure yconst.Click
m.oo.ywinConst()
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar noshow
can choose the form caption color and fontname and fontsize
show or hide the form caption
change the form caption in textbox
press (enable t)he checkbox to refresh
can change the 2 gradient colors (theme)
press (enable) the checkbox to refresh
can show windows eventhandler constants in a txt file (editable but not affect result...)
read the summary help on vfp wineventhandler in the form browser.
Of course this work is to continue to solve the points in ypb button.
Any contribution is welcome !
ENDTEXT
Messagebox(m.myvar,0+32+4096)
Endproc
Procedure ypb.Click
Local m.myvar
TEXT to m.myvar noshow
remarks and problems to solve :
-this class support forms with showWindow=0,1
-Actually it dont support top level forms (showWindow=2) even with set realHWND.
-the 4 titlebar system buttons controls are hidden by the gradient drawing.set a transparency in code to see them (color alpha channel)
must mouse over on the 3 right buttons to make them visible.
the left system button is always hidden but click is accessible.
-must introduce sysmetric() in borders
-form refreshing to review (shake)
-add a titelbar transparency to show system buttons
-add on titlebar 1 or more image button (draw),cliquable to fire a
contextuel menu or any action.
-center the form caption title
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Problems encoutered")
Endproc
Procedure Init
With Thisform
.Height=570
.Width=840
.AutoCenter=.T.
.realHWND=Iif(.ShowWindow = 2, Sys(2327, Sys(2325, Sys(2326, .HWnd))), .HWnd)
.SetAll("backcolor",Rgb(128,0,64),"commandgroup")
.Resize()
Endwith
Try
Bindevent(Thisform.chkCaption,"Click", Thisform, "vfprefresh", 1)
Bindevent(Thisform.chkGrad ,"Click", Thisform, "vfprefresh", 1)
Catch To loError
Messagebox(loError.Message)
Endtry
Thisform.olecontrol1.silent=.T.
Local m.myvar
TEXT to m.myvar noshow
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META charset=UTF-8>
<META name=GENERATOR content="MSHTML 11.00.10586.71"></HEAD>
<BODY oncontextmenu="return false;">
<center><h2 style="color: maroon;">WINEVENTS SUMMARY HELP</h2></center>
<P><FONT color=#800040>The operating system broadcasts a message to all running
applications whenever a power management<BR> event occurs such as system
stand-by or hibernation. Additionally, messages are broadcast when <BR>one
attempts to shutdown Windows. You can trap for these events and perform
necessary actions or <BR>even prevent the power suspension or shutdown from
occurring.
</FONT></P>
<P><FONT color=#800040>Sample: to run the sample, click on the Enable Event
button. Once the event is active, click on the<BR> Start menu and select
Shut Down. When the dialog appears, select either Stand by or Hibernate. <BR>A
dialog will appear asking if you want to go in Stand By mode. All responses are
recorded to <BR>the edit box on the right side. In fact, if you select Yes, when
you resume from Stand By mode,<BR> power events will still be received. You
are also prompted if you attempt to shutdown Windows.</FONT></P>
<P>Details: <BR>This sample uses the following binding to detect power
management changes:<BR><FONT style="BACKGROUND-COLOR: #ffff80"
color=#0000ff>BINDEVENT(_VFP.hWnd, WM_POWERBROADCAST, THIS,
"handlewinmsg")</FONT></P>
<P>You can find additional information about Power Management events in
MSDN:</P>
<P>System Shutdown events<BR><FONT style="BACKGROUND-COLOR: #ffff80"
color=#0000ff>WM_QUERYENDSESSION Message</FONT></P>
<P>Power Management events</P>
<P><FONT style="BACKGROUND-COLOR: #ffff80" color=#0000ff>WM_POWERBROADCAST
Message</FONT></P>
<P>Click on the Constants button to view values for the #DEFINES.<BR>With
Windows Message events, you can use Activate and Paint messages when working
with GDI+ for<BR> custom graphics drawing.<BR>Sample: to run the sample,
click on the Enable Event button. Once the event is active, you should <BR>see
some GDI+ text graphics on the Visual FoxPro titlebar. Try switching between
applications using<BR> your mouse or ALT+TAB and you will see Paint and
Activate events causing the titlebar to repaint <BR>the text in different
colors. If you click on the Gradient checkbox, you will see the titlebar
<BR>displayed in a gradient.</P>
<P>Details: <BR>This sample uses the following binding to handle application
paint events:<BR><FONT style="BACKGROUND-COLOR: #ffff80"
color=#ff0000>BINDEVENT(_VFP.hWnd, WM_NCPAINT, THIS, "handlewinmsg")</FONT></P>
<P><FONT style="BACKGROUND-COLOR: #ffff80" color=#ff0000>BINDEVENT(_VFP.hWnd,
WM_NCACTIVATE, THIS, "handlewinmsg")</FONT></P>
<P>Note that you can also bind to a specific form by passing in its
hWnd:<BR><FONT style="BACKGROUND-COLOR: #ffff80"
color=#ff0000>BINDEVENT(myForm.hWnd, WM_NCPAINT, THIS, "handlewinmsg")
</FONT></P>
<P>The sample uses the GDI+ Graphics class library in the FFC folder.</P>
<P>You can find additional information about application paint events and GDI+
in MSDN: <BR><FONT style="BACKGROUND-COLOR: #ffd7c4" color=#8000ff>WM_NCPAINT
Message<BR>WM_NCACTIVATE Message</FONT></P>
<P>Click on the Constants button to view values for
#DEFINES.<BR></P></BODY></HTML>
ENDTEXT
Local m.o,m.lcdest
m.lcdest=Addbs(Sys(2023))+"ytemp.html"
Strtofile(m.myvar,m.lcdest)
Thisform.olecontrol1.Navigate(m.lcdest)
Endproc
Procedure Resize
With Thisform
.ycol1.Top=1
.ycol1.Left=1
.ycol1.option1.BackColor=.xc1
.ycol1.option2.BackColor=.xc2
.ycol1.option3.BackColor=.xc3
.olecontrol1.Top=.ycol1.Top+.ycol1.Height+2
.ycont1.Top=.olecontrol1.Top+.olecontrol1.Height+25
.chkCaption.Top=.ycont1.Top+.ycont1.Height+5
.yconst.Top=.chkCaption.Top
.ypb.Top=.chkCaption.Top
.chkGrad.Top=.chkCaption.Top
Endwith
Endproc
Procedure Destroy
m.oo=Null
Clea Events
Endproc
Enddefine
*ENDDefine oform
Define Class gdititlebar As wmbase
Height = 23
Width = 90
ofont = 0
ostrformat = 0
factive = .T.
cstr = "this is the new form caption/SKIN drawn with VFP9 gdiplus !"
nsavehwnd = 0
lcleanalldlls = .T.
Name = "gdititlebar"
Procedure drawit
Lparameters HWnd As Integer
This.oHandler=yform
Local oGraphics As gpgraphics, hdc, cRect, lcStr
Local windx,windy,windw,Windh
Local oBrush, oRect
hdc=GetWindowDC(HWnd)
oGraphics=Newobject("gpGraphics", Home()+"ffc\_gdiplus")
oGraphics.CreateFromHDC(hdc)
cRect=Space(4*4)
GetWindowRect(HWnd,@cRect)
windx=CToBin(Substr(cRect,1+0*4,4),"4rs")
windy=CToBin(Substr(cRect,1+1*4,4),"4rs")
windw=CToBin(Substr(cRect,1+2*4,4),"4rs")-windx
Windh=CToBin(Substr(cRect,1+3*4,4),"4rs")-windy
* Draw gradient
If Type("THIS.oHandler.chkGrad")="O" And This.oHandler.chkGrad.Value=.F.
Else
nWidth = yform.Width+20
oRect= Newobject("gprectangle",Home()+"ffc\_gdiplus","",0,0,nWidth,30)
oRect1= Newobject("gprectangle",Home()+"ffc\_gdiplus","",0,0,6,yform.Height+30)
oRect2= Newobject("gprectangle",Home()+"ffc\_gdiplus","",0,yform.Height+30,yform.Width+18,9)
oRect3= Newobject("gprectangle",Home()+"ffc\_gdiplus","",yform.Width+9,0,6,yform.Height+30)
oBrush=Newobject("gphatchbrush",Home()+"ffc\_gdiplus","",4)
nlBrush=0
nGradMode=Iif(This.factive, 2, 3)
*2 colors
locolor1=0x9f000000 + Eval(yColor2(yform.xc2)) &&alpha chanelhave transparency to dont hide system buttons
locolor2=0x9f000000 + Eval(yColor2(yform.xc3)) &&alpha chanelhave transparency to dont hide system buttons
GdipCreateLineBrushFromRect(oRect.GdipRectF,m.locolor1,m.locolor2,nGradMode,1,@nlBrush)
oRect.w=nWidth
oBrush.SetHandle(nlBrush)
oGraphics.FillRectangle(oBrush,oRect)
oGraphics.FillRectangle(oBrush,oRect1)
oGraphics.FillRectangle(oBrush,oRect2)
oGraphics.FillRectangle(oBrush,oRect3)
Endif
* Draw string
This.cstr=yform.ycaption.Value
If Type("THIS.oHandler.chkCaption")="O" And This.oHandler.chkCaption.Value=.F.
lcStr=""
Else
lcStr=This.cstr
Endif
locolor1= 0xff000000 + Eval(yColor2(yform.xc1))
locolor2= 0xff000000 + Eval(yColor2(yform.xc1))
This.ofont = Newobject("gpfont", Home()+"ffc\_gdiplus", "", yform.xc5, yform.xc4, 0, 3) &&
This.ostrformat = Newobject("gpstringformat", Home()+"ffc\_gdiplus")
If This.factive
oGraphics.DrawStringA(lcStr,This.ofont,;
NEWOBJECT("gprectangle",Home(1)+"ffc\_gdiplus","",40,1,windw-100,125),;
THIS.ostrformat,;
NEWOBJECT("gpsolidbrush",Home(1)+"ffc\_gdiplus","",m.locolor1 ))
Else
oGraphics.DrawStringA(lcStr,This.ofont,;
NEWOBJECT("gprectangle",Home(1)+"ffc\_gdiplus","",40,1,windw-100,125),;
this.ostrformat,;
NEWOBJECT("gpsolidbrush",Home(1)+"ffc\_gdiplus","",m.locolor2 ))
Endif
ReleaseDC(HWnd, hdc)
Endproc
Procedure Destroy
This.RemoveDLL("GetWindowDC")
This.RemoveDLL("ReleaseDC")
This.RemoveDLL("GetWindowRect")
This.RemoveDLL("DefWindowProc")
This.RemoveDLL("InvalidateRect")
This.RemoveDLL("GdipCreateLineBrushFromRect")
DoDefault()
Endproc
Procedure handlewinmsg
Lparameters HWnd As Integer, Msg As Integer, wParam As Integer, Lparam As Integer
Local nRetvalue, hdc, lcStr
nRetvalue=0
lcStr=""
Do Case
Case Msg=WM_NCPAINT
nRetvalue= CallWindowProc(This.noldproc, HWnd, Msg, wParam, Lparam)
This.drawit(HWnd)
If wParam = 0 && wparam=1 means entire window needs to be painted
nRetvalue=1 && 0 means we processed the msg
Endif
lcStr = "Paint event"
Case Msg=WM_NCACTIVATE
This.factive=wParam != 0 &&wParam is TRUE for Active
nRetvalue= CallWindowProc(This.noldproc , HWnd, Msg, wParam, Lparam)
This.drawit(HWnd)
lcStr = "Activate event"
Endcase
If Vartype(This.oHandler)="O" And Pemstatus(This.oHandler,"HandleWinMsg",5)
This.oHandler.handlewinmsg(lcStr)
Endif
Return nRetvalue
Endproc
Procedure init2
Declare Integer GetWindowDC In WIN32API ;
integer HWnd
Declare Integer ReleaseDC In WIN32API ;
integer HWnd, ;
integer hDC
Declare Integer GetWindowRect In win32api ;
integer HWnd,String @cRect
Declare Integer DefWindowProc In WIN32API ;
integer HWnd,Integer Msg,;
integer wParam,;
integer Lparam
Declare Integer InvalidateRect In WIN32API ;
integer HWnd, Integer lpRect, Integer fErase
Declare Integer GdipCreateLineBrushFromRect In GDIPlus.Dll ;
string,;
integer,Integer,;
integer, Integer, Integer @
InvalidateRect(0,0,0)
This.ofont = Newobject("gpfont", Home()+"ffc\_gdiplus", "", yform.xc5, yform.xc4, 0, 3) &&
This.ostrformat = Newobject("gpstringformat", Home()+"ffc\_gdiplus")
Endproc
Procedure releaseevent
If This.Eventloaded
Unbindevent(This.nsavehwnd , WM_NCPAINT)
Unbindevent(This.nsavehwnd , WM_NCACTIVATE)
Endif
This.Eventloaded=.F.
Endproc
Procedure loadEvent
This.nsavehwnd = yform.realHWND
Bindevent(This.nsavehwnd, WM_NCPAINT , This, "handlewinmsg")
Bindevent(This.nsavehwnd, WM_NCACTIVATE, This, "handlewinmsg")
This.Eventloaded=.T.
Endproc
Procedure ywinConst
*Modi File wmhandler.h Noedit Nomenu
Run/N notepad wmHandler.h
Endproc
Procedure ylog
Modi File Addbs(Sys(2023))+"ylog.txt" Noedit Nomenu
Endproc
Enddefine
*
*-- EndDefine: gdititlebar
Define Class wmbase As Custom
lkeepdlls = .F.
noldproc = 0
Eventloaded = .F.
lloadonstart = .F.
oHandler = .F.
lscreenhwnd = .F.
lcleanalldlls = .F.
Name = "wmbase"
Dimension asavedlls[1]
Procedure dump
Lparameters cstr As String
Local num,i
num = 0
For i = 1 To Len(cstr)
num=num+(256^(i-1) ) * Asc(Substr(cstr,i,1))
Endfor
Return Int(num)
Endproc
Procedure handlewinmsg
Lparameters HWnd As Integer, Msg As Integer, wParam As Integer, Lparam As Integer
Endproc
Procedure RemoveDLL
Lparameters tcDLLName
If This.lkeepdlls
Return
Endif
If Ascan(This.asavedlls, tcDLLName, -1, -1, 1, 1)=0
Clear Dlls &tcDLLName
Endif
Endproc
Procedure Init
Local laDLLs
Dimension laDLLs[1]
Adlls(laDLLs)
Acopy(laDLLs,This.asavedlls)
Declare Integer GetWindowText In user32;
INTEGER HWnd,;
STRING @lpString,;
INTEGER cch
Declare Integer GetWindowLong In WIN32API ;
integer HWnd, ;
integer nIndex
Declare Integer CallWindowProc In WIN32API ;
integer lpPrevWndFunc, ;
integer HWnd,Integer Msg,;
integer wParam,;
integer Lparam
This.noldproc=GetWindowLong(Iif(This.lscreenhwnd, _Screen.HWnd,_vfp.HWnd),GWL_WNDPROC)
This.init2()
If This.lloadonstart
This.loadEvent()
Endif
Endproc
Procedure Destroy
Local laDLLs, i, lnCount
Dimension laDLLs[1]
If This.Eventloaded
This.releaseevent()
Endif
If This.lcleanalldlls
lnCount = Adlls(laDLLs)
For i = 1 To lnCount
This.RemoveDLL(laDLLs[m.i, 1])
Endfor
Endif
This.RemoveDLL("GetWindowLong")
This.RemoveDLL("CallWindowProc")
Endproc
Procedure loadEvent
Endproc
Procedure releaseevent
Endproc
Procedure init2
Endproc
Enddefine
*
*-- EndDefine: wmbase
Define Class ycol As OptionGroup
Anchor=0
AutoSize = .T.
ButtonCount = 3
BackStyle = 0
Value = 1
Height = 28
Left = 36
Top = 2
Width = 266
Name = "Optiongroup1"
option1.Caption = "Title col"
option1.Value = 1
option1.Height = 17
option1.Left = 5
option1.Top = 5
option1.Width = 60
option1.AutoSize = .T.
option1.Name = "Option1"
option2.Caption = "Gradient col1"
option2.Height = 17
option2.Left = 72
option2.Top = 6
option2.Width = 91
option2.AutoSize = .T.
option2.Name = "Option2"
option3.Caption = "Gradient col2"
option3.Height = 17
option3.Left = 170
option3.Top = 6
option3.Width = 91
option3.AutoSize = .T.
option3.Name = "Option3"
Procedure Init
This.SetAll("mousepointer",15,"optionbutton")
Endproc
Procedure option1.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
yform.xc1=m.xcolor
This.BackColor=m.xcolor
Thisform.chkCaption.Click
Thisform.chkGrad.Click
Endproc
Procedure option2.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
yform.xc2=m.xcolor
Thisform.chkCaption.Click
Thisform.chkGrad.Click
This.BackColor=m.xcolor
Endproc
Procedure option3.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
yform.xc3=m.xcolor
This.BackColor=m.xcolor
Thisform.chkCaption.Click
Thisform.chkGrad.Click
Endproc
Enddefine
*
*-- EndDefine: ycol
Define Class yfontsize As ComboBox
Height = 25
Left = 84
Top = 216
Width = 61
Name = "Combo1"
Procedure Init
With This
.AddItem("title fontsize=8")
.AddItem("title fontsize=9")
.AddItem("title fontsize=10")
.AddItem("title fontsize=11")
.AddItem("title fontsize=12")
.AddItem("title fontsize=14")
.AddItem("title fontsize=16")
.AddItem("title fontsize=18")
.AddItem("title fontsize=20")
.ListIndex=1
.Value=1
.Style=2
Endwith
Endproc
Procedure Click
With Thisform
Do Case
Case This.Value=1
.xc4=8
Case This.Value=2
.xc4=9
Case This.Value=3
.xc4=10
Case This.Value=4
.xc4=11
Case This.Value=5
.xc4=12
Case This.Value=6
.xc4=13
Case This.Value=7
.xc4=16
Case This.Value=8
.xc4=18
Case This.Value=9
.xc4=20
Endcase
.chkCaption.Click()
Inke(0.5)
.chkCaption.Click()
Endwith
Endproc
Enddefine
*
*-- EndDefine: yfontsize
Define Class ycont As Container
Width = 747
Height = 153
Name = "Container1"
Add Object grid1 As Grid With ;
Height = 133, ;
Left = 5, ;
Top = 20, ;
Width = 349, ;
Name = "Grid1"
Add Object commandgroup1 As CommandGroup With ;
ButtonCount = 4, ;
Value = 1, ;
Height = 132, ;
Left = 359, ;
Top = 21, ;
Width = 94, ;
Name = "Commandgroup1", ;
Command1.Top = 5, ;
Command1.Left = 5, ;
Command1.Height = 27, ;
Command1.Width = 84, ;
Command1.Caption = "Command1", ;
Command1.Name = "Command1", ;
Command2.Top = 34, ;
Command2.Left = 5, ;
Command2.Height = 27, ;
Command2.Width = 84, ;
Command2.Caption = "Command2", ;
Command2.Name = "Command2", ;
Command3.Top = 63, ;
Command3.Left = 5, ;
Command3.Height = 27, ;
Command3.Width = 84, ;
Command3.Caption = "Command3", ;
Command3.Name = "Command3", ;
Command4.Top = 92, ;
Command4.Left = 5, ;
Command4.Height = 27, ;
Command4.Width = 84, ;
Command4.Caption = "Command4", ;
Command4.Name = "Command4"
Add Object image1 As Image With ;
Picture = Home(1)+"samples\tastrade\bitmaps\fullandr.bmp", ;
Stretch = 2, ;
Height = 127, ;
Left = 468, ;
Top = 7, ;
Width = 120, ;
Name = "Image1"
Add Object edit1 As EditBox With ;
Height = 133, ;
Left = 602, ;
Top = 15, ;
Width = 145, ;
forecolor=Rgb(128,0,64),;
Name = "Edit1"
Add Object chkGrad As Checkbox With ;
Top = 500 - 25,;
Caption = "Display new titlebar gradient",;
FontName = 'Tahoma',;
FontSize = 9,;
AutoSize = .T.,;
Left = 800 - 200,;
Value = .F.,;
Anchor = 0,;
name="chkGrad"
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
With This
.RecordSource="ycurs"
.DeleteMark=.F.
.GridLines=0
.Themes=.F.
.SetAll("backcolor",Rgb(212,208,200),"header")
.SetAll("forecolor",Rgb(255,0,0),"header")
.SetAll("fontbold",.T.,"header")
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(225,205,235) , RGB(208,215,212))", "Column")
Locate
.Refresh
Endwith
Procedure edit1.Init
TEXT to this.value noshow
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst.
ENDTEXT
Endproc
Enddefine
*
*-- EndDefine: ycont
Define Class yfonts As ComboBox
FontBold = .T.
Height = 25
Left = 84
Top = 216
Width = 96
ForeColor = Rgb(255,0,0)
Name = "Combo1"
Procedure Click
Thisform.xc5=This.Value
Endproc
Procedure Init
With This
.AddItem("Verdana")
.AddItem("Segoe script")
.AddItem("Arial")
.AddItem("Tahoma")
.ListIndex=1
.Style=2
Endwith
Endproc
Enddefine
Function ycreate_winhandlerh() &&extensively for all windows events (for more use)
Local m.myvar
TEXT to m.myvar noshow
* Common Stuff
#define BROADCAST_QUERY_DENY 0x424D5144 &&// Return this value to deny a query.("BMQD")
#define GWL_WNDPROC (-4)
#define WM_USER 0x0400
*-- Windows messages
#define WM_NULL 0x0000
#define WM_CREATE 0x0001
#define WM_DESTROY 0x0002
#define WM_MOVE 0x0003
#define WM_SIZE 0x0005
#define WM_ACTIVATE 0x0006
#define WM_SETFOCUS 0x0007
#define WM_KILLFOCUS 0x0008
#define WM_ENABLE 0x000A
#define WM_SETREDRAW 0x000B
#define WM_SETTEXT 0x000C
#define WM_GETTEXT 0x000D
#define WM_GETTEXTLENGTH 0x000E
#define WM_PAINT 0x000F
#define WM_CLOSE 0x0010
#define WM_QUERYENDSESSION 0x0011
#define WM_QUIT 0x0012
#define WM_QUERYOPEN 0x0013
#define WM_ERASEBKGND 0x0014
#define WM_SYSCOLORCHANGE 0x0015
#define WM_ENDSESSION 0x0016
#define WM_SHOWWINDOW 0x0018
#define WM_WININICHANGE 0x001A
#define WM_DEVMODECHANGE 0x001B
#define WM_ACTIVATEAPP 0x001C
#define WM_FONTCHANGE 0x001D
#define WM_TIMECHANGE 0x001E
#define WM_CANCELMODE 0x001F
#define WM_SETCURSOR 0x0020
#define WM_MOUSEACTIVATE 0x0021
#define WM_CHILDACTIVATE 0x0022
#define WM_QUEUESYNC 0x0023
#define WM_GETMINMAXINFO 0x0024
#define WM_PAINTICON 0x0026
#define WM_ICONERASEBKGND 0x0027
#define WM_NEXTDLGCTL 0x0028
#define WM_SPOOLERSTATUS 0x002A
#define WM_DRAWITEM 0x002B
#define WM_MEASUREITEM 0x002C
#define WM_DELETEITEM 0x002D
#define WM_VKEYTOITEM 0x002E
#define WM_CHARTOITEM 0x002F
#define WM_SETFONT 0x0030
#define WM_GETFONT 0x0031
#define WM_SETHOTKEY 0x0032
#define WM_GETHOTKEY 0x0033
#define WM_QUERYDRAGICON 0x0037
#define WM_COMPAREITEM 0x0039
#define WM_COMPACTING 0x0041
#define WM_WINDOWPOSCHANGING 0x0046
#define WM_WINDOWPOSCHANGED 0x0047
#define WM_POWER 0x0048
#define WM_COPYDATA 0x004A
#define WM_CANCELJOURNAL 0x004B
#define WM_NCCREATE 0x0081
#define WM_NCDESTROY 0x0082
#define WM_NCCALCSIZE 0x0083
#define WM_NCHITTEST 0x0084
#define WM_NCPAINT 0x0085
#define WM_NCACTIVATE 0x0086
#define WM_GETDLGCODE 0x0087
#define WM_NCMOUSEMOVE 0x00A0
#define WM_NCLBUTTONDOWN 0x00A1
#define WM_NCLBUTTONUP 0x00A2
#define WM_NCLBUTTONDBLCLK 0x00A3
#define WM_NCRBUTTONDOWN 0x00A4
#define WM_NCRBUTTONUP 0x00A5
#define WM_NCRBUTTONDBLCLK 0x00A6
#define WM_NCMBUTTONDOWN 0x00A7
#define WM_NCMBUTTONUP 0x00A8
#define WM_NCMBUTTONDBLCLK 0x00A9
#define WM_KEYFIRST 0x0100
#define WM_KEYDOWN 0x0100
#define WM_KEYUP 0x0101
#define WM_CHAR 0x0102
#define WM_DEADCHAR 0x0103
#define WM_SYSKEYDOWN 0x0104
#define WM_SYSKEYUP 0x0105
#define WM_SYSCHAR 0x0106
#define WM_SYSDEADCHAR 0x0107
#define WM_KEYLAST 0x0108
#define WM_INITDIALOG 0x0110
#define WM_COMMAND 0x0111
#define WM_SYSCOMMAND 0x0112
#define WM_TIMER 0x0113
#define WM_HSCROLL 0x0114
#define WM_VSCROLL 0x0115
#define WM_INITMENU 0x0116
#define WM_INITMENUPOPUP 0x0117
#define WM_MENUSELECT 0x011F
#define WM_MENUCHAR 0x0120
#define WM_ENTERIDLE 0x0121
#define WM_CTLCOLORMSGBOX 0x0132
#define WM_CTLCOLOREDIT 0x0133
#define WM_CTLCOLORLISTBOX 0x0134
#define WM_CTLCOLORBTN 0x0135
#define WM_CTLCOLORDLG 0x0136
#define WM_CTLCOLORSCROLLBAR 0x0137
#define WM_CTLCOLORSTATIC 0x0138
#define WM_MOUSEFIRST 0x0200
#define WM_MOUSEMOVE 0x0200
#define WM_LBUTTONDOWN 0x0201
#define WM_LBUTTONUP 0x0202
#define WM_LBUTTONDBLCLK 0x0203
#define WM_RBUTTONDOWN 0x0204
#define WM_RBUTTONUP 0x0205
#define WM_RBUTTONDBLCLK 0x0206
#define WM_MBUTTONDOWN 0x0207
#define WM_MBUTTONUP 0x0208
#define WM_MBUTTONDBLCLK 0x0209
#define WM_MOUSELAST 0x0209
#define WM_PARENTNOTIFY 0x0210
#define WM_ENTERMENULOOP 0x0211
#define WM_EXITMENULOOP 0x0212
#define WM_POWERBROADCAST 0x0218
#define WM_DEVICECHANGE 0x0219
#define WM_MDICREATE 0x0220
#define WM_MDIDESTROY 0x0221
#define WM_MDIACTIVATE 0x0222
#define WM_MDIRESTORE 0x0223
#define WM_MDINEXT 0x0224
#define WM_MDIMAXIMIZE 0x0225
#define WM_MDITILE 0x0226
#define WM_MDICASCADE 0x0227
#define WM_MDIICONARRANGE 0x0228
#define WM_MDIGETACTIVE 0x0229
#define WM_MDISETMENU 0x0230
#define WM_DROPFILES 0x0233
#define WM_MDIREFRESHMENU 0x0234
#define WM_CUT 0x0300
#define WM_COPY 0x0301
#define WM_PASTE 0x0302
#define WM_CLEAR 0x0303
#define WM_UNDO 0x0304
#define WM_RENDERFORMAT 0x0305
#define WM_RENDERALLFORMATS 0x0306
#define WM_DESTROYCLIPBOARD 0x0307
#define WM_DRAWCLIPBOARD 0x0308
#define WM_PAINTCLIPBOARD 0x0309
#define WM_VSCROLLCLIPBOARD 0x030A
#define WM_SIZECLIPBOARD 0x030B
#define WM_ASKCBFORMATNAME 0x030C
#define WM_CHANGECBCHAIN 0x030D
#define WM_HSCROLLCLIPBOARD 0x030E
#define WM_QUERYNEWPALETTE 0x030F
#define WM_PALETTEISCHANGING 0x0310
#define WM_PALETTECHANGED 0x0311
#define WM_HOTKEY 0x0312
#define WM_THEMECHANGED 0x031A
#define WM_PENWINFIRST 0x0380
#define WM_PENWINLAST 0x038F
* WM_ACTIVATE state values
#define WA_INACTIVE 0
#define WA_ACTIVE 1
#define WA_CLICKACTIVE 2
* Device and Media Events
#define WM_USER_SHNOTIFY WM_USER+10
#define SHCNE_RENAMEITEM 0x00000001
#define SHCNE_CREATE 0x00000002
#define SHCNE_DELETE 0x00000004
#define SHCNE_MKDIR 0x00000008
#define SHCNE_RMDIR 0x00000010
#define SHCNE_MEDIAINSERTED 0x00000020
#define SHCNE_MEDIAREMOVED 0x00000040
#define SHCNE_DRIVEREMOVED 0x00000080
#define SHCNE_DRIVEADD 0x00000100
#define SHCNE_NETSHARE 0x00000200
#define SHCNE_NETUNSHARE 0x00000400
#define SHCNE_ATTRIBUTES 0x00000800
#define SHCNE_UPDATEDIR 0x00001000
#define SHCNE_UPDATEITEM 0x00002000
#define SHCNE_SERVERDISCONNECT 0x00004000
#define SHCNE_UPDATEIMAGE 0x00008000
#define SHCNE_DRIVEADDGUI 0x00010000
#define SHCNE_RENAMEFOLDER 0x00020000
#define SHCNE_FREESPACE 0x00040000
#define SHCNE_DISKEVENTS 0x0002381F
#define SHCNE_GLOBALEVENTS 0x0C0581E0 // Events that dont match pidls first
#define SHCNE_ALLEVENTS 0x7FFFFFFF
#define SHCNE_INTERRUPT 0x80000000 // The presence of this flag indicates
#define CSIDL_DESKTOP 0x0000 &&// <desktop>
#define CSIDL_INTERNET 0x0001 &&// Internet Explorer (icon on desktop)
#define CSIDL_PROGRAMS 0x0002 &&// Start Menu\Programs
#define CSIDL_CONTROLS 0x0003 &&// My Computer\Control Panel
#define CSIDL_PRINTERS 0x0004 &&// My Computer\Printers
#define CSIDL_PERSONAL 0x0005 &&// My Documents
#define CSIDL_FAVORITES 0x0006 &&// <user name>\Favorites
#define CSIDL_STARTUP 0x0007 &&// Start Menu\Programs\Startup
#define CSIDL_RECENT 0x0008 &&// <user name>\Recent
#define CSIDL_SENDTO 0x0009 &&// <user name>\SendTo
#define CSIDL_BITBUCKET 0x000a &&// <desktop>\Recycle Bin
#define CSIDL_STARTMENU 0x000b &&// <user name>\Start Menu
#define CSIDL_MYDOCUMENTS 0x000c &&// logical "My Documents" desktop icon
#define CSIDL_MYMUSIC 0x000d &&// "My Music" folder
#define CSIDL_MYVIDEO 0x000e &&// "My Videos" folder
#define WM_DEVICECHANGE 0x0219
#define DBT_DEVNODES_CHANGED 0x0007
#define DBT_DEVICEARRIVAL 0x8000 &&// system detected a new device
#define DBT_DEVICEQUERYREMOVE 0x8001 &&// wants to remove, may fail
#define DBT_DEVICEQUERYREMOVEFAILED 0x8002 &&// removal aborted
#define DBT_DEVICEREMOVEPENDING 0x8003 &&// about to remove, still avail.
#define DBT_DEVICEREMOVECOMPLETE 0x8004 &&// device is gone
#define DBT_DEVTYP_OEM 0x00000000 &&// oem-defined device type
#define DBT_DEVTYP_DEVNODE 0x00000001 &&// devnode number
#define DBT_DEVTYP_VOLUME 0x00000002 &&// logical volume
#define DBT_DEVTYP_PORT 0x00000003 &&// serial, parallel
#define DBT_DEVTYP_NET 0x00000004 &&// network resource
* Power Events
#define PBT_APMQUERYSUSPEND 0x0000
#define PBT_APMQUERYSTANDBY 0x0001
#define PBT_APMQUERYSUSPENDFAILED 0x0002
#define PBT_APMQUERYSTANDBYFAILED 0x0003
#define PBT_APMSUSPEND 0x0004
#define PBT_APMSTANDBY 0x0005
#define PBT_APMRESUMECRITICAL 0x0006
#define PBT_APMRESUMESUSPEND 0x0007
#define PBT_APMRESUMESTANDBY 0x0008
#define PBTF_APMRESUMEFROMFAILURE 0x00000001
#define PBT_APMBATTERYLOW 0x0009
#define PBT_APMPOWERSTATUSCHANGE 0x000A
#define PBT_APMOEMEVENT 0x000B
#define PBT_APMRESUMEAUTOMATIC 0x0012
#define HWND_TOP (0)
#define HWND_BOTTOM (1)
#define HWND_TOPMOST (0xffffffff)
#define HWND_NOTOPMOST (0xfffffffe)
#define WS_OVERLAPPED 0x00000000
#define WS_POPUP 0x80000000
#define WS_CHILD 0x40000000
#define WS_MINIMIZE 0x20000000
#define WS_VISIBLE 0x10000000
#define WS_DISABLED 0x08000000
#define WS_CLIPSIBLINGS 0x04000000
#define WS_CLIPCHILDREN 0x02000000
#define WS_MAXIMIZE 0x01000000
#define WS_CAPTION 0x00C00000
#define WS_BORDER 0x00800000
#define WS_DLGFRAME 0x00400000
#define WS_VSCROLL 0x00200000
#define WS_HSCROLL 0x00100000
#define WS_SYSMENU 0x00080000
#define WS_THICKFRAME 0x00040000
#define WS_GROUP 0x00020000
#define WS_TABSTOP 0x00010000
#define WS_MINIMIZEBOX 0x00020000
#define WS_MAXIMIZEBOX 0x00010000
#define WS_TILED WS_OVERLAPPED
#define WS_ICONIC WS_MINIMIZE
#define WS_SIZEBOX WS_THICKFRAME
#define WS_TILEDWINDOW WS_OVERLAPPEDWINDOW
#define WS_EX_DLGMODALFRAME 0x00000001
#define WS_EX_NOPARENTNOTIFY 0x00000004
#define WS_EX_TOPMOST 0x00000008
#define WS_EX_ACCEPTFILES 0x00000010
#define WS_EX_TRANSPARENT 0x00000020
#define WS_EX_MDICHILD 0x00000040
#define WS_EX_TOOLWINDOW 0x00000080
#define WS_EX_WINDOWEDGE 0x00000100
#define WS_EX_CLIENTEDGE 0x00000200
#define WS_EX_CONTEXTHELP 0x00000400
#define WS_EX_RIGHT 0x00001000
#define WS_EX_LEFT 0x00000000
#define WS_EX_RTLREADING 0x00002000
#define WS_EX_LTRREADING 0x00000000
#define WS_EX_LEFTSCROLLBAR 0x00004000
#define WS_EX_RIGHTSCROLLBAR 0x00000000
#define WS_EX_CONTROLPARENT 0x00010000
#define WS_EX_STATICEDGE 0x00020000
#define WS_EX_APPWINDOW 0x00040000
#define WS_EX_OVERLAPPEDWINDOW (WS_EX_WINDOWEDGE | WS_EX_CLIENTEDGE)
#define WS_EX_PALETTEWINDOW (WS_EX_WINDOWEDGE | WS_EX_TOOLWINDOW | WS_EX_TOPMOST)
#define WS_EX_LAYERED 0x00080000
#DEFINE WM_SETTINGCHANGE 0x001A
ENDTEXT
Strtofile(m.myvar,"wmhandler.h")
Endfunc
Function yColor2
*convert RGB colot to HTML color and add chanel alpha opaque
Lparameters xcolor
If m.xcolor=-1
Return .F.
Endi
xhtml_color=Chrtran("123456","563412",Right(Trans(m.xcolor ,"@0"),6))
Return ("0xF2"+xhtml_color) &&95% opacity
Important:All Codes above are tested on VFP9SP2 & windows 10 pro