FiveTech Support Forums

#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

SetDialogEsc( .F. )

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

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

#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

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

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

PROCEDURE OverrideAndExtend()

   OVERRIDE METHOD GetDlgCode IN CLASS TButton WITH KGetDlgCode

RETURN

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.

/*
 * 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 <!-- m --><a class="postlink" href="https://www.gnu.org/">https://www.gnu.org/</a><!-- m -->).
 *
 * 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_ */

/*
 * 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 <!-- m --><a class="postlink" href="https://www.gnu.org/">https://www.gnu.org/</a><!-- m -->).
 *
 * 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_ */

    ACTIVATE DIALOG oDlg CENTERED VALID ! GetASyncKey(VK_ESCAPE)

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. )

#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