Este es un Ejemplo de Como podemos Crear accesos directos para nuestra aplicaciones.
olnk:=CreateObject("WScript.Shell")
//Creación del objeto tipo shell
strDesktop :=olnk:SpecialFolders():Item("Startup")
//Retorna la dirección en donde se encontrara el acceso directo
---------- Paramestros para ITem()
AllUsersDesktop: Dirección del escritorio de Todos los Usuario
AllUsersStartMenu: Dirección de Menú Principal de Todos los Usuarios
AllUsersPrograms: Dirección de Todos los Programas de Todos los Usuarios
AllUsersStartup: Dirección de Todos los Programas Inicio de Todos los Usuarios
Desktop: Dirección del escritorio de usuario actual
Favorites: Dirección de Favoritos del Usuario actual
Fonts: Dirección de Instalación de Fonts del sistema
MyDocuments: Directorio Mis Documentos de Usuario actual
NetHood: Objects that appear in Network Neighborhood
PrintHood: Printer links
Recent: Shortcuts to current users recently opened documents
SendTo: Shortcuts to applications that show up as possible send-to targets when a user right-clicks on a file in Windows Explorer
StartMenu: Shortcuts that appear in the current users start menu
Startup: Shortcuts to applications that run automatically when the current user logs on to the system
Templates: Application template files specific to the current user */
----------
strPath := olnk:ExpandEnvironmentStrings("C:\MyFolder\MyExe.EXE")
//indica la ubicación de nuestra aplicación
oShellLink:=olnk:CreateShortcut(strDesktop + "\acceso directo a MyExe.lnk")
//Crea el acceso directo
oShellLink:TargetPath := strPath
// Asigna el destino
//-------------Esto no es indispensable-----------
oShellLink:WindowStyle := 1
// Estilo de ventana
oShellLink:IconLocation := "C:\myFolder\MyExe.EXE, 0"
//Ubucacion de Icono asocias. Si los iconos están incluidos debe de ponerse "myexe.exe, 0" 0 es la posicion del icono
oShellLink:Description := "Descripcion del Acceso"
oShellLink:WorkingDirectory := "C:\myFolder\"
Direccion de Trabajo
//----------------------------------------------------------
oShellLink:Save()
// Guardar el Acceso deirecto.
RETURN
/*
NuevoObjShell :=CreateObject("WScript.Shell") // Crea un Objeto Sherll
DirectorioDestino :=NuevoObjShell:SpecialFolders():Item("Startup") // Retorna la direccion solicitada en Item(Ver Referencia)
UbicacionDelEjecutable :=NuevoObjShell:ExpandEnvironmentStrings("C:\Directorio\Ejecutable.EXE")
NuevoObjShortCut :=NuevoObjShell:CreateShortcut(DirectorioDestino + "\Nombre del Acceso.lnk")
NuevoObjShortCut:TargetPath:=UbicacionDelEjecutable
//-------------Esto no es indispensable-----------
NuevoObjShortCut:WindowStyle := 1
NuevoObjShortCut:IconLocation := "C:\Directorio\miicon.ico" // Si los iconos estan incluidos debe de ponerse "c:\Directorio\Ejecutable.exe, 0" 0 es la posicion del icono
NuevoObjShortCut:Description := "Compatibiliadad para impresoras"
NuevoObjShortCut:WorkingDirectory := "C:\Directorio\"
//----------------------------------------------------------
NuevoObjShortCut:Save()
Referencia de SpecialFolders():Item("Startup")
lunes, 27 de septiembre de 2010
llamar varias funciones/procedimientos desde el mismo control
Algunas veces, según las circunstancias, necesitamos llamar a distintas funciones o procedimientos desde un mismo control. este ejemplo ilustra cómo podemos realizar realizarlo.
#include "minigui.ch"
Function Main Local
mNumFunc:= 1
PRIVATE maFunction
maFunction:= {{ || mYProy1()},{ || mYProy2()}}
DEFINE WINDOW Form_1 ;
AT 0,0 ;
WIDTH 550 ;
HEIGHT 400 ;
TITLE 'Hello World!' ;
MAIN DEFINE MAIN MENU
DEFINE POPUP 'Test'
MENUITEM 'Llamar a la función' ACTION EVAL(maFunction[mNumFunc])
MENUITEM 'Cambiar el Numero de Funcion' ACTION mYProy3(@mNumFunc)
END POPUP
END MENU
@ 10,25 BUTTONEX Btx_Test CAPTION "Test" WIDTH 100 HEIGHT 25 ACTION EVAL(maFunction[mNumFunc])
END WINDOW
Form_1.Center
Form_1.Activate Return Nil
*----------
Procedure mYProy1()
msgbox("myProy1")
RETURN
*----------
Procedure mYProy2()
msgbox("myProy2")
RETURN
*----------
Procedure mYProy3(mNumFunc)
// Solo debemos de cambiar el numero de posición enel vector.
mNumFunc:= IF(mNumFunc = 1,2,1)
RETURN
#include "minigui.ch"
Function Main Local
mNumFunc:= 1
PRIVATE maFunction
maFunction:= {{ || mYProy1()},{ || mYProy2()}}
DEFINE WINDOW Form_1 ;
AT 0,0 ;
WIDTH 550 ;
HEIGHT 400 ;
TITLE 'Hello World!' ;
MAIN DEFINE MAIN MENU
DEFINE POPUP 'Test'
MENUITEM 'Llamar a la función' ACTION EVAL(maFunction[mNumFunc])
MENUITEM 'Cambiar el Numero de Funcion' ACTION mYProy3(@mNumFunc)
END POPUP
END MENU
@ 10,25 BUTTONEX Btx_Test CAPTION "Test" WIDTH 100 HEIGHT 25 ACTION EVAL(maFunction[mNumFunc])
END WINDOW
Form_1.Center
Form_1.Activate Return Nil
*----------
Procedure mYProy1()
msgbox("myProy1")
RETURN
*----------
Procedure mYProy2()
msgbox("myProy2")
RETURN
*----------
Procedure mYProy3(mNumFunc)
// Solo debemos de cambiar el numero de posición enel vector.
mNumFunc:= IF(mNumFunc = 1,2,1)
RETURN
miércoles, 22 de septiembre de 2010
Funcion STOD()
Sabemos que para ordenamientos de datos, utilizamos la función DTOS, para cambiar de fechas 30/01/9999 a 99990130. Ahora contamos la la función STOD que revierte este cambio Ej.
mdDato:= DATE() //30/01/9999
mdDato:= DTOS(mdDato) //99990130
mdDato:= STOD(mdDato) //30/01/9999
mdDato:= DATE() //30/01/9999
mdDato:= DTOS(mdDato) //99990130
mdDato:= STOD(mdDato) //30/01/9999
lunes, 20 de septiembre de 2010
Buscar Formularios y Controles en Uso
ASCAN(_HMG_aFormNames,{ |x| UPPER(AllTrim(x)) == UPPER("Nombre del Formulario") })
// _HMG_aFormNames: Vector Contiene el Nombre de Todos los Formularios activos
ASCAN(_HMG_aControlNames,{ |x| UPPER(AllTrim(x)) == UPPER("Nombre del Control") })
// _HMG_aControlNames: Vector que contiene el Nombre de Todos los controles activos.
// _HMG_aFormNames: Vector Contiene el Nombre de Todos los Formularios activos
ASCAN(_HMG_aControlNames,{ |x| UPPER(AllTrim(x)) == UPPER("Nombre del Control") })
// _HMG_aControlNames: Vector que contiene el Nombre de Todos los controles activos.
Machote de Mantenimiento de Datos
#include "minigui.ch"
#include "Dbstruct.ch"
Function Main
SET CENTURY ON
SET DELETED ON
SET BROWSESYNC ON
DEFINE WINDOW Form_1 ;
AT 0,0 ;
WIDTH 640 HEIGHT 480 ;
TITLE 'Demo de Mantenimiento de Datos' ;
MAIN NOMAXIMIZE ;
ON INIT OpenTables() ;
ON RELEASE CloseTables()
DEFINE MAIN MENU
POPUP 'Registros'
ITEM 'Ingresar' ACTION PDatos_Detalles("INGRESAR")
ITEM 'Editar' ACTION PDatos_Detalles("EDITAR")
ITEM 'Actualizar Ventana' ACTION Form_1.Browse_1.Refresh()
SEPARATOR
ITEM 'Exit' ACTION Form_1.Release()
END POPUP
POPUP 'Help'
ITEM 'About' ACTION MsgInfo ( "Machote de mantenimiento de Datos", "About" )
END POPUP
END MENU
DEFINE STATUSBAR
KEYBOARD
DATE
IF "/" $ Set( 4 )
CLOCK AMPM
ELSE
CLOCK
ENDIF
END STATUSBAR
DEFINE BROWSE Browse_1
ROW 10
COL 10
WIDTH 610
HEIGHT 390
HEADERS { 'Codigo' , 'Nombre' , 'Apellido', 'Nacimiento', 'Casado'}
WIDTHS { 150 , 150 , 150 , 150 , 150 }
WORKAREA Test
FIELDS { 'Test->Code' , 'Test->First' , 'Test->Last' , 'Test->Birth' , 'if(Test->Married,"SI","NO")' }
VALUE 1
ON DBLCLICK PDatos_Detalles("EDITAR")
END BROWSE
END WINDOW
CENTER WINDOW Form_1
Form_1.Browse_1.SetFocus()
ACTIVATE WINDOW Form_1
Return Nil
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
Procedure OpenTables()
if !file("test.dbf")
CreateTable()
endif
Use Test Shared
Index on field->code to code temporary
Return
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
Procedure CloseTables()
Use
Return
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PDatos_Detalles(mUso)
PRIVATE mNuevo // varible que controla si se agrega un dato nuevo
// Prifijo determina el termina a que se le esta dando mantenimiento
// Puede ser, WLista1_Destalles, WUsuarios_Detalles, WArticulos_Destalles, Etc.
IF mUso = "INGRESAR"
mNuevo:= .T.
ENDIF
DEFINE WINDOW WPrefijo_Detalles ;
AT 0,0 ;
WIDTH 650 ; //GetDesktopWidth()-250;
HEIGHT 250 ;
TITLE "Detalles de Datos" ;
MODAL ;
NOSIZE
DEFINE TOOLBAR TlB_Datos BUTTONSIZE 50,40 SIZE 8 FLAT //BORDER
BUTTON Btn_nuevo ;
CAPTION "&Nuevo" ;
TOOLTIP 'nueva Cuenta' ;
ACTION PPrefijo_Accion("INGRESAR") ;
PICTURE "edit_new.bmp"
BUTTON Btn_Editar ;
CAPTION "&Editar";
TOOLTIP 'Cambiar Datos de Cuenta' ;
ACTION PPrefijo_Accion("EDITAR") ;
PICTURE "edit_edit.bmp" ;
SEPARATOR
BUTTON Btn_Guardar ;
CAPTION "&Guardar";
TOOLTIP 'Guardar Datos' ;
ACTION PPrefijo_Accion("GUARDAR") ;
PICTURE "edit_save.bmp"
BUTTON Btn_Cancelar ;
CAPTION "&Cancelar";
TOOLTIP 'Cancelar' ;
ACTION PPrefijo_Accion("CANCELAR");
PICTURE "edit_cancel.bmp"
BUTTON Btn_Deshacer ;
CAPTION "&Deshacer";
TOOLTIP 'Regresa los Datos Originales' ;
ACTION PPrefijo_Accion("DESHACER") ;
PICTURE "edit_undo.bmp" ;
SEPARATOR
BUTTON Btn_Borrar ;
CAPTION "E&liminar";
TOOLTIP 'Eliminar Cuenta' ;
ACTION PPrefijo_Accion("ELIMINAR");
PICTURE "edit_delete.bmp"
END TOOLBAR
mLinea:= 50
@ mLinea , 05 FRAME Frm_Principales CAPTION "Datos Principales" WIDTH 635 HEIGHT 150
@ mLinea+=20,120 GETBOX Txt_Codigo VALUE 0 WIDTH 100 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Codigo VALUE "Código" WIDTH 100 HEIGHT 20
@ mLinea+=20,120 GETBOX Txt_Nombre VALUE SPACE(100) WIDTH 250 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Nombre VALUE "Nombre" WIDTH 100 HEIGHT 20
@ mLinea+=20,120 GETBOX Txt_Apellido VALUE SPACE(100) WIDTH 250 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Apellido VALUE "Apellido" WIDTH 100 HEIGHT 20
@ mLinea+=20,120 DATEPICKER Dpk_FecNac VALUE CTOD("") WIDTH 100 HEIGHT 20
@ mLinea+=20,120 CHECKBOX Ckb_Casado CAPTION "Casado" VALUE .F. WIDTH 100 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Casado VALUE "Estado Civil" WIDTH 100 HEIGHT 20
END WINDOW
PPrefijo_Accion(mUso)
WPrefijo_Detalles.center
WPrefijo_Detalles.activate
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_Accion(mUso)
DO CASE
CASE mUso="INGRESAR"
mNuevo:= .T.
PPrefijo_Datos(mUso,.F.)
CASE mUso="EDITAR"
mNuevo:= .F.
PPrefijo_Datos(mUso,.F.)
CASE mUso="GUARDAR"
IF !PPrefijo_Guardar()
mUso:=IF(mNuevo,"INGRESAR","EDITAR")
ELSE
mNuevo:= .F.
PPrefijo_Datos(mUso,.T.)
ENDIF
CASE mUso="CANCELAR"
IF mNuevo
WPrefijo_Detalles.release
ELSE
PPrefijo_Datos(mUso,.T.)
ENDIF
CASE mUso="DESHACER"
mUso:="EDITAR"
PPrefijo_Datos(mUso,.F.)
CASE mUso="ELIMINAR"
IF test->(FLock())
test->(DBDELETE())
test->(dbUnLock())
WPrefijo_Detalles.release
ELSE
msgbox("Registro en Uso.")
ENDIF
ENDCASE
PPrefijo_SetButtons(mUso)
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_SetButtons(mUso)
LOCAL mVBtnStatus:= {}
// Normalmente cuando se Ingresa o Modifica,
//es necesario desabilitar siertas opciones
DO CASE
CASE mUso="INGRESAR"
mVBtnStatus:= {.F.,.F.,.T.,.T.,.F.,.F.,.F.}
CASE mUso="EDITAR"
mVBtnStatus:= {.F.,.F.,.T.,.T.,.T.,.F.,.F.}
OTHERWISE // Modo Normal
mVBtnStatus:= {.T.,.T.,.F.,.F.,.F.,.T.,.T.}
ENDCASE
SETPROPERTY("WPrefijo_Detalles","Btn_nuevo" ,"enabled",mVBtnStatus[1])
SETPROPERTY("WPrefijo_Detalles","Btn_editar" ,"enabled",mVBtnStatus[2])
SETPROPERTY("WPrefijo_Detalles","Btn_Guardar" ,"enabled",mVBtnStatus[3])
SETPROPERTY("WPrefijo_Detalles","Btn_cancelar","enabled",mVBtnStatus[4])
SETPROPERTY("WPrefijo_Detalles","Btn_deshacer","enabled",mVBtnStatus[5])
SETPROPERTY("WPrefijo_Detalles","Btn_Borrar" ,"enabled",mVBtnStatus[6])
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_Datos(mUso,mReadOnly)
IF mUso = "INGRESAR"
WPrefijo_Detalles.Txt_Codigo.VALUE:= 0
WPrefijo_Detalles.Txt_Nombre.VALUE:= SPACE(100)
WPrefijo_Detalles.Txt_Apellido.VALUE:= SPACE(100)
WPrefijo_Detalles.Dpk_FecNac.VALUE:= CTOD("")
WPrefijo_Detalles.Ckb_Casado.VALUE:= .f.
MReadOnly:= IF(MReadOnly = NIL,.F.,MReadOnly)
ELSE
WPrefijo_Detalles.Txt_Codigo.VALUE:= test->code
WPrefijo_Detalles.Txt_Nombre.VALUE:= test->First
WPrefijo_Detalles.Txt_Apellido.VALUE:= test->Last
WPrefijo_Detalles.Dpk_FecNac.VALUE:= test->birth
WPrefijo_Detalles.Ckb_Casado.VALUE:= test->Married
MReadOnly:= IF(MReadOnly = NIL,.T.,MReadOnly)
ENDIF
PPrefijo_ReadOnly(MReadOnly)
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_ReadOnly(MReadOnly)
WPrefijo_Detalles.Txt_Codigo.ReadOnly:= mReadOnly
WPrefijo_Detalles.Txt_Nombre.ReadOnly:= mReadOnly
WPrefijo_Detalles.Txt_Apellido.ReadOnly:= mReadOnly
WPrefijo_Detalles.Dpk_FecNac.Enabled:= !mReadOnly
WPrefijo_Detalles.Ckb_Casado.Enabled:= !mReadOnly
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_Guardar()
IF EMPTY(WPrefijo_Detalles.Txt_Codigo.VALUE)
WPrefijo_Detalles.Txt_Codigo.setfocus
RETURN(.F.)
ENDIF
IF mNuevo .AND. test->(DBSEEK(WPrefijo_Detalles.Txt_Codigo.VALUE))
WPrefijo_Detalles.Txt_Codigo.setfocus
RETURN(.F.)
ENDIF
IF EMPTY(WPrefijo_Detalles.Txt_Nombre.VALUE)
WPrefijo_Detalles.Txt_Nombre.setfocus
RETURN(.F.)
ENDIF
IF EMPTY(WPrefijo_Detalles.Txt_Apellido.value)
WPrefijo_Detalles.Txt_Apellido.setfocus
RETURN(.F.)
ENDIF
IF !Test->(FLock())
msgbox("Tabla ocupada")
RETURN
ENDIF
IF mNuevo
Test->(DBAPPEND())
REPLACE Test->Code WITH WPrefijo_Detalles.Txt_Codigo.VALUE
ENDIF
REPLACE test->First WITH WPrefijo_Detalles.Txt_Nombre.VALUE
REPLACE test->Last WITH WPrefijo_Detalles.Txt_Apellido.VALUE
REPLACE test->birth WITH WPrefijo_Detalles.Dpk_FecNac.VALUE
REPLACE test->Married WITH WPrefijo_Detalles.Ckb_Casado.VALUE
Test->(DBUnLock())
mNuevo:=.F.
RETURN(.T.)
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
Procedure CreateTable
LOCAL aDbf[6][4], i
aDbf[1][ DBS_NAME ] := "Code"
aDbf[1][ DBS_TYPE ] := "Numeric"
aDbf[1][ DBS_LEN ] := 10
aDbf[1][ DBS_DEC ] := 0
//
aDbf[2][ DBS_NAME ] := "First"
aDbf[2][ DBS_TYPE ] := "Character"
aDbf[2][ DBS_LEN ] := 25
aDbf[2][ DBS_DEC ] := 0
//
aDbf[3][ DBS_NAME ] := "Last"
aDbf[3][ DBS_TYPE ] := "Character"
aDbf[3][ DBS_LEN ] := 25
aDbf[3][ DBS_DEC ] := 0
//
aDbf[4][ DBS_NAME ] := "Married"
aDbf[4][ DBS_TYPE ] := "Logical"
aDbf[4][ DBS_LEN ] := 1
aDbf[4][ DBS_DEC ] := 0
//
aDbf[5][ DBS_NAME ] := "Birth"
aDbf[5][ DBS_TYPE ] := "Date"
aDbf[5][ DBS_LEN ] := 8
aDbf[5][ DBS_DEC ] := 0
//
aDbf[6][ DBS_NAME ] := "Bio"
aDbf[6][ DBS_TYPE ] := "Memo"
aDbf[6][ DBS_LEN ] := 10
aDbf[6][ DBS_DEC ] := 0
DBCREATE("Test", aDbf)
Use Test
For i:= 1 To 100
append blank
Replace code with i
Replace First With 'First Name '+ Ltrim(Str(i))
Replace Last With 'Last Name '+ Ltrim(Str(i))
Replace Married With ( i/2 == int(i/2) )
replace birth with date()-Max(10000, Random(20000))+Random(LastRec())
Next i
Use
Return
#include "Dbstruct.ch"
Function Main
SET CENTURY ON
SET DELETED ON
SET BROWSESYNC ON
DEFINE WINDOW Form_1 ;
AT 0,0 ;
WIDTH 640 HEIGHT 480 ;
TITLE 'Demo de Mantenimiento de Datos' ;
MAIN NOMAXIMIZE ;
ON INIT OpenTables() ;
ON RELEASE CloseTables()
DEFINE MAIN MENU
POPUP 'Registros'
ITEM 'Ingresar' ACTION PDatos_Detalles("INGRESAR")
ITEM 'Editar' ACTION PDatos_Detalles("EDITAR")
ITEM 'Actualizar Ventana' ACTION Form_1.Browse_1.Refresh()
SEPARATOR
ITEM 'Exit' ACTION Form_1.Release()
END POPUP
POPUP 'Help'
ITEM 'About' ACTION MsgInfo ( "Machote de mantenimiento de Datos", "About" )
END POPUP
END MENU
DEFINE STATUSBAR
KEYBOARD
DATE
IF "/" $ Set( 4 )
CLOCK AMPM
ELSE
CLOCK
ENDIF
END STATUSBAR
DEFINE BROWSE Browse_1
ROW 10
COL 10
WIDTH 610
HEIGHT 390
HEADERS { 'Codigo' , 'Nombre' , 'Apellido', 'Nacimiento', 'Casado'}
WIDTHS { 150 , 150 , 150 , 150 , 150 }
WORKAREA Test
FIELDS { 'Test->Code' , 'Test->First' , 'Test->Last' , 'Test->Birth' , 'if(Test->Married,"SI","NO")' }
VALUE 1
ON DBLCLICK PDatos_Detalles("EDITAR")
END BROWSE
END WINDOW
CENTER WINDOW Form_1
Form_1.Browse_1.SetFocus()
ACTIVATE WINDOW Form_1
Return Nil
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
Procedure OpenTables()
if !file("test.dbf")
CreateTable()
endif
Use Test Shared
Index on field->code to code temporary
Return
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
Procedure CloseTables()
Use
Return
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PDatos_Detalles(mUso)
PRIVATE mNuevo // varible que controla si se agrega un dato nuevo
// Prifijo determina el termina a que se le esta dando mantenimiento
// Puede ser, WLista1_Destalles, WUsuarios_Detalles, WArticulos_Destalles, Etc.
IF mUso = "INGRESAR"
mNuevo:= .T.
ENDIF
DEFINE WINDOW WPrefijo_Detalles ;
AT 0,0 ;
WIDTH 650 ; //GetDesktopWidth()-250;
HEIGHT 250 ;
TITLE "Detalles de Datos" ;
MODAL ;
NOSIZE
DEFINE TOOLBAR TlB_Datos BUTTONSIZE 50,40 SIZE 8 FLAT //BORDER
BUTTON Btn_nuevo ;
CAPTION "&Nuevo" ;
TOOLTIP 'nueva Cuenta' ;
ACTION PPrefijo_Accion("INGRESAR") ;
PICTURE "edit_new.bmp"
BUTTON Btn_Editar ;
CAPTION "&Editar";
TOOLTIP 'Cambiar Datos de Cuenta' ;
ACTION PPrefijo_Accion("EDITAR") ;
PICTURE "edit_edit.bmp" ;
SEPARATOR
BUTTON Btn_Guardar ;
CAPTION "&Guardar";
TOOLTIP 'Guardar Datos' ;
ACTION PPrefijo_Accion("GUARDAR") ;
PICTURE "edit_save.bmp"
BUTTON Btn_Cancelar ;
CAPTION "&Cancelar";
TOOLTIP 'Cancelar' ;
ACTION PPrefijo_Accion("CANCELAR");
PICTURE "edit_cancel.bmp"
BUTTON Btn_Deshacer ;
CAPTION "&Deshacer";
TOOLTIP 'Regresa los Datos Originales' ;
ACTION PPrefijo_Accion("DESHACER") ;
PICTURE "edit_undo.bmp" ;
SEPARATOR
BUTTON Btn_Borrar ;
CAPTION "E&liminar";
TOOLTIP 'Eliminar Cuenta' ;
ACTION PPrefijo_Accion("ELIMINAR");
PICTURE "edit_delete.bmp"
END TOOLBAR
mLinea:= 50
@ mLinea , 05 FRAME Frm_Principales CAPTION "Datos Principales" WIDTH 635 HEIGHT 150
@ mLinea+=20,120 GETBOX Txt_Codigo VALUE 0 WIDTH 100 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Codigo VALUE "Código" WIDTH 100 HEIGHT 20
@ mLinea+=20,120 GETBOX Txt_Nombre VALUE SPACE(100) WIDTH 250 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Nombre VALUE "Nombre" WIDTH 100 HEIGHT 20
@ mLinea+=20,120 GETBOX Txt_Apellido VALUE SPACE(100) WIDTH 250 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Apellido VALUE "Apellido" WIDTH 100 HEIGHT 20
@ mLinea+=20,120 DATEPICKER Dpk_FecNac VALUE CTOD("") WIDTH 100 HEIGHT 20
@ mLinea+=20,120 CHECKBOX Ckb_Casado CAPTION "Casado" VALUE .F. WIDTH 100 HEIGHT 20
@ mLinea+5 , 20 LABEL Lbl_Casado VALUE "Estado Civil" WIDTH 100 HEIGHT 20
END WINDOW
PPrefijo_Accion(mUso)
WPrefijo_Detalles.center
WPrefijo_Detalles.activate
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_Accion(mUso)
DO CASE
CASE mUso="INGRESAR"
mNuevo:= .T.
PPrefijo_Datos(mUso,.F.)
CASE mUso="EDITAR"
mNuevo:= .F.
PPrefijo_Datos(mUso,.F.)
CASE mUso="GUARDAR"
IF !PPrefijo_Guardar()
mUso:=IF(mNuevo,"INGRESAR","EDITAR")
ELSE
mNuevo:= .F.
PPrefijo_Datos(mUso,.T.)
ENDIF
CASE mUso="CANCELAR"
IF mNuevo
WPrefijo_Detalles.release
ELSE
PPrefijo_Datos(mUso,.T.)
ENDIF
CASE mUso="DESHACER"
mUso:="EDITAR"
PPrefijo_Datos(mUso,.F.)
CASE mUso="ELIMINAR"
IF test->(FLock())
test->(DBDELETE())
test->(dbUnLock())
WPrefijo_Detalles.release
ELSE
msgbox("Registro en Uso.")
ENDIF
ENDCASE
PPrefijo_SetButtons(mUso)
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_SetButtons(mUso)
LOCAL mVBtnStatus:= {}
// Normalmente cuando se Ingresa o Modifica,
//es necesario desabilitar siertas opciones
DO CASE
CASE mUso="INGRESAR"
mVBtnStatus:= {.F.,.F.,.T.,.T.,.F.,.F.,.F.}
CASE mUso="EDITAR"
mVBtnStatus:= {.F.,.F.,.T.,.T.,.T.,.F.,.F.}
OTHERWISE // Modo Normal
mVBtnStatus:= {.T.,.T.,.F.,.F.,.F.,.T.,.T.}
ENDCASE
SETPROPERTY("WPrefijo_Detalles","Btn_nuevo" ,"enabled",mVBtnStatus[1])
SETPROPERTY("WPrefijo_Detalles","Btn_editar" ,"enabled",mVBtnStatus[2])
SETPROPERTY("WPrefijo_Detalles","Btn_Guardar" ,"enabled",mVBtnStatus[3])
SETPROPERTY("WPrefijo_Detalles","Btn_cancelar","enabled",mVBtnStatus[4])
SETPROPERTY("WPrefijo_Detalles","Btn_deshacer","enabled",mVBtnStatus[5])
SETPROPERTY("WPrefijo_Detalles","Btn_Borrar" ,"enabled",mVBtnStatus[6])
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_Datos(mUso,mReadOnly)
IF mUso = "INGRESAR"
WPrefijo_Detalles.Txt_Codigo.VALUE:= 0
WPrefijo_Detalles.Txt_Nombre.VALUE:= SPACE(100)
WPrefijo_Detalles.Txt_Apellido.VALUE:= SPACE(100)
WPrefijo_Detalles.Dpk_FecNac.VALUE:= CTOD("")
WPrefijo_Detalles.Ckb_Casado.VALUE:= .f.
MReadOnly:= IF(MReadOnly = NIL,.F.,MReadOnly)
ELSE
WPrefijo_Detalles.Txt_Codigo.VALUE:= test->code
WPrefijo_Detalles.Txt_Nombre.VALUE:= test->First
WPrefijo_Detalles.Txt_Apellido.VALUE:= test->Last
WPrefijo_Detalles.Dpk_FecNac.VALUE:= test->birth
WPrefijo_Detalles.Ckb_Casado.VALUE:= test->Married
MReadOnly:= IF(MReadOnly = NIL,.T.,MReadOnly)
ENDIF
PPrefijo_ReadOnly(MReadOnly)
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_ReadOnly(MReadOnly)
WPrefijo_Detalles.Txt_Codigo.ReadOnly:= mReadOnly
WPrefijo_Detalles.Txt_Nombre.ReadOnly:= mReadOnly
WPrefijo_Detalles.Txt_Apellido.ReadOnly:= mReadOnly
WPrefijo_Detalles.Dpk_FecNac.Enabled:= !mReadOnly
WPrefijo_Detalles.Ckb_Casado.Enabled:= !mReadOnly
RETURN
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
PROCEDURE PPrefijo_Guardar()
IF EMPTY(WPrefijo_Detalles.Txt_Codigo.VALUE)
WPrefijo_Detalles.Txt_Codigo.setfocus
RETURN(.F.)
ENDIF
IF mNuevo .AND. test->(DBSEEK(WPrefijo_Detalles.Txt_Codigo.VALUE))
WPrefijo_Detalles.Txt_Codigo.setfocus
RETURN(.F.)
ENDIF
IF EMPTY(WPrefijo_Detalles.Txt_Nombre.VALUE)
WPrefijo_Detalles.Txt_Nombre.setfocus
RETURN(.F.)
ENDIF
IF EMPTY(WPrefijo_Detalles.Txt_Apellido.value)
WPrefijo_Detalles.Txt_Apellido.setfocus
RETURN(.F.)
ENDIF
IF !Test->(FLock())
msgbox("Tabla ocupada")
RETURN
ENDIF
IF mNuevo
Test->(DBAPPEND())
REPLACE Test->Code WITH WPrefijo_Detalles.Txt_Codigo.VALUE
ENDIF
REPLACE test->First WITH WPrefijo_Detalles.Txt_Nombre.VALUE
REPLACE test->Last WITH WPrefijo_Detalles.Txt_Apellido.VALUE
REPLACE test->birth WITH WPrefijo_Detalles.Dpk_FecNac.VALUE
REPLACE test->Married WITH WPrefijo_Detalles.Ckb_Casado.VALUE
Test->(DBUnLock())
mNuevo:=.F.
RETURN(.T.)
*----------------------------------------------------------------------------
*----------------------------------------------------------------------------
Procedure CreateTable
LOCAL aDbf[6][4], i
aDbf[1][ DBS_NAME ] := "Code"
aDbf[1][ DBS_TYPE ] := "Numeric"
aDbf[1][ DBS_LEN ] := 10
aDbf[1][ DBS_DEC ] := 0
//
aDbf[2][ DBS_NAME ] := "First"
aDbf[2][ DBS_TYPE ] := "Character"
aDbf[2][ DBS_LEN ] := 25
aDbf[2][ DBS_DEC ] := 0
//
aDbf[3][ DBS_NAME ] := "Last"
aDbf[3][ DBS_TYPE ] := "Character"
aDbf[3][ DBS_LEN ] := 25
aDbf[3][ DBS_DEC ] := 0
//
aDbf[4][ DBS_NAME ] := "Married"
aDbf[4][ DBS_TYPE ] := "Logical"
aDbf[4][ DBS_LEN ] := 1
aDbf[4][ DBS_DEC ] := 0
//
aDbf[5][ DBS_NAME ] := "Birth"
aDbf[5][ DBS_TYPE ] := "Date"
aDbf[5][ DBS_LEN ] := 8
aDbf[5][ DBS_DEC ] := 0
//
aDbf[6][ DBS_NAME ] := "Bio"
aDbf[6][ DBS_TYPE ] := "Memo"
aDbf[6][ DBS_LEN ] := 10
aDbf[6][ DBS_DEC ] := 0
DBCREATE("Test", aDbf)
Use Test
For i:= 1 To 100
append blank
Replace code with i
Replace First With 'First Name '+ Ltrim(Str(i))
Replace Last With 'Last Name '+ Ltrim(Str(i))
Replace Married With ( i/2 == int(i/2) )
replace birth with date()-Max(10000, Random(20000))+Random(LastRec())
Next i
Use
Return
Suscribirse a:
Comentarios (Atom)