Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Grid property - Transparent?
Message
From
04/03/2016 13:48:19
 
 
To
04/03/2016 12:17:41
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Windows 7
Database:
Visual FoxPro
Application:
Desktop
Miscellaneous
Thread ID:
01632529
Message ID:
01632549
Views:
65
this another one on a top level form semi transparent with some parameters as :
-form.transparency
-form.backcolor
(read the help on form)
the form have no titlebar and is movable by mousedown.(ESCor X button release it)
make transparency >210 preferably.
run this code:
_Screen.WindowState=1
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu

*
Define Class asup As Form
	BorderStyle = 0
	Height = 611
	Width = 952
	ShowWindow = 2
	AutoCenter = .T.
	Caption = ""
	KeyPreview = .T.
	TitleBar = 0
	AlwaysOnTop = .T.
	BackColor = Rgb(0,0,0)
	TitleBar=1
	yalpha = 220
	Name = "Form1"

	Add Object grid1 As Grid With ;
		Anchor = 15, ;
		Height = 528, ;
		Left = 24, ;
		Top = 48, ;
		Width = 901, ;
		Name = "Grid1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 20, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "X", ;
		Height = 35, ;
		Left = 900, ;
		MousePointer = 15, ;
		Top = 10, ;
		Width = 20, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontName = "Segoe Script", ;
		FontSize = 20, ;
		BackStyle = 0, ;
		Caption = "This is a semi transparent form", ;
		Height = 47, ;
		Left = 197, ;
		Top = 0, ;
		Width = 464, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label2"

	Add Object label3 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 20, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "?", ;
		Height = 35, ;
		Left = 784, ;
		MousePointer = 15, ;
		Top = 11, ;
		Width = 19, ;
		ForeColor = Rgb(0,255,0), ;
		Name = "Label3"

	Add Object optiongroup1 As OptionGroup With ;
		AutoSize = .T., ;
		ButtonCount = 1, ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		Value = 1, ;
		Height = 27, ;
		Left = 708, ;
		Top = 12, ;
		Width = 71, ;
		Name = "Optiongroup1", ;
		Option1.FontBold = .T., ;
		Option1.FontSize = 10, ;
		Option1.BackStyle = 0, ;
		Option1.Caption = "Color", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.MousePointer = 15, ;
		Option1.Top = 5, ;
		Option1.Width = 61, ;
		Option1.ForeColor = Rgb(255,255,255), ;
		Option1.Name = "Option1"

	Procedure RightClick
		#Define LWA_COLORKEY 1
		#Define LWA_ALPHA 2

		Thisform.yalpha=Int(Val(Inputbox("Alpha 0-255","",Trans(Thisform.yalpha))))
		If Empty(Thisform.yalpha)
			Thisform.yalpha=220
		Endi
		= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor,Thisform.yalpha,LWA_ALPHA)
	Endproc

	Procedure KeyPress
		Lparameters nKeyCode, nShiftAltCtrl
		If nKeyCode=27
			Thisform.Release
		Endi
	Endproc

	Procedure Init
		Thisform.TitleBar=0
		Publi m.yrep0
		m.yrep0=Addbs(Justpath(Sys(16,1)))
		Local nExStyle, nRgb, nAlpha, nFlags
		#Define LWA_COLORKEY 1
		#Define LWA_ALPHA 2
		#Define GWL_EXSTYLE -20
		#Define WS_EX_LAYERED 0x80000
		nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
		nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
		= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
		= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor,Thisform.yalpha,LWA_ALPHA)
	Endproc

	Procedure Load
		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

	Endproc

	Procedure MouseDown
		Lparameters nButton, nShift, nXCoord, nYCoord
		If !Thisform.WindowState=2
			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)
		Endi
	Endproc

	Procedure DblClick
		Thisform.Release
	Endproc

	Procedure Destroy
		Clea Events
	Endproc

	Procedure grid1.Init
		Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
		With This
			.RecordSource="ycurs"
			.DeleteMark=.F.
			.GridLines=0
			.FontBold=.T.
			.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(145,55,105)  , RGB(100,255,40))", "Column")
			.AutoFit
			Locate
		Endwith
	Endproc

	Procedure label1.Click
		Thisform.Release
	Endproc

	Procedure label2.MouseDown
		Lparameters nButton, nShift, nXCoord, nYCoord
		This.Parent.MouseDown()
	Endproc


	Procedure label3.Click
		Local m.myvar
		TEXT to m.myvar noshow
-The form is movable by mousedown
-Adjust by rightclick on form transparency (above 170 until 255)---make grid readable.
-Adjust form.backcolor
		ENDTEXT
		Messagebox(m.myvar,0+32+4096)
	Endproc

	Procedure optiongroup1.Click
		Local m.xcolor
		m.xcolor=Getcolor()
		If !m.xcolor=-1
			Thisform.BackColor=m.xcolor
		Endi
	Endproc

	Procedure optiongroup1.AddObject
		Lparameters cName, cClass
	Endproc

Enddefine
*
*-- EndDefine: asup
Previous
Reply
Map
View

Click here to load this message in the networking platform