VALID EN DIALOGO NOWAIT NO funciona con telca ESC (Soluciona

[miarcod]

Hola,
Sigo comprobando el motivo por el que la tecla Esc me cierra los dialogos y he descubierto que el valid no funciona cuando se pulsa la tecla escape

Pongo ejemplo. En este ejemplo, si cierro el dialogo con el raton pulsado el boton de cerrar la comprobación de finalización del diálogo funciona correctamente,
sin embargo si pulso la tecla escape, da igual lo que le responda a la pregunta de validacion del dialogo y siempre se cierra

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

STATIC oWnd

//----------------------------------------------------------------------------//
function Main()
//Local oWnd

DEFINE WINDOW oWnd FROM 0,0 TO 600,800 PIXEL TITLE "Prueba" ;
       MENU BuildMenu(oWnd)

ACTIVATE  WINDOW ownd ON INIT oWnd:Center()
return nil

//----------------------------------------------------------------------------//
STATIC FUNCTION BuildMENU()
LOCAL OMENU
MENU  oMenu
   MENUITEM "Prueba" ACTION Prueba2()
   MENUITEM "Salir"  ACTION oWnd:End()
ENDMENU
RETURN oMenu

//----------------------------------------------------------------------------//
STATIC FUNCTION Prueba2(oWnd)
Local oChild, oDlg, oFld


DEFINE DIALOG oDlg  SIZE 640, 480 PIXEL;
       COLOR NIL, CLR_HGREEN ;
       TITLE "Folder en dialogo" ;
       OF oWnd

@ 1, 1 FOLDER oFld PROMPTS "Folder1", "Folder2" OF oDlg;
       SIZE 200,200

ACTIVATE DIALOG oDlg NOWAIT VALID MsgYesNo("¿Salir?")

RETURN NIL

 

Será algo de mi versión de FIVEWIN

fivewin 13.06
harbour 3.2.0dev (r1307082134)
bcc7

[cnavarro]

Prueba a poner al principio de la function Main()

Code: Select all  Expand view  RUN

SetDialogEsc( .F. )
 

[miarcod]

gracias. pero no funciona

[cnavarro]

Acabo de probar tu ejemplo, tal cual, con la version actual y ejecuta el Valid

[carlos vargas]

prueba por favor.

llama a OverrideAndExtend() al inicio de tu aplicacion.
en caso que uses harbour deberas inclur la lib xhb.lib

Code: Select all  Expand view  RUN

   ACTIVATE DIALOG oDlgMenu CENTER NOWAIT VALID ( oFntTitle:END(), !GetKeyState( VK_ESCAPE ) )
 

Code: Select all  Expand view  RUN

// esto antes del inicio de tu app, es para incluir un archivo de cabezera solo en caso que uses harbour
#ifdef __HARBOUR__
   #ifndef __XHARBOUR__
      #include "xhb.ch"
      #include "xhbcls.ch"
      #stdout Compilando con HARBOUR compiler, incluye compatibiidad con XHARBOUR.
   #else
      #stdout Compilando con XHARBOUR compiler.
   #endif
#endif

PROCEDURE OverrideAndExtend()

   OVERRIDE METHOD GetDlgCode IN CLASS TButton WITH KGetDlgCode

RETURN

/*-------------------------------------------------------------------------------------------------*/

FUNCTION KGetDlgCode( nLastKey )
   LOCAL Self := HB_QSelf()

   ::oWnd:nLastKey := nLastKey

   DO CASE
   CASE ::oWnd:oWnd != NIL .and. ( ::oWnd:oWnd:IsKindOf( "TFOLDER"   ) .or. ;
                                   ::oWnd:oWnd:IsKindOf( "TFOLDEREX" ) .or. ;
                                   ::oWnd:oWnd:IsKindOf( "TPAGES" )  )
      RETURN DLGC_WANTALLKEYS
   CASE nLastKey == VK_ESCAPE .and. ::oWnd:oWnd != NIL .and. ( ::oWnd:oWnd:IsKindOf( "TWINDOW" ) .and. ::oWnd:IsKindOf( "TDIALOG" ) )
      RETURN DLGC_WANTALLKEYS
   ENDCASE

RETURN NIL
 

[karinha]

No funciona con xHarbour y FWXH17.01

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

STATIC oWnd, lSalir := .F.

//----------------------------------------------------------------------------//
function Main()

   SetDialogEsc( .F. )

   OverrideAndExtend()

   DEFINE WINDOW oWnd FROM 0,0 TO 600,800 PIXEL TITLE "Prueba" ;
          MENU BuildMenu(oWnd)

   ACTIVATE  WINDOW ownd ON INIT oWnd:Center()

return nil

//----------------------------------------------------------------------------//
STATIC FUNCTION BuildMENU()

   LOCAL OMENU

   MENU  oMenu
      MENUITEM "Prueba" ACTION Prueba2()
      MENUITEM "Salir"  ACTION oWnd:End()
   ENDMENU

RETURN oMenu

//----------------------------------------------------------------------------//
STATIC FUNCTION Prueba2(oWnd)

   Local oChild, oFld, oDlg

   DEFINE DIALOG oDlg  SIZE 640, 480 PIXEL;
          COLOR NIL, CLR_HGREEN ;
          TITLE "Folder en dialogo" ;
          OF oWnd

   @ 1, 1 FOLDER oFld PROMPTS "Folder1", "Folder2" OF oDlg;
          SIZE 200,200

   @ 12.5, 8 BUTTON "&Cancel" OF oDlg ;
           ACTION( lSalir := .T.,  oDlg:End() ) CANCEL

   // no funciona con xHarbour
   // ACTIVATE DIALOG oDlg NOWAIT VALID( lSalir )

   // no funciona con xHarbour
   ACTIVATE DIALOG oDlg NOWAIT VALID ( !GetKeyState( VK_ESCAPE ) )

   // VALID MsgYesNo("¿Salir?")

RETURN NIL

PROCEDURE OverrideAndExtend()

   OVERRIDE METHOD GetDlgCode IN CLASS TButton WITH KGetDlgCode

RETURN

/*-------------------------------------------------------------------------------------------------*/

FUNCTION KGetDlgCode( nLastKey )
   LOCAL Self := HB_QSelf()

   ::oWnd:nLastKey := nLastKey

   DO CASE
   CASE ::oWnd:oWnd != NIL .and. ( ::oWnd:oWnd:IsKindOf( "TFOLDER"   ) .or. ;
                                   ::oWnd:oWnd:IsKindOf( "TFOLDEREX" ) .or. ;
                                   ::oWnd:oWnd:IsKindOf( "TPAGES" )  )
      RETURN DLGC_WANTALLKEYS
   CASE nLastKey == VK_ESCAPE .and. ::oWnd:oWnd != NIL .and. ( ::oWnd:oWnd:IsKindOf( "TWINDOW" ) .and. ::oWnd:IsKindOf( "TDIALOG" ) )
      RETURN DLGC_WANTALLKEYS
   ENDCASE

RETURN NIL
 

[Rick Lipkin]

Miarcod

Here is a VERY simple solution :

Code: Select all  Expand view  RUN

ACTIVATE DIALOG oDlg ;
               VALID (!GETKEYSTATE( 27 ))  // do not allow esc key here
 

or in a Mdi

Code: Select all  Expand view  RUN

   ACTIVATE DIALOG oDlg NOWAIT ;
        VALID (!GETKEYSTATE( 27 ))  // do not allow esc key here
 

Rick Lipkin

[karinha]

Miarcod

Here is a VERY simple solution :

Code: Select all  Expand view  RUN

ACTIVATE DIALOG oDlg ;
               VALID (!GETKEYSTATE( 27 ))  // do not allow esc key here
 

or in a Mdi

Code: Select all  Expand view  RUN

   ACTIVATE DIALOG oDlg NOWAIT ;
        VALID (!GETKEYSTATE( 27 ))  // do not allow esc key here
 

Rick Lipkin

Rick con NOWAIT, no funciona. mismo siendo MDI. regards, saludos.

[miarcod]

Gracias a todos

No consigo implementar la soucion de Carlos Vargas

Al intentar compilar el codigo

Code: Select all  Expand view  RUN

PROCEDURE OverrideAndExtend()

   OVERRIDE METHOD GetDlgCode IN CLASS TButton WITH KGetDlgCode

RETURN

Me arrroja error

Code: Select all  Expand view  RUN

Harbour 3.2.0dev (r1307082134)
Copyright (c) 1999-2013, http://harbour-project.org/
Compiling 'PRG_INI.PRG'...
PRG_INI.PRG(53) Error E0030  Syntax error "syntax error at 'METHOD'"
1 error

No code generated.
 

No encuentro los ficheros de cabecera

xhb.ch (este si lo encuentro en una version anterior de habror la 8.0.1 (Rev 9429)
xhbcls.ch

[karinha]

Code: Select all  Expand view  RUN

/*
 * Header file for cross-compatibility with xhb
 *
 * Copyright 1999-2007 {list of individual authors and e-mail addresses}
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.txt.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA (or visit the web site https://www.gnu.org/).
 *
 * As a special exception, the Harbour Project gives permission for
 * additional uses of the text contained in its release of Harbour.
 *
 * The exception is that, if you link the Harbour libraries with other
 * files to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the Harbour library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the Harbour
 * Project under the name Harbour.  If you copy code from other
 * Harbour Project or Free Software Foundation releases into a copy of
 * Harbour, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for Harbour, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 *
 */

#ifndef XHB__CH_
#define XHB__CH_

#include "hbcompat.ch"

#ifdef __HARBOUR__

#ifndef __XHARBOUR__
   #pragma -ks+
   #pragma -kd+
   REQUEST xhb_Lib

   #xtranslate __Keyboard( [<x,...>] )           => xhb__Keyboard( <x> )
   #xtranslate __CopyFile( [<x,...>] )           => xhb_CopyFile( <x> )

   #xuntranslate AIns(                           =>
   #xuntranslate ADel(                           =>

   #xtranslate AIns( <a>, <n>, [<x,...>] )       => xhb_AIns( <a>, <n>, <x> )
   #xtranslate ADel( <a>, <n>, <l> )             => xhb_ADel( <a>, <n>, <l> )

   #xuntranslate NetName(                        =>
   #xuntranslate MemoWrit(                       =>

   #xtranslate NetName( [<x,...>] )              => xhb_NetName( <x> )
   #xtranslate MemoWrit( [<x,...>] )             => xhb_MemoWrit( <x> )

   #xtranslate SaveScreen( [<x,...>] )           => xhb_SaveScreen( <x> )
   #xtranslate RestScreen( [<x,...>] )           => xhb_RestScreen( <x> )
   #xtranslate RTrim( [<x,...>] )                => xhb_RTrim( <x> )
   #xtranslate Trim( [<x,...>] )                 => xhb_Trim( <x> )
   #xtranslate AllTrim( [<x,...>] )              => xhb_AllTrim( <x> )

   /* _SET_TRACE* / TraceLog() */
   #xtranslate Set( _SET_TRACE [,<x,...>] )      => xhb_SetTrace( <x> )
   #xtranslate Set( _SET_TRACEFILE [,<x,...>] )  => xhb_SetTraceFile( <x> )
   #xtranslate Set( _SET_TRACESTACK [,<x,...>] ) => xhb_SetTraceStack( <x> )

#endif

#endif /* __HARBOUR__ */

#endif /* XHB__CH_ */
 

[karinha]

Code: Select all  Expand view  RUN

/*
 * Header file for cross-compatibility with xhb class code extensions
 *
 * Warning: using this functionality may break logical inheritance
 *          scheme or even some internal class definitions in both
 *          Harbour and xHarbour compilers. In Harbour it's unsupported
 *          feature added here only for strict XHB compatibility.
 *
 * Copyright 2009 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.txt.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA (or visit the web site https://www.gnu.org/).
 *
 * As a special exception, the Harbour Project gives permission for
 * additional uses of the text contained in its release of Harbour.
 *
 * The exception is that, if you link the Harbour libraries with other
 * files to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the Harbour library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the Harbour
 * Project under the name Harbour.  If you copy code from other
 * Harbour Project or Free Software Foundation releases into a copy of
 * Harbour, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for Harbour, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 *
 */

#ifndef XHB_CLS__CH_
#define XHB_CLS__CH_

#ifdef __HARBOUR__

#ifndef __XHARBOUR__

   #include "hboo.ch"

   #xtranslate __xhb_cls_scope( <scope>, .T. ) => <scope> + HB_OO_CLSTP_PERSIST
   #xtranslate __xhb_cls_scope( <scope>, .F. ) => <scope>
   #xtranslate __xhb_cls_scope( , .T. ) => HB_OO_CLSTP_PERSIST
   #xtranslate __xhb_cls_scope( , .F. ) =>

   #xcommand OVERRIDE METHOD <!Message!> [IN] CLASS <!Class!> ;
                             WITH [METHOD] <!Method!> [SCOPE <Scope>] => ;
            __clsModMsg( <Class>():classH, #<Message>, @<Method>() )


   #xcommand EXTEND CLASS <!Class!> WITH <data: DATA, VAR> <!VarName!> ;
                          [SCOPE <scope>] [<persist: PERSISTENT>] ;
                          [<case: NOUPPER>] => ;
            __clsAddMsg( <Class>():classH, #<VarName>, ;
                         __cls_IncData( <Class>():classH ), ;
                         HB_OO_MSG_PROPERTY, NIL, ;
                         __xhb_cls_scope( <scope>, <.persist.> ) )


   #xcommand EXTEND CLASS <!Class!> WITH METHOD <!Method!> [SCOPE <scope>] ;
                          [<persist: PERSISTENT>] [<case: NOUPPER>] => ;
            __clsAddMsg( <Class>():classH, #<Method>, @<Method>(), ;
                         HB_OO_MSG_METHOD, NIL, ;
                         __xhb_cls_scope( <scope>, <.persist.> ) )


   #xcommand EXTEND CLASS <!Class!> WITH MESSAGE <!Message!> METHOD <!Method!> ;
                          [SCOPE <scope>] [<persist: PERSISTENT>] ;
                          [<case: NOUPPER>] => ;
            __clsAddMsg( <Class>():classH, #<Message>, @<Method>(), ;
                         HB_OO_MSG_METHOD, NIL, ;
                         __xhb_cls_scope( <scope>, <.persist.> ) )


   #xcommand EXTEND CLASS <!Class!> WITH MESSAGE <!Message!> INLINE <code,...> ;
                          [SCOPE <scope>] [<persist: PERSISTENT>] ;
                          [<case: NOUPPER>] => ;
            __clsAddMsg( <Class>():classH, #<Message>, ;
                         {| Self | HB_SYMBOL_UNUSED( Self ), <code> }, ;
                         HB_OO_MSG_INLINE, NIL, ;
                         __xhb_cls_scope( <scope>, <.persist.> ) )


   #xcommand EXTEND CLASS <!Class!> WITH MESSAGE <Message>( <params,...> ) ;
                          INLINE <code,...> ;
                          [SCOPE <scope>] [<persist: PERSISTENT>] ;
                          [<case: NOUPPER>] => ;
            __clsAddMsg( <Class>():classH, #<Message>, ;
                         {| Self, <params> | HB_SYMBOL_UNUSED( Self ), <code> }, ;
                         HB_OO_MSG_INLINE, NIL, ;
                         __xhb_cls_scope( <scope>, <.persist.> ) )


#endif /* __XHARBOUR__ */

#endif /* __HARBOUR__ */

#endif /* XHB_CLS__CH_ */
 

[Armando]

Miarcod:

Tal vez así?

Code: Select all  Expand view  RUN

    ACTIVATE DIALOG oDlg CENTERED VALID ! GetASyncKey(VK_ESCAPE)
 

Con esto evitas que se cierre el dialogo y obligas al usuario a usar el botón o la
espantosa X

Saludos

[Rick Lipkin]

Miarcod:

For Mdi .. the key is to lock the dialog with the mdi child .. Here is the solution to keep the ESC key from executing within a mdi child.

// lock the dialog with the MdiChild
ON INIT ( oDlg:Move( 0,0, oWndchild:nWidth, oWndchild:nHeight, .T. )

Rick Lipkin

Code: Select all  Expand view  RUN

DEFINE ICON oICO RESOURCE "CROWN"

DEFINE WINDOW oWndChild     ;
       MDICHILD             ;
       NOZOOM               ;
       NOMINIMIZE           ;
       FROM 0,1 to 32,98    ;
       ICON oICO            ;
       OF oWnd              ;
       TITLE cTitle

DEFINE DIALOG oDlg RESOURCE "DRVRBROW" of oWndChild

       REDEFINE xBROWSE oLBX             ;
       RECORDSET oRsDrv                  ;
       COLUMNS "LNAME",                  ;
               "FNAME",                  ;
               "DISPATCHDRIVER",         ;
               "MTRPOOL",                ;
               "ACTIVE",                 ;
               "AVAILABLE"               ;
       COLSIZES 150,150,80,80,80,80      ;
       HEADERS "Lname",                  ;
               "Fname",                  ;
               "Dispatch Drvr",          ;
               "MtrPool",                ;
               "Active",                 ;
               "Is Available"            ;
       ID 111 of oDlg                    ;
       AUTOSORT AUTOCOLS LINES CELL

   oLbx:lHScroll := .f. // turn off horiz scroll bar
   oLbx:nMarqueeStyle := MARQSTYLE_HIGHLROW
   oLbx:lRecordSelector := .f.

   oLbx:SetGroupHeader( 'Dispatch Information', 3, 6 )

   oLbx:lFooter   := .t.
   oCol           := oLbx:aCols[ 1 ]
   oCol:bFooter   := { || Ltrim( Str( oLbx:KeyNo() ) ) + " / " + LTrim( Str( oLbx:KeyCount() ) ) }
   oLbx:bChange   := { || oCol:RefreshFooter() }


   oLbx:bClrGrad := { | lInvert | If( ! lInvert, ;
                    { { 0.50, 15790320, 15790320 }, ;
                    { 0.50,   15790320, 15790320 } }, ;
                    { { 0.50, 15790320, 15790320 }, ;
                    { 0.50,   15790320, 15790320 } } ) }

 
    oLbx:bLDblClick := { |nRow,nCol | _Drvrview( "V",oRsDrv,oBtn1,oBtn2,oBtn3,oBtn4,oBtn5 ) }
    _BrowColor( oLbx )

   REDEFINE BTNBMP oBTN1 ID 113           ;
       RESOURCE "ADD16","DADD16","DADD16" ;
       PROMPT "&Add" LEFT 2007;
       ACTION ( _Drvrview("A",oRsDrv,oBtn1,oBtn2,oBtn3,oBtn4,oBtn5 ),; // add
                          oLBX:ReFresh(),( oLbx:SetFocus(), .F. ) ) ;
       GRADIENT GreyButtonGrad()

   REDEFINE BTNBMP oBTN2 ID 114           ;
   RESOURCE "EDIT16","DEDIT16","DEDIT16"    ;
       PROMPT "&Edit" LEFT 2007;
       ACTION ( _Drvrview("E",oRsDrv,oBtn1,oBtn2,oBtn3,oBtn4,oBtn5 ),; // edit
                oLBX:ReFresh(),( oLbx:SetFocus()) );
       GRADIENT GreyButtonGrad()

   REDEFINE BTNBMP oBTN3 ID 115            ;
       RESOURCE "VIEW16","DVIEW16","DVIEW16" ;
       PROMPT "&View" LEFT 2007;
       ACTION ( _Drvrview("V",oRsDrv,oBtn1,oBtn2,oBtn3,oBtn4,oBtn5 ),; // view
                oLBX:ReFresh(),( oLbx:SetFocus(), .F. ) ) ;
       GRADIENT GreyButtonGrad()



    ACTIVATE DIALOG oDlg NOWAIT ;
                  VALID (!GETKEYSTATE( 27 ))  // do not allow esc key here

ACTIVATE WINDOW oWndChild ;
   ON INIT ( oDlg:Move( 0,0, oWndchild:nWidth, oWndchild:nHeight, .T. ),oLbx:SetFocus(), ;
                 oDlg:refresh(.t.),oLbx:SetFocus());
                 VALID ( IF( !lOK, _ExitPgm(.T., oRsDrv,oWndChild,@lOk ), .F. ))


RETURN( .T. )


 

[miarcod]

He agregado las clases

WINDOW
DIALOG

Para intentar interceptar la pulsacion de la tecla ESCAPE pero no consiguo detectarla en ninguno de los métodos

[miarcod]

Sigo investigando y he descubierto que este comportamiento se produce cuando el dialogo tiene un folder. Si el dialogo NO TIENE FOLDER el valid se ejectua correctamente.

Pongo un ejemplo

Code: Select all  Expand view  RUN

#include "fivewin.ch"

function main()
Local oWnd, odlg

DEFINE  WINDOW oWnd FROM 0,0 TO 400, 800 PIXEL;
        TITLE "Prueba" ;//MDI ;
        MENU MiMenu(oWnd)

oWnd:bLClicked := { || Prueba1(oWnd) }
oWnd:bRClicked := { || Prueba2(oWnd) }

ACTIVATE WINDOW oWnd ON INIT (oWnd:Center(), .f.)
return nil

STATIC FUNCTION MiMenu(oWnd)
Local oMnu
   MENU oMnu
       MENUITEM "Pruebas"
          MENU
             MENUITEM "Prueba con folder" ACTION Prueba1(oWnd)
             MENUITEM "Prueba sin folder" ACTION Prueba2(oWnd)
         ENDMENU
   ENDMENU

RETURN oMnu


STATIC FUNCTION Prueba1(oWnd)
Local oDlg, oFld

DEFINE DIALOG oDlg TITLE "Dialogo"

@ 1,1 FOLDER oFld  OF oDlg

ACTIVATE DIALOG oDlg NOWAIT CENTER;
         VALID MsgYesNo("Salir")
RETURN NIL



STATIC FUNCTION Prueba2(oWnd)
Local oDlg

DEFINE DIALOG oDlg TITLE "Dialogo"

ACTIVATE DIALOG oDlg NOWAIT CENTER;
         VALID MsgYesNo("Salir")
RETURN NIL

 

¿Alguna sugerencia?