WindowEventCodeBlock

Source code related resources

Moderator: Rathinagiri

User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

WindowEventCodeBlock

Post by srvet_claudio »

A new more powerful concept: WindowEventCodeBlock

Code: Select all

#include "hmg.ch"

Function Main

public aRows [21] [3]

   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 800 ;
      HEIGHT 650 ;
      MAIN 

      @  10, 10 Label Label_1 ;
         width 80;
         height 20;
         value "WindowEventCodeBlock: this is beautiful";
         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)"; 
         autosize

      @ 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


      #define WS_BORDER  0x00800000
      #define WS_CAPTION 0x00C00000
      #define WS_SIZEBOX 0x00040000

      hWnd := Form_1.Grid_1.Handle
      HMG_ChangeWindowStyle (hWnd, WS_CAPTION + WS_SIZEBOX, NIL, .F., .T.)
   
      nIndex := SetWindowEventCodeBlock (hWnd, {|| ProcMoveSizeControl() })

      ON KEY F5 OF Form_1 ACTION MsgDebug (RemoveWindowEventCodeBlock (hWnd, 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.

   #define WM_WINDOWPOSCHANGED 0x0047

   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
 
      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)
         // RedrawWindow (GetParent (hWnd))
         Return 0
      ENDIF

   ENDIF

Return NIL



#pragma BEGINDUMP

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


#include <windows.h>
#include <tchar.h>
#include <commctrl.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;


//        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;

   PHB_ITEM pCodeBlock = hb_arrayGetPtr ( pArrayEventCodeBlock, (HB_SIZE) dwRefData );

   if ( pCodeBlock )
   {  PHB_ITEM pItem = hb_vmEvalBlock ( pCodeBlock );
      if ( hb_itemType (pItem) & HB_IT_NUMERIC )
      {   int nRet = hb_itemGetNI (pItem);
          hb_itemRelease (pItem);
          return nRet;
      }
   }

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


//        SetWindowEventCodeBlock ( hWnd, CodeBlock ) --> nIndex
HB_FUNC ( SETWINDOWEVENTCODEBLOCK )
{
   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 (dwRefData == 0)
       pArrayEventCodeBlock = hb_itemArrayNew (0);

   hb_arrayAddForward (pArrayEventCodeBlock, hb_itemPutPtr (NULL, pCodeBlock));

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

   HMG_retnl ((LONG_PTR) uIdSubclass);
}


//        RemoveWindowEventCodeBlock ( hWnd, nIndex ) --> lBoolean
HB_FUNC ( REMOVEWINDOWEVENTCODEBLOCK )
{
   HWND     hWnd        = (HWND)     HMG_parnl (1);
   UINT_PTR uIdSubclass = (UINT_PTR) HMG_parnl (2);
   BOOL lRet = FALSE;

   if (pArrayEventCodeBlock && (uIdSubclass > 0) && (uIdSubclass <= hb_arrayLen (pArrayEventCodeBlock)))
   {  if (RemoveWindowSubclass (hWnd, SubClassProc, uIdSubclass))
      {  PHB_ITEM pCodeBlock = hb_arrayGetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass);
         if (pCodeBlock)
            hb_itemRelease (pCodeBlock);
         hb_arraySetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass, NULL);
         lRet = TRUE;
      }
   }
   hb_retl (lRet);
}


#pragma ENDDUMP
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

WindowEventCodeBlock

Post by Pablo César »

Very nice Claudio !

I have replaced InvalidateRect (GetParent (hWnd)) inside of IF flag == .T. then seems become faster when moving Grid position.

This new event SetWindowEventCodeBlock is to limitation moving and resizing of control. Very nice !

Thank you Claudio !
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: WindowEventCodeBlock

Post by srvet_claudio »

Hi all.
Use this code instead of the previous one, because this version it is portable to 32/64-bit.

Code: Select all


// A new more powerful concept: WindowEventCodeBlock

#include "hmg.ch"

Function Main

public aRows [21] [3]

   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 800 ;
      HEIGHT 650 ;
      MAIN 

      @  10, 10 Label Label_1 ;
         width 80;
         height 20;
         value "WindowEventCodeBlock: this is beautiful";
         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)"; 
         autosize

      @ 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


      #define WS_BORDER  0x00800000
      #define WS_CAPTION 0x00C00000
      #define WS_SIZEBOX 0x00040000

      hWnd := Form_1.Grid_1.Handle
      HMG_ChangeWindowStyle (hWnd, WS_CAPTION + WS_SIZEBOX, NIL, .F., .T.)
   
      nIndex := SetWindowEventCodeBlock (hWnd, {|| ProcMoveSizeControl() })

      ON KEY F5 OF Form_1 ACTION MsgDebug (RemoveWindowEventCodeBlock (hWnd, 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.

   #define WM_WINDOWPOSCHANGED 0x0047

   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
 
      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)
         // RedrawWindow (GetParent (hWnd))
         Return 0
      ENDIF

   ENDIF

Return NIL



#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;


//        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;

   PHB_ITEM pCodeBlock = hb_arrayGetPtr ( pArrayEventCodeBlock, (HB_SIZE) dwRefData );

   if ( pCodeBlock )
   {  PHB_ITEM pItem = hb_vmEvalBlock ( pCodeBlock );
      if ( 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
         hb_itemRelease (pItem);
   }

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


//        SetWindowEventCodeBlock ( hWnd, CodeBlock ) --> nIndex
HB_FUNC ( SETWINDOWEVENTCODEBLOCK )
{
   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 (dwRefData == 0)
       pArrayEventCodeBlock = hb_itemArrayNew (0);

   hb_arrayAddForward (pArrayEventCodeBlock, hb_itemPutPtr (NULL, pCodeBlock));

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

   HMG_retnl ((LONG_PTR) uIdSubclass);
}


//        RemoveWindowEventCodeBlock ( hWnd, nIndex ) --> lBoolean
HB_FUNC ( REMOVEWINDOWEVENTCODEBLOCK )
{
   HWND     hWnd        = (HWND)     HMG_parnl (1);
   UINT_PTR uIdSubclass = (UINT_PTR) HMG_parnl (2);
   BOOL lRet = FALSE;

   if (pArrayEventCodeBlock && (uIdSubclass > 0) && (uIdSubclass <= hb_arrayLen (pArrayEventCodeBlock)))
   {  if (RemoveWindowSubclass (hWnd, SubClassProc, uIdSubclass))
      {  PHB_ITEM pCodeBlock = hb_arrayGetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass);
         if (pCodeBlock)
            hb_itemRelease (pCodeBlock);
         hb_arraySetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass, NULL);
         lRet = TRUE;
      }
   }
   hb_retl (lRet);
}


#pragma ENDDUMP

Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: WindowEventCodeBlock

Post by srvet_claudio »

Pablo César wrote: I have replaced InvalidateRect (GetParent (hWnd)) inside of IF flag == .T. then seems become faster when moving Grid position.
Of course, but the repainting of the parent window is not the same.
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

Re: WindowEventCodeBlock

Post by Javier Tovar »

Al compilar el segundo ejemplo en HMG.3.4.0 Deja de funcionar automaticamente, Win 7 32bits

Y el HMG los dos se ejecutan sin problemas! Win 7 32bits

Saludos
Javier Tovar
Posts: 1275
Joined: Tue Sep 03, 2013 4:22 am
Location: Tecámac, México

Re: WindowEventCodeBlock

Post by Javier Tovar »

Y muy bonitas muestras! Gracias Dr. Claudio!
User avatar
andyglezl
Posts: 1461
Joined: Fri Oct 26, 2012 7:58 pm
Location: Guadalajara Jalisco, MX
Contact:

Re: WindowEventCodeBlock

Post by andyglezl »

Conmigo es aleatorio, a veces funciona y a veces deja de funcionar...
Win 7 / 32 / HMG 3.4
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

WindowEventCodeBlock

Post by Pablo César »

In all my tests when running executable, it's working alternately.

One time is working and in second time not. Subsequently.

Strange behaviour.
Screen2.png
Screen2.png (73.14 KiB) Viewed 5535 times
Running on Win 7 32 bits in Classic and Aero mode (both with runtime error).
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil

WindowEventCodeBlock

Post by Pablo César »

I do not know if this demo is working properly in 64bits (I have no conditions to test it).
srvet_claudio wrote:
Pablo César wrote: I have replaced InvalidateRect (GetParent (hWnd)) inside of IF flag == .T. then seems become faster when moving Grid position.
Of course, but the repainting of the parent window is not the same.
Y que esto influenciaria, Dr. Claudio ?
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: WindowEventCodeBlock

Post by srvet_claudio »

Pablo César wrote:In all my tests when running executable, it's working alternately.

One time is working and in second time not. Subsequently.

Strange behaviour.
Screen2.png
Running on Win 7 32 bits in Classic and Aero mode (both with runtime error).
I'm sorry, It is an elementary problem of converting pointers in C

Code: Select all


// A new more powerful concept: WindowEventCodeBlock

#include "hmg.ch"

Function Main

public aRows [21] [3]

   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 800 ;
      HEIGHT 650 ;
      MAIN 

      @  10, 10 Label Label_1 ;
         width 80;
         height 20;
         value "WindowEventCodeBlock: this is beautiful";
         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)"; 
         autosize

      @ 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


      #define WS_BORDER  0x00800000
      #define WS_CAPTION 0x00C00000
      #define WS_SIZEBOX 0x00040000

      hWnd := Form_1.Grid_1.Handle
      HMG_ChangeWindowStyle (hWnd, WS_CAPTION + WS_SIZEBOX, NIL, .F., .T.)
   
      nIndex := SetWindowEventCodeBlock (hWnd, {|| ProcMoveSizeControl() })

      ON KEY F5 OF Form_1 ACTION MsgDebug (RemoveWindowEventCodeBlock (hWnd, 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.

   #define WM_WINDOWPOSCHANGED 0x0047

   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
 
      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)
         // RedrawWindow (GetParent (hWnd))
         Return 0
      ENDIF

   ENDIF

Return NIL



#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;


//        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;

   PHB_ITEM pCodeBlock = hb_arrayGetPtr ( pArrayEventCodeBlock, (HB_SIZE) dwRefData );

   if ( pCodeBlock )
   {  PHB_ITEM pItem = hb_vmEvalBlock ( 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);
}


//        SetWindowEventCodeBlock ( hWnd, CodeBlock ) --> nIndex
HB_FUNC ( SETWINDOWEVENTCODEBLOCK )
{
   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 (dwRefData == 0)
       pArrayEventCodeBlock = hb_itemArrayNew (0);

   hb_arrayAddForward (pArrayEventCodeBlock, hb_itemPutPtr (NULL, pCodeBlock));

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

   HMG_retnl ((LONG_PTR) uIdSubclass);
}


//        RemoveWindowEventCodeBlock ( hWnd, nIndex ) --> lBoolean
HB_FUNC ( REMOVEWINDOWEVENTCODEBLOCK )
{
   HWND     hWnd        = (HWND)     HMG_parnl (1);
   UINT_PTR uIdSubclass = (UINT_PTR) HMG_parnl (2);
   BOOL lRet = FALSE;

   if (pArrayEventCodeBlock && (uIdSubclass > 0) && (uIdSubclass <= hb_arrayLen (pArrayEventCodeBlock)))
   {  if (RemoveWindowSubclass (hWnd, (SUBCLASSPROC) SubClassProc, uIdSubclass))
      {  PHB_ITEM pCodeBlock = hb_arrayGetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass);
         if (pCodeBlock)
            hb_itemRelease (pCodeBlock);
         hb_arraySetPtr (pArrayEventCodeBlock, (HB_SIZE) uIdSubclass, NULL);
         lRet = TRUE;
      }
   }
   hb_retl (lRet);
}


#pragma ENDDUMP
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
Post Reply