Form round edges

[capri1966]

Hi, could somebody explain to me how to make a form with round edges with VFP 6. I'm developing an app and i need to do this, please

 

[vgulielmus]

This examples are inspired by various sources.
One problem in VFP6 is the lack of hwnd. You can get the hwnd via API getfocus() in the form's activate event

I have two solutions in my mind.
1) "Cover" the form with a shape with rounded corners, set the form's background color as invisible and to "cut" the title bar and the window frame (form's borders).

DECLARE integer GetFocus in User32 
Declare Long SetWindowRgn IN WIN32API Long hWnd, Long hRgn, String bRedraw
Declare Long CreateRectRgn IN WIN32API Long X1, Long Y1, Long X2, Long Y2
DECLARE INTEGER SetLayeredWindowAttributes IN win32api INTEGER HWND,  INTEGER crKey, INTEGER bAlpha, INTEGER dwFlags
DECLARE INTEGER SetWindowLong IN user32.DLL INTEGER hWnd, INTEGER nIndex, INTEGER dwNewLong
DECLARE INTEGER GetWindowLong IN user32.DLL INTEGER hWnd, INTEGER nIndex
#DEFINE LWA_COLORKEY	1
#DEFINE LWA_ALPHA		2
#DEFINE GWL_EXSTYLE		-20
#DEFINE WS_EX_LAYERED	0x00080000

PUBLIC ofrm
ofrm = CREATEOBJECT("MyForm")
ofrm.show()

DEFINE CLASS myform as Form
	backcolor = RGB(128,255,255)
	showwindow = 2
	nflags = 0
	hwnd = 0
	caption = ''
	ADD OBJECT shp as shape with curvature = 20
	PROCEDURE Activate
		Thisform.hwnd = getfocus() 
		This.shp.width = This.width
		This.shp.height = This.height
		Thisform.Makeirr(Thisform.HWnd,Thisform.BackColor,1) && transparent
	ENDPROC
	PROCEDURE makeirr
		LPARAMETERS nHWND, nColor, nAction
		LOCAL lnFlags
		SetWindowRgn(thisform.hwnd, CreateRectRgn(SYSMETRIC(3),SYSMETRIC(4)+SYSMETRIC(9),This.width+SYSMETRIC(3),This.height+SYSMETRIC(4)+SYSMETRIC(9)), "True")
		do case 
		case nAction = 1 && Make Transparent
			lnFlags = GetWindowLong(nHWND, GWL_EXSTYLE)	&&Gets the existing flags from the window
			thisform.nFlags = lnFlags 
			lnFlags	= BITOR(lnFlags, WS_EX_LAYERED)			&&Appends the Layered flag to the existing ones
			SetWindowLong(nHWND, GWL_EXSTYLE, lnFlags)		&&Sets the new flags to the window
			SetLayeredWindowAttributes(nHWND, nColor, 0, LWA_COLORKEY)
		case nAction = 2 && Make Opaque 
			SetWindowLong(nHWND, GWL_EXSTYLE, thisform.nFlags)      &&Sets the original flags to the window
			SetLayeredWindowAttributes(nHWND, nColor, 0, 0)
		endcase 
	ENDPROC
ENDDEF

2) use the API CreateEllipticRgn

* CTRL+F4 to close any form
#define RGN_OR 2
Declare Long CombineRgn IN WIN32API Long hrgnDest, Long hrgnSrc1, Long hrgnSrc2, Long fnCombineMode
Declare Long SetWindowRgn IN WIN32API Long hWnd, Long hRgn, String bRedraw
Declare Long CreateEllipticRgn IN WIN32API Long X1, Long Y1, Long X2, Long Y2
Declare Long DeleteObject IN WIN32API LONG hObject
DECLARE integer GetFocus in User32 

PUBLIC ofrm
ofrm=CREATEOBJECT("MyForm")
oFrm.visible=.T.

DEFINE CLASS MyForm as Form
	nSteps=100 
	nStepW=20 && nStepW <= nSteps
	Top=300
	Left=800
	hwnd = 0
	procedure activate
		Thisform.hwnd = getfocus() 
		This.reshape
	ENDPROC
	PROCEDURE resize
		This.reshape
	ENDPROC
	PROCEDURE reshape
		IF This.nSteps<This.nStepW
			RETURN
		ENDIF
		LOCAL x1,x2
		x1=CreateEllipticRgn(0,0,(This.width+2*SYSMETRIC(3))*This.nStepW/This.nSteps,This.height+2*SYSMETRIC(4)+SYSMETRIC(9))
		FOR lni=1 TO This.nSteps-This.nStepW+1
			x2=CreateEllipticRgn((This.width+2*SYSMETRIC(3))*lni/This.nSteps,0,(This.width+2*SYSMETRIC(3))*(lni+This.nStepW)/This.nSteps,This.height+2*SYSMETRIC(4)+SYSMETRIC(9))
			CombineRgn(x1,x1,x2,RGN_OR)
			DeleteObject(x2)
		NEXT
		SetWindowRgn(thisform.hwnd, x1, "True")
	ENDPROC
ENDDEFINE

Respectfully,
Vilhelm-Ion Praisach
Resita, Romania

 

[capri1966]

Thank you so much