Crear Accesos directos

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

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

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

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.

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

ORDDESCEND

Esta es una excelente herramienta que invierte el indice actual de manera que le podemos ir diciendo adiós a nuestros indices DESCEND


USE clientes VIA "DBFCDX"
INDEX ON Apellido TAG Apellido
INDEX ON Nombre TAG Nombre DESCENDING

SET ORDER TO TAG Apellido
// La llave Apellido fue originalmente creada ascendente

// Cambiamos a descendente
ORDDESCEND(,, .T.)
// ahora Apellido queda ordenada de forma decendente

ORDSCOPE

Tomar en cuanta que cuando hacemos un ORDSCOPE, esto solo afectara al indice seleccionado. los demás indices no son afectados.

ORDSCOPE

Filtra una tabla ordenada con todos los registros en secuencia que inicien con el dato especificado.

ORSCOPE(0,"CUENTA") // Inicio
ORSCOPE(1,"CUENTA") // fin

"CUENTA" puede estar contenido en una variable

No olvidar liberar la tabla a la que fue aplicado cuando terminemos de utilizarlo para no bloquear su uso con otras relaciones

LIBERAR
ORSCOPE(0,NIL)
ORSCOPE(1,NIL)

DOMETHOD, GETPROPERTY Y SETPROPERTY

DOMETHOD() GETPROPERTY() SETPROPERTY() Estas funciones son muy útiles cuando se desea ejecutar un método, extraer o asignar alguna propiedad de un control por medio de parámetros dentro de funciones.

IMPUTMASK Y PICTURE

TEXTBOX tiene gracias a su IMPUTMASK muchas formas de solicitar datos, pero se desea ingresar caracteres y dígitos con una máscara específica, sugiero utilizar GETBOX con PICTURE esto funciona de la misma manera que lo hacia CLIPPER.

Bienvenido

Te doy la Bienvenida a este sencillo espacio en la red, esperando que sea de utilidad para toda la comunidad de programadores que ayudan al mundo a realizar sus tareas de forma mas sencilla.

BOTONES INICIAR PROCESO

Cuando definimos un BOTON (button, buttonex, etc) que llama un proceso con algún ciclo, vale la pena des habilitar el botón hasta finalizado el proceso que realiza pues de lo contrario, existe la posibilidad de que el usuario lo presione una segunda vez ejecutando de esta forma el proceso varias veces en forma simultanea.

GRID

Cuando iniciamos una ventana con el método ON INIT <>, y en <> llenamos alguna GRID:

tomar en cuenta que el usuario puede presionar X antes de que la GRID acabe de llenarse, eso provocaría un error pues la ventana y sus controles se destruyen mientras que <> continua llenando la el Control GRID.

Recomiendo usar INTERACTIVE CLOSE.

GETBOX VALID

Para validad más de una función deben de encerrarse entre paréntesis () y separarse con una coma @ .... GETBOX .... VALID (Función 1, Función 2,...) .

A demás, VALID es my parecido a ON LOSTFOCUS de manera que, cuando el control GETBOX pierda el foco, se validaran las funciones.

ON CHANGE

Cuando se asigna el método ON CHANGE a un control, este se ejecutará siempre que cambie el valor del control, no importa si es por un evento que realice el usuario o si asignamos desde la secuencia del programa un nuevo valor.