Dr. Claudio, como que la función "SetWindowPos()" no actualiza las propiedades de ROW, COL, WIDTH, HEIGHT
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