API Creating irregularly shaped FoxPro form using transparency color

[realshyfox]

I found two examples and I began to build an example similar to the one from news2news (I realy didn´t see the code itself, just the picture, because their system didn´t accept my mastercard ), that has the same title as mine. I don´t know if their aproach is the same as mine but ... here it goes.

I´ve used 2 examples ... so I shall give the proper credits to it´s owners:

1. Move Form WithOut TitleBar

http://www.berezniker.com/content/pages/visual-foxpro/move-form-without-titlebar

2. Creating Irregularly shaped windows
Microsoft Visual FoxPro 9\Samples\Solution\Toledo

PUBLIC oform1
 
oForm1 = NEWOBJECT("form1")
oForm1.Show()

RETURN
 
DEFINE CLASS form1 AS form
	
	ShowWindow = 2 
  	nFlags = 0
 
	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 192, Left = 152, Height = 27, Width = 84, ;
		Caption = "Exit", Name = "Command1"
 
	ADD OBJECT command2 AS commandbutton WITH ;
		Top = 84, Left = 48, Height = 27, Width = 108, ;
		Caption = "Make \<Transparent", SpecialEffect = 2, Name = "Command2"
 
	PROCEDURE Load
		DECLARE Long ReleaseCapture IN WIN32API
		DECLARE Long SendMessage IN WIN32API ;
				Long HWND, Long wMsg, Long wParam, Long Lparam
	ENDPROC
 
 	PROCEDURE Init
 			
	DECLARE INTEGER SetLayeredWindowAttributes IN win32api;
		INTEGER HWND,  INTEGER crKey, INTEGER bAlpha, INTEGER dwFlags

	*These functions get and set a window's attributes
	DECLARE INTEGER SetWindowLong IN user32.DLL ;
		INTEGER hWnd, INTEGER nIndex, INTEGER dwNewLong

	DECLARE INTEGER GetWindowLong IN user32.DLL ;
		INTEGER hWnd, INTEGER nIndex
		
 		WITH Thisform
			.AutoCenter = .T.
			.BorderStyle= 0
			.Caption	= ""
			.Closable	= .F.
			.ControlBox	= .F.
			.TitleBar	= 0
			.BackColor	= RGB(255,0,255)
			.Height		= 370
			.Width		= 410
			.Picture    = "C:\Program Files\Microsoft Visual FoxPro 9\Samples\Solution\Toledo\i_2.bmp"
			.nFlags = 0
		ENDWITH	
		
 	ENDPROC
 	
 	PROCEDURE MakeIrregular
********************************************************************************
* To create a non-rectangular form, a transparent color needs to be set.
* Anything drawn using this color will be transparent, and any
* mouse clicks in these regions will pass through to the visible form.
*
* This technique only works in Windows 2000/XP but it is much more efficient
* than previous techniques of setting a bounding region for the form.
*
* This can be used to create non-rectangluar forms, to create hovering agents,
* or simply to confuse your coworkers <g>.
*
* Although this function makes a form transparent, the Form must be setup
* accept these changes. First, the ShowWindow property MUST BE set to
* 2 'As Top-Level Form'. Otherwise the window cannot be drawn layered.
* Second, if you want to turn off the window's frame, since it will not be
* drawn transparent, you can set the following properties:
*	BorderStyle = 0
*	Caption		= ""
*	Closable	= .F.
*	ControlBox	= .F.
*	TitleBar	= 0
*
********************************************************************************
*-- Pass in the window handle (Thisform.HWIND) and the color to make transparent.
LPARAMETERS nHWND, nColor, nAction

*Constants for SetLayeredWindowAttributs
#DEFINE LWA_COLORKEY	1
#DEFINE LWA_ALPHA		2

*Constants for SetWindowLong and GetWindowLong
#DEFINE GWL_EXSTYLE		-20
#DEFINE WS_EX_LAYERED	0x00080000

LOCAL lnFlags

*The form's window must be set to Layered, so that it is drawn
* in a separate layer.
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

 	
	PROCEDURE MouseDown
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		#DEFINE WM_SYSCOMMAND 0x112
		#DEFINE WM_LBUTTONUP 0x202
		#DEFINE MOUSE_MOVE 0xf012
 
		IF nButton = 1 		&& LMB
			= ReleaseCapture()
			* Complete left click by sending 'left button up' message
			= SendMessage(Thisform.HWnd, WM_LBUTTONUP, 0x0, 0x0)
			* Initiate Window Move
			= SendMessage(Thisform.HWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0x0)
		ENDIF
	ENDPROC
	
	PROCEDURE Destroy
		CLEAR DLLS	
	ENDPROC
 
	PROCEDURE command1.Click
		Thisform.Release()
	ENDPROC
	
	PROCEDURE command2.Click
	
   If this.Caption = 'Make \<Transparent'
   	Thisform.Makeirregular(Thisform.HWnd,Thisform.BackColor,1)
    This.Caption = 'Make \<Opaque'
		Else 
    Thisform.Makeirregular(Thisform.HWnd,Thisform.BackColor,2)
    This.Caption = 'Make \<Transparent'
   Endif
	
	ENDPROC
	
ENDDEFINE

Thank you to all of you that share your experience so others can learn from you!

Oh and ... yeah ... thanks to my credit card that sometimes pushes me to work ... a litle

Till the next time ... I salute you !