Ejemplo de un mantenimiento con vtna no modal

Ejemplo de un mantenimiento con vtna no modal

Postby artu01 » Tue Oct 25, 2016 6:55 pm

Gente:

Podrian ayudarme con dos cositas.

1.Proporcionar un ejemplo de un browse que haga un mantenimiento(ABC) sobre una ventana de dialogo no modal

2. Invocar al browse anterior desde un get (me interesa la parte de traer al get los datos de la fila seleccionada en el browse)


Si el browse estuviese montado sobre una ventana modal si puedo capturar los datos, pero cuando es una ventana no modal no logro
traer los datos al get

Mil Gracias
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
artu01
 
Posts: 397
Joined: Fri May 11, 2007 8:20 pm
Location: Lima

Re: Ejemplo de un mantenimiento con vtna no modal

Postby armando.lagunas » Tue Oct 25, 2016 9:36 pm

Buen día:

Este es un ejemplo, "en el cual te puedes orientar", que tengo con una pantalla no modal, con agregado, edición, Eliminación, Impresión y Traspaso a excel de un maestro de clientes.

Code: Select all  Expand view

//------------------------------------------------------------------------
//---- Programa           :                             [ Client.prg ]  --
//---- Contenido          :                    [ Maestro de Clientes ]  --
//------------------------------------------------------------------------

#include "TSBrow60.ch"
#include "FiveWin.ch"
#include "FileXLS.ch"
#include "splitter.Ch"
#include "Report.ch"
#include "BtnGet.ch"

STATIC oTree, oItem, cRecor, nIni, lBor
STATIC aPro , tImp, pUni, tCom, tIva, Tota, Flet, cBod

//-----------------
FUNCTION Clientes()
LOCAL oDlg, oFol, oPun, oBrw, oSpl, oSay, xSay, oFon, oChk
LOCAL oBmp, cBmp, oTab, oLbx, oMet, lSw , yLbx, Met2

SELECT PA04    ; ZAP
SELECT PA02    ; ZAP
lBor           := .F.
oItem          := ARRAY(2)
cRecor         := ""
xSay           := {NIL,NIL,NIL,0,NIL,0,NIL,0,NIL,0,NIL,NIL}
nIni           := 0
lSw            := .F.

DEFINE FONT   oFon NAME "Tahoma" SIZE 0,-12 BOLD
DEFINE CURSOR oPun RESOURCE "MANO"

DEFINE DIALOG oDlg RESOURCE 81 TITLE "Registro de Clientes"

     SELECT CLIE    ; SET ORDER TO 3          ; DBGOTOP()
     REDEFINE BROWSE  oBrw                                                                  ;
            FIELDS  CLIE->CODIGO, CLIE->RUT, CLIE->NOMBRE                                   ;
            HEADERS "Código","Rut","Nombre del Cliente"                                     ;
            ALIAS "CLIE"                                                                    ;
            COLOR nRGB(  0, 90,157), nRGB(255,255,237)                                      ;
            SIZES 70,80,450                                                                 ;
            ID 13 CURSOR oPun OF oDlg GRID

            oBrw:SetColor( { 3, 5, 6, 9, 11, 12, 15 }, { GetSysColor(7), CLR_YELLOW, {CLR_HBLUE, CLR_BLUE}, GetSysColor(7), CLR_GRAY , {CLR_WHITE, CLR_GRAY} , CLR_NBLUE } )
            oBrw:nFreeze       := 1
            oBrw:bLDblClick    := { |nRow, nCol| Editar(oBrw, .f.) }
            oBrw:nHeightHead   += 9
            oBrw:nLineStyle    := LINES_ALL
            oBrw:lNoHScroll    := .t.
            oBrw:bChange       := { || Recor( oSay ) }
            oBrw:nClrText      := { || IIF(CLIE->ACTIVO = .F. ,nRGB(255,196,196)  , nRGB(  0, 90,157) ) }

            oBrw:bKeyChar      := {|nKey| iif(nKey==13,Editar(oBrw, .f.) ,MsgBeep() )}

      REDEFINE TABS oTab      ID 15 PROMPT "A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","Todos" ;
            ACTION Filtro(oTab:nOption, oBrw) OPTION 1 OF oDlg

            oTree := TTreeView():ReDefine( 14, oDlg,,, .T. , )
            oTree:blDblClick  := { || IIF(SUBSTR(oTree:GetSelText(),1,1) = "<", Act_Tree(SUBSTR(oTree:GetSelText(),2,2), oBrw,oTree:GetSelText() ), MsgBeep() ), oBrw:Refresh() }

     REDEFINE SPLITTER oSpl ID 129 VERTICAL PREVIOUS CONTROLS oTree HINDS CONTROLS oBrw  LEFT MARGIN  70 RIGHT MARGIN 200 OF oDlg _3DLOOK UPDATE

     REDEFINE SAY oSay VAR cRecor         ID 10 PICTURE "@K" COLOR GetSysColor(7) OF oDlg

     REDEFINE BTNBMP ID 500 OF oDlg RESOURCE   83 NOBORDER TOOLTIP " Ingresar Cliente "      ACTION Editar(oBrw, .t.)     WHEN EVAL({|| ( CLAV->S001 = "41TYR" ) })
     REDEFINE BTNBMP ID 502 OF oDlg RESOURCE   81 NOBORDER TOOLTIP " Modifica Cliente "      ACTION Editar(oBrw, .f.)     WHEN EVAL({|| ( CLAV->S002 = "5985P" ) })
     REDEFINE BTNBMP ID 501 OF oDlg RESOURCE   48 NOBORDER TOOLTIP " Eliminar Cliente "      ACTION Borrar(oBrw)               WHEN EVAL({|| ( CLAV->S003 = "GT565" ) })
     REDEFINE BTNBMP ID 503 OF oDlg RESOURCE 1187 NOBORDER TOOLTIP " Buscar Cliente "        ACTION BuscarClientes(oBrw, oTab) WHEN EVAL({|| ( CLAV->S006 = "P90W1" ) })
     REDEFINE BTNBMP ID 505 OF oDlg RESOURCE   42 NOBORDER TOOLTIP " Trasladar a MS-Excel® " ACTION TrasladarExcel(oBrw)       WHEN EVAL({|| ( CLAV->S007 = "MTYEA" ) })


  REDEFINE BUTTON                    ID 101 OF oDlg ACTION ( oFon:End(), oDlg:End() ) UPDATE

ACTIVATE DIALOG oDlg ON INIT ( Filtro(1, oBrw), IIF(!SndPlaySound(".\SYSTEM\OPEN.WAV",1),MsgBeep(),), Carga(), .T. ) CENTER NOMODAL
oFon:End()
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION Editar( oBrw, cAppend )
LOCAL cCod, cRut, cNom, cSig, cDir, cCiu, cGir, cFon, cFax, Mail, cDia, cAct, cApe
LOCAL xGet, xDlg, oChk, oSay, cRot, cCon

xGet := {NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL}

IF !cAppend ; SELECT CLIE ; cCod := CLIE->CODIGO      ; cRut := CLIE->RUT      ; cNom := CLIE->NOMBRE
                            cDir := CLIE->DIRECCION   ; cGir := CLIE->GIRO     ; cCiu := CLIE->CIUDAD
                            cSig := CLIE->SIGLA       ; cFax := CLIE->FAX      ; cDia := CLIE->DIAS
                            Mail := CLIE->CORREO      ; cFon := CLIE->FONO     ; cAct := CLIE->ACTIVO
                            cApe := CLIE->APERTURA    ; cRot := CLIE->ROTACION ; cCon := CLIE->CONTACTO
ELSE        ; SELECT CLIE ; cCod := STRTRAN(STR((RecCount()+1),5,0)," ","0")   ; cApe := DATE()
                            cRut := SPACE(10)         ; cNom := SPACE(40)      ; cDir := SPACE(40)
                            cGir := SPACE(40)         ; cCiu := SPACE(20)      ; cSig := SPACE(20)
                            cFax := SPACE(20)         ; cDia := 0              ; cFon := SPACE(20)
                            Mail := SPACE(30)         ; cAct := .T.            ; cRot := 0
                            cCon := SPACE(30)
ENDIF

DEFINE DIALOG xDlg RESOURCE 245 TITLE IIF(cAppend,"Ingresar","Modificar")

   REDEFINE CHECKBOX   oChk VAR cAct                 ID 113                           OF xDlg

   IF cAppend        ; REDEFINE GET xGet[1] VAR cCod ID 9150 PICTURE "XXXXX" VALID( EstaClie(cCod) )                 OF xDlg
   ELSE              ; REDEFINE GET xGet[1] VAR cCod ID 9150 PICTURE "XXXXX" COLOR nRGB(0,64,128), nRGB(255,255,196) OF xDlg READONLY
   ENDIF

   REDEFINE SAY oSay    PROMPT "Creado el : "+DTOC(cApe) ID 10 OF xDlg COLOR GetSysColor(7)

   REDEFINE GET xGet[02] VAR cRut ID 9151  PICTURE "#XXXXXXXXX" VALID( ValRut(cRut) ) OF xDlg WHEN {|| MyColorGet( xGet[02] ) }
   REDEFINE GET xGet[03] VAR cNom ID 9152  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[03] ) }
   REDEFINE GET xGet[04] VAR cSig ID 9156  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[04] ) }
   REDEFINE GET xGet[05] VAR cDir ID 9153  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[05] ) }
   REDEFINE GET xGet[06] VAR cCiu ID 9155  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[06] ) }
   REDEFINE GET xGet[07] VAR cGir ID 9154  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[07] ) }
   REDEFINE GET xGet[08] VAR cFon ID 9157  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[08] ) }
   REDEFINE GET xGet[09] VAR cFax ID 9158  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[09] ) }
   REDEFINE GET xGet[10] VAR Mail ID   13  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[10] ) }
   REDEFINE GET xGet[13] VAR cCon ID   15  PICTURE "@K"                               OF xDlg WHEN {|| MyColorGet( xGet[13] ) }

   REDEFINE BUTTON ID 14 OF xDlg ACTION IIF(Grabar(cCod, cRut, cNom, cDir, cGir, cCiu, cSig, cFon, cFax, cDia, Mail, cAct, cAppend, cApe, cRot, cCon), xDlg:End(),NIL)
   REDEFINE BUTTON ID 16 OF xDlg ACTION xDlg:End()

ACTIVATE DIALOG xDlg CENTERED

oBrw:UpStable()
oBrw:Refresh()
oBrw:SetFocus()
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION EstaClie( cCod )
LOCAL cVal := .F.,nReg, cInd := CLIE->(IndexOrd())
IF cCod <>  "     "
   SELECT CLIE ; nReg := RECNO() ; SET ORDER TO 1
   SEEK cCod
   IF !EOF()   ; MsgAlert("Esta codificación ya se encuentra registrada...","Existe en la Tabla Maestra") ; cVal := .F.
   ELSE        ; cVal := .T.
   END         ; GO nReg
ELSE           ; cVal := .T.
ENDIF
SELECT CLIE    ; SET ORDER TO cInd
RETURN cVal
//-------------------------------------------------------------------------
STATIC FUNCTION Grabar(cCod, cRut, cNom, cDir, cGir, cCiu, cSig, cFon, cFax, cDia, Mail, cAct, cAppend, cApe, cRot, cCon )
LOCAL mPro, nPos, mRut, mDig, nInd := CLIE->(IndexOrd())
nPos := RAT("-",cRut)
mRut := SUBSTR(cRut,1,( nPos - 1 ))
mDig := SUBSTR(cRut,( nPos + 1 ),1)
mRut := STUFF(mRut,1,0,STRTRAN(SPACE((9-nPos))," ","0"))+"-"+mDig
IF cCod <> SPACE(5)
   IF !cAppend                  ; SELECT CLIE
      IF RLOCK()                ; SET ORDER TO 0
         CLIE->CODIGO   := cCod ; CLIE->RUT      := mRut ; CLIE->NOMBRE   := cNom ; CLIE->DIRECCION := cDir
         CLIE->CIUDAD   := cCiu ; CLIE->GIRO     := cGir ; CLIE->SIGLA    := cSig ; CLIE->FONO      := cFon
         CLIE->FAX      := cFax ; CLIE->DIAS     := cDia ; CLIE->CORREO   := Mail ; CLIE->ACTIVO    := cAct
         CLIE->APERTURA := cApe ; CLIE->ROTACION := cRot ; CLIE->CONTACTO := cCon
         DBCOMMIT()             ; DBUNLOCK()
      END
   ELSE                 ; SELECT CLIE
      IF RLOCK()        ; APPEND BLANK                  ; SET ORDER TO 0
         CLIE->CODIGO   := cCod ; CLIE->RUT      := mRut ; CLIE->NOMBRE   := cNom ; CLIE->DIRECCION := cDir
         CLIE->CIUDAD   := cCiu ; CLIE->GIRO     := cGir ; CLIE->SIGLA    := cSig ; CLIE->FONO      := cFon
         CLIE->FAX      := cFax ; CLIE->DIAS     := cDia ; CLIE->CORREO   := Mail ; CLIE->ACTIVO    := cAct
         CLIE->APERTURA := cApe ; CLIE->ROTACION := cRot ; CLIE->CONTACTO := cCon
         DBCOMMIT()             ; DBUNLOCK()
      END
   END
END
SELECT CLIE                     ; SET ORDER TO nInd
RETURN .T.
//-------------------------------------------------------------------------
STATIC FUNCTION Filtro(nOpt, oBrw)
IF nOpt < 27
   IF nOpt = 01 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "A" ; ENDIF
   IF nOpt = 02 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "B" ; ENDIF
   IF nOpt = 03 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "C" ; ENDIF
   IF nOpt = 04 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "D" ; ENDIF
   IF nOpt = 05 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "E" ; ENDIF
   IF nOpt = 06 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "F" ; ENDIF
   IF nOpt = 07 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "G" ; ENDIF
   IF nOpt = 08 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "H" ; ENDIF
   IF nOpt = 09 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "I" ; ENDIF
   IF nOpt = 10 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "J" ; ENDIF
   IF nOpt = 11 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "K" ; ENDIF
   IF nOpt = 12 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "L" ; ENDIF
   IF nOpt = 13 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "M" ; ENDIF
   IF nOpt = 14 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "N" ; ENDIF
   IF nOpt = 15 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "O" ; ENDIF
   IF nOpt = 16 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "P" ; ENDIF
   IF nOpt = 17 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "Q" ; ENDIF
   IF nOpt = 18 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "R" ; ENDIF
   IF nOpt = 19 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "S" ; ENDIF
   IF nOpt = 20 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "T" ; ENDIF
   IF nOpt = 21 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "U" ; ENDIF
   IF nOpt = 22 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "V" ; ENDIF
   IF nOpt = 23 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "W" ; ENDIF
   IF nOpt = 24 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "X" ; ENDIF
   IF nOpt = 25 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "Y" ; ENDIF
   IF nOpt = 26 ; SELECT CLIE ; INDEX ON CLIE->NOMBRE TAG 4 TO .\TEMP\PASO.CDX FOR SUBSTR(CLIE->NOMBRE,1,1) = "Z" ; ENDIF
   SET INDEX TO .\TEMP\PASO.CDX
ELSE
   SELECT CLIE ; SET ORDER TO 3
ENDIF
DBGOTOP()
oBrw:UpStable()
oBrw:Refresh(.T.)
oBrw:SetFocus()
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION TrasladarExcel( oBrw )
LOCAL oFileXLS, lIni := .t., nFont1, nFont2, nFont3, nRow, nInd
nInd := CLIE->(IndexOrd())
IF CLIE->(RECCOUNT()) > 0
   IF MsgYesNo("Desea trasladar la tabla de Clientes a MS-Excel® ... ?","PREGUNTA")
     CursorWait()
     DEFINE XLS FONT nFont1 NAME "Tahoma" HEIGHT 16 BOLD
     DEFINE XLS FONT nFont2 NAME "Tahoma" UNDERLINE BOLD
     DEFINE XLS FONT nFont3 NAME "Tahoma" HEIGHT 8
     XLS oFileXLS FILE .\XLS\CLientes.xls AUTOEXEC
         XLS COL 1  WIDTH 1    OF oFileXLS
         XLS COL 2  WIDTH 14.0 OF oFileXLS
         XLS COL 3  WIDTH 20.0 OF oFileXLS
         XLS COL 4  WIDTH 50.0 OF oFileXLS
         nRow := 2
         @ nRow,2 XLS SAY " TABLA DE CLIENTES EN DESPACHO" FONT nfont1 OF oFileXLS
         nRow += 2
         @ nRow,2  XLS SAY "Codigo"            FONT nfont3 OF oFileXLS
         @ nRow,3  XLS SAY "Rut"               FONT nfont3 OF oFileXLS
         @ nRow,4  XLS SAY "Nombre"            FONT nfont3 OF oFileXLS
         nRow += 2
         SELECT CLIE   ;  SET ORDER TO 1 ; DBGOTOP()
         DO WHILE .NOT.EOF()
            @ nRow,2  XLS SAY  CLIE->CODIGO    FONT nFont3 OF oFileXLS
            @ nRow,3  XLS SAY  CLIE->RUT       FONT nFont3 OF oFileXLS
            @ nRow,4  XLS SAY  CLIE->NOMBRE    FONT nFont3 OF oFileXLS
            nRow++
            SKIP
         ENDDO
         XLS PAGE BREAK AT nRow OF oFileXLS
         SET XLS TO DISPLAY  OF oFileXLS
         SET XLS TO PRINTER ;
             HEADER "&ZFecha: &F&CTraspaso de Base DBF a Hoja XLS&DPágina Nº &P" ;
             FOOTER "Sistema Genesis PYME 2004 Ver.4.00" ;
             TOP MARGIN 0.6 ;
             BOTTOM MARGIN 0.8 ;
             LEFT MARGIN 0 ;
             OF oFileXLS
    ENDXLS oFileXLS
    CursorArrow()
   ENDIF
ELSE
   MsgStop("No hay Datos","ATENCION")
ENDIF
RELEASE oFileXLS, lIni, nFont1, nFont2, nFont3, nRow
SELECT CLIE ; SET ORDER TO nInd
DBGOTOP()
RETURN NIL
//-------------------------------------------------------------------------
STATIC FUNCTION BuscarClientes(oBrw, oTab)
LOCAL xLbx, oPun, xDlg, oGet, oMet, wRef, oChk
IF lBor = .F.
   SELECT PA04  ; ZAP
ENDIF
wRef := SPACE(20)
oTab:nOption := 27
oTab:Refresh()
SELECT CLIE      ; SET ORDER TO 3 ; DBGOTOP()
oBrw:Refresh()

   DEFINE CURSOR oPun RESOURCE "MANO"
   DEFINE DIALOG xDlg RESOURCE 129 TITLE "Busqueda de Clientes por Nombre"

   SELECT PA04
   REDEFINE BROWSE xLbx FIELDS PA04->PROV, PA04->NOMB HEADERS "Codigo","Nombre" ;
                     ALIAS "PA04"                                    ;
                     COLOR   nRGB(  0, 90,157) ,  nRGB(255,255,237)  ;
                     SIZES 80,450                                    ;
                     ID 1000 CURSOR oPun OF xDlg GRID

            xLbx:SetColor( { 3, 5, 6, 9, 11, 12, 15 }, { GetSysColor(7), CLR_YELLOW, {CLR_HBLUE, CLR_BLUE}, GetSysColor(7), CLR_GRAY , {CLR_WHITE, CLR_GRAY} , CLR_NBLUE } )
            xLbx:nFreeze       := 1
            xLbx:bLDblClick    := { |nRow, nCol| (Buscar(PA04->PROV), xDlg:End()) }
            xLbx:nHeightHead   += 9
            xLbx:nHeightCell   += 2.5
            xLbx:nLineStyle    := LINES_ALL
            xLbx:bChange       := { || xDlg:Update() }
            xLbx:nClrText      := { || IIF(PA04->ACTI = .F. ,nRGB(255,196,196)  , nRGB(  0, 90,157) ) }
            xLbx:bKeyChar      := {|nKey| iif(nKey==13,(Buscar(PA04->PROV), xDlg:End()) ,MsgBeep() )}

      REDEFINE GET      oGet   VAR wRef   ID 58 OF xDlg PICTURE "@K" UPDATE

      oMet := TProgress():Redefine( 57, xDlg )

      REDEFINE CHECKBOX oChk   VAR lBor            ID 61 OF xDlg

   REDEFINE BTNBMP ID 55  OF xDlg RESOURCE 1167 NOBORDER TOOLTIP " Traslada "       ACTION (Buscar(PA04->PROV), xDlg:End())
   REDEFINE BTNBMP ID 56  OF xDlg RESOURCE 1148 NOBORDER TOOLTIP " Buscar "         ACTION Executa(oMet, wRef, xLbx )
   ACTIVATE DIALOG xDlg CENTER ON INIT IF(!SndPlaySound(".\SYSTEM\OPEN1.WAV",1),MsgBeep(),)

SELECT CLIE
oBrw:Reset()
oBrw:UpStable()
oBrw:Refresh()
oBrw:SetFocus()
RELEASE xDlg, oGet, xLbx, oPun
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION Borrar( oBrw )
LOCAL nInd := CLIE->(IndexOrd())
IF CLIE->(RECCOUNT()) > 0
   IF MsgNoYes( "Sacar al Cliente de la Tabla de Principal ?","ELIMINACION DE REGISTRO")
      SELECT CLIE
      IF RLOCK()
         SET ORDER TO 0
         DBDELETE()    ; DBUNLOCK()
         SET ORDER TO nInd
      ENDIF
   ENDIF
ELSE
   MsgStop("No hay Datos para efectuar esta operación...","ATENCION")
ENDIF
SELECT CLIE ; SET ORDER TO nInd
oBrw:Display()
oBrw:Refresh()
oBrw:SetFocus()
RETURN .T.
//-------------------------------------------------------------------------
STATIC FUNCTION Act_Tree( cValor, oBrw, cTit )
IF SUBSTR(cValor, 1, 1 )  = "2"
   Reportes(cValor, cTit,"1")
ENDIF
oBrw:UpStable()
oBrw:Refresh()
oBrw:GotFocus()
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION Recor ( oSay )
cRecor := STRTRAN(STR(CLIE->(RECNO()),6,0)," ","0")+" de "+STRTRAN(STR(CLIE->(LASTREC()),6,0)," ","0")
oSay:Refresh()
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION Carga()
   oItem[1] := oTree:Add( "Informe Clientes" )
            oItem[1]:Add( "<21> Activos " )
            oItem[1]:Add( "<22> Inactivos ")
            oItem[1]:Add( "<23> Todos ")
            oItem[1]:Add( "<24> Vista Actual ")
// oTree:Expand()
Return NIL
//-------------------------------------------------------------------------
STATIC FUNCTION Reportes( cValor, cTit, yLbx, cPro, cNom )
LOCAL xDlg, lImp := .F., oChk, oRad, nRad := 1, oBit, oSay
   DEFINE DIALOG xDlg RESOURCE 107
          REDEFINE SAY      oSay VAR PrnGetName() ID 110 OF xDlg COLOR GetSysColor(7)
          REDEFINE CHECKBOX oChk VAR lImp ID 101         OF xDlg
          REDEFINE BITMAP   oBit ID 196                  OF xDlg RESOURCE 90
          REDEFINE RADIO    oRad VAR nRad ID 106,102,103 OF xDlg

          oBit:lTransparent  := .T.
          oRad:bChange       := {|| IIF(oRad:nOption=3, ( lImp := .F.,   oChk:Disable() , oChk:Refresh() ),  ;
                                    IIF(oRad:nOption=2, ( lImp := .F.,   oChk:Disable() , oChk:Refresh() ),  ;
                                    IIF(oRad:nOption=1, ( oChk:Enable(), oChk:Refresh()),)               ))}

          REDEFINE BUTTON ID 610 OF xDlg ACTION Informes( cValor, lImp, nRad, cTit )
          REDEFINE BUTTON ID 611 OF xDlg ACTION xDlg:End()
   ACTIVATE DIALOG xDlg CENTER
RETURN NIL
//-------------------------------------------------------------------------
STATIC FUNCTION Informes( cValor, lImp, nRad, cTit )
LOCAL  oRpt, oFon := {NIL,NIL,NIL}, oPrn, nInd
SET 3DLOOK ON
IF     lImp     ; PRINTER oPrn FROM USER PREVIEW
ELSE            ; PRINTER oPrn
ENDIF
IF     nRad = 1 ; PRINTER oPrn PREVIEW
ELSEIF nRad = 2 ; PRINTER oPrn
ELSE            ; PRINTER oPrn PREVIEW // ARCHIVO ASCII
ENDIF
oPrn:cDocument := "Registro de Clientes"

DEFINE FONT  oFon[1] NAME "Arial Narrow" SIZE 0,-7
DEFINE FONT  oFon[2] NAME "Arial Narrow" SIZE 0,-10 BOLD
DEFINE FONT  oFon[3] NAME "Arial Narrow" SIZE 0,-9  BOLD

nInd := CLIE->(IndexOrd())
IF cValor = "24" ;  SELECT CLIE                     ; DBGOTOP()
ELSE             ;  SELECT CLIE  ; SET ORDER TO 3   ; DBGOTOP()
ENDIF
   REPORT oRpt TITLE  " "," ","REGISTRO GENERAL DE CLIENTES","OPCION LISTADO "+cTit," "," "           ;
       HEADER     PARA->EMPRESA, PARA->DIRECCION    ;
       FOOTER ALLTRIM(PARA->SIGLA)+" "+PARA->Rut+" Página Nro : "+STR(oRpt:nPage,3,0)+"    ( Fecha :"+DTOC(DATE())+" Hora : "+SUBSTR(TIME(),1,5)+" )" RIGHT ;
       FONT   oFon[1],oFon[2],oFon[3]                                                  ;
       TO DEVICE oPrn                                                                  ;
       CAPTION "Clientes"+SUBSTR(cTit,5)

       GROUP ON SUBSTR(CLIE->NOMBRE,1,1) ;
       HEADER "CLIENTES CON LETRA INICIAL "+SUBSTR(CLIE->NOMBRE,1,1) ;
       FOOTER "Total Clientes "+" ["+LTRIM(STR(oRpt:aGroups[1]:nCounter))+"]" FONT 3


       COLUMN TITLE "NOMBRE","CLIENTE"   DATA CLIE->NOMBRE                                  FONT 1
       COLUMN TITLE "CODIGO","CLIENTE"   DATA CLIE->CODIGO                                  FONT 1
       COLUMN TITLE "RUT"                DATA CLIE->RUT                                     FONT 1
       COLUMN TITLE "TELEFONO"           DATA CLIE->FONO                                    FONT 1
       COLUMN TITLE "CORREO"             DATA CLIE->CORREO                                  FONT 1
       COLUMN TITLE "CONTACTO"           DATA CLIE->CONTACTO                                FONT 1
       COLUMN TITLE " "                  DATA 1                                             FONT 1 TOTAL
       COLUMN TITLE "EST"                DATA IIF(CLIE->ACTIVO,"<A>","-I-")                 FONT 1 SIZE 6 CENTER GRID 1 SHADOW
   END REPORT
   oRpt:lJoin           := .T.
   oRpt:lAutoland       := .T.

IF oRpt:lCreated
       oRpt:bPreInit         := {|| CLIE->(dbGotop()) }
       oRpt:lJoin            := .T.
       oRpt:lAutoland        := .T.
       oRpt:oTitle:aFont[3]  := {|| 2 }
       oRpt:Stabilize()
END
IF cValor = "21"     ; ACTIVATE REPORT oRpt ON ENDGROUP oRpt:NewLine() FOR CLIE->ACTIVO = .T.
ELSEIF cValor = "22" ; ACTIVATE REPORT oRpt ON ENDGROUP oRpt:NewLine() FOR CLIE->ACTIVO = .F.
ELSE                 ; ACTIVATE REPORT oRpt ON STARTGROUP oRpt:NewLine()
ENDIF
SELECT CLIE ; SET ORDER TO nInd ; DBGOTOP()
oFon[1]:End()
oFon[2]:End()
oFon[3]:End()
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION Executa( oMet, wRef, xLbx )
LOCAL xRef, nInd
nInd := CLIE->(IndexOrd())
IF lBor = .F.
   SELECT PA04  ; ZAP
ENDIF
xRef := ALLTRIM(wRef)
IF EMPTY(xRef)
   xRef := " "
ENDIF
nIni := 0
SELECT CLIE  ; SET ORDER TO 3   ; DBGOTOP()
oMet:SetRange( 0, CLIE->(RecCount()) )
DO WHILE !EOF()
   IF AT(UPPER(xRef),CLIE->NOMBRE) > 0
      SELECT PA04   ;  DBAPPEND()
      PA04->PROV    := CLIE->CODIGO   ;  PA04->NOMB    := CLIE->NOMBRE
      PA04->ACTI    := CLIE->ACTIVO
   ENDIF
   SELECT CLIE      ; DBSKIP()  ; oMet:SetPos( nIni++ )
ENDDO
SELECT CLIE         ; SET ORDER TO nInd
SELECT PA04         ; DBGOTOP()
oMet:SetPos(0)
xLbx:UpStable()
xLbx:Refresh()
xLbx:SetFocus()
RETURN Nil
//-------------------------------------------------------------------------
STATIC FUNCTION Buscar(cCod)
SELECT CLIE         ; SET ORDER TO 1
SEEK cCod
RETURN Nil
//-------------------------------------------------------------------------

 


este es un trozo de codigo de la pantalla principal, es un boton de entrada de un dialogo, una vez validada la contraseña de usuario, y en donde abro todas las tablas que utilizo en el sistema

Code: Select all  Expand view


   DEFINE DIALOG oDlg RESOURCE 200
      REDEFINE BITMAP Bit2                     ID 14 OF oDlg RESOURCE 10
      REDEFINE BITMAP oBit                     ID 12 OF oDlg RESOURCE 55

      REDEFINE GET oPas VAR  cPas ID 102 PICTURE "XXXXXXXX"     OF oDlg VALID Val_Pass(cPas)

      oPas:bGotFocus  := {|| oPas:SetColor(nRGB(  0,  0,  0),nRGB(203,222,254)), oPas:Refresh() }
      oPas:bLostFocus := {|| oPas:SetColor(nRGB(192,192,192),nRGB(255,255,255)), oPas:Refresh() }

      oPas:cToolTip   := " Aquí se ingresa la Clave personal "+CRLF+ ;
                         "  asignada por el Administrador... "

      oMet := TProgress():Redefine( 13, oDlg )

      REDEFINE BUTTON ID 103 OF oDlg     ACTION ( Respuesta := AbrirTablas( oMet, cUni, oMsg, cAbre, Data1, Data2 ), oDlg:End() ) // WHEN EVAL({|| cPas <> SPACE(08) })

   ACTIVATE DIALOG oDlg CENTER ON PAINT oMsg := TMsgBar():New( oDlg, " ALM Systems® 1998-2005 ",.F.,.F.,.T.,.F.,GetSysColor(7),,oFont,.F. )
                             

 


y aqui la funcion en donde abro las tablas

Code: Select all  Expand view


FUNCTION AbrirTablas( oMet, cUni, oMsg, cAbre, Data1, Data2 )
LOCAL Valor := .T.

nIni := 0

oMet:SetRange( 0, 34 )

   oMsg:SetMsg( "Archivo : Clientes.dbf")
   USE &(cUni+"\FRUSUR.05\BASES\CLIENTES.DBF")   ALIAS CLIE SHARED NEW
   IF !FILE(cUni+"\FRUSUR.05\INDICES\CLIENTES.CDX")
      INDEX ON CLIE->CODIGO               TAG 1 TO &(cUni+"\FRUSUR.05\INDICES\CLIENTES.CDX")
      INDEX ON CLIE->RUT                  TAG 2 TO &(cUni+"\FRUSUR.05\INDICES\CLIENTES.CDX")
      INDEX ON CLIE->NOMBRE               TAG 3 TO &(cUni+"\FRUSUR.05\INDICES\CLIENTES.CDX")
   ENDIF       ; SET INDEX TO &(cUni+"\FRUSUR.05\INDICES\CLIENTES.CDX")
   oMet:SetPos( nIni++ )

   oMsg:SetMsg( "Archivo : Comprado.dbf")
   USE &(cUni+"\FRUSUR.05\BASES\COMPRADO.DBF")   ALIAS COMP SHARED NEW
   IF !FILE(cUni+"\FRUSUR.05\INDICES\COMPRADO.CDX")
      INDEX ON COMP->CODIGO               TAG 1 TO &(cUni+"\FRUSUR.05\INDICES\COMPRADO.CDX")
      INDEX ON COMP->RUT                  TAG 2 TO &(cUni+"\FRUSUR.05\INDICES\COMPRADO.CDX")
      INDEX ON COMP->NOMBRE               TAG 3 TO &(cUni+"\FRUSUR.05\INDICES\COMPRADO.CDX")
   ENDIF       ; SET INDEX TO &(cUni+"\FRUSUR.05\INDICES\COMPRADO.CDX")
  oMet:SetPos( nIni++ )

   oMsg:SetMsg( "Archivo : Frutas.dbf")
   USE &(cUni+"\FRUSUR.05\BASES\FRUTAS.DBF")    ALIAS FRUT SHARED NEW
   IF !FILE(cUni+"\FRUSUR.05\INDICES\FRUTAS.CDX")
      INDEX ON FRUT->ESPECIE+FRUT->COD_RA TAG 1 TO &(cUni+"\FRUSUR.05\INDICES\FRUTAS.CDX")
      INDEX ON FRUT->NOMBRE               TAG 2 TO &(cUni+"\FRUSUR.05\INDICES\FRUTAS.CDX")
      INDEX ON FRUT->COD_RA               TAG 3 TO &(cUni+"\FRUSUR.05\INDICES\FRUTAS.CDX")
   ENDIF       ; SET INDEX TO &(cUni+"\FRUSUR.05\INDICES\FRUTAS.CDX")
   oMet:SetPos( nIni++ )

....
....

RETURN Valor
 


una imagen por si te sirve

Image


Espero que te sirva

Saludos
SkyPe: armando.lagunas@hotmail.com
Mail: armando.lagunas@gmail.com
User avatar
armando.lagunas
 
Posts: 346
Joined: Mon Oct 05, 2009 3:35 pm
Location: Curico-Chile

Re: Ejemplo de un mantenimiento con vtna no modal

Postby artu01 » Tue Oct 25, 2016 10:11 pm

Excelente maestro! voy a chequear tu codigo y te aviso

Gracias
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
artu01
 
Posts: 397
Joined: Fri May 11, 2007 8:20 pm
Location: Lima

Re: Ejemplo de un mantenimiento con vtna no modal

Postby artu01 » Fri Oct 28, 2016 6:21 pm

Armando y foro
lo que quiero hacer es poner un get y si el usuario no sabe que codigo de articulo escribir entonces da un Enter en blanco y se abre un cuadro de dialogo NO MODAL con un browse para que el usuario seleccione su codigo con un Enter y se cierre el browse y regrese
al get, pero se carga la ventana de la ayuda y el control se regresa al get sin haber esa dependencia que si existe en el dialogo MODAL

Defino el browse (ayuda)
Code: Select all  Expand view

FUNCTION Brwartic( nTipo, labre, aValRet)
   LOCAL aRect, oBtn
   LOCAL cBmp1
   LOCAL cClase, cTipo, nOrd
   Local lSalir   := .F.

   DEFAULT nTipo := 1
   DEFAULT lAbre := .T.

   SELECT ARTICULO
   ARTICULO->(DBGotop())

   cBMP1 := LoadBitMap(GetResources(), "MARCA" )

   //Crea Ventana para el Browse
   DEFINE DIALOG oDlg RESOURCE "BRW_ARTICULOSA" TITLE "Maestro de Articulos"

   REDEFINE XBROWSE oBrw                                           ;
      FIELDS ARTICULO->Cod                                          ;
            ,ARTICULO->DesG                                            ;
            ,Transform(ARTICULO->Pv, "999.9999")             ;
      SIZES 70, 250,120, 90                                             ;
      HEADERS "Codigo"                                                  ;
            ,"Descripcion"                                                  ;
            ,"Precio S/."                                                    ;
      COLOR 0, RGB(192,210,192)                                  ;
      ID 5000 OF oDlg                                                     ;
      UPDATE

      oBrw:SetRdd()

      ...
      ...
      REDEFINE BUTTON oBtn ID ID_ENTER OF oDlg  ;
         ACTION ( oDbfArt:Load(), aValRet:={oDbfArt:Cod, oDbfArt:DESG, oDbfArt:uM},oDlg:End() ) CANCEL
         oBtn:cTooltip := "Selecciona un registro"    

   ACTIVATE DIALOG oDlg CENTERED NOWAIT

RETURN ( eval({|| msgalert("salio de articulos"), aValRet   }) )
 


Defino un cuadro de dialogo
Code: Select all  Expand view

....
....
       DEFINE DIALOG oDlgItem RESOURCE "DLG_item_guia" TITLE "Item"

       REDEFINE GET oGet VAR carticu ID 101 OF oDlgItem       ;
                PICTURE "@!"                                  ;      
                VALID ValArt(@cArticu, oDlgItem) UPDATE            //despues de hacer el valid me deberia estar cargado el valor para la variable carticu
                IIF( lmodo, oGet:Enable(), oGet:Disable() )
 

defino la funcion ValArt()
Code: Select all  Expand view

static FUNCTION ValArt(cCod, oDlg)
  Local cDesCta, nRecAc, nRecDa, aDatos:={}
  local lok
   IF Empty(cCod)

      nRecAc:=ARTICULO->(IndexOrd())
      aDatos:=BRWARTIC(2,.F., @aDatos)  
      IF aDatos[1] <> Nil                  //esta linea de codigo se ejecuta al abrir la ayuda y no despues de que se muestra la ayuda
         cCod:=aDatos[1]                    
         cDescri := aDatos[2]
      ENDIF
      Articulo->(DBSetOrder(nRecAc))
   EndIf

RETURN ( lok )

 


Una imagen vale mas que mil palabras reza el dicho

http://subefotos.com/ver/?c68b9d450b4bc ... 9a849o.jpg
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
artu01
 
Posts: 397
Joined: Fri May 11, 2007 8:20 pm
Location: Lima

Re: Ejemplo de un mantenimiento con vtna no modal

Postby cmsoft » Fri Oct 28, 2016 7:53 pm

El tema es que si la ventana de ayuda de los articulos es no modal, el control pasa por la ventana y sale (no para). Creo yo en mi humilde opinion que no tiene sentido que esa ventana de ayuda de articulos sea no modal, porque si entro ahi es porque no sabia el codigo y quiere buscarlo.
En mi caso, y creo que es lo mismo que te compartio Armando, cuando entra al dialogo de mostrar los datos del cliente, o en tu caso la ventana de ayuda, creo que el dialogo debe ser modal.
User avatar
cmsoft
 
Posts: 1189
Joined: Wed Nov 16, 2005 9:14 pm
Location: Mercedes - Bs As. Argentina

Re: Ejemplo de un mantenimiento con vtna no modal

Postby artu01 » Wed Nov 02, 2016 6:17 am

Cmsoft gracias por responder y a convencerme que un sistema los browses no deben abrirse siempre en nomodal, segun sea el caso se abriran
en modal o en no modal.... si se desea que la ayuda devuelva algun dato despues de mostrarse sera modal pero si es por simple consulta
éste sera nomodal
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
artu01
 
Posts: 397
Joined: Fri May 11, 2007 8:20 pm
Location: Lima


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: carlos vargas and 31 guests