WindowEventCodeBlock

Source code related resources

Moderator: Rathinagiri

User avatar
andyglezl
Posts: 981
Joined: Fri Oct 26, 2012 7:58 pm
Location: Guadalajara Jalisco, MX
Has thanked: 20 times
Been thanked: 41 times
Contact:

Re: WindowEventCodeBlock

Post by andyglezl » Wed Feb 18, 2015 5:44 pm

Dr. Claudio
Este último ejemplo funciona OK. Win 7 / 32 / HMG 3.4
----------------------------------------------------------
Dr. Claudio
This last example function OK. Win 7/32 / HMG 3.4

Gracias / Thanks
Andrés González López
Desde Guadalajara, Jalisco. México.

User avatar
srvet_claudio
Posts: 2030
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Has thanked: 34 times
Been thanked: 143 times
Contact:

Post by srvet_claudio » Wed Feb 18, 2015 6:22 pm

andyglezl wrote:Dr. Claudio
Este último ejemplo funciona OK. Win 7 / 32 / HMG 3.4
----------------------------------------------------------
Dr. Claudio
This last example function OK. Win 7/32 / HMG 3.4

Gracias / Thanks
Gracias Andrés por probarlo.
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com

User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil
Has thanked: 100 times
Been thanked: 179 times

Post by Pablo César » Wed Feb 18, 2015 6:30 pm

srvet_claudio wrote:Please test this version.

The syntax is:
nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, NIL ) // Precess all messages

nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, { WM_KEYUP, WM_SIZE, WM_WINDOWPOSCHANGED } ) // Precess only this list of messages

nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, WM_WINDOWPOSCHANGED ) // Precess only this message

RemoveEventCodeBlock (nIndex)
Great ! Thank you Claudio for new implements, so cool !! :D

Sorry I was out (in client attendance) I just arrived and I've tested, is 100% OK.

I updated my Demo is so good !

Code: Select all

/*
  WindowEventCodeBlock Demo
  Author: Dr. Claudio Soto
  A new more powerful concept: WindowEventCodeBlock
  
  Adapted Demo by Pablo César
  On February, 2015
*/

#include "hmg.ch"

#define WM_WINDOWPOSCHANGED 0x0047
#define WS_BORDER           0x00800000
#define WS_CAPTION          0x00C00000
#define WS_SIZEBOX          0x00040000
#define WM_MOVE             0x0003
#define WM_SIZE             0x0005

Function Main()
Local aRows [21] [3]

Public hWnd, nIndex

aRows [1]   := {'Simpson','Homer','555-5555'}
aRows [2]   := {'Mulder','Fox','324-6432'} 
aRows [3]   := {'Smart','Max','432-5892'} 
aRows [4]   := {'Grillo','Pepe','894-2332'} 
aRows [5]   := {'Kirk','James','346-9873'} 
aRows [6]   := {'Barriga','Carlos','394-9654'} 
aRows [7]   := {'Flanders','Ned','435-3211'} 
aRows [8]   := {'Smith','John','123-1234'} 
aRows [9]   := {'Pedemonti','Flavio','000-0000'} 
aRows [10]   := {'Gomez','Juan','583-4832'} 
aRows [11]   := {'Fernandez','Raul','321-4332'} 
aRows [12]   := {'Borges','Javier','326-9430'} 
aRows [13]   := {'Alvarez','Alberto','543-7898'} 
aRows [14]   := {'Gonzalez','Ambo','437-8473'} 
aRows [15]   := {'Batistuta','Gol','485-2843'} 
aRows [16]   := {'Vinazzi','Amigo','394-5983'} 
aRows [17]   := {'Pedemonti','Flavio','534-7984'} 
aRows [18]   := {'Samarbide','Armando','854-7873'} 
aRows [19]   := {'Pradon','Alejandra','???-????'} 
aRows [20]   := {'Reyes','Monica','432-5836'} 
aRows [21]   := {'Fernández','two','0000-0000'} 

FOR i = 1 TO 21
    AADD (aRows[i],str(i))
NEXT

DEFINE WINDOW Form_1 ;
   AT 0,0 ;
   WIDTH 940 ;
   HEIGHT 750 ;
   TITLE "WindowEventCodeBlock Demo" ;
   MAIN ON PAINT Proc_OnPaint()
   
   @  10, 10 LABEL Label_1 ;
      width 80 ;
      height 20 ;
      value "Try to move out of yellow frame" ;
	  backcolor {255, 255, 102} ;
      autosize
  
   @  50, 10 LABEL Label_2; 
      width 80;
      height 20;
      value "Limits the size and movement of the GRID in the screen (max Row,Col --> 150,150) (Width, Height --> 200 to 500)"; 
	  backcolor {255, 255, 102} ;
      autosize

   @  50, 700 CHECKBUTTON Button_1;
      caption "Disable Move/Resize Control";
      width 180;
	  height 28;
	  value .T.;
	  on change ControlIt(This.Value)
      
   @  100, 700 BUTTON Button_2;
      caption "Refresh Control";
	  action RefreshIt();
      width 180;
	  height 28
   
   @ 80,10 GRID Grid_1 ;
      WIDTH 540 ;
      HEIGHT 500 ;
      HEADERS {'Last Name','First Name','Phone',"Num"} ;
      WIDTHS {140,140,140,50};
      ITEMS aRows ;
      VALUE 1

      Form_1.Grid_1.ColumnCONTROL (4) := {"TEXTBOX", "NUMERIC",NIL,NIL}
      Form_1.Grid_1.ColumnJUSTIFY (4) := GRID_JTFY_RIGHT

END WINDOW
hWnd := Form_1.Grid_1.Handle
HMG_ChangeWindowStyle (hWnd, WS_CAPTION + WS_SIZEBOX, NIL, .F., .T.)
SetWindowText(hWnd,"My Grid")

EnableChngPos()

MAXIMIZE WINDOW Form_1
ACTIVATE WINDOW Form_1
Return Nil

Function RefreshIt()
RedrawWindow (GetParent (hWnd))
Return 0

Function ControlIt(lControl)
If lControl
   Form_1.Button_1.Caption:="Disable Move/Resize Control"
   EnableChngPos()
Else
   Form_1.Button_1.Caption:="Enable Move/Resize Control"
   DisableChngPos()
Endif
Return Nil

Function EnableChngPos()
// nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, NIL )   // Precess all messages 
// nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, { WM_KEYUP, WM_SIZE, WM_WINDOWPOSCHANGED } )   // Precess only this list of messages
nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, WM_WINDOWPOSCHANGED )   // Precess only this message
Return Nil

Function DisableChngPos()
RemoveEventCodeBlock ( nIndex )
Return Nil

Function ProcMoveSizeControl
LOCAL aEventCodeBlockInfo := GetEventCodeBlockInfo()
// LOCAL hWnd   := aEventCodeBlockInfo [1]
LOCAL nMsg   := aEventCodeBlockInfo [2]
LOCAL wParam := aEventCodeBlockInfo [3]
LOCAL lParam := aEventCodeBlockInfo [4]
LOCAL nIndex := aEventCodeBlockInfo [5]
LOCAL aInfo, x, y, cx, cy
LOCAL flag := .F.

IF nMsg == WM_WINDOWPOSCHANGED

   aInfo := WM_WINDOWPOSCHANGED_INFO ( lParam )
   x  := aInfo [1]   // nCol
   y  := aInfo [2]   // nRow
   cx := aInfo [3]   // nWidth
   cy := aInfo [4]   // nHeight

   IF x > 150
      x := 150
      flag := .T.
   ENDIF

   IF y > 150
      y := 150
      flag := .T.
   ENDIF

   IF cx > 500
      cx := 500
      flag := .T.
   ENDIF

   IF cx < 200
      cx := 200
      flag := .T.
   ENDIF

   IF cy > 500
      cy := 500
      flag := .T.
   ENDIF

   IF cy < 200
      cy := 200
      flag := .T.
   ENDIF

   SetWindowText(hWnd,"My Grid at "+HB_NTOS(x)+" , "+HB_NTOS(y)+" SIZE "+HB_NTOS(cx)+" , "+HB_NTOS(cy))
   
   IF flag == .T.
      InvalidateRect (GetParent (hWnd))
      SetWindowPos (hWnd, 0, x, y, cx, cy, SWP_NOOWNERZORDER + SWP_NOSENDCHANGING + SWP_DRAWFRAME + SWP_FRAMECHANGED)
      Return 0
   ENDIF

ENDIF
Return NIL

Function Proc_OnPaint()
LOCAL hDC, BTstruct
hDC := BT_CreateDC ("Form_1", BT_HDC_INVALIDCLIENTAREA, @BTstruct)
FillRect(hDC,00,00,650,650,{255, 255, 102})
BT_DeleteDC (BTstruct)
RETURN


#pragma BEGINDUMP

#include "SET_COMPILE_HMG_UNICODE.ch"
#include "HMG_UNICODE.h"


#include <windows.h>
#include <tchar.h>
#include <commctrl.h>

#include "hbvm.h"
#include "hbapiitm.h"
#include "hbapi.h"


HB_FUNC ( WM_WINDOWPOSCHANGED_INFO )
{
   LPARAM lParam = (LPARAM) HMG_parnl (1);
   if ( lParam )
   {  LPWINDOWPOS lpWindowPos = (LPWINDOWPOS) lParam;
      hb_reta (4);
      hb_storvni (lpWindowPos->x,   -1, 1);
      hb_storvni (lpWindowPos->y,   -1, 2);
      hb_storvni (lpWindowPos->cx,  -1, 3);
      hb_storvni (lpWindowPos->cy,  -1, 4);
   }
}



/********************************************************************/
/*   WindowEventCodeBlock,   by Dr. Claudio Soto,   February 2015   */
/********************************************************************/

PHB_ITEM  pArrayEventCodeBlock  = NULL;


HWND      EventCodeBlock_hWnd   = NULL;
UINT      EventCodeBlock_uMsg   = 0;
WPARAM    EventCodeBlock_wParam = 0;
LPARAM    EventCodeBlock_lParam = 0;
DWORD_PTR EventCodeBlock_nIndex = 0;


typedef struct
{
   HWND hWnd;
   PHB_ITEM  pCodeBlock;
   PHB_ITEM  pArrayMSG;
} EventCBData;


//        GetEventCodeBlockInfo () --> array { hWnd, uMsg, wParam, lParam, nIndex }
HB_FUNC ( GETEVENTCODEBLOCKINFO )
{
   hb_reta (5);
   HMG_storvnl ((LONG_PTR) EventCodeBlock_hWnd,    -1, 1);
   HMG_storvnl ((LONG_PTR) EventCodeBlock_uMsg,    -1, 2);
   HMG_storvnl ((LONG_PTR) EventCodeBlock_wParam,  -1, 3);
   HMG_storvnl ((LONG_PTR) EventCodeBlock_lParam,  -1, 4);
   HMG_storvnl ((LONG_PTR) EventCodeBlock_nIndex,  -1, 5);
}


// Process CodeBlocks of Window Event
LRESULT CALLBACK SubClassProc (HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam, UINT_PTR uIdSubclass, DWORD_PTR dwRefData)
{
   UNREFERENCED_PARAMETER (uIdSubclass);

   EventCodeBlock_hWnd   = hWnd;
   EventCodeBlock_uMsg   = uMsg;
   EventCodeBlock_wParam = wParam;
   EventCodeBlock_lParam = lParam;
   EventCodeBlock_nIndex = dwRefData;

   EventCBData * pEventCBData = (EventCBData *) hb_arrayGetPtr ( pArrayEventCodeBlock, (HB_SIZE) dwRefData );

   if ( pEventCBData )
   {
      HB_SIZE nPos = 0;
      if (pEventCBData->pArrayMSG)
      {
         PHB_ITEM pValue = hb_itemNew ( NULL );
         hb_itemPutNI (pValue, (int) uMsg);
         nPos = hb_arrayScan (pEventCBData->pArrayMSG, pValue, NULL, NULL, HB_FALSE);
         hb_itemRelease (pValue);
      }
      else
         nPos = 1;

      if (pEventCBData->pCodeBlock && nPos > 0)
      {  PHB_ITEM pItem = hb_vmEvalBlock ( pEventCBData->pCodeBlock );
         if ( pItem && ( hb_itemType (pItem) & HB_IT_NUMERIC ))
         {
            #ifdef _WIN64
               LRESULT nRet = (LRESULT) hb_itemGetNLL (pItem);
            #else
               LRESULT nRet = (LRESULT) hb_itemGetNL  (pItem);
            #endif
            // hb_itemRelease (pItem);
            return nRet;
         }
         else if (pItem)
         {   // hb_itemRelease (pItem);
         }
      }
   }

   return DefSubclassProc(hWnd, uMsg, wParam, lParam);
}


//        SetEventCodeBlock ( hWnd, CodeBlock [, nMsg | aMsg ] ) --> nIndex
HB_FUNC ( SETEVENTCODEBLOCK )
{
   static UINT_PTR uIdSubclass = 0;
   static DWORD_PTR dwRefData  = 0;

   HWND     hWnd       = (HWND) HMG_parnl (1);
   PHB_ITEM pCodeBlock = (HB_ISBLOCK (2) ? hb_itemClone (hb_param (2, HB_IT_BLOCK)) : NULL);

   if (IsWindow(hWnd) && pCodeBlock)
   {
      if (pArrayEventCodeBlock == NULL)
         pArrayEventCodeBlock = hb_itemArrayNew (0);

      EventCBData * pEventCBData = (EventCBData *) hb_xgrab (sizeof (EventCBData));
 
      PHB_ITEM pArrayMSG  = NULL;

      if (HB_ISNUM (3))
      {  pArrayMSG = hb_itemArrayNew (0);
         hb_arrayAddForward (pArrayMSG, hb_itemPutNI (NULL, hb_parni(3)));
      }
      else if (HB_ISARRAY (3) && (hb_parinfa (3,0) > 0))
         pArrayMSG = hb_itemClone (hb_param (3, HB_IT_ARRAY)); 

/*
      else if (HB_ISARRAY (3))
      {  pArrayMSG = hb_itemClone (hb_param (3, HB_IT_ARRAY)); 
         if (hb_arrayLen (pArrayMSG) == 0)
         {  hb_itemRelease (pArrayMSG);
            pArrayMSG = NULL;
         }
      }
*/
      pEventCBData->hWnd       = hWnd;
      pEventCBData->pCodeBlock = pCodeBlock;
      pEventCBData->pArrayMSG  = pArrayMSG;

      hb_arrayAddForward (pArrayEventCodeBlock, hb_itemPutPtr (NULL, (void *) pEventCBData));

      SetWindowSubclass (hWnd, (SUBCLASSPROC) SubClassProc, ++uIdSubclass, ++dwRefData);

      HMG_retnl ((LONG_PTR) uIdSubclass);
   }
   else
      HMG_retnl ((LONG_PTR) 0);
}


//        RemoveEventCodeBlock ( nIndex ) --> lBoolean
HB_FUNC ( REMOVEEVENTCODEBLOCK )
{
   UINT_PTR uIdSubclass = (UINT_PTR) HMG_parnl (1);
   BOOL lRet = FALSE;

   if (pArrayEventCodeBlock && (uIdSubclass > 0) && (uIdSubclass <= (UINT_PTR) hb_arrayLen (pArrayEventCodeBlock)))
   {
      EventCBData * pEventCBData = (EventCBData *) hb_arrayGetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass);

      if (pEventCBData && RemoveWindowSubclass (pEventCBData->hWnd, (SUBCLASSPROC) SubClassProc, uIdSubclass))
      {
         if (pEventCBData->pCodeBlock)
            hb_itemRelease (pEventCBData->pCodeBlock);

         if (pEventCBData->pArrayMSG)
            hb_itemRelease (pEventCBData->pArrayMSG);

         hb_xfree ((void *) pEventCBData);

         hb_arraySetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass, NULL);
         lRet = TRUE;
      }
   }
   hb_retl (lRet);
}

//   FillRect,    adapted by Pablo César,   February 2015
HB_FUNC( FILLRECT )
{
   RECT rc;
   HBRUSH brush;

   rc.left   = hb_parni( 2 );
   rc.top    = hb_parni( 3 );
   rc.right  = hb_parni( 4 );
   rc.bottom = hb_parni( 5 );
   brush = CreateSolidBrush( RGB(hb_parvni(6, 1), hb_parvni(6, 2), hb_parvni(6, 3) ) ) ;

   FillRect( ( HDC ) HMG_parnl( 1 ),    // handle to device context
             &rc,                       // pointer to structure with rectangle
             brush );                   // handle to brush
   DeleteObject(brush);
}

#pragma ENDDUMP
Thank you very much Claudio. Excellent work, you're a genious !
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein

User avatar
srvet_claudio
Posts: 2030
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Has thanked: 34 times
Been thanked: 143 times
Contact:

Post by srvet_claudio » Wed Feb 18, 2015 6:41 pm

Pablo César wrote: I've tested, is 100% OK.
Thanks for testing it.
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com

User avatar
andyglezl
Posts: 981
Joined: Fri Oct 26, 2012 7:58 pm
Location: Guadalajara Jalisco, MX
Has thanked: 20 times
Been thanked: 41 times
Contact:

Post by andyglezl » Wed Feb 18, 2015 9:17 pm

Hola
Aqui jugando con el ejemplo de Dr. Claudio...
Creo que se tiene un mundo de posibilidades con esto, pero a la vez implica mucho trabajo y dedicación.
De momento no se me ocurre en donde o como aplicarlo; solamente en algun IDE pero no tengo conocimiento en eso.
(tal vez a los trabajos de Pablo Cesar ó Javier)
------------------------------------------------------------------------------------------------------------------------------------------
hello
Here playing with the example of Dr. Claudio ...
I think you have a world of possibilities with this, but at the same time a lot of work and dedication.
At the moment I can not think where or how to apply it; only in some IDE but I have no knowledge of that.
(perhaps to the work of Pablo Cesar or Javier)
WinEvenCodeBlocks2.jpg
WinEvenCodeBlocks2.jpg (217.88 KiB) Viewed 537 times
sample1.rar
(1.1 MiB) Downloaded 85 times
Andrés González López
Desde Guadalajara, Jalisco. México.

User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil
Has thanked: 100 times
Been thanked: 179 times

Post by Pablo César » Wed Feb 18, 2015 9:32 pm

Toda herramienta para auxiliar al desenvolvimiento es bien venida Andrés.

Con esta funcion que Claudio exjemplificó y amplió, se puede hacer que en tu nuevos fmg por ejemplo, se puedan posicionar y redimensionar en el lugar que a uno más le convenga y eso se puede hacer en tiempo real de ejecucion. Bastaria guardar los 4 valores para cada control.

Inclusive en la funcion InputWindow, cuando el componente sea EditBox por ejemplo, se podrá aumentar el ancho o la altura del cntrol caso sea muy chico. Pero todo depende de implementacion. Si hay herramientas: es posible hacerlo. Todo depende de la creatividad de cada uno.
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein

User avatar
srvet_claudio
Posts: 2030
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Has thanked: 34 times
Been thanked: 143 times
Contact:

Post by srvet_claudio » Wed Feb 18, 2015 10:00 pm

andyglezl wrote:Hola
Aqui jugando con el ejemplo de Dr. Claudio...
Creo que se tiene un mundo de posibilidades con esto, pero a la vez implica mucho trabajo y dedicación.
De momento no se me ocurre en donde o como aplicarlo; solamente en algun IDE pero no tengo conocimiento en eso.
(tal vez a los trabajos de Pablo Cesar ó Javier)
------------------------------------------------------------------------------------------------------------------------------------------
hello
Here playing with the example of Dr. Claudio ...
I think you have a world of possibilities with this, but at the same time a lot of work and dedication.
At the moment I can not think where or how to apply it; only in some IDE but I have no knowledge of that.
(perhaps to the work of Pablo Cesar or Javier)
WinEvenCodeBlocks2.jpg
sample1.rar
This is only a trivial example, the important is that with WindowEventCodeBlock () and CreateEvent () is able to have full control of the system messages, this opens very many possibilities.

See this example that uses the same concept that WindowEventCodeBlock () viewtopic.php?f=15&t=1313&
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com

Javier Tovar
Posts: 1275
Joined: Tue Sep 03, 2013 4:22 am
Location: Tecámac, México
Has thanked: 1 time
Been thanked: 2 times

Post by Javier Tovar » Thu Feb 19, 2015 4:31 pm

Gracias Dr. Claudio Soto, una vez mas! Funciona Bien en win7 32bits

Muy buen trabajo!

Saludos

EduardoLuis
Posts: 578
Joined: Tue Jun 04, 2013 6:33 pm
Location: Argentina
Has thanked: 1 time
Been thanked: 37 times

Post by EduardoLuis » Fri Feb 20, 2015 12:41 pm

Hi Claudio:

As allways EXCELLENT job.- This new tool open lots of chances.-
Thanks for your effort and for share it with all of us.-
With regards. Eduardo

Como siempre un excelente trabajo. Esta nueva herramienta abre infinidad de oportunidades.-
Gracias por tu esfuerzo y por compartirlo con todos nosotros.-
Cordialmente. Eduardo

User avatar
andyglezl
Posts: 981
Joined: Fri Oct 26, 2012 7:58 pm
Location: Guadalajara Jalisco, MX
Has thanked: 20 times
Been thanked: 41 times
Contact:

Post by andyglezl » Sat Feb 21, 2015 5:25 pm

Hola

Dr. Claudio, como que la función "SetWindowPos()" no actualiza las propiedades de ROW, COL, WIDTH, HEIGHT
IF flag == .T.
// esta función no altera las propiedades de ROW, COL, WIDTH, HEIGHT
SetWindowPos( hWnd, 0, x, y, cx, cy, SWP_NOOWNERZORDER + SWP_NOSENDCHANGING + SWP_DRAWFRAME + SWP_FRAMECHANGED )
// habrá que hacerlo manualmente ?
SetProperty( "Form_1", "Grid_1", "ROW", y )
SetProperty( "Form_1", "Grid_1", "COL", x )
SetProperty( "Form_1", "Grid_1", "WIDTH", cx )
SetProperty( "Form_1", "Grid_1", "HEIGHT", cy )

// RedrawWindow (GetParent (hWnd))
Return 0
ENDIF

***** SAMPLE1.PRG

Code: Select all

*-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

#include "hmg.ch"

#define WS_BORDER  0x00800000
#define WS_CAPTION 0x00C00000
#define WS_SIZEBOX 0x00040000
#define WM_WINDOWPOSCHANGED 0x0047
#define WM_SIZE 0x0005
#define WM_MOVE 0x0003

#xtranslate _HMG_aFormHandles        => _HMG_SYSDATA\[67\]  //4
#xtranslate _HMG_aFormNames          => _HMG_SYSDATA\[66\]  //3
#xtranslate _HMG_aFormVirtualWidth   => _HMG_SYSDATA\[92\]  //
#xtranslate _HMG_aFormVirtualHeight  => _HMG_SYSDATA\[91\]  //
#xtranslate _HMG_aControlHandles     => _HMG_SYSDATA\[3\]
#xtranslate _HMG_aControlNames       => _HMG_SYSDATA\[2\]
#xtranslate _HMG_aControlType        => _HMG_SYSDATA\[1\]
#xtranslate _HMG_aControlFontSize    => _HMG_SYSDATA\[28\]  //?

FUNCTION Main
	PUBLIC aRows [1] [4]
	PUBLIC nCountCtrl := 1
	
	DEFINE WINDOW Form_1 AT 0,0 WIDTH 800 HEIGHT 650 MAIN
	
		DEFINE CONTEXT MENU OF Form_1
			ITEM 'CREATE'		ACTION nil
			SEPARATOR
			ITEM 'GRID'			ACTION CreaGrid( ThisWindow.Name )
			ITEM 'EDITBOX'      ACTION CreaEditBox( ThisWindow.Name )
			ITEM 'DATEPICKER'   ACTION CreaDatePicker( ThisWindow.Name )
			ITEM '...'          ACTION nil
			ITEM '...'        	ACTION nil
			ITEM '...'          ACTION nil
			ITEM '...'    		ACTION nil
			ITEM '...'   		ACTION nil
			ITEM '...'        	ACTION nil
			ITEM '...'          ACTION nil
			ITEM '...'         	ACTION nil
			ITEM 'SAVE'         ACTION Save( ThisWindow.Name )
			SEPARATOR
			ITEM 'Salir'        ACTION IF( MsgYesNo( "Desea Salir del Sistema ?", "A V I S O", .T. ), Form_1.release, nil ) IMAGE 'Salir2.Bmp'			
		END MENU
	
		@  10 , 10  Label Label_1 WIDTH 80 HEIGHT 15 VALUE "WindowEventCodeBlock: this is beautiful" AUTOSIZE
		@  40 , 10  Label Label_2 WIDTH 80 HEIGHT 15 VALUE "Limits the size and movement of the GRID in the screen ( Row,Col-> 150,150 ) (Width, Height-> 200 to 500)" AUTOSIZE
		@  90 , 160 Label Label_3 WIDTH 80 HEIGHT 15 VALUE "<--- Limits the movement of the GRID in this area ( Row,Col-> 70,10 to 150,150 )  try it !" AUTOSIZE
		
		DRAW RECTANGLE IN WINDOW Form_1 AT 70 , 10 TO 150 , 150 PENCOLOR RED PENWIDTH 2 // FILLCOLOR <anFillColor> 	
		@ 150 , 150 GRID Grid_1 WIDTH 540 HEIGHT 500 HEADERS {'Name','Type','R-C-W-H|Value',"Coord."} WIDTHS {140,140,140,140} ITEMS aRows VALUE 1
					hWndGrid_1 := Form_1.Grid_1.Handle
					HMG_ChangeWindowStyle( hWndGrid_1, WS_SYSMENU + WS_CAPTION + WS_SIZEBOX, NIL, .F., .T. )
					SetWindowText( hWndGrid_1,"Control Grid" )
					
		@ 160 , 010 DATEPICKER DP1 WIDTH 140 HEIGHT 70 FONT "Verdana" SIZE 9
					hWndDP1 := Form_1.DP1.Handle
					HMG_ChangeWindowStyle( hWndDP1, WS_SYSMENU + WS_CAPTION + WS_SIZEBOX, NIL, .F., .T. )
					SetWindowText( hWndDP1,"Control Calendar" )	// ??????  no works
				  
		@ 150 , 690 EDITBOX EB1 WIDTH 350 HEIGHT 200 FONT "Verdana" SIZE 9 VALUE "..." MAXLENGTH 230 
					hWndEB1 := Form_1.EB1.Handle
					HMG_ChangeWindowStyle( hWndEB1, WS_SYSMENU + WS_CAPTION + WS_SIZEBOX, NIL, .F., .T. )
					SetWindowText( hWndEB1,"Control EditBox" )			
	
	END WINDOW
	*nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, NIL )   // Precess all messages
	*nIndex := SetEventCodeBlock (hWnd, {|| ProcMoveSizeControl()}, { WM_KEYUP, WM_SIZE, WM_WINDOWPOSCHANGED } )   // Precess only this list of messages
	nIndex := SetEventCodeBlock (hWndGrid_1, {|| ProcMoveSizeControl()}, WM_WINDOWPOSCHANGED )   // Precess only this message
	
	ON KEY F5 OF Form_1 ACTION MsgDebug (RemoveEventCodeBlock (nIndex))
	
	MAXIMIZE WINDOW Form_1
	ACTIVATE WINDOW Form_1
	
RETURN
FUNCTION ProcMoveSizeControl()
	LOCAL aEventCodeBlockInfo := GetEventCodeBlockInfo()
	LOCAL hWnd   := aEventCodeBlockInfo [1]
	LOCAL nMsg   := aEventCodeBlockInfo [2]
	LOCAL wParam := aEventCodeBlockInfo [3]
	LOCAL lParam := aEventCodeBlockInfo [4]
	LOCAL nIndex := aEventCodeBlockInfo [5]
	LOCAL aInfo, x, y, cx, cy
	LOCAL flag := .F.
	
	IF nMsg == WM_WINDOWPOSCHANGED
	
		aInfo := WM_WINDOWPOSCHANGED_INFO ( lParam )
		x  := aInfo [1]   // nCol
		y  := aInfo [2]   // nRow
		cx := aInfo [3]   // nWidth
		cy := aInfo [4]   // nHeight
	
		IF x < 10		// AGL
			x := 10
			flag := .T.
		ENDIF
		IF x > 150
			x := 150
			flag := .T.
		ENDIF
	
		IF y < 70		// AGL
			y := 70
			flag := .T.
		ENDIF
		IF y > 150
			y := 150
			flag := .T.
		ENDIF
	
		IF cx > 500
			cx := 500
			flag := .T.
		ENDIF
	
		IF cx < 200
			cx := 200
			flag := .T.
		ENDIF
	
		IF cy > 500
			cy := 500
			flag := .T.
		ENDIF
	
		IF cy < 200
			cy := 200
			flag := .T.
		ENDIF
	
		Form_1.Title := "AT "+HB_NTOS(x)+" , "+HB_NTOS(y)+" SIZE "+HB_NTOS(cx)+" , "+HB_NTOS(cy)
		InvalidateRect( GetParent( hWnd ) )
		
		IF flag == .T.
			SetWindowPos( hWnd, 0, x, y, cx, cy, SWP_NOOWNERZORDER + SWP_NOSENDCHANGING + SWP_DRAWFRAME + SWP_FRAMECHANGED )
			
			//  Como que no cambia las siguientes propiedades...  habrá que hacerlo manualmente ?
			SetProperty( "Form_1", "Grid_1", "ROW", y )
			SetProperty( "Form_1", "Grid_1", "COL", x )
			SetProperty( "Form_1", "Grid_1", "WIDTH", cx )
			SetProperty( "Form_1", "Grid_1", "HEIGHT", cy )

			// RedrawWindow (GetParent (hWnd))
			Return 0
		ENDIF
	
	ELSE
		Form_1.Title := "MSG "+HB_NTOS(nMsg)
	ENDIF
	
Return NIL
FUNCTION CreaGrid( cForm )
	LOCAL aRows := { { 'ONE', 'TWO', 'THREE', 'FOUR' } }
	nCountCtrl++
	cNomCtrl := "GRID_" + STRZERO( nCountCtrl, 4 )
	@ 020 , 000 GRID &cNomCtrl OF &cForm WIDTH 200 HEIGHT 150 HEADERS { 'ONE', 'TWO', 'THREE', 'FOUR' } WIDTHS { 50, 50, 50, 50 } ITEMS aRows VALUE 1
				hWndGrid := Form_1.&cNomCtrl..Handle
				HMG_ChangeWindowStyle( hWndGrid, WS_SYSMENU + WS_CAPTION + WS_SIZEBOX, NIL, .F., .T. )
				SetWindowText( hWndGrid,"Control Grid: "+cNomCtrl )
Return
FUNCTION CreaEditBox( cForm )
	nCountCtrl++
	cNomCtrl := "EB_" + STRZERO( nCountCtrl, 4 )
	@ 020 , 000 EDITBOX &cNomCtrl OF &cForm WIDTH 200 HEIGHT 150 FONT "Verdana" SIZE 9 VALUE "..." MAXLENGTH 230 
				hWndEB := Form_1.&cNomCtrl..Handle
				HMG_ChangeWindowStyle( hWndEB, WS_SYSMENU + WS_CAPTION + WS_SIZEBOX, NIL, .F., .T. )
				SetWindowText( hWndEB,"Control EditBox: " + cNomCtrl )	
Return
FUNCTION CreaDatePicker( cForm )
	nCountCtrl++
	cNomCtrl := "DP_" + STRZERO( nCountCtrl, 4 )
	@ 020 , 000 DATEPICKER &cNomCtrl OF &cForm WIDTH 140 HEIGHT 70 FONT "Verdana" SIZE 9
				hWndDP := Form_1.&cNomCtrl..Handle
				HMG_ChangeWindowStyle( hWndDP, WS_SYSMENU + WS_CAPTION + WS_SIZEBOX, NIL, .F., .T. )
				SetWindowText( hWndDP,"Control Calendar: " + cNomCtrl )	// ??????  no works
Return
FUNCTION Save( cForm )
	LOCAL cCtrls := "ANIMATEBOX.PLAYER.IMAGE.MONTHCAL.DATEPICK.GRID.COMBO.TREE.LIST.TAB.RADIOGROUP.BUTTON.CHECKBOX.BROWSE.EDIT.LABEL."
	*MSGDEBUG( _HMG_aControlNames )		;	MSGDEBUG( _HMG_aControlType )
	Form_1.Grid_1.DeleteAllItems
	AEVAL( _HMG_aControlNames, { | cValue, ind |  ;
	IF( _HMG_aControlType[ind] $ cCtrls  .AND. UPPER( _HMG_aControlNames[ind] ) != "MESSAGE", ( ;		// Hay que ignorar un LABEL="Message"	// ????
	cx:="|"+ STRZERO( GetProperty( cForm, cValue , "ROW"   ) , 4 )+"|"+ STRZERO( GetProperty( cForm, cValue , "COL"   ) , 4 )+"|"+ ;
             STRZERO( GetProperty( cForm, cValue , "WIDTH" ) , 4 )+"|"+ STRZERO( GetProperty( cForm, cValue , "HEIGHT") , 4 )+"|" , ;
 	Form_1.Grid_1.AddItem( { cValue, _HMG_aControlType[ind], ChkPropCtrl( cForm, cValue, ind, _HMG_aControlType[ind] ), cx } ) ), nil ) } ) 
Return
FUNCTION ChkPropCtrl( cForm, cCtrl, ind, cType)
    LOCAL xVal, i1
    IF cType $ "ANIMATEBOX.PLAYER"
        xVal := hb_valtoexp( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "FILE") )
    ELSEIF cType $ "IMAGE"
        xVal := GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "PICTURE")
    ELSEIF cType $ "MONTHCAL.DATEPICK"
        xVal := DTOC( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "VALUE") )
    ELSEIF cType $ "GRID"
		xVal := hb_valtoexp( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "HEADER", 1 ) )+"..."
  		*AEVAL( _HMG_aControlNames,  { | cValue, xind |  xVal += hb_valtoexp( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "HEADER", xind ) )+" - "  } )
        * OJO:  Falta complementar con TODOS los Headers del Grid, un FOR-NEXT
    ELSEIF cType $ "COMBO"
        xVal := GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "DISPLAYVALUE")
    ELSEIF cType $ "TREE.LIST"
        xVal := GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "ITEM", 1 )
    ELSEIF cType $ "TAB"
        xVal := hb_valtoexp( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "ITEM", 1 ) ) // Form_1.Tab_1(1).Grid_1.Value
    ELSEIF cType $ "RADIOGROUP"
        xVal := STR( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "VALUE") )
    ELSEIF cType $ "BUTTON"
        xVal := GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "CAPTION")
    ELSEIF cType $ "CHECKBOX"
        xVal := IF( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "VALUE"), "TRUE", "FALSE" )
    ELSEIF cType $ "BROWSE"
        xVal := "Enc. "+STR( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "HEADER", 1 ) )
	ELSE			// Cualquier otro Control   "EDIT", "LABEL", 
        xVal := hb_valtoexp( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "VALUE") )
    ENDIF

	xVal :=      STRZERO( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "ROW"   ) , 4 )+ ;
			"-"+ STRZERO( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "COL"   ) , 4 )+ ;
			"-"+ STRZERO( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "WIDTH" ) , 4 )+ ;
			"-"+ STRZERO( GetProperty( cForm, ALLTRIM(_HMG_aControlNames[ind] ), "HEIGHT") , 4 )+"|" + xVal
	
RETURN( xVal )
*---------------------------------------------------------------------------------------------------------------------------------------------








*---------------------------------------------------------------------------------------------------------------------------------------------
#pragma BEGINDUMP

#include "SET_COMPILE_HMG_UNICODE.ch"
#include "HMG_UNICODE.h"
#include <windows.h>
#include <tchar.h>
#include <commctrl.h>
#include "hbvm.h"
#include "hbapiitm.h"
#include "hbapi.h"

	HB_FUNC ( WM_WINDOWPOSCHANGED_INFO )
	{
		LPARAM lParam = (LPARAM) HMG_parnl (1);
		if ( lParam )
		{  LPWINDOWPOS lpWindowPos = (LPWINDOWPOS) lParam;
			hb_reta (4);
			hb_storvni (lpWindowPos->x,   -1, 1);
			hb_storvni (lpWindowPos->y,   -1, 2);
			hb_storvni (lpWindowPos->cx,  -1, 3);
			hb_storvni (lpWindowPos->cy,  -1, 4);
		}
	}
	/********************************************************************/
	/*   WindowEventCodeBlock,   by Dr. Claudio Soto,   February 2015   */
	/********************************************************************/
	PHB_ITEM  pArrayEventCodeBlock  = NULL;
	
	HWND      EventCodeBlock_hWnd   = NULL;
	UINT      EventCodeBlock_uMsg   = 0;
	WPARAM    EventCodeBlock_wParam = 0;
	LPARAM    EventCodeBlock_lParam = 0;
	DWORD_PTR EventCodeBlock_nIndex = 0;
	
	typedef struct
	{
		HWND hWnd;
		PHB_ITEM  pCodeBlock;
		PHB_ITEM  pArrayMSG;
	} EventCBData;
	
	//        GetEventCodeBlockInfo () --> array { hWnd, uMsg, wParam, lParam, nIndex }
	HB_FUNC ( GETEVENTCODEBLOCKINFO )
	{
		hb_reta (5);
		HMG_storvnl ((LONG_PTR) EventCodeBlock_hWnd,    -1, 1);
		HMG_storvnl ((LONG_PTR) EventCodeBlock_uMsg,    -1, 2);
		HMG_storvnl ((LONG_PTR) EventCodeBlock_wParam,  -1, 3);
		HMG_storvnl ((LONG_PTR) EventCodeBlock_lParam,  -1, 4);
		HMG_storvnl ((LONG_PTR) EventCodeBlock_nIndex,  -1, 5);
	}
	// Process CodeBlocks of Window Event
	LRESULT CALLBACK SubClassProc (HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam, UINT_PTR uIdSubclass, DWORD_PTR dwRefData)
	{
		UNREFERENCED_PARAMETER (uIdSubclass);
		
		EventCodeBlock_hWnd   = hWnd;
		EventCodeBlock_uMsg   = uMsg;
		EventCodeBlock_wParam = wParam;
		EventCodeBlock_lParam = lParam;
		EventCodeBlock_nIndex = dwRefData;
		
		EventCBData * pEventCBData = (EventCBData *) hb_arrayGetPtr ( pArrayEventCodeBlock, (HB_SIZE) dwRefData );
		
		if ( pEventCBData )
		{
			HB_SIZE nPos = 0;
			if (pEventCBData->pArrayMSG)
			{
				PHB_ITEM pValue = hb_itemNew ( NULL );
				hb_itemPutNI (pValue, (int) uMsg);
				nPos = hb_arrayScan (pEventCBData->pArrayMSG, pValue, NULL, NULL, HB_FALSE);
				hb_itemRelease (pValue);
			}
			else
				nPos = 1;
		
			if (pEventCBData->pCodeBlock && nPos > 0)
			{  PHB_ITEM pItem = hb_vmEvalBlock ( pEventCBData->pCodeBlock );
				if ( pItem && ( hb_itemType (pItem) & HB_IT_NUMERIC ))
				{
					#ifdef _WIN64
					LRESULT nRet = (LRESULT) hb_itemGetNLL (pItem);
					#else
					LRESULT nRet = (LRESULT) hb_itemGetNL  (pItem);
					#endif
					// hb_itemRelease (pItem);
					return nRet;
				}
				else if (pItem)
				{   // hb_itemRelease (pItem);
			}
		}
	}
	return DefSubclassProc(hWnd, uMsg, wParam, lParam);
	}
	//        SetEventCodeBlock ( hWnd, CodeBlock [, nMsg | aMsg ] ) --> nIndex
	HB_FUNC ( SETEVENTCODEBLOCK )
	{
		static UINT_PTR uIdSubclass = 0;
		static DWORD_PTR dwRefData  = 0;
		
		HWND     hWnd       = (HWND) HMG_parnl (1);
		PHB_ITEM pCodeBlock = (HB_ISBLOCK (2) ? hb_itemClone (hb_param (2, HB_IT_BLOCK)) : NULL);
		
		if (IsWindow(hWnd) && pCodeBlock)
		{
			if (pArrayEventCodeBlock == NULL)
				pArrayEventCodeBlock = hb_itemArrayNew (0);
		
			EventCBData * pEventCBData = (EventCBData *) hb_xgrab (sizeof (EventCBData));
		
			PHB_ITEM pArrayMSG  = NULL;
		
			if (HB_ISNUM (3))
			{  pArrayMSG = hb_itemArrayNew (0);
				hb_arrayAddForward (pArrayMSG, hb_itemPutNI (NULL, hb_parni(3)));
			}
			else if (HB_ISARRAY (3) && (hb_parinfa (3,0) > 0))
				pArrayMSG = hb_itemClone (hb_param (3, HB_IT_ARRAY));
		
		/*
			else if (HB_ISARRAY (3))
			{  pArrayMSG = hb_itemClone (hb_param (3, HB_IT_ARRAY));
				if (hb_arrayLen (pArrayMSG) == 0)
				{  hb_itemRelease (pArrayMSG);
					pArrayMSG = NULL;
				}
			}
		*/
			pEventCBData->hWnd       = hWnd;
			pEventCBData->pCodeBlock = pCodeBlock;
			pEventCBData->pArrayMSG  = pArrayMSG;
		
			hb_arrayAddForward (pArrayEventCodeBlock, hb_itemPutPtr (NULL, (void *) pEventCBData));
		
			SetWindowSubclass (hWnd, (SUBCLASSPROC) SubClassProc, ++uIdSubclass, ++dwRefData);
		
			HMG_retnl ((LONG_PTR) uIdSubclass);
	}
		else
			HMG_retnl ((LONG_PTR) 0);
	}
	//        RemoveEventCodeBlock ( nIndex ) --> lBoolean
	HB_FUNC ( REMOVEEVENTCODEBLOCK )
	{
		UINT_PTR uIdSubclass = (UINT_PTR) HMG_parnl (1);
		BOOL lRet = FALSE;
		
		if (pArrayEventCodeBlock && (uIdSubclass > 0) && (uIdSubclass <= (UINT_PTR) hb_arrayLen (pArrayEventCodeBlock)))
		{
			EventCBData * pEventCBData = (EventCBData *) hb_arrayGetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass);
		
			if (pEventCBData && RemoveWindowSubclass (pEventCBData->hWnd, (SUBCLASSPROC) SubClassProc, uIdSubclass))
			{
				if (pEventCBData->pCodeBlock)
					hb_itemRelease (pEventCBData->pCodeBlock);
		
				if (pEventCBData->pArrayMSG)
					hb_itemRelease (pEventCBData->pArrayMSG);
		
				hb_xfree ((void *) pEventCBData);
		
				hb_arraySetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass, NULL);
				lRet = TRUE;
			}
		}
		hb_retl (lRet);
	}

#pragma ENDDUMP
Andrés González López
Desde Guadalajara, Jalisco. México.

Post Reply