DELPHI AL LIMITE http://delphialtimite blogspot com/) CONTENIDO CONTENIDO Explorar unidades y directorios ‘Mostrando datos en el componente StringGrid La barra de estado Creando un navegador con el componente WebBrowser. Creando consultas SQL con parametros Creando consultas SQL rapidas con IBSQL_ Como poner una imagen de fondo en una aplicacion MDI Leyendo los metadatos de una tabla de Interbase/Firebird. Generando mimeros aleatonios ‘Moviendo sprites con el teclado y el raton ‘Mover sprites con doble buffer Como dibujar sprites transparentes. Creando tablas de memoria con ClientDataSet Como crear un hilo de ejecucion Conectando a pelo con INTERBASE 0 FIREBIRD Efectos de animacion en las ventana. Gvardando y cargando opciones ‘Minimizar en la bandeja del sistema Como ocultar una aplicacion Capturar el teclado en Windows. Capturar la pantalla de Windows Obtener los favoritos de Intemet Explorer Crear un acceso directo Averiguar la version de Windows Recorrer un arbol de directorios Ejecutar un programa al arrancar Windows Listar los programas instalados en Windows Ejecutar un programa y esperar a que termine Obtener modos de video Utilizar una fuente TTF sin instalarla Convertir un icono en imagen BMP. Borrar archivos temporales de Internet Deshabilitar el cortafuegos de Windows XP Leer el ntimero de serie de una unidad Leer los archivos del portapapeles. Averiguar los datos del usuario de Windows Leer la cabecera PE de un programa Leer las dimensiones de imagenes JPG, PNG y GIF Descargar un archivo de Intemet sin utilizar componentes ul 13 16 19 B 7 31 35 30 42 45 47 49 32 37 39 60 61 62 63 65 66 a7 69 70 1 n B 74 1S 16 1 1 1D 33 87Averiguar el nombre del procesador y su velocidad Generar claves aleatorias ‘Meter recursos dentro de un ejecutable Dibujar un gradiente en un formulario Trocear y unir archivos ‘Mover componentes en tiempo de ejecucion Trabajando con arrays dinamicos Clonar las propiedades de un control Aplicar antialiasing a una imagen Dibujar varias columnas en un ComboB ox. Conversiones entre unidades de medida Tipos de puntero Dando formato a los mimeros reales Conversiones entre tipos numéricos Creando un cliente de chat IRC con Indy (1) Creando un cliente de chat IRC con Indy (11) Creando un cliente de chat IRC con Indy (111) Creando un procesador de textos con RichE dit (1) Creando un procesador de textos con RichE dit (11) Dibujando con la clase TCanvas (1) Dibujando con la clase TCanvas (II) Dibujando con la clase TCanvas (IID). El componente TTreeView (1) El componente TTreeView (II) Explorar unidades y directonios ‘Mostrando datos en el componente StringGrid Funciones y procedimientos para fecha y hora (1) Funciones y procedimientos para fecha y hora (II) Funciones y procedimientas para fecha y hora (III) Implementando interfaces en Delphi (1) Implementando interfaces en Delphi (II). Implementando interfaces en Delphi (III) La potencia de los ClientDataSet (D. La potencia de los ClientDataSet (II) La potencia de los ClientDataSet (ITI) La potencia de los ClientDataSet (IV) La potencia de los ClientDataSet (V’) ‘Mostrando informacion en un ListView (0). ‘Mostrando informacion en un ListView (II, ‘Mostrando informacion en un ListView (II) Trabajando con archivos de texto y binarios (1) Trabajando con archivos de texto y binarios (11) Trabajando con archivos de texto y binarios (III) Trabajando con archivos de texto y binarios (IV) Trabajando con archivos de texto y binarios (V) Trabajando con documentos XML (1) Trabajando con documentos XML (11), Trabajando con documentos XML (IID) Creando informes con Rave Reports (1) Creando informes con Rave Reports (II)Creando informes con Rave Reports (III) Creando informes con Rave Reports (IV) Creando informes con Rave Reports (V’) Como manejar excepciones en Delphi (1) Como manejar excepciones en Delphi (II) Creando aplicaciones multicapa (1) Creando aplicaciones multicapa (11) Creando aplicaciones multicapa (111) Creando aplicaciones multicapa (IV) Enviando un correo con INDY. Leyendo el correo con INDY ‘Subiendo archivos por FTP con INDY Descargando archivos por FTP con INDY Operaciones con cadenas de texto (1) Operaciones con cadenas de texto (II) Operaciones con cadenas de texto (III) Operaciones con cadenas de texto (IV) Operaciones con cadenas de texto (V) El objeto StringList (1. El objeto StringList (11) El objeto StringList (111) Convertir cualquier tipo de variable a String (1). Convertir cualquier tipo de variable a String (II) 233 237 239 143 146 250 253 257 261 264 265 269 m 73 174 7 280 283 288 291 204 300 303Explorar unidades y directorios Si importante es controlar el manejo de archivos no menos importante es el saber moverse por las unidades de disco y los directorios. Veamos que tenemos Delphi para estos menesteres: function CreateDir( const Dir: string ): Boolean; Esta funcidn crea un nuevo directorio en la ruta indicada por Dir. Devuelve True o False dependiendo si ha podido crearlo o no. El tinico inconveniente que tiene esta funcién es que deben existir los directorios padres. Por ejemplo: CreateDir( 'C:\prueba' ) devuelve True CreateDir( 'C:\prueba\documentos' ) —devuelve True CreateDir( 'C:\otraprueba\documentos' ) devuelve False (y no lo crea) function ForceDirectories( Dir: string ): Boolean; Esta funcidn es similar a CreateDir salvo que también crea toda la ruta de directorios padres. ForceDirectories( ‘C:\prueba’ } devuelve True ForceDirectories( 'C:\prueba\documentos' ) _—devuelve True ForceDirectories( 'C:\otraprueba\documentos' ) devuelve True procedure ChDir( const S: string ); overload; Este procedimiento cambia el directorio actual al indicado por el parametro S. Por ejemplo: chDir( 'C:\Windows\Fonts' ); function GetCurrentDir: string; Nos devuelve el nombre del directorio actual donde estamos posicionados. Por ejemplo: GetCurrentDir devuelve C:\Windows\Fonts function SetCurrentDir( const Dir: string ): Boolean; Establece el directorio actual devolviendo True si lo ha conseguido. Por ejemplo: SetCurrentDir( 'C:\Windows\Java’ }; procedure GetDir( D: Byte; var S: string );Devuelve el directorio actual de una unidad y lo mete en la variable S. El pardmetro D es el nlimero de la unidad siendo D Unidad Unidad por defecto h h c 0 1 3 Por ejemplo para leer el directorio actual de la unidad ‘Directorio: String: begin GetDir( 3, sDixectorio }; ShowNessage( 'E1 directorio actual de la unidad sDirectorio )? end; est + function RemoveDir( const Dir: string ): Boolean; Elimina un directorio en el caso de que este vacio, devolviendo False sino ha podido hacerlo. RenoveDir( 'C:\prueba\documentos' ) devuelve True RenoveDir( 'Ci\prueba’ } devuelve True RenoveDir( 'C:\otraprueba’ ) devuelve False porque no esta function DirectoryExists( const Directory: string ): Boolean; Comprueba si existe el directorio indicado por el parametro Directory. Por ejemplo: DirectoryExists( 'C:\Windows\System32\" ) devuelve True DirectoryExists( 'C:\Windows\MisDocumentos\' ) devuelve False function DiskFree( Drive: te ): Int64; Devuelve el ntimero de bytes libres de una unidad de dico indicada por la letra Drive Drive Unidad Unidad por defecto a 0 1 3 Por ejemplo vamos a ver el nimero de bytes libres de la unidad C: DiskFree( 3) devuelve 5579714560function DiskSize( Drive: Byte ): Int64; Nos dice el tamajio total en bytes de una unidad de disco. Por ejemplo: DiskSize( 3) devuelve 20974428160 BUSCANDO ARCHIVOS DENTRO DE UN DIRECTORIO Para buscar archivos dentro de un directorio disponemos de las funciones: function FindFirst( const Path: string; Attr: Integer; var F: TSearchRec ): integer; Busca el primer archivo, directorio o unidad que se encuentre dentro de una ruta en concreto, Devuelve un cero si ha encontrado algo. El parémetro TSearchRec es una estructura de datos donde se almacena lo encontrado: cype ‘TsearchRec = record Integer; Integer; Integer; ‘TFileNane; ExcludeAttr: Integer; FindHandle: THandle; FindData: TWin32FindData; end; function FindNext( var F: TSearchRec ): Integer; Busca el siguiente archivo, directorio 0 unidad especificado anteriormente por la funcién FindFirst. Devuelve un cero si ha encontrado algo procedure FindClose( var F: TSearchRec ); Este procedimiento cierra la busqueda comenzada por FindFirst y FindNext \Veamos un ejemplo donde se utilizan estas funciones. Vamos a hacer un procedimiento que lista sélo los archivos de un directorio que le pasemos y vuelca su contenido en un StringList: procedure TFPrincipal.Listar( sDirectorio: string; var Resultado: ‘TseringList }; Busqueda: TSearchRec; iResultade: Integer: begin 7/ Nos aseguramos que termine en contrabarra sDirectorio := IncludeTrailingBackslash( sDirectorio );FindFirst( sDirectorio + '*.*', faAnyFile, Busqueda iResultado while iResultado = 0 do begin // ca encontrado un archivo y no es un directorio? Lf ( Busqueda.actr and falrchive = fadrchive ) and ( Busqueda.Attr and faDirectory © faDirectory ) then Resultado.Add( Busqueda.Nane ); iResultado end; FindNext( Busqueda ); FindClose( Busqueda ); end; Si listamos el raiz de la unidad C: Directorio: TStringhist; begin Directorio := TStringlist.Create; Listar( 'c:', Directorio }; ShowNessage(‘Directorio.Text }; Directorio. Free; end; El resultado seria ‘AUTOEXEC. BAT Bootfont. bin CONFIG. SYS INSTALL. LOG 10. SYS MSDOS. SYS NTDETECT. COM Con estas tres funciones se pueden hacer cosas tan importantes como eliminar directorios, realizar busquedas de archivos, calcular lo que ocupa un directorio en bytes, etc Pruebas realizadas en Delphi 7. Mostrando datos en el componente StringGrid Anteriormente vimos como mostrar informacién en un componente ListView Wegando incluso a cambiar el color de filas y columnas a nuestro antojo. El Unico inconveniente estaba en que no se podian cambiar los titulos de las columnas, ya que venian predeterminadas por los colores de Windows Pues bien, el componente de la clase TStringGrid es algo mas cutre que el ListView, pero permite cambiar al 100% el formato de todas las celdas \Veamos primero como meter informacién en el mismo, Al igual que ocurria con el ListView, todos las celdas de un componente StringGrid son de tipo string, siendo nosotros los que le tenemos que dar formato a mano.ANADIENDO DATOS A LA REJILLA Vamos a crear una rejilla de datos con las siguiente columnas: NOMBRE, APELLIDOL, APELLIDO2, NIF, IMPORTE PTE. Cuando insertamos un componente StringGrid en el formulario nos va a poner por defecto la primera columna con celdas fijas (fixed). Vamos a fijar las siguientes propiedades: Propiedad Valor Descripeién colcount. 5 5 columnas RowCount 4 4 filas FixedCols 0 0 columnas fijas FixedRows 1 1 fila fija DefaultRovHeight 20 altura de las filas a 20 pixels Ahora creamos un procedimiento para completar de datos la rajilla: procedure TFormulario.RellenarTabla; begin with StringGrid do begin 7/ Titulo de las colusnas Cells(0, 0] := 'NOMBRE'; Cells{1, 0] := ‘APELLIDOL'; Cells[2, “APELLIDO2"; cells[3, mF; cells[4, ‘IMPORTE PTE. // Datos cells[0, “PABLO* cells[1, “GARCIA' ; Cells[2, “OQRTINEZ' ; cells[3, *@7348321D'; cells[4, *1500,36'; // Datos Cells(0, 2] := ‘MARIA’; celis{i, 2) cells{2, 23 “SANCHEZ; *PALAZOM' ; Celis(3, 2] := '44978234A'; Celis[4, 2] i= '635,21'; // Datos celis[0, cells[1, cells[2, “GUILLEN ; cells[3, “7@8626031'; cells[4, "211,66"; end; end; Al ejecutar el programa puede apreciarse lo mal que quedan los datos enpantalla, sobre todo la columna del importe pendients Tt DANDO FORMATO A LAS CELDAS DE UN COMPONENTE STRINGGRIND Lo que vamos a hacer a continuacién es lo siguiente: - La primera fila fija va a ser de color de fondo azul oscuro con fuente blanca y ademas el texto va a ir centrado, - La columna del importe pendiente va a tener la fuente de color verde y va a ir alineada a la derecha. - El resto de columnas tendran el color de fondo blanco y el texto en negro. Todo esto hay que hacerlo en el evento OnDrawCell del componente StringGrid procedure TFormulario. StringGridDrawCell( Sender: Tobject; ACol, ‘BRow: Integer; Rect: TRect; State: TGridDrawState }7 Texto: String? // Texto que va a imprimir en la celda actual Alineacion: TAlignment; // Alineacién que le vamos a dar al texto ianchoTexto: Integer; // Ancho del texto a imprimir en pixels begin ‘with StringGrid.Canvas do begin // Lo primero es coger la fuente por defecto que le hexos asignado al componente Font. Nane Font. Size StringGrid. Font.Name; StringGrid. Font. Size; Af ARow = 0 then ‘Alineacion else // Si es 1a columna del importe pendiente alineanos 21 texto a la derecha Af ACol = 4 then Alineacion else Alineacion ‘vaCenter ‘taRightdustify vaLeftJustity: // cs una celda fija de sélo lectura? if gdFixed in State then begin Brush.Color := clNavy; // 12 ponemos azul de fondo Font.Color := cluhite; 7/ fuente blanca Font.Style := [fsBold]; // y negrita end elsebegin // dEsta enfocada 1a celda? if gdFocused in State then begin Brush. Color Font. Color Font. Style end else begin 7/ Para el resto de celdas el fondo Lo ponemos blanco Brush. Color := clWindow; clRed; —// fondo rojo clihite; // fuente blanca [ésBold]; // y negrita // cEs la columna del importe pendiente? if Acol = 4 then begin Font. Color Font. Style Alingacion end else begin Font. Color Font.Style : end; end; end; clGreen; // 1a pintamos de azul [esBold]; // y negrita i= taRightJustity; sTexto := StringGrid.Cells[ACol,ARow]; FillRect( Rect ); AanchoTexto := TexeWidth( sTexto }; case Alineacion of vaLeftdustify: Textout( Rect.Left + 5, Rect.Top + 2, sTexto }: taCenter: Textout( Rect.Left + ( ( Rect.Right ~ Rect.Left ) - ianchoTexto ) div 2, Rect.Top +2, sTexto ); taRightdustify: TextOut( Rect.Right - idnchoTexto - 2, Rect.Top +2, sTexto }; end; end; end; Asi quedaria al ejecutarlo: Di Scomconests natn Sdlo hay un pequefio inconveniente y es que la rejilla primero se pinta de manera normal y luego nosotros volvemos a pintarla encima con el evento OnDrawCelll con lo cual hace el proceso dos veces. Si queremos que sdlo se haga una vez hay que poner a False la propiedad DefaultDrawing. Quedaria de la siguiente manera:Por lo demas creo que este componi lue puede sernos muy util para mostrar datos por pantalla en formato de sdlo lectura. En formato de escritura es algo flojo porque habria que controlar que tipos de datos puede escribir el usuario segun en que columnas esté, Pruebas realizadas en Delphi 7. La barra de estado Es raro encontrar una aplicacién que no lleve en alguno de sus formularios la barra de estado, Hasta ahora he utilizado ejemplos sencillos de meter texto en la barra de estado de manera normal, pero el componente StatusBar permite meter multiples paneles dentro de la barra de estado e incluso podemos cambiar el formato de la fuente en cada uno de ellos. ESCRIBIENDO TEXTO SIMPLE El componente de la clase TStatusBar tiene dos estados: uno para escribir texto simple en un sdlo panel y otro para escribir en multiples paneles. Supongamos que el componente de la barra de estado dentro de nuestro formulario de llama BarraEstado. Para escribir en un sélo panel se hace de la siguiente manera BarraEstado.SimplePanel = True; BarraEstado.SimpleText := ‘Texto de prueba‘; Se puede escribir tanto texto como longitud tenga la barra de estado, o mejor dicho, tanto como sea la longitud del formulario. ESCRIBIENDO TEXTO EN MULTIPLES PANELES Para escribir en multiples paneles dentro de la misma barra de estado hay que crear un panel por cada apartado. En este ejemplo voy a crear en la barra de estado tres paneles y en cada uno de ellos voy a poner un formato diferente. begin BarraEstado.SimplePanel BarraEstado. Panels. Clear; False; with Barrafstado.Panels.add do begin Text Width := 50; Style := psOunerDray; Alignment := taRightJustity; end;with Barrafstado.Panels.Add do begin Text = 'ys50'; Width := 50; Style := psOunerDray; Alignment := taRightJustity; end; with Barrafstado.Panels.Add do begin Text "Texto seleccionado'; Style := psText; Width := 50; end; end; La propiedad Style de cada panel determina si es psText o psOwnerDraw. Por defecto todos los paneles que se crean tiene el estilo psText (texto normal) Si elegimos el estilo psOwnerDraw significa que vamos a ser nosotros los encargados de dibujar el contenido del mismo, Ello se hace en el evento ‘OnDrawPanel de la barra de estado: procedure TFormulario.BarraEstadoDravPanel( StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect ); begin case Panel. ID of 0: with BarraEstado.Canvas do begin Font.Name := ‘Tahoma’; Font.Size := 10; Font.Style := [£sBold]; Font.Color := clNavy: TextOue( Rect.Left +2, Rect.Top, Panel. Text )7 end; A: with BarraEstado.Canvas do begin Font.Name := ‘Tahoma’; Font.Size := 10; Font.Style := [£sBold]; Font.Color := clRed; Textdue( Rect.Left +2, Rect.Top, Panel. Text )7 end; end; end; Cuando se van creando paneles dentro de una barra de estado, a cada uno de ellos se le va asignado la propiedad ID a0, 1, 2, etc, la cual es de solo lectura. Como puede verse en el evento OnDrawPanel si el ID es 0 lo pinto de azul y si es 1 de rojo. Pero sdlo funcionara en aquellos paneles cuyo estilo sea psOwnerDraw. Quedaria de la siguiente manera:‘También puede cambiarse en cada panel propiedades tales como el marco (bevel), la alineacién del texto (alignment) y el ancho (width) Esto nos permitira informar mejor al usuario sobre el comportamiento de nuestra aplicacién en tiempo real y de una manera elegante que no interfiere con el contenido del resto del formulario. Pruebas realizadas en Delpl Creando un navegador con el componente WebBrowser Delphi incorpora dentro de la pestafia Internet el componente de la clase ‘TWebBrowser el cual utiliza el motor de Internet Explorer para afiadir un navegador en nuestras aplicaciones. gusase, ia cami (fy Seguro que os preguntareis, ;que utilidad puede tener esto si ya tengo Internet Explorer, Firefox, Opera, etc.? Pues hay ocasiones en que un cliente nos pide que ciertos usuarios sdlo puedan entrar a ciertas paginas web. Por ejemplo, si un usuario est en el departamento de compras, es ldgico que a donde sdlo tiene que entrar es a las paginas de sus proveedores y no a otras para bajarse musica MP3 a todo trapo (no os podeis imaginar la pasta que pierden las empresas por este motivo) Entonces vamos a ver como crear un pequefio navegador con las funcionalidades minimas.‘CREANDO LA VENTANA DE NAVEGACION Vamos a crear la siguiente ventana: Incorpora los siguientes componentes: - Un panel en la parte superior con su propiedad Align fijada a alTop (pegado arriba) - Dentro del panel tenemos una etiqueta para la direccién - Un componente ComboBox llamado URL para la barra de direcciones. - Tres botones para ir atris, adelante y para detener - Una barra de progreso para mostrar la carga de la pagina web - Un componente WebBrower ocupando el resto del formulario mediante su propiedad Align en alClient, de tal manera que si maximizamos la ventana se respete el posicionamiento de todos los componentes. CREANDO LAS FUNCIONES DE NAVEGACION Una vez hecha la ventana pasemos a crear cada uno de los eventos relacionados con la navegacién. Comencemos con el evento de pulsar Intro dentro de la barra de direcciones llamada URL: procedure TFormulario.URLKeyDown( Sender: Tobject; var Key: Word; Shift: Tshiftstate ); begin if key = VK_RETUPN then begin WebBrowser.Wavigate( URL.Text }; URL. Items.Add( URL.Text }; end; end; Si se pulsa la tecla Intro hacemos el objeto WebBrowser navegue a esadireccién. Ademas afiadimos esa direccién a la lista de direcciones URL por la que hemos navegado para guardar un historial de las mismas Cuando se pulse el botén atras en la barra de navegacién hacemos lo siguiente: procedure TFormulario.BAtrasClick( Sender: Tobject }+ begin ‘WebBrowser. GoBack; end; Lo mismo cuando se pulse el botén adelante: procedure TFormulario.BAdelanteClick( Sender: Tobject ); begin ‘WebBrowser. GoForvard; end; Y también si queremos detener la navegacién: procedure TFormulario.BDetenexClick( Sender: Tobject }; begin WebBrowser. Stop; end; Hasta aqui tenemos la parte basica de la navegacién. Pasemos ahora a controlar el progreso de la navegacién asi como que el usuario sdlo pueda entrar a una pagina en concreto. Ala barra de progreso situada a la derecha del botén BDetener la llamaremos Progreso y por defecto estara invisible. Sdlo la vamos a hacer aparecer cuando comience la navegacién. Eso se hace en el evento OnBeforeNavigate2: procedure TFormulario. VebBrowserBeforeNavigate2( Sender: Tobject; const pDisp: IDispatch; var URL, Flags, TargetFramelane, PostData, Headers: OleVariant; var Cancel: WordBool }; begin if Pos( ‘terra’, URL) = 0 then cancel := True; Progreso. Show; end; ‘Aqui le hemos dicho al evento que antes de navegar sila URL de la pagina web no contiene la palabra terra que cancele la navegacién. Asi evitamos que el usuario se distraiga en otras paginas web En el caso de que si pueda navegar entonces mostramos la barra de progreso de la carga de la pagina web. Para controlar el progreso de la navegacién se utiliza el evento OnProgressChange procedure TFormulario.VebBrowserProgressChange( Sender: Tobject: Progress, ProgressMax: Integer }; beginProgreso.Max := ProgressMax; Progreso.Position := Progress; end; Cuando termine la navegacién debemos ocultar de nuevo la barra de progreso. Eso lo hard en el evento OnDocumentComplete: procedure TFormulario.VebBrowserDocumentCouplete( Sender: Tobject; const pDisp: IDispatch; var URL: OleVariant }; begin Progreso.Hide; end; Con esto ya tenemos un sencillo navegador que sélo accede a donde nosotros le digamos. A partir de aqui podemos ampliarle muchas mas caracteristicas tales como memorizar las URL favoritas, permitir visualizar a pantalla completa (FullScreen) e incluso permitir multiples ventanas de navegacién a través de pestafias (con el componente PageControl) ‘También se pueden bloquear ventanas emergentes utilizando el evento ‘OnNewWindow?2 evitando asi las asquerosas ventanas de publicidad: procedure TFormulario. VebBrowserNewiindow2 (Sender: TObject; var ppDisp: IDispateh; var Cancel: Word8ool); begin Cancel + end; True; Aunque ultimamente los publicistas muestran la publicidad en capas mediante hojas de estilo en cascada, teniendo que utilizar otros programas mas avanzados para eliminar publicidad. Pruebas realizadas en Delphi 7. Creando consultas SQL con parametros En el articulo anterior vimos como realizar consultas SQL para INSERT, DELETE, UPDATE y SELECT utilizando el componente IBSQL que forma parte de la paleta de componentes IBExpress. También quedé muy claro que la velocidad de ejecucién de consultas con este componente respecto a otros como IBQuery es muy superior. Todo lo que hemos visto esta bien para hacer consultas esporadicas sobre alguna tabla que otra, pero jque ocurre si tenemos que realizar miles de consultas SQL de una sola vez? UTILIZANDO UNA TRANSACCION POR CONSULTA.Supongamos que tenemos que modificar el nombre de 1000 registros de la tabla CLIENTES: i: Integer? dvTiempo: Diord; begin ‘with Consulta do begin TMAAAAAALLLAL METODO VENTO S///IIIIIIIAAAAL dvTiempo := TimeGetTine; for i := 1 to 1000 do begin SQL. Clear; SQL-Add( ‘UPDATE CLIENTES' }; SQL:Add( ‘SET NOMBRE = ‘+ QuotedStr( ‘NOMBRE CLIENTE we ' + IneToser( i) ) )3 SQL-Add( ‘WHERE ID = ' + IntToStr( i ) ‘Transaction. StartTransaction; uy Execquery; Transaction. Commit; except on E: Exception do begin Application.MessageBox( PChar( E.Message ), ‘Error de SQL', MB_ICONSTOP }; Transaccion-Rollback; end; end; end; ShowMessage( ‘Tiempo: | + IntToStr( TimeGetTime - dvTiempo ) + ' milisegundos' }; end; end; Como puede verse arriba, por cada cliente actualizado he generado una SQL distinta abriendo y cerrando una transaccién para cada registro. He utilizado la funcién TimeGetTime que se encuentra en la unidad MMSystem para calcular el tiempo que tarda en actualizarme el nombre de los 1000 clientes En un PC con Pentium 4 a 3 Ghz, 1 GB de RAMy utilizando el motor de bases de datos Firebird 2.0 me ha tardado 4167 milisegundos, ‘Aunque las consultas SQL van muy répidas con los componentes IBSQL aqui el fallo que cometemos es que por cada registro actualizado se abre y se cierra una transaccién, En una base de datos local no se nota mucho pero en una red local con muchos usuarios trabajando a la vez le puede pegar fuego al concentrador. Lo ideal seria poder modificar la SQL pero sin tener que cerrar la transaccién.Como eso no se puede hacer en una consulta que esta abierta entonces hay que utilizar los parémetros. Los pardmetros (Params) nos permiten enviar y recoger informacién de una consulta SQL que se esta ejecutando sin tener que cerrarla y abrila UTILIZANDO PARAMETROS EN LA CONSULTA Para introducir parametros en una consulta SQL hay que afiadir dos puntos delante del parametro, Por ejemplo UPDATE CLIENTES SET NOMBRE = :NOMBRE WHERE ID = :1D Esta consulta tiene dos pardmetros: ID y NOMBRE. Los nombres de los parametros no tienen porque coincidir con el nombre del campo. Bien podrian ser asi UPDATE CLIENTES SET NOMBRE = :NUEVONOMBRE WHERE ID = :IDACTUAL De este modo se pueden modificar las condiciones de la consulta SQL sin tener que cerrar la transaccién. Después de crear la consulta SQL hay que llamar al método Prepare para que prepare la consulta con los futuros parsmetros que se le van a suministrar (no es obligatorio pero si recomendable). Veamos el ejemplo anterior utilizando parametros y una sdla transaccién para los 1000 registros: i: Integer? dvTiempo: Diord; begin ‘with Consulta do begin . TMMAAAAAALLAL METODO PAPIDO ////////IIAAALAL dvTiempo := TimeGetTine; ‘Transaction. StartTransaction; SQL. Clear; SQL.Add( ‘UPDATE CLIENTES' ); SQL-Add( ‘SET NOMBRE = :NOMBRE' ); SQL.Add( ‘WHERE ID = :1D' }; Prepare: for i t= 1 to 1000 do begin Paraus.ByName( ‘NOMBRE! ).AsString := ‘NOMBRE CLIENTE N° '+ IneTostr( i} Params.ByName( ‘ID’ ).AsInteger := i; Execduers end; uy Transaction. Commit;except on E: Exception do begin Application.MessageBox( PChar( E.Message ), ‘Error de SQL', MB_ICONSTOP }; Transaccion-Rollback; end; end; ShowMessage( ‘Tiempo: | + IntToStr( TimeGetTime - dvTiempo ) + ' milisegundos' }; end; end; En esta ocasién me ha tardado sélo 214 milisegundos, es decir, se ha reducido al 5% del tiempo anterior sin saturar al motor de bases de datos abriendo y cerrando transacciones sin parar. Este método puede aplicarse también para consultas con INSERT, SELECT y DELETE. En lo Unico en lo que hay que tener precaucién es en no acumular muchos datos en la transaccién, ya que podria ser peor el remedio que la enfermedad. Si teneis que actualizar cientos de miles de registros de una sola vez, recomiendo realizar un Commit cada 1000 registros para no saturar la memoria caché de la transaccién. Todo depende del ntimero de campos que tengan las tablas asi como el ntimero de registros a modificar. Utilizad la funcién TimeGetTime para medir tiempos y sacar conclusiones. Y si el proceso a realizar va a tardar mas de 2 0 3 segundos utilizar barras de progreso @ hilos de ejecucién, ya que algunos usuarios neurdticos podrian creer que nuestro programa se ha colgado y empezarian ha hacer clic como posesos (0s aseguro que existe gente asi, antes de que termine la consulta SQL ya te estin llamando por teléfono echandote los perros) Pruebas realizadas con Firebird 2.0 y Dephi 7 Creando consultas SQL rapidas con IBSQL Cuando se crea un programa para el mantenimiento de tablas de bases de datos (clientes, articulos, etc.) el método ideal es utilizar componentes ClientDataSet como vimos anteriormente. Pero hay ocasiones en las que es necesario realizar consultas rapidas en el servidor tales como incrementar existencias en almacén, generar recibos automaticamente o incluso incrementar nuestros contadores de facturas sin utilizar generadores. En ese caso el componente mas rapido para bases de datos Interbase/Firebird es IBSQL el cual permite realizar consultas SQL sin que estén vinculadas a ningun componente visual. Vamos a ver unos ejemplos de insercién,modificacién y eliminacién de registros utilizando este componente. INSERTANDO REGISTROS EN UNA TABLA Aqui tenemos un ejemplo de insertar un registro en una tabla llamada CLIENTES utilizando un objeto IBSQL llamado Consulta with Consulta do begin SQL. Clear; SQL.Add( ‘INSERT INTO CLIENTES' ); SQL:Add( '( NOMBRE, NIF, IMPORTEPTE )* ); SQL.Add( 'VALUES' }; SQL-Add( '( '*ANTONTO GARCIA LOPEZ‘*, ‘*46876289D'*, 140.23 }' }z ‘Transaction. StartTransaction; uy Execuery; Transaction. Commit; except on E: Exception do begin Application.MessageBox( PChar( E.Message ), ‘Error de SQL', MB_ICONSTOP }; Transaccion-Rollback; end; end; end; Como puede apreciarse hemos tenido que abrir nosotros a mano la transaccién antes de ejecutar la consulta ya que el objeto IBSQL no la abre automaticamente tal como ocurre en los componentes IBQuery Una vez ejecutada la consulta, si todo ha funcionado correctamente enviamos la transaccién al servidor mediante el método Commit, En el caso de que falle mostramos el error y cancelamos la transaccién utilizando el método RollBack MODIFICANDO LOS REGISTROS DE UNA TABLA El método para modificar los registros es el mismo que para insertarlos: with Consulta do begin SQL. Clears SQL.Add( ‘UPDATE CLIENTES' }; SQL. Add( 'SET NOMBRE = ''MARTA GUILLEN ROJO'',' ); SQL:Add( (NIF = ‘ses236724W'', ' ); SQL-Add( ‘IMPORTEPTE = 80.65' SQL-Add( ‘WHERE 1D=21963' }; ‘Transaction. StartTransaction; uyExecduery; Transaction. Commit; except on E: Exception do begin Application.MessageBox( PChar( E.Message ), ‘Error de SQL', MB_ICONSTOP }; Transaccion-Rollback; end; end; end; ELIMINANDO REGISTROS DE LA TABLA Al igual que para las SQL para INSERT y UPDATE el procedimiento es el mismo: with Consulta do begin SQL. Clear; SQL-Add( ‘DELETE FROM CLIENTES' ); SQL.Add( ‘WHERE 1D=21964' }; ‘Transaction. StartTransaction; uy Execduery; Transaction. Commit; except on E: Exception do begin Application.MessageBox( PChar( E.Message ), ‘Error de SQL', MB_ICONSTOP }; Transaccion-Rollback; end; end; end; CONSULTANDO LOS REGISTROS DE UNA TABLA El método de consultar los registros de una tabla mediante SELECT difiere de los que hemos utilizado anteriormente ya que tenemos que dejar la transaccién abierta hasta que terminemos de recorrer todos los registros: with Consulta do begin SQL. Clear; SQL.Add( ‘SELECT * FROM CLIENTES' ); SQL-Add( ‘ORDER BY ID* }; ‘Transaction. StartTransaction; // Ejecutarmos consulta ty Execduery; except on E: Exception do begin Application.MessageBox( PChar( E.Message ), ‘Error de SQL', MB_ICONSTOP };Transaccion-Rollback; end; end; // Recorrenos los registros while not Eof do begin Meno. Lines. Add( FieldByNane( 'NOMBRE' ).AsString ); Next; end; // Cexramos 1a consulta y 1a transaccién Close; Teansaction.Active : end; False; ‘Aunque pueda parecer un cofiazo el componente de la clase TIBSQL respesto a los componentes TIBTable o TIBQuery, su velocidad es muy superior a ambos componentes, sobre todo cuando se ejecutan las consultas sucesivamente, En el préximo articulo veremos cémo utilizar pardmetros en las consultas. Pruebas realizadas en Firebird 2.0 y Delphi 7. Como poner una imagen de fondo en una aplicaci6én MDI En un articulo anterior vimos como crear aplicaciones MDI gestionando multiples ventanas hijas dentro de la ventana padre Una de las cosas que mas dan vistosidad a una aplicacién comercial es tener un fondo con nuestra marca de fondo de la aplicacién (al estilo Contaplus 0 Facturaplus} Para introducir una imagen de fondo en la ventana padre MDI hay que hacer lo siguiente: - Introducir en la ventana padre (la que tiene la propiedad FormStyle a MDIForm) un componente de la clase Timage situado en la pestafia Additional. Al componenente lo vamos a llamar Fondo. - En dicha imagen vamos a cambiar la propidedad Align a alClient para que ‘ocupe todo el fondo del formulario padre. - Ahora sdlo falta cargar la imagen directamente: Fondo. Picture. LoadFrouFile( ‘c:\imagenes\fondo.bmp' ); El Unico inconveniente que tiene esto es que no podemos utilizar los eventos del formulario al estar la imagen encima (Drag and Drop, etc).UTILIZANDO EL CANVAS Otra forma de hacerlo seria poniendo el objeto Thmage en medio del formulario pero de manera invisible (sin alClient). Después en el evento OnPaint del formulario copiamos el contenido de la imagen Tlmage al fondo del formulario: procedure TFormulario.FormPaint( Sender: Tobject }; var R: TRect; begin R.beft t= 0; RiTop := 07 R.Right := Fondo. Width, R.Bottom := Fondo.Height, Canvas. CopyRect( R, Fondo.Canvas, R }; end; Asi podemos tener igualmente una imagen de fondo sin renunciar a los eventos del formulario (OnMouseMove, OnClick, etc.) Pruebas realizadas en Dephi 7. Leyendo los metadatos de una tabla de Interbase/ Firebird No hay nada que cause mas pereza a un programador que la actualizacién de campos en las bases de datos de nuestros clientes. Hay muchas maneras de hacerlo: desde archivos de texto con metadatos, archivos SQL 9 incluso actualizaciones por Internet con FTP o correo electrénico, Yo lo que suelo hacer es tener un archivo GDB o FDB (segtin sea Interbase o Firebird respectivamente) que contiene todas las bases de datos vacias. Si tengo que ampliar algin campo lo hago sobre esta base de datos Después cuando tengo que actualizar al cliente lo que hago es mandarle mi GDB vacio y mediante un pequefio programa que tengo hecho compara las estructuras de la base de datos de mi GDB vacio y las del cliente, creando tablas y campos nuevos segtin las diferencias sobre ambas bases de datos. Ahora bien, ;Cémo podemos leer el tipo de campos de una tabla? Pues en principio tenemos que el componente IBDatabase tiene la funcién GetTableNames que devuelve el nombre de las tablas de una base de datos y la funcién GetFieldNames que nos dice los campos pertenecientes a una tabla en onereto. El problema radica en que no me dice que tipo de campo es (float, string, blob, etc) LEYENDO LOS CAMPOS DE UNA TABLA Para leer los campos de una tabla utilizo el componente de la clase TIBQuery situado en la pestafia Interbase. Cuando este componente abre una tabla carga el nombre de los campos y su tipo en su propiedad FieldDefs. Voy arealizar una aplicacién sencilla en la cual seleccionamos una base de datos Interbase o Firebird y cuando se elija una tabla mostrar sus metadatos de esta manera: a ase cats: FiDerOUDEERULTENEGGRSBSDNTTSRE ania Tatts FTE =] _ ator Va a contener los siguientes componentes: BE fwedecios [aa etn! [ a inter fs “conpos Amie = Un componente Edit con el nombre RUTADB que va 2 guardar la ruta de la base de datos. - Un componente de la clase TOpenDialog llamado AbrirBaseDatos para buscar la base de datos Firebird/Interbase. - Un botén llamado BExaminar - Un componente ComboBox llamado TABLAS que guardara el nombre de las tablas de la base de datos. - Un componente IBDatabase llamado BaseDatos que utilizaremos para conectar, - Un componente IBTransaetion llamado Transaccion para asociarlo a la basede datos, - Un componente IBQuery llamado IBQuery que utilizaremos para abrir una tabla. -Y por tiltimo un campo Meme llamado Memo para mostrar la informacion de los metadatos. Comenzemos a asignar lo que tiene que hacer cada componente: - Hacemos doble clic sobre el componente BaseDatos y le damos de usuario SYSDBA y password masterkey. Pulsamos Ok y desactivamos su propiedad LoginPrompt. - Asignamos el componente Transaccion a los componentes BaseDatos y [Query - Asignamos el componente BaseDatos a los componentes Transaccion y [Query - En la propiedad Filter del componente AbrirBaseDatos ponemos: Interbase |*.edb| Firebird | *.fdb - Al pulsar el botdn Examinar hacemos lo siguiente procedure TFormulario.BExaminarClick( Sender: TObject ); begin LE AbrirBaseDatos.Execute then begin RUTADB.Text := AbrirBaseDatos. FileName; BaseDatos.DatabaseName := '127.0.0.1:' + RUTADB.Text; uy BaseDatos. Open; except on E: Exception do Application.MessageBox( PChar( E.Message ), ‘Error al abrir base de datos’, ‘MB_ICONSTOP ); end; BaseDatos.GetTableNanes( TABLAS. Itens, False }; end; end; Lo que hemos hecho es abrir la base de datos y leer el nombre de las tablas que guardaremos dentro del ComboBox \lamado TABLAS. Cuando el usuario seleccione una tabla y pulse el botén Mostrar hacemos lo siguiente:procedure TFormulario.BMostrarClick( Sender: Tobject }; a: Integer? sTipo: String? begin with IBQuery do begin ‘Meno.Lines.Add( ‘CREATE TABLE ' + TABLAS.Text + ' (' ); SQL. Clear; SQL.Add( ‘SELECT * FROM | + TABLAS.Text ); open; for i t= 0 to FieldDefs.count - 1 do begin sTipo r= ''; Lf FieldDefs. Ivens[i].FieldClass.ClassNane = 'TIBStringField' then sTipo := 'VARCHAR(' + IntToStr( FieLdByllame( FieldDefs.Items[i].Name ).Size } + ')'; if FieldDefs.Itens[i].FieldClass.ClassNane = 'TFloatField' then sTipo := ‘DOUBLE PRECISION'; // Tambien podria ser FLOAT (32 bits) aunque prefiero DOUBLE (é4 bits) Af FieldDefs.Ivens[i].FieldClass.ClassNane = 'TIntegerField' then sTipo := ‘INTEGER: if FieldDefs.Ivens[i].FieldClass.ClassNane = ‘TDateField' then sTipo := 'DATE'; if FieldDefs.Itens[i].FieldClass.ClassNane = ‘TTimeField' then sTipo := 'TIME'; if FieldDefs.Itens[i].FieldClass.ClassNane = 'TDateTineField’ then sTipo := ‘TIMESTAMP! ; if FieldDefs.Itens[i].FieldClass.ClassNane = ‘TBlobField' then sTipo := "BLOB"; // GBs un campo obligatorio? LE FieldByNane( FieldDefs.Items[i].Nane ).Requized then sTipo := sTipo + * NOT NULL'; Meno.Lines.Add( ' ' + FieldDefs.Ivens[i].Name + ' ' + sTipo ); // Si no es el altino campo afiadimos una coma al final AE i < FieldDefs.Count - 1 then Memo. Lines[Meno. Lines. Count-1] lets! end; Meno. Lines[Meno. Lines. Count Meno.Lines.Add( ')' ); close; Transaction.Active := False;end; end; Lo que hace este procedimiento es abrir con el componente IBQuery la tabla seleccionada y segtin los tipos de campos creamos la SQL de creacién de la tabla. Este método también nos podria ser util para hacer un programa que copie datos entre tablas Interbase/Firebird. Pruebas realizadas con Firebird 2.0 y Delphi 7. Generando nimeros aleatorios Las funciones de las que disponen los lenguajes de programacién para generar numeros aleatorios se basan en una pequefia semilla segun la fecha del sistema y a partir de ahi se van aplicando una serie de formulas se van generando numeros al azar seguin los milisegundos que lleva el PC arrancado. Dephi dispone de la funcién Random para generar ntimeros aleatorios entre 0 y el pardmetro que se le pase. Pero para que la semilla no sea siempre la misma es conveniente inicializarla utilizando el procedimiento Randomize Por ejemplo, si yo quisiera inventarme 10 numeros del 1 y 100 haria lo siguiente: procedure TFormulario. Inventar10Numeros; i: Integer? begin Randomize; 1 to 10 do sLines.Add( IntToStr( Random( 100) +1) ); El resultado lo he volcado a un campo Memo. INVENTANDO LOS NUMEROS DE LA LOTO Supongamos que quiero hacer el tipico programa que genera automaticamente las combinaciones de la loto. El método es tan simple como hemos visto anteriormente: procedure TFormulario. InventarLoto; i: Integer; begin Randomize; 1 to 6 do sLines.Add( IntToStr( Random( 4°) +1) );Pero asi como lo genera es algo chapucero. Primero tenemos el problema de que los ntimeros inventados no los ordena y luego podria darse el caso de el ordenador se invente un ntimero dos veces Para hacerlo como Dios manda vamos a crear la clase TSorteo encargada de inventarse los 6 numeros de la loto y el complementario. Ademas lo vamos a hacer como si fuera de verdad, es decir, vamos a crear un bombo, le vamos a introducir las 49 bolas y el programa las va a agitar y sacara una al azar. Y por Ultimo también daremos la posibilidad de excluir ciertos nimeros del bombo (por ejemplo el 1 y 49 son los que menos salen por estadistica) Comencemos creando la clase TSerteo en la seccién type: cype Tsorteo = class ‘Tate; Museros: Tstringlist; Complementario: Strin Excluidos: TStringlis constructor Create; destructor Destroy; override; procedure Inventar; procedure Excluir( sNumero: String ); end; Como podemos ver en la clase los nuimeros inventados y los excluidos los voy a meter en un StringList. El constructor de la clase TSorteo va a crear ambos StringList: constructor TSorteo.Create; begin dumeros := TStringList. Create; Excluidos := TStringlist. Create; end; Y el destructor los liberara de memoria destructor TSorteo.Destroy; begin Excluidos. Free; Muneros. Free; end; Nuestra clase TSorteo también va a incluir un método para excluir del sorteo el nimero que queramos: procedure TSorteo.Excluir( sMumero: String ); begin // Antes de excluirlo comprobamos si ya lo esta if Excluidos.Index0f( slfumero } = -1 then Excluidos.Add( sNumero ); end;Y aqui tenemos la funcién que se inventa el sorteo evitando los excluidos: procedure TSorteo. Inventar; Boubo: TStringhist; i, iPosl, iPos2: Integer; stlumero, sBola: String; begin // Metemos las 49 bolas en el bombo Boubo := TStringlist. Create; Muneros.Clear; for i begin sNumexo + 1 to 48 do CompletarCodigo( IntToStr( i}, 2} if Excluidos.Index0f( stfumero ) = -1 then Boubo.Add( sNunero }; end; // Agivanos las bolas con el método de la burbuja LE Bombo. Count > 0 then for i i= 1 to 10000 + Random( 10000 } do begin 7/ Wos inventanos dos posiciones distintas en ©1 boxbo iPosl := Random( Bombo.Count }; 4iPos2 := Random( Boubo.Count }; if ( iPost iPos2 <= 49 ) then begin 7/ Intexcambianos las bolas en esas dos posiciones inventadas sBola := Bombo[iPosl]; 0) and | 0) and ( Post 48) and ( iPos? Bombo[iFosl] := Bombo[iPos2]; Bombo[ifos2] := sBola; end; end; // Vauos sacando las 6 bolas al azar + complementario for i t= 0 to é do begin ‘LE Boubo.Count > 0 then APosl := Random( Bombo.Count } else iPosl, Af ( iPosl >= 0 ) and ( iPosl 49) then ‘sBola := Boubo[iPos1] else sBola z= ''; // Zs 21 complenentario? EL = é then // bo sacamos aparte Complementario := sBola else // lo metemos en la lista de mimeros Mumeros.Add( sBola ); // Sacamos 1a bola extraida del bomboif ( iPosl >= 0 ) and ( iPosl <= 49 ) and ( Bombo.Count > 0 ) then Bonbo.Delete( iPosl }; end; // Ordenamos los € mimeros Muneros.Sort; Bonbo. Free; end; El procedimiento Inventar hace lo siguiente: 1° Crea un bombo dentro de un StringList y le mete las 49 bolas: 2° Elimina los numero excluidos si los hay (los excluidos hay que meterlos en dos cifras, 01, 07, etc.) 3° Agita los ntimeros dentro del bombo utilizando del método de la burbuja para que queden todas las bolas desordenadas: 4° Extrae las 6 bolas y el complementario eligiendo a azar dos posiciones del StringList para hacerlo todavia mas rebuscado. Al eliminar la bola extraida evitamos asi numeros repetidos, tal como si fuera el sorteo real. 5° Una vez inventados los ntimeros los deposita en el StringList llamado Numeros y elimina de memoria el Bombo Ahora vamos a utilizar nuestra clase TSorteo para generar una combinacién’ procedure TFormulario. InventarSorteo; S: TSorteo; begin Randomize; § := TSorteo. Create; 8. Inventar; Meno.Lines.Add( $.Muneros.Text }; 5. Free end; Si quisiera excluir del sorteo los nimero 1 y 49 haria lo siguiente: S: TSorteo; begin Randomize; § := TSorteo. Create; S.Excluir( '01' ); S.Excluir( '49' ); S.Inventar; Meno.Lines.Add( $.Nuneros.Text }; S.Free; end; Este es un método simple para generar los numeros de la loto pero las variantes que se pueden hacer del mismo son infinitas, Ya depende de laimaginacién de cada cual y del uso que le vaya a dar al mismo. Igualmente seria sencillo realizar algunas modificaciones para inventar otros sorteos tales como el gordo de la primitiva, el sorteo de los euromillones o la quiniela de futbol Moviendo sprites con el teclado y el ratén Basandome en el ejemplo del articulo anterior que mostraba como realizar el movimiento de sprites con fondo vamos a ver como el usuario puede mover los sprites usando el teclado y el raton. CAPTURANDO LOS EVENTOS DEL TECLADO La clase TForm dispone de dos eventos para controlar las pulsaciones de teclado: OnKeyDown y OnKeyUp. Necesitamos ambos eventos porque no sdlo me interesa saber cuando un usuario ha pulsado una tecla sino también cuando la ha soltado (para controlar las diagonales). Para hacer esto voy a crear cuatro variables booleanas en la seccién private el formulario que me van a informar de cuando estan pulsadas las teclas del cursor: cype private ( Private declarations } Sprite: Tsprite; Buffer, Fondo: Timage; bDerecha, bIzquierda, bArriba, babajo: Boolean; Estas variables las voy a actualizar en el evento OnKeyDown: procedure TFormulario.ForaKeyDown( Sender: TObject; var Key: Word; Shift: Tshiftstate ); begin case key of VK_LEFT: bizquierda := True; VE DOWN: bAbajo := True; VKUP: barriba := True; VEIRIGHT: bDerecha := True; end; end; yen el evento OnKeyUp procedure TFormulario. ForaKeyUp( Sender: Tobject; var Key: Word; Shift: Tshiftstate ); begin case key of ‘VK _LEFT: bizquierda := False; VEDOWN: bAbajo := False; VELUP: barriba := False; VERIGHT: bDerecha := False;end; end; Al igual que hice con el ejemplo anterior voy a utilizar un temporizador (Timer) llamado TmpTeclado con un intervalo que va a ser también de 10 milisegundos y cuyo evento OnTimer va a encargarse de dibujar el sprite en pantalla: procedure TFormulario.TapTecladoTimer( Sender: TObject ); begin 7/ Ga pulsado 1a vecla izquierda? if bizquierda then if Sprite.x > 0 then Dec( Sprite.x }; // Ha pulsado 1a tecla arriba? AE Arriba then if Sprite.y > 0 then Dec( Sprite.y ); // Ha pulsado 1a tecla derecha? Lf BDerecha then if Sprite.x + Sprite.Imagen.Width < ClientWidth then Ine( Sprite.x ); // Ha pulsado 1a tecla abajo? if babajo then if Sprite.y + Sprite.Imagen.Height < ClientHeight then Ine( Sprite.y ); Dibujarsprite: end; Este evento comprueba la pulsacién de todas las teclas controlando que el sprite no se salga del formulario. El procedimiento de DibujarSprite seria el siguiente: procedure TFormulario.Dibujarsprite; Origen, Destino: TRect; begin // Copiamos ©1 fondo de pantalla al buffer Origen. Left := Sprite.x: Origen. Top := Sprite.y: Origen|Right := Sprite.x + Sprite. Imagen. Width; Origen.Botton := Sprite.y + Sprite. Imagen. Height; Destino.Left := 0; Destino. Top Destino.Right := Sprite. Imagen. Width; Destino.Bottom := Sprite. Inagen.Height; Buffer.Canvas.CopyMode :+ enSrcCopy; Buffer.Canvas.CopyRect( Destino, Fondo.Canvas, Origen ); // Dibujanos el sprite en el buffer encima del fondo copiado Sprite.Dibujar( 0, 0, Buffer.Canvas ); // Dibujanos el contenido del buffer a la pantalla Canvas.Draw( Sprite.x, Sprite.y, Buffer. Picture. Graphic ); end;Practicamente es el mismo visto en el articulo anterior. Ya sdlo hace falta poner el marcha el mecanismo que bien podria ser en el evento OnCreate del formulario: begin ‘TapTeclado.Enabled := True; Sprite.x :5 250; Sprite.y := 150; end; CAPTURANDO LOS EVENTOS DEL RATON Para capturar las coordenadas del ratén vamos a utilizar el evento OnMouseMove del formulario: procedure TFormulario.ForaMouseMove( Sender: TObject; Shift: ‘Tsnigescate: X, Yi Integer ); begin Sprite.x := X; Sprite.y t= ¥; end; Para controlar los eventos del ratén voy a utilizar un temporizador distinto al del teclado llamado TmpRaton con un intervalo de 10 milisegundos. Su evento OnTimer seria sencillo: procedure TFormulario.TapRatonTimer( Sender: TObject }; begin Dibujarsprite: end; Aqui nos surge un problema importante: como los movimientos del ratén son mas bruscos que los del teclado volvemos a tener el problema de que el sprite nos va dajando manchas en pantalla. Para solucionar el problema tenemos que restaurar el fondo de la posicién anterior del sprite antes de dibujarlo en la nueva posicién, Para ello voy a guardar en la clase TSprite las coordenadas anteriores: cype ‘Tsprite = class public x, ¥» MANterior, yAnterior: Integer; ColorTransparente: TColor; Imagen, Mascara: TImage; constrlctor Create; destructor Destroy; override; procedure Cargar( sImagen: string ); procedure Dibujar( x, y: Integer; Canvas: TCanvas ); end; Al procedimiento DibujarSprite le vamos a afiadir que restaure el fondo del sprite de la posicién anterior: procedure TFormulario.Dibujarsprite;Origen, Destino: TRect; begin // Restauramos 21 fondo de 1a posicién anterior del sprite LE ( Sprite.zanterior <> Sprite.x ) oz ( Sprite.yanterior <> Sprite.y ) then begin Origen. Left := Sprite-xAnterior; Origen. Top := Sprite.yanterior: Origen.Right := Sprite.xAnterior + Sprite. Imagen. Width; Origen.Bottom := Sprite.yAnterior + Sprite. Imagen. Height; Destino := Origen; Canvas. CopyMode := cuSrcCopy; Canvas. CopyRect( Destino, Fondo.Canvas, Origen }; end; // Copiamos ©1 fondo de pantalla al buffer Origen. Left := Sprite.x: Origen. Top :+ Sprite-y; Origen/Right := Sprite.x + Sprite. Imagen. Width; Origen.Bottom := Sprite.y + Sprite. Imagen. Height; Destino.Left := 0; Destino.Top : Destino.Right := Sprite. Imagen. Width; Destino.Bottom := Sprite. Imagen. Height; Buffer.Canvas.CopyMode :> enSrcCopy; Buffer.Canvas.CopyRect( Destino, Fondo.Canvas, Origen ); // Dibujanos el sprite en el buffer encima del fondo copiado Sprite.Dibujar( 0, 0, Buffer.Canvas ); // Dibujanos e1 contenido del buffer a la pantalla Canvas.Draw( Sprite.x, Sprite.y, Buffer.Picture.Graphic ); Sprite.xanterior Sprite. yanterior end; Sprite.x; Sprite.y? Y finalmente activamos el temporizador que controla el ratén y ocultamos el cursor del ratdn para que no se superponga encima de nuestro sprite begin ‘TapRaton.Enabled := True; Sprite.x := 250; Sprite.y := 150; ShovCursor( False ); end; Al ejecutar el programa podeis ver como se mueve el sprite como si fuera el cursor del ratén, ‘Aunque se pueden hacer cosas bonitas utilizando el Canvas no os hagais muchas ilusiones ya que si por algo destaca la libreria GDI de Windows (el Canvas) es por su lentitud y por la diferencia de velocidad entre ordenadores. Para hacer cosas serias habria que irse a la librerias SDL (mi favorita), OpenGL o DirectX ( aunque hay decenas de motores graficos 2D y 3D para Delphi en Internet que simplifican el trabajo)Pruebas realizadas en Delphi 7. Mover sprites con doble buffer En el articulo anterior creamos la clase TSprite encargada de dibujar figuras en pantalla. Hoy vamos a reutilizarla para mover sprites, pero antes vamos a hacer una pequefia modificacién: cype ‘Tsprite public x, yi Integer; ColorTransparente: TColor; Imagen, Mascara: TImage; constructor Create; destructor Destroy; override; procedure Cargar( sTmagen: string ); procedure Dibujar( x, y: Integer; Canvas: TCanvas ); end; class Sélo hemos modificado el evento Dibujar afiadiendo las coordenadas de donde se va a dibujar (independientemente de las que tenga el sprite). La ‘implementacién de toda la clase TSprite quedaria de esta manera ( Tsprite } constructor TSprite.Create; begin inherited; Imagen := Timage.Create( nil ); Imagen. AutoSize := True; Mascara := TImage.Create( nil ); ColorTransparente := RGB( 255, 0, 255 ); end; destructor Tsprite-Destroy; begin Mascara. Free; Imagen. Free; inherited; end; procedure Tsprite.Cargar( sImagen: string ); i, 3: Integer; begin Imagen. Picture. LoadFromFile( sIuagen ); Mascara.Width != Imagen. Width; Mascara.Height := Inagen,Height; for } := 0 to Imagen-Height - 1 do for i := 0 to Imagen.Width - 1 do Af Inagen.Canvas.Pixels[i, }] = ColorTransparente then beginImagen. Canvas. Pixels[i, 3] + Mascara. Canvas. Pixels[i, 3] end else ‘Mascara. Canvas. Pixels[i, 3] 0; = RGB( 255, 255, 255); RGB( 0, 0, 0 }s end; procedure TSprite.Dibujar( x, y: Integer; Canvas: TCanvas }; begin Canvas. CopyMode := cuSrcand; Canvas.Draw( x, y, Mascara.Picture.Graphic }; Canvas. CopyMode :+ cuSrcPaint; Canvas.Drav( x, y, Imagen. Picture. Graphic }; end; CREANDO EL DOBLE BUFFER Cuando se mueven figuras grdficas en un formulario aparte de producirse parpadeos en el sprite se van dejando rastros de las posiciones anteriores. Sucede algo como esto: a6] OEE Para evitarlo hay muchisimas técnicas tales como el doble o triple buffer. Aqui vamos a ver como realizar un doble buffer para mover sprites. El formulario va a tener el siguiente fondo: El fondo tiene unas dimensiones de 500x300 pixels, Para ajustar el fondo al formulario configuramos las siguientes propiedades en el inspector de objetos: 500 300 Formulario.ClientWidth Formulario.ClientHeight Se llama doble buffer porque vamos a crear dos imagenes: Fondo, Buffer: TImage; El Fondo guarda la imagen de fondo mostrada anteriormente y el Buffer va a encargarse de mezclar el sprite con el fondo antes de llevarlo a la pantalla.Los pasos para dibujar el sprite serian los siguientes: Paral canvas del formuario 1° Se copia un trozo del fondo al buffer. 2° Se copia el sprite sin fondo encima del buffer. 3° Se lleva el contenido del buffer a pantalla Lo primero que vamos a hacer es declarar en la seccién private del formulario los objetos: private ( Private declarations } Sprite: Tsprite: Buffer, Fondo: TInage; Después los creamos en el evento OnCreate del formulario: procedure TFormulario.FormCreate( Sender: Tobject }+ begin Sprite := Tsprite.Create: Sprite.Cargar( ExtractFilePath( Application.ExeNane ) + ‘sprite-bmp' Buffer := TImage.Create( nil }; Buffer.Width := Sprite. Imagen. Width; Buffer Height := Sprite. Imagen. Height: Fondo := TImage.Create( nil }; Fondo. Picture. LoadFroaFile( ExtractFilePath( Application.ExeName ) + ‘fondo-bmp' ); end;El fondo también lo he creado como imagen BMP en vez de JPG para poder utilizar la funcidn CopyRect del Canvas. Nos aseguramos de que en el evento ‘OnDestroy del formulario se liberen de memoria: procedure TFormulario.FormDestroy( Sender: Tobject }; begin Sprite. Free; Buffer.Free; Fondo. Free; end; Aunque podemos mover el sprite utilizando un bucle for esto podria dejar nuestro programa algo pillado, Lo mejor es moverlo utilizando un objeto de la clase TTimer. Lo introducimos en nuestro formulario con el nombre Temporizador. Por defecto hay que dejarlo desactivado (Enabled = False) y vamos a hacer que se mueva el sprite cada 10 milisegundos (Invertal = 10) En el evento OnTimer hacemos que se mueva el sprite utilizando los pasos mencionados procedure TFSprites.TemporizadorTimer( Sender: TObject ); Origen, Destino: TRect; begin if Sprite.x < 400 then begin Inc( Sprite.x ); // Copiamos ©1 fondo de pantalla al buffer Origen. Left := Sprite.x: Origen. Top := Sprite.y: Origen:Right := Sprite.x + Sprite. Imagen. Width; Origen.Bottom := Sprite.y + Sprite. Imagen. Height; Destino.Left := 0; Destino.Top : Destino.Right := Sprite. Imagen. Width: Destino.Bottom := Sprite. Inagen. Height; Buffer.Canvas.CopyMode :+ emSrceCopy; Buffer.Canvas.CopyRect( Destino, Fondo.Canvas, Origen }; // Dibujanos el sprite en el buffer encima del fondo copiado Sprite.Dibujar( 0, 0, Buffer.Canvas ); // Dibujanos el contenido del buffer a la pantalla Canvas.Draw( Sprite.x, Sprite.y, Buffer. Picture.Graphic ); end else ‘Tenporizador.Enabled end; False; En el evento OnPaint del formulario tenemos que hacer que se dibuje el fondo: procedure TFormulario.FormPaint( Sender: Tobject }; begin Canvas.Drav( 0, 0, Fondo. Picture.Graphic }; end;Esto es necesario por si el usuario minimiza y vuelve a mostrar la aplicacién, ya que sélo se refresca la zona por donde est moviéndose el sprite. Por fin hemos conseguido el efecto deseado: Pruebas realizadas en Delphi 7. Como dibujar sprites transparentes Un Sprite es una figura grafica movil utilizada en los videojuegos de dos dimensiones. Por ejemplo, un videojuego de naves espaciales consta de los sprites de la nave, los meteoritos, los enemigos, etc., es decir, todo lo que sea movil en pantalla y que no tenga que ver con los paisajes de fondo. Anteriormente vimos como copiar imagenes de una superficie a otra utilizando los métodos Draw 0 CopyRect que se encuentran en la clase TCanvas. También se vid como modificar el modo de copiar mediante la propiedad CopyMode la cual permitia los valores emSreCopy, smMergePaint, ete. El problema radica en que por mucho que nos empefiemos en dibujar una imagen transparente ningun tipo de copia funciona: o la hace muy transparente 0 se estropea el fondo. DIBUJAR SPRITES MEDIANTE MASCARAS. Para dibujar sprites transparentes hay que tener dos imagenes: a original cuyo color de fondo le debemos dar alguno como comtin (como el negro) y la imagen de la mascara que es igual que la original pero como si fuera un negativo. Supongamos que quiero dibujar este sprite (archivo BMP) Es conveniente utilizar de color transparente un color de uso como comtin. En este caso he elegido el color rosa cuyos componentes RGB son (255,0,255). La mascara de esta imagen seria la siguiente:Esta mascara no es necesario crearla en ningtin programa de dibujo ya que la vamos a crear nosotros internamente, Vamos a encapsular la creacién del sprite en la siguiente clase cype ‘Tsprite = class public x, yi Integer; ColorTransparente: TColor; Imagen, Mascara: TImage; constructor Create; destructor Destroy; override; procedure Cargar( Imagen: string ); procedure Dibujar( Canvas: TCanvas ); end; Esta clase consta de las coordenadas del sprite, el color que definimos como transparente y las imagenes a dibujar incluyendo su mascara. En el constructor de la clase creo dos objetos de la clase Thmage en memoria constructor TSprite.Create; begin inherited; Imagen := Timage.Create( nil ); Imagen. AutoSize := True; Mascara := TImage.Create( nil ); ColorTransparente := RGB( 255, 0, 255); end; También he definido el color rosa como color transparente. Como puede apreciarse he utilizado el procedimiento RGB que convierte los tres componentes del color al formato de TColor que los guarda al revés BGR. Asi podemos darle a Delphi cualquier color utilizando estos tres componentes copiados de cualquier programa de dibujo. En el destructor de la clase nos aseguramos de que se liberen de memoria ambos objetos: destructor Tsprite.Destroy: begin Mascara. Free; Imagen. Free; inherited; end; Ahora implementamos la funcién que carga de un archivo la imagen BMP y a continuacién crea su mascara procedure Tsprite.Cargar( sImagen: string ); i, 3: Integer; beginImagen. Picture. LoadFromFile( sImagen ); Mascara.Width |= Imagen. Width; Mascara.Height := Inagen,Height; for } := 0 to Imagen-Height - 1 do for i := 0 to Inagen.Width - 1 do if Inagen.Canvas.Pixels[i,j] = ColorTransparente then begin Imagen. Canvas. Pixels[ i,j] Mascara. Canvas. Pixels[i,3] end else Mascara. Canvas. Pixels[i,i] r= RGB( 255, 255, 255}; RGB( 0, 0, 0}: end; Aqui nos encargamos de dejar la mascara en negativo a partir de la imagen original Para dibujar sprites recomiendo utilizar archivos BMP en lugar de JPG debido a que este Ultimo tipo de imagenes pierden calidad y podrian afectar al resultado de la mascara, dando la sensacién de que el sprite tiene manchas. Hay otras librerias para Delphi que permiten cargar imagenes PNG que son ideales para la creacién de videojuegos, pero esto lo veremos en otra ocasién. Una vez que ya tenemos nuestro sprite y nuestra mascara asociada al mismo podemos crear el procedimiento encargado de dibujarlo: procedure TSprite.Dibujar( Canvas: TCanvas }; begin Canvas. CopyMode := cuSrcAnd; Canvas.Draw( x, y, Mascara.Picture.Graphic ) Canvas. CopyMode :+ cuSrcPaint; Canvas.Drav( x, y, Inagen.Picture.Graphic };} end; El Unico parimetro que tiene es el Canvas sobre el que se va a dibujar el sprite, Primero utilizamos la mascara para limpiar el terreno y después dibujamos el sprite sin el fondo. Vamos a ver como utilizar nuestra clase para dibujar un sprite en el formulario: procedure TFormulario.DibujarCoche; Sprite: Tsprite: begin Sprite := Tsprite.Create: Sprite.x := 100; Sprite.y := 100; Sprite. Cargar( ExtractFilePath( Application.ExeNane ) + ‘sprite-bup' M Sprite.Dibujar( Canvas ); Sprite. Free; end; Este seria el resultado en el formulario:Si el sprite lo vamos a dibujar muchas veces no es necesario crearlo y destruirlo cada vez. Deberiamos crearlo en el evento OnCreate del formulario y en su evento OnDestroy liberarlo (Sprite.Free) En el préximo articulo veremos como mover el sprite en pantalla utilizando una técnica de doble buffer para evitar parpadeos en el movimiento. Pruebas realizadas en Delphi 7. Creando tablas de memoria con ClientDataSet IT is [ceed ee eo pe Stxuasronines st euone Sume arse Tormes, anaspoe t010m0€ 1215906 Una de las cosas que mas se necesitan en un programa de gestidn es la posibilidad crear tablas de memoria para procesar datos temporalmente, sobre todo cuando los datos origen vienen de tablas distintas Es muy comin utilizar componentes de tablas de memoria tales como los que Wevan los componentes RX (TRxMemoryData) 0 el componente kbmMemTable. Pues veamos como hacer tablas de memoria utilizando el componente de la clase TClientDataSet sin tener que utilizar ningun componente externo a Delphi. DEFINIENDO LA TABLA. Lo primero es afiadir a nuestro proyecto un componente ClientDataSet ya sea en un formulario o en un médulo de datos. Como vamos a crear una tabla de recibos lo vamos a llamar TRecibos Ahora vamos a definir los campos de los que se compone la tabla. Para ello pulsamos el botdn [...] en la propiedad FieldDefs. En la ventana que se abre pulsamos el botén Add New y vamos creando los campos: Mane Datatpe SizeMUMERO —ftInteger CLIENTE —£tString o 20 IMPORTE —£tFloat 0 o o PAGADO —‘£tFloat PENDIENTE £tFloat Para crear la tabla de memoria pulsamos el componente TClientDataSet con el botén derecho del ratdn y seleccionamos Create DataSet. Una vez creado sélo nos falta hacer que los campos sean persistentes. Eso se consigue haciendo doble clic sobre el componente y pulsando la combinacién de teclas CTRL+ A Con estos sencillos pasos ya hemos creado una tabla de memoria y ya podemos abrirla para introducir datos, No es necesario abrir la tabla ya que estas tablas de memoria hay que dejarlas activas por defecto. DANDO FORMATO A LOS CAMPOS Como tenemos tres campos de tipo real vamos a dar formato a los mismos del siguiente modo 1, Hacemos doble clic sobre el componente ClientDataSet. 2. Seleccionamos los campos IMPORTE, PAGADO y PENDIENTE. 3, Activamos en el inspector de objetos su propiedad Currency. Con esto ya tenemos los campos en formato moneda y con decimales. REALIZANDO CALCULOS AUTOMATICAMENTE Anuestra tabla de recibos le vamos a hacer que calcule automaticamente el importe pendiente. Esto lo vamos a hacer antes de que se ejecute el Post, en el evento BeforePost procedure TFormulario. TRecibosBefo! begin ‘TRecibosPENDIENTE.AsFloat := TRecibosIMPORTE.AsFloat - ‘TRecibosPAGADO.AsFloat; end; ost( DataSet: TDataSet ); De este modo, tanto si insertamos un nuevo registro como si lo modificamos realizar el calculo del importe pendiente antes de guardar el registro. ANADIENDO, EDITANDO Y ELIMINANDO REGISTROS DE LA TABLA Insertamos tres registros: begin ‘TRecibos. Append; ‘TRecibosiUMERO. AsInteger ‘TRecibosCLIENTE. AsString ‘TRecibosIMPORTE.AsFloat + TRANSPORTES PALAZON, $.L.'; 1500;‘TRecibosPAGADO.AsFloat ‘TRecibos. Post; 500; ‘TRecibos. Append; ‘TRecibosiUMERO. AsInteger + ‘TRecibosCLIENTE. AsString ‘TRecibosIMPORTE. AsFloat ‘TRecibosPAGADO.AsFloat ‘TRecibos. Post; “TALLERES CHAPINET, 8.1." 200; 200; ‘TRecibos. Append; ‘TRecibosiUMERO. AsInteger ‘TRecibosCLIENTE. AsString ‘TRecibosTMPORTE.AsFloat ‘TRecibosPAGADO.AsFloat ‘TRecibos. Post; end; 3: 'GRUAS MARTINEZ, SL. 625; 350; Si queremos modificar el primer registro: begin ‘TRecibos.First; ‘TRecibos.Edit; ‘TRecibosCLIENTE.AsString := ‘ANTONIO PEREZ BERNAL; ‘TRecibosIMPORTE.AsFloat := 100; ‘TRecibosPAGADO.AsFloat := 55; TRecibos. Post; end; Y para eliminarlo: begin ‘TRecibos. First: ‘TRecibos.Delete: end: MODIFICANDO LOS CAMPOS DE LA TABLA Si intentamos afiadir un nuevo campo a la tabla en FieldDefs y luego pulsamos CTRL + A para hacer el campo persistente veremos que desaparece de la definicién de campos. Para hacerlo correctamente hay que hacer lo siguiente: 1. Pulsamos el componente ClientDataSet con el botdn derecho del ratén. 2, Seleccionamos Clear Data 3, Afiadimos el nuevo campo en FieldDefs 4. Volvemos a pulsar el el botén derecho del ratén el componente y seleccionamos Create DataSet. 5, Pulsamos CTRL + A para hacer persistente el nuevo campo. Estos son los pasos que hay que seguir si se crean, modifican o eliminan campos en la tablaCREANDO CAMPOS VIRTUALES PARA SUMAR COLUMNAS Vamos a crear tres campos virtuales que sumen autométicamente el valor de las columnas IMPORTE, PAGADO y PENDIENTE para totalizarlos. Comencemos con el cdlculo del importe total: 1. Pulsamos el componente ClientDataSet con el botdn derecho del ratén. 2, Seleccionamos Clear Data 3, Hacemos doble clic en el componente ClientDataSet 4, Pulsamos la combinacién de teclas CTRL + N para afiadir un nuevo campo Name: TOTALIMPORTE FieldType: Agregate 5, Pulsamos Ok. Seleccionamos el campo creado escribimos en su propiedad Expression’ SUM (IMPORTE} y activamos su propiedad Active. También activamos su propiedad Currency 6. Creamos en el formulario un campo de tipo DBText y asociamos en nuevo campo creado: DataSource: TRecibos DataField: TOTALIMPORTE 7. Volvemos a pulsar el el botén derecho del ratén el componente y seleccionamos Create DataSet. 8. Activamos en el componente TClientDataSet la propiedad AgeregatesActive Igualmente habria que crear dos campos mas para sumar las columnas del importe pagado y el importe pendiente, Utilizar ClientDataSet para crear tablas de memoria es ideal para procesar listados en tablas temporales sin tener que volcar el resultado en ninguna base de datos. Ademas podemos importar y exportar datos a XML usando el ment contextual de este componente. Pruebas realizadas en Delphi 7. Cémo crear un hilo de ejecucién Hay ocasiones en que necesitamos que nuestro programa realize paralelamente algun proceso secundario que no interfiera en la aplicacién principal, ya que si nos metemos en bucles cerrados 0 procesos pesados(traspaso de ficheros, datos, etc.) nuestra aplicacién se queda medio muerta (no se puede ni mover la ventana, minimizarla y menos cerrarla} Para ello lo que hacemos es crear un hilo de ejecucién heredando de la clase Thread del siguiente modo ‘THilo = class( TThread ) Ejecutar: procedure of object; procedure Execute; override; end; La definicién anterior hay que colocarla dentro del apartado Type de nuestra unidad (en la seccién interface}. Le he afiadido el procedimiento Ejecutar para poder mandarle que procedimiento queremos que se ejecute paralelamente. En el apartado implementation de nuestra unidad redifinimos el procedimiento de la clase TThread para que llame a nuestro procedimiento Ejecutar: procedure THilo.Execute; begin Ejecutar; Terminate; end; Con esto ya tenemos nuestra clase THilo para crear todos los hilos de ejecucién que nos de la gana, Ahora vamos a ver como se crea un hilo y se pone en marcha Hilo: THilo; // variable global o publica procedure CrearHilo; begin Hilo.Ejecutar Hilo. Priority : Hilo-Resume; end; ProcesarDatos; ‘tpNormal; procedure ProcesarDatos; begin // Este es el procedimiento que ejecutara nuestro hilo // Cuidado con hacer procesos criticos aqui 7/ EL procesamiento paralelo de XP no es el de Linux 7/ Se puede ix por las patas abajo. end; Si en cualquier momento queremos detener la ejecucién del hilo: Hilo.Terminate; FreekndNil( Hilo ); Los hilos de ejecucién sdlo conviene utilizarlos en procesos criticosimportantes. No es conveniente utilizarlos asi como asi ya que se pueden comer al procesador por los piés. Pruebas realizadas en Delphi 7 Conectando a pelo con INTERBASE o FIREBIRD Aunque Delphi contiene componentes para mostrar directamente datos de una tabla, en ocasiones nos obligan a mostrar el contenido de una base de datos en una pagina web o en una presentacién multimedia con SDL, OPENGL 6 DIRECTX. En este caso, los componentes de la pestafia DATA CONTROLS no nos sirven de nada. Nos los tenemos que currar a mano. Voy a mostraros un ejemplo de conexién con una base de datos de INTERBASE © FIREBIRD mostrando el resultado directamente dentro de un componente ListView, aunque con unas modificaciones se puede lanzar el resultado a un archivo de texto, pagina web, XML 0 lo que sea. Lo primero es conectar con la base de datos: function ConectarBaseDatos( sBaseDatos: String }: TIBDatabase; var DB: TIBDatabase; begin DB := TIBDatabase.Create( nil ); DB-Name := 'IB'; DB-Databasellane := '127.0.0.1:' + sBaseDatos; DB.Params.Add( ‘user_name=SYSDBA' ); DB.Parans.Add( asterkey' ); DB-SQLDialect : DB. LoginPrompt, try DB. open: except raise Exception.Create( ‘No puedo conectar con INTERBASE/FIREBIRD.' + #13 + #13 + 'Congulte con el administrador del programa.’ ); end; False; Result, end; DB; Si nos fijamos en el procedimiento, primero se crea en tiempo real un componente de conexién a bases de datos TIBDatabase. Después le decimos con que IP va a conectar (en principio en nuestra misma maquina) y la ruta de la base de datos que es la que se le pasa al procedimiento, ‘Mas adelante le damos el usuario y password por defecto y desactivamos en Login. Finalmente contectamos con la base de datos controlando la excepcién sicasca Un ejemplo de conexién seria var DB: TIBDatabase;r\bases\bases.gdb' ); // PARA INTERBASE 6 \bases\bases.fdb' ); // PARA FIREBIRD ConectarBaseDatos( * ConectarBaseDatos( * Af DB = nil then Exit: Una vez conectados a la base de datos vamos a ver como listar los registros de una tabla dentro de un ListView: procedure ListarTabla( DB: TIBDatabase; sTabla: String; Listado: ThistView }7 var Campos: TStringlist; a: Integer: Consulta: TIBSQL; Transaccion: TIBTransaction; begin if DB = nil then Exit; // Creamos un stringlist para meter los campos de la tabla Campos := TStringList.Create; DB.GetFieldianes( sTabla, Campos ); // Creamos una transaccién para la consulta Transaccion := TIBTransaction.Create( nil ); Transaccion.DefaultDatabase := DB; // Creamos una consulta Consulta := TIBSQL.Create( nil }; Consulta. Transaction := Transaccion; Consulta. SQL.Add( ‘SELECT * FROM ' + sTabla ); Transaccion. StartTransaction; uy Consulta. ExecQuery: except Transaccion.Rollback; end; // Ceeauos en el listview una columna por cada caupo Listado. Columns. Clear; Listado.Colums.Add; Listado.Columns[0].Width := 0; for i :+ 0 to Campos.Count - 1 do begin Listado.Columns.Add; Listado.Colums[i+l].Caption Listado.Colums[i+l]-Wiath end; Campos[i]; 100; // Listanos los registros Listado. Clear; while not Consulta.Eof do begin Listado. Items. Add; for i := 0 to Campos.Count - 1 do Listado. Items[Listado. Items. Count-1]. SubItens.Add( Consulta. Fie1dByNane ( Campos[i] )-AsString ); Consulta.Next;end; // Una vez hemos terminado liberanos los objetos creados FreeandMil( Campos ); FreeAndNil( Consulta ); FreeandNil( Transaccion }; end; Por supuesto, todo este proceso se puede mejorar refactorizando cédigo y dividiendo las partes mas importantes en clases mas pequefias. Haciendo muchas pruebas con objetos TIBSQL y TIBQuery me he dado cuenta que para operaciones donde se requiere velocidad los objetos TIBSQL con mucho mas rapidos que los TIBQuery, aunque estos tiltimos son mucho mas completos. Pruebas realizadas en Delphi 7 Efectos de animacion en las ventanas En este articulo explicaré de forma detallada cémo crear animaciones para las ventanas de delphi con los mismos efectos que disponen los sistemas operativos Windows, y aclararé cuando aplicarlos y los problemas que tienen. La funcidn encargada de animar ventanas es la siguiente (api de windows) AnimateWindow Y los parametros que la definen son los siguientes: hWnd - Manejador o Handle de la ventana, a la cual se aplica el efecto. dwTime - Velocidad para reproducir el efecto. A mas tiempo, mas suave y con ms lentitud es el efecto. dwFlags - Parimetros que definen el tipo de efecto, la orientacién y la activacién de la ventana Se pueden combinar varios parametros para conseguir efectos personalizados Dentro del pardmetro dwFlags, se pueden realizar los efectos de animacién que detallo: Tipos de efectos AW SLIDE Esta es una animacion de deslizamiento, Este pardmetro es ignorado si se utiliza la bandera AW_CENTER. De forma predaterminada, y sino se indica este pardmetro, todas las ventanas utilizan el efecto de persiana, 0 enrollamiento. AW_BLEND Aplica un efecto de aparicién gradual. Recuerde utilizar este pardmetro sila ventana tiene prioridad sobre las demas. Este efecto sélo funciona conWindows 2000 y Windows XP. AW_HIDE Oculta la ventana, sin animacién, Hay que combinar con otro parémetro para que la ocultacién muestre animacién. Por ejemplo con AW_SLIDE 0 AW_BLEND. AW_CENTER Este efecto provoca que la ventana aparezca desde el centro de la pantalla 0 escritorio. Para que funcione, debe ser combinado con el parimetro AW_HIDE para mostrar la ventana, ono utilizar AW_HIDE para ocultarla Orientacion al mostrar u ocultar AW_HOR_POSITIVE Animar la ventana de izquierda a derecha. Este parametro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER 0 AW_BLEND, no tendra efecto. AW_HOR_NEGATIVE Animar la ventana de derecha a izquierda. Este parimetro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER 0 AW_BLEND, no tendra efecto. AW_VER_POSITIVE Animar la ventana de arriba hacia abajo. Este parametro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER 0 AW_BLEND, no tendra efecto. ‘AW_VER_NEGATIVE Animar la ventana de abajo hacia arriba, Este parametro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER 0 AW_BLEND, no tendra efecto. Otros parametros AW_ACTIVATE Este pardmetro traspasa el foco de activacién a la ventana antes de aplicar el efecto. Recomiendo utilizarlo, sobre todo cuando las ventanas contiene algun tema de Windows XP. No utilizar con la bandera AW_HIDE.Utilizando la funcion en Delphi {En qué evento utilizar esta funcién? Normalmente, y a nivel personal y por experiencias negativas, siempre la utilizo en el evento FormShow de la ventana a la cual aplicar el efecto. Un ejemplo seria el siguiente procedure TFForml. ForShow (Sender: Tobject! begin AninateWindow( Handle, 400, AW_ACTIVATE or AW_SLIDE or AW_VER_POSITIVE }; end; (Este efecto va mostrando la ventana de arriba hacia abajo con deslizamiento) Problemas con los temas de Windows XP y las ventanas de Delphi Naturalmente, no todo es una maravilla, y entre los problemas que pueden surgir al crear estos efectos, estan los siguientes: - Temas visuales de Windows XP. Cuando un efecto de animacién es mostrado, a veces ciertos controles de la ventana, como los TEdit, ComboBox, etc, no terminan de actualizarse, quedando con el aspecto antiguo de Windows 98. Para solucionar este problema, hay que escribir la funcién "RedrawWindow! a continuacién de AnimateWindow: procedure TFForml. ForShow (Sender: Tobject! begin AninateWindow( Handle, 400, AW_ACTIVATE or AW_SLIDE or AW_VER_POSITIVE }; HedravWindow( Handle, nil, 0, RDW_ERASE or PDW_FRAME or PDW_INVALIDATE ox RDW_ALLCHTLDREN )7 end; - Ocultando ventanas entre ventanas de Delphi: Por un problema desconocido de delphi (por lo menos desconozco si Delphi2006 lo hace), ocultar una ventana con animacién, teniendo otras ventanas de delphi (de tu aplicacién) detrs, produce un efecto de redibujado fatal, que desmerece totalmente el efecto realizado. Esto no pasa si las ventanas que aparecen detras no son de Delphi, o de tu propia aplicacién. Por ese motivo, personalmente nunca utilizo este efecto de ocultacién de ventanas. Ultimos consejos Por tiltimo, permitidme daros un consejo. Estos efectos también son validos en Windows 2000, pero los efectos pueden no ser tan fluidos como en Windows XP. Por ello, no estaria mal que estos efectos sean una opcidn de configuracién de vuestra aplicacién, es decir, permitir al usuario activarlos desactivarlos ‘También recomiendo no abusar de estos efectos, al final terminan siendo un poco molestos. Realizarlos en las ventanas principales es mejor que en todas las ventanas. Espero que el articulo sea de utilidad, y dé un toque de elegancia a vuestras aplicaciones Pruebas realizadas en Delphi 7. Guardando y cargando opciones Hay ocasiones en que nos interesa que las opciones de nuestro programa permanezcan en el mismo después de terminar su ejecucién. Principalmente se suelen utilizar cuatro maneras de guardar las opciones: 1° En un archivo de texto plano. 2° En un archivo binario. 3° En un archivo INI. 4° En el registro del sistema de Windows. Vamos a suponer que tenemos un formulario de opciones con campos de tipo string, integer, boolean, date, time y real. Los archivos de opciones se creardn en el mismo directorio en el que se ejecuta nuestra aplicacién. GUARDANDO OPCIONES EN TEXTO PLANOPara ello utilizamos un archivo de tipo TextFile para guardar la informacién: procedure TFPrincipal. GuardarTexto; var F: TextFile; begin 7/ Asignanos @1 archivo de opciones al puntero F AssignFile( F, ExtractFilePath( Application.Exellame ) + ‘opciones. txt! 7 // Morimos ©1 archivo en modo creacién/escritura Rewrite F); // Guardanos las opciones WeiteLn( F, IMPRESOPA.Text ); WeiteLn( F, IntToStr( COPIAS.Value ) Af VISTAFREVIA. Checked then Weiteln( F, ‘CON VISTA PREVIA' ) else ‘Weiteln( F, ‘SIN VISTA PREVIA' ); WeiteLn( F, DateToStr( FECHA.Date ) ); WeiteLn( F, HORA.Text ); WeiteLn( F, FormatFloat( '###0.00', MARGE. Value ) CloseFile( F ); end; CARGANDO OPCIONES DESDE TEXTO PLANO Antes de abrir el archivo comprobamos si existe: procedure TFPrincipal.CargarTexto; var F: TextFile; sLinea: String: begin // Si no existe el archivo de opciones no hacemos nada if not FileExists( ExtractFilePath( Application.Exelane ) + ‘opciones.txt" ) then Exit; // Asignanos 21 archivo de opciones al puntero F AssignFile( F, ExtractFilePath( Application.Exellame ) + ‘opciones. txt! 7 // Morimos ©1 archivo en modo Lectura Reset( F }; // Cargamos 1as opciones Readin( F, slinea }; IMPPESORA.Text := sLinea; Readin( F, slinea }; COPIAS.Value := SteToInt( shinea }; Readin( F, shinea }; VISTAPREVIA. Checked sLinea = ‘CON VISTA PREVIA';Readin( F, shinea }; FECHA.Daté := StrToDate( shinea }; Readin( F, shinea }; HORA.Text':= sLinea; Readin( F, shinea }; MARGEN. Value = StzToFloat( shinea ); CloseFile( F ); end; GUARDANDO OPCIONES EN UN ARCHIVO BINARIO Lo que hacemos en esta ocacién es crear un registro (record) que contenga las opciones de nuestro programa. Después volcamos todo el contenido del registro en un archivo binario del mismo tipo. En la interfaz de nuestra unidad definimos: cype ‘Topciones = record slmpresora: String[100]; icopias: Integer; bVistaPrevia: Boolean; Fecha: Tate; tHora: TTime; rMargen: Real; end; Y creamos el procemimiento que lo graba procedure TFPrincipal. GuardarBinario; // Creauos un registro y un fichero para el misuo Opciones: Topciones; Fi file of Topciones; begin // Mevenos las opciones del formulario en 1 registro Opciones. sImpresora := INPRESORA.Text; Opciones. iCopias := COPIAS. Value; Opciones. bVistaPrevia := VISTAPREVIA. Checked; Opciones. dFecha := FECHA.Date; Opciones. tHora := SteToTime( HORA.Text }; Opciones. rMargen := MARGEN. Value; // Asignanos 21 archivo de opciones al puntero F AssignFile( F, ExtractFilePath( Application.Exellame ) + ‘opciones. dat! }; // Morimos #1 archivo en modo creacién/escritura Rewrite F}; // Guardamos de golpe todas las opciones Weite( F, Opciones ); // Cerramos ©1 ficheroCloseFile( F ); end; CARGANDO OPCIONES DESDE UN ARCHIVO BINARIO Utilizamos el registro creado anteriormente: procedure TFPrincipal. CargarBinario; // Creauos un registro y un fichero para el misuo Opciones: Topciones; Fi file of Topciones; begin 7/ Asignanos @1 archivo de opciones al puntero F AssignFile( F, ExtractFilePath( Application.Exellame ) + ‘opciones. dat! }; // Morimos ¢1 archivo en modo creacién/escritura Reset( F ); // Guardamos de golpe todas las opciones Read( F, Opciones ); // Cerramos #1 fichero CloseFile( F ); // Copiamos las opciones del registro en ¢1 formulario de opciones IMPRESORA.Text := Opciones. sImpresora; COPIAS.Value := Opciones. icopias; VISTAPREVIA. Checked := Opciones. bVistaPrevia; FECHA. Date := Opciones. dFecha; HOPA.Text := TimeToStr( Opciones. tora ); MARGEN.Value := Opciones. rMargen; end; GUARDANDO OPCIONES EN UN ARCHIVO INI Los dos casos anteriores tienen un defecto: si ampliamos el nlimero de opciones e intentamos cargar las opciones con el formato antiguo se puede provocar un error de E/S debido a que los formatos de texto o binario han cambiado. Lo mas flexible en este claso es utilizar un archivo INI, el cual permite agrupar opciones y asignar un nombre a cada una procedure TFPrincipal. GuardarINI; var INI: TiniFile; begin // Creamos @1 archivo INT INI := TINTFile. Create( ExtractFilePath( Application.ExeNane ) + ‘opciones. ini' ); // Guardanos las opciones INI.WeiteString( ‘OPCIONES', 'IMPRESORA', IMPRESORA.Text ); INI-WeiteMnteger( ‘OPCIONES', ‘coPras*, COPIAS.Value ); INI-WeiteBool( ‘OPCIONES', 'VISTAPREVIA', VISTAPREVIA. Checked ); INI-WeiteDate( ‘OPCIONES', 'FECHA', FECHA.Date }; INT WeiteTime( 'OPCIONES', 'HORA', ‘ScrToTime( HORA.Text ) };INI.WeiteFloat( ‘OPCIONES', ‘MARGEN', MARGEN.Value }; // AL Liberar el archivo INI se cierra el archivo opciones. ini INI. Free; end; CARGANDO OPCIONES DE UN ARCHIVO INI Aunque aqui comprobamos si existe el archivo, no es necesario, ya que cargaria las opciones por defecto: procedure TFPrincipal.CargarINI; var INI: TiniFile; begin // Si no existe el archivo no hacenos nada if not FileExists( ExtractFilePath( Application.ExeNane ) + ‘opciones. ini" ) then Exit: // Creamos ©1 archivo INT INI := TINIFile.Create( ExtractFilePath( Application.ExeName ) + ‘opciones. ini' ); // Guaxdanos las opciones IMPRESORA.Text i= INI.ReadString( ‘OPCIONES', 'IMPRESORA', '' ); COPIAS.Value := INI.ReadInteger( ‘OPCIONES',” ‘COPIAS*, OJ; VISTAPREVIA. Checked := INI,ReadBool( 'OPCIONES', 'VISTAPREVIA', False ); FECHA.Date := INI.ReadDate( 'OPCIONES', 'FECHA', Date )7 HOPA.Text := TimeToStr( INI.ReadTime( ‘OPCIOWES', ‘HORA', Time ) MARGEN.Value := INT.ReadFloat( 'OPCIONES', 'MARGEN', 0.00 ); // AL Liberar el archivo INI se cierra el archivo opciones. ini INI. Free; end; GUARDANDO OPCIONES EN EL REGISTRO DEL SISTEMA Si queremos que nadie nos toque las opciones del programa podemos guardarlo todo en el registro de Windows: procedure TFPrincipal. GuardarRegistroSistena; var Reg: TRegistry; begin // Creamos un objeto para manejar el registro Reg := TRegistry. Create; // Guardanos las opciones try Reg-RootKey := HKEY_LOCAL MACHINE; Lf Reg. Openkey( '\Software\MiPrograma', True ) then begin Reg.WriteString( 'IMPRESORA', IMPRESORA.Text }+ Reg.WriteInteger( ‘COPIAS', COPIAS.Value }; Reg.WriteBool( ‘VISTAPREVIA', VISTAPREVIA.Checked ); Reg.WriteDate( ‘FECHA', FECHA.Date ); Reg.WriteTime( ‘HORA', StrToTime( HORA.Text ) }; Reg.WriteFloat( ‘MARGEN', MARGEN.Value }; Reg.CloseKey;end; finally Reg. Free; end; end; Para probar si se ha guardado la informacién pulsa el botén INICIO y opcién EJECUTAR: REGEDIT. Las opciones se habran guardado en la carpeta: \HKEY_LOCAL_MACHINE\SOFTWARE\MiPrograma CARGANDO OPCIONES DESDE EL REGISTRO DEL SISTEMA Antes de cargar las opciones comprueba si existe la clave: procedure TFPrincipal. CargarRegistroSistena; var Reg: TRegistry; begin // Creamos un objeto para manejar el registro Reg := TRegistry. Create; // Guardanos las opciones try Reg-RootKey := HKEY_LOCAL MACHINE; Lf Reg. Openkey( '\Software\MiPrograma', True ) then begin IMPRESORA.Text := Reg.ReadString( ‘IMPRESORA' }; COPIAS.Value := Reg.ReadInteger( ‘COPIAS' ); VISTAPREVIA. Checked := Reg.ReadBool( ‘VISTAPREVIA' ); FECHA.Date := Reg.ReadDate( ‘FECHA’ ); HORA.Text := TimeToStr( Reg.ReadTime( ‘HORA’ ) MARGEN. Value := Reg.ReadFloat( ‘MARGEN' ); Reg.CloseKey; end; finally Reg. Free; end; end; Pruebas realizadas en Delphi 7 Minimizar en la bandeja del sistema Una de las caracteristicas mas utilizadas en los programas P2P es la de minimizar nuestra aplicacién en la bandeja del sistema (al lado del reloj de Windows en la barra de tareas) Voy a mostraros como modificar el formulario principal de vuestra aplicacién para que se minimize en la bandgja del sistema y una vez minimizado cuando se pulse sobre el icono se restaure. También vamos a afiadir la posibilidad de pulsar dicho icono con el botén derecho del ratén y que muestre un menu contextual (popup) con la opcién Mostrar. Lo primero de todo es afiadir un menu contextual a nuestro formulario principal (PopupMenu) con el nombre MenuBandeja. Afiadimos una solaopcidn llamada Mostrar. A continuacién afiadimos en la seccién uses del formulario principal la unidad ShellAPI Windows, Messages, ...., Shel1API; Después en la seccién private insertamos la variable: IconData: TNotifylconData; En la misma seccién private afiadimos los procedimientos. procedure WMSysCommand( var Msg: TWMSysCommand ); message ‘Wi_SYSCOMMAND ; Procedure Restaurar( var Msg: THessage ); message WM_USER+; Cuya implementacién seria la siguiente procedure TFPrincipal.¥MSysCommand( var Msg: TWMSysCommand }; begin if Msg.CudType = SC_MINIMIZE then Mininizar else DefaultHandler( Mag}; end; procedure TFPrincipal.Restaurar( var Msg: Message }; var p: TPoint; begin 7/ GHa pulsado ©1 botén izquierdo del ratén? if Msg. 1Param = WM_LBUTTONDOWN then MostrarClick( Self ); // Ha pulsado en 1a bandeja del sistema con 1 botén derecho del raton? LE Mag. 1Param = WM_PBUTTONDOWN then begin SetForegroundiindow( Handle }; GetCursorFos( p ); MenuBandeja.Popup( p.x, p.¥ )7 PostMessage( Handle, WM_MULL, 0, 0); end; end; El procedimiento WMSysCommand es el encargado de interceptar los mensajes del sistema que manda Windows a nuestra aplicacién. En el caso de que el mensaje enviado sea SC_MINIMIZE minimizamos la ventana en la bandeja del sistema. Si es otro mensaje dejamos que Windows lo maneje (DefaultHandler) El procedimiento Restaurar comprueba si ha pulsado el botén izquierdo del ratén sobre el icono de la bandeja del sistema para volver a mostrar nuestra ventana. Si pulsa el botén derecho llamar a nuestro menu contextual MenuBandejaAhora creamos el procedimiento encargado de minimizar la ventana procedure TFPrincipal.Minimizar; begin ‘with IconData do begin cbSize := sizeof( IconData }; nd := Handle; uD := 100; uFlags := NIF MESSAGE + MIF ICOM + NIF_TIP; uCallbackWessage := WH_USER + 1; // Usamos de icono el mismo de la aplicacién hIcon := Application. Icon. Handle; // Como Hint del icono, el nombre de 1a aplicacién StrPCopy( s2Tip, Application.Title }; end; // Ponemos ®1 icono al lado del relo} Shell _NotifyIcon( NIM_ADD, @IconData ); // Ocultamos ©1 formulario Hide; end; Y por tiltimo el evento al pulsar la opcién Mostrar en el menti contextual: procedure TFPrincipal.MostrarClick( Sender: Tobject }; begin 7/ Volvenos a mostrar de nuevo el formulario FPrincipal. show: ShovWindow( Application-Handle, SW_SHOW ); // Eliminanos e1 icono de la bandeja del sistena Shell _NotifyIcon( NIM_DELETE, @IconData ); IconData.Wnd = 0; end; ‘Aunque pueda parecer algo engorroso creo que es mas limpio que tener que instalar componentes para que realicen esto. Al fin y al cabo sdlo hay que hacerlo sélo en el formulario principal. Pruebas realizadas en Delphi 7. Cémo ocultar una aplicaci6n Vamos a ver como hacer que una aplicacién cualquiera hecha en Delphi quede oculta de la barra de tareas de Windows y del escritorio. Sdlo podra verse ejecutando el administrador de tareas en la pestafia Procesos. Para ello vamos a afiadir en el evento OnCreate del formulario principal de nuestra aplicacién lo siguiente: procedure TFPrincipal. FormCreate (Sender: Tobject)begin 7/ Hacenos que el formulario sea invisible poniendolo en la // esquina superior izquierda, tamafio cero y aplicacién invisible BorderStyle := bsNone; Lett := 0; Top Width := 0; Height := 0; Visible := False; Application.Title Application. ShowNainForm False; // Lo ocultamos de 1a barra de tareas ShovWindow( Application-Handle, SW_HIDE ); SetWindowLong( Application.Handle, GWL_EXSTYLE, GetWindovLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW) ; end; Esto nos puede ser util para crear programas residentes ocultos al usuario para administracién de copias de seguridad, reparacién automatica de bases de datos y envio de mailing automatizado. Capturar el teclado en Windows Hay ocasiones en las cuales nos interesa saber si una tecla de Windows ha sido pulsada aunque estemos en otra aplicacién que no sea la nuestra. Por ejemplo en el articulo anterior mostré como capturar la pantalla, Seria interesante que si pulsamos F8 estando en cualquier aplicacién nos capture la pantalla (incluso si nuestra aplicacién esta minimizada) Para ello vamos a utilizar la funcidn de la API de Windows GetAsyncKeyState la cual acepta como parémetro la tecla pulsada (VK_RETURN, VK_ESCAPE, VK_F8, etc] y nos devuelve -32767 si la tecla ha sido pulsada Como el teclado hay que leerlo constantemente y no conviene dejar un bucle cerrado consumiendo mucho procesador, lo que vamos a hacer es meter a nuestro formulario un temporizador TTimer activado cada 10 milisegundos (inverval) y con el evento OnTimer definido de la siguiente manera procedure TFormulario.TemporizadorTimer( Sender: TObject ); begin // Ha pulsado una tecla? if GetasyncKeyState( VK_F8 ) = -32767 then CapturarPantalla; end; Para capturar niimeros o letras se hace con la funcién ord: Af GetAsyncKeyState( Ord( ‘A! ) ) then if GetAsyncKeyState( Ord( ‘5! ) ) then Si es una letra hay que pasarla a maytisculas.Sdlo con esto podemos interceptar cualquier tecla del buffer de Windows. Por ejemplo se podria hacer una aplicacién que al pulsar F10 minimize todas las ventanas de Windows Pruebas realizadas en Delphi 7. Capturar la pantalla de Windows Vamos a crear un procedimiento que captura un trozo de la pantalla de Windows y la guarda en un bitmap procedure CapturarPantalla( x, y, idncho, iAlto: Integer; Imagen: ‘Teitmap ); De: HDC; ApPal : PLOGPALETTE; begin if ( iancho = 0 ) OR ( iAlto = 0) then Exits Imagen.Width := iancho; Imagen.Height := ialto; DC t= GetDe( 0}; if (DC = 0) then Exit; if ( GetDeviceCaps( dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE ) then begin GetMem( 1pPal, SizeOf( TLOGPALETTE ) + ( 255 * Sizeot( TPALETTEENTRY ) )"); Fillchar( 1pPal*, SizeOf( TLOGPALETTE ) + ( 255 * SizeOt( TPALETTEENTRY } }, #0); ‘IpPal*.palVersion : ipPal*.palliumEntries IpPal*.palPalEntry ); $300; = GetSystemPaletteEntries( DC, 0, 256, if (1pPal*.PallusEntries < 0) then Imagen. Palette := CreatePalette( IpPal~ }; FreeMem( IpPal, SizeOf( TLOGPALETTE ) + ( 255 * Sizeot( TPALETTEENTRY } ) ); end; BicBlt( Imagen.Canvas.Handle, 0, 0, idncho, iAlto, DC, x, y, SRCCOPY ReleaseDe( 0, DC); end; Resumiendo a grandes rasgos lo que hace el procedimiento es crear un dispositive de contexto donde segtin el nimero de bits por pixel reserva unazona de memoria para capturar el escritorio. Después mediante la funcién BitBlt vuelca la imagen capturada al Canvas de la imagen que le pasamos Para capturar toda la pantalla de Windows utilizando este procedimiento hacemos lo siguiente var Imagen: TBitmap; begin Imagen := TBitmap. Create; CapturarPantalla( 0, 0, Screen.Width, Screen.Height, Imagen }+ Imagen. SaveToFile( ExttactFilePath( Application.Exellane ) + ‘eaptura.bup' )? Inagen. Free; end; La pantalla capturada la guarda en el archivo eaptura.bmp al lado de nuestro ejecutable. Solo faltaria el poder capturar una tecla de Windows desde cualquier aplicacién para activar nuestro capturador de pantalla (para que no se capture a si mismo). Pruebas realizadas en Delphi 7. Obtener los favoritos de Internet Explorer El siguiente procedimiento recursivo obtiene la lista de los enlaces favoritos de Internet Explorer. Puede ser de mucha utilidad en el caso de formatear el equipo y salvar la lista de favoritos a un archivo de texto o a una base de datos. Lo primero es afiadir en use: Windows, Dialogs, ..., Sh0bj; Y este seria el procedimiento: function ObtenerFavoritosIE( sRutaFavoritos: String ): TStrings; Busqueda: TSearchrec; ListaFavoritos: TStrings; sRuta, sDirectorio, sArchivo: String; Buffer: array[0..2047] of Char; aEncontrade: Integer: begin ListaFavoritos TstringList.create;try, ‘sRuta sDirectorio aEncontrado + sRutaFavoritos + '\*.url'; ExtractFilepath( sRuta ); FindFirst( sFuta, fadnyFile, Busqueda ); while iEncontrado = 0 do begin SetString( sArchivo, Buffer, GetPrivateProfileString( ‘InternetShortcut', PChar( ‘URL' ), nil, Buffer, SizeOf( Buffer ), PChar( Directorio + Busqueda.tame } ) ); ListaFavoritos.Add( sArchivo }; iEncontrado := FindNext( Busqueda }; end; iEncontrado := FindFirst( sDirectorio + '\*.*', faanyFile, Busqueda }; while iEncontrado = 0 do begin LE ( ( Busqueda.Actr and faDirectory } > 0) and ( Busqueda.Name(1] <> '.' ) then ListaFavoritos. AddStrings( ObtenerFavoritosIE( sDirectorio + ‘\" + Busqueda.name ) ); iEncontrado end; FindNext( Busqueda ); FindClose( Busqueda ); finally Result, end; end; ListaFavoritos; Para utilizar el procedimiento supongamos que en el formulario tenemos un ‘componente ListBox (FAVORITOS) y un botdn (BFavoritos) que al pulsarlo nos trae todos los favoritos a dicha lista procedure TFPrincipal.BFavoritosClick( Sender: Tobject }; pidl: PItemIDList; sRutaFavoritos: array[0..MAX PATH] of Char; begin SHGetSpecialFolderLocation( Handle, CSIDL_FAVORITES, pidl ); SHGetPathFromIDList( pidl, sPutaFavoritos ); FAVORITOS. Items := ObtenerFavoritoslE( StrPas( sRutaFavoritos } }; end; Pruebas realizadas en Delphi 7. Crear un acceso directo Aqui tenemos un pequefio pero interesante procedimiento para crear accesos directos en Windows. Antes de implementarlo hay que affadir en uses una serie de unidades externasWindows, Dialogs, Shl0b}, Activex, StdCtrls, Registry, Com0bi; Este seria el procedimiento: procedure CrearAccesoDirecto( sExe, sArgunentos, sDirTrabajo, sNombreLnk, sDirDestino: string }; Objeto: 1Unknown; UnSlink: TShellLink; FicheroP: IPersistFile; WFichero: VideString; begin Objeto := CreateCondbject( CLSID_ShellLink ); UnSlink := Objeto as IShellLink; FicheroP := Objeto as IPersistFile; with UnSlink do begin SetArguments( PChar( sArgumentos ) ) SetPath( PChar( sExe ) }; SetWorkingDirectory( PChar( sDirTrabajo ) ); end; WFichero := sDizDestino + '\! + sNoubreLnk FicheroP.Save( PUChar( WFichero }, False ) end; Y estos son sus pardmetros: sExe -> Ruta que apunta al ejecutable o archivo a crear el acceso directo sArgunentos -> Parametros que le mandanos al EXE sDirTrabajo -> Ruta al directorio de trabajo del ejecutable sNombreLnit -> Nombre del acceso directo sDizDestino -> Ruta destino donde se creara el acceso directo Aqui os muestro un ejemplo de cémo crear un acceso directo de la calculadora de Windows al escritorio: procedure CrearAccesoCalculadora; sEscritorio: String; Registro: Registry; begin Registro := Registry. Create; // Leenos 1a ruta del escritorio uy Registro.RootKey HREY_CURRENT_USER; Lf Registro. openKey( ' \Software\Microsoft\Windows\CurrentVersion\explozer\Shell Folders', True ) chen sEscritorio finally Registro.CloseKey; Registro.Free; inherited; Registro.ReadString( ‘Desktop!end; CrearAccesoDirecto( * Windows\Systen32\cale.exe', '', :\Windows\Systen32\", ‘Calculadora. Ink", sEscritorio ); end; Pruebas realizadas en Delphi 7. Averiguar la versi6n de Windows La siguiente funcion nos devuelve la version de Windows donde se esta ejecutando nuestro programa: function obtenerVersioi osVerInfo: T0SVersionInfo; VersionMayor, VersionMenoi begin Result := 'Desconocida'; osVer Info. dw0sVersionInfoSize 1 String: Integer; = SizeO£( T0SVersionInfo ); if GetVersionEx( osVerInfo ) then begin ‘VersionMlenor := osVerInfo. duMinorVersion; VersionMlayor := osVerInfo. duMajorVersion; case osVerInfo.dvPlatformId of ‘VER_PLATFORMWIN32_NT: begin if VersionMayor <= 4 then Result := ‘Windows NT! else if ( VersionMayor = 5 ) and ( VersionMenor = 0 ) then Result := ‘Windows 2000' else if ( VersionMayor = 5 ) and ( VersionMenor = 1) then Result := ‘Windows XP! else if ( VersionMayor = € ) then Result := ‘Windows Vista‘; end; ‘YVER_PLATFORM_VIN32_VINDOWS: begin if ( VersionMayor = 4 ) and ( VersionMenor = 0 ) then Result := ‘Windows 95! else if ( VersionMayor = 4) and ( VersionMenor = 10 ) then begin Af osVerInfo.s2CspVersion[1] = 'A' then Result := ‘Windows 92 Second Edition’ else Result := ‘Windows 98'; end else if ( VersionMayor = 4 ) and ( VersionMenor Result := ‘Windows Milleniua’ 80) thenelse Result "Desconocida' ; end; end; end; end; Primero averigua de que plataforma se trata, Si es Win32 los sistemas operativos pueden ser: Windows 95, Windows 98, Windows 98 Second Edition y Windows Millenium. Por otro lado, si se trata de la plataforma NT entonces las versiones son: Windows NT, Windows 2000, Windows XP y Windows Vista. Esta funcién puede ser de utilidad para saber que librerias DLL tiene instaladas, que comandos del sistema podemos ejecutar o para saber si tenemos que habilitar o deshabilitar ciertas funciones de nuestra aplicacién, Pruebas realizadas en Delphi 7. Recorrer un arbol de directorios El procedimiento que voy a mostrar a continuacién recorre el contenido de directorios, subdirectorios y archivos volcando la informacion en un campo memo (TMemo} ‘Modificando su comportamiento puede ser utilizado para realizar copias de seguridad, calcular el tamajio de un directorio o borrar el contenido de los mismos. El procedimiento RecorrerDirectorio toma como primer pardmetro la ruta que desea recorrer y como segundo parametro si deseamos que busque también en subdirectorios: procedure TrBuscar.RecorrerDirectorio( sRuta: String; bIncluirSubdirectorios: Boolean ); Directorio: TSearchRec; iResultade: Integer: begin 7/ 94 1a vuta no termina en contrabarra se la ponenos if sRuta[Length(sFuta)] < '\' then sRuta := sRuta + '\'; // Qo existe e1 directorio que vanos a recorrer? if not DirectoryExists( sRuta } then begin Application.MessageBox( PChar( ‘No existe el directorio:' + #13 + #13 + sRuta ), 'Exror', MB_ICONSTOP }; Exit; end; ipesultado := FindFirst( sRuta + '*.*', Faanyfile, Directorio }; while iResultado = 0 do begin// 2Bs wm directorio y hay que entrar en é1? Lf ( Dizectorio.attr and faDirectory = faDirectory ) and bIncluirSubdirectorios then begin Af ( Dixectorio.Name <> '.' ) and ( Directorio.Mane &> '..' ) then RecorrerDirectorio( sRuta + Directorio.Name, True ); end else 7/ @Mo es el nombre de una unidad ni un directorio? Lf ( Dizectorio.actr and faVolumeld <> faVolumeID ) then Archivos. Lines.Add( sRuta + Directorio.Name }; iResultado end; FindNext( Directorio ); SysUtils.FindClose( Directorio }; end; Antes de comenzar a buscar directorios se asegura de que la ruta que le pasemos termine en contrabarra y en el caso de que no sea asi se la pone al final Para recorrer un directorio utiliza la estructura de datos TSearchRec la cual se utiliza para depositar en ella la informacién del contenido de un directorio mediante las funciones FindFirst y FindNext. TSearchRee no contiene la informacién de todo el directorio sino que es un puntero al directorio 0 archivo actual. Sdlo mirando los atributos mediante la propiedad Attr podemos saber si lo que estamos leyendo es un directorio, archivo 0 unidad: También se cuida de saltarse los directorios '."y '.."ya que sino el procedimiento recursivo RecorrerDirectorio se volveria loco hasta reventar la pila, Realizar modificaciones para cambiar su comportamiento puede ser peligroso sino llevais cuidado ya que la recursividad puede de dejar sin memoria la aplicacién. Al realizar tareas como borrar subdirectorios mucho cuidado no darle la ruta C:\. Mejor hacer ensayos volando el contenido en un Memo hasta tener el resultado deseado. Pruebas realizadas en Delphi 7. Ejecutar un programa al arrancar Windows Para ejecutar automaticamente nuestra aplicacién al arrancar Windows vamos a utilizar la siguiente clave del registro del sistema: HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\, Todos los programas que se introduzcan dentro de esa clave (antivirus, monitores del sistema, etc.) arrancaran al iniciar Windows.Para ello vamos a utilizar el objeto TRegistry. Para ello hay que afiadir su unidad correspondiente en uses: uses Windows, Messages, ..., Registry; Ahora vamos con el procedimiento encargado de poner nuestro programa al inicio de Windows: procedure TFPrincipal. PonerProgramalnicio; var Registro: TRegistry; begin Registro := TRegistry. Create; Registro.RootKey := HKEY_LOCAL MACHINE, Af Registro. openKey( ‘Software \Microsoft\Windows\CurrentVersion\Run', FALSE ) then begin Registro.WriteString( ExtractFileNane( Application.ExeNane }, Application. Exellame ); Registro.CloseKey; end; Registro. Free; end; El método WriteString toma como primer parametro la el nombre del valor en el registro y como segtindo parametro la ruta donde se encuentra el programa a ejecutar. En nuestro caso como nombre del valor le he dado el nombre de nuestro ejecutable y como segundo la ruta desde donde estamos ejecutando el programa en este mismo instante Si en un futuro deseamos quitar el programa entonces sdlo hay que eliminar la clave: procedure TFPrincipal. QuitarProgramalnicio; var Registro: TRegistry; begin Registro := TRegistry. Create; Registro.RootKey := HKEY_LOCAL MACHINE, Af Registro. openKey( ‘Software \Microsoft\Windows\CurrentVersion\Run', FALSE ) then begin // cExiste el valor que vamos a borrar? if Registro. ValueExists( ExtractFileNane( Application. ExeName ) ) then Registro.DeleteValue( ExtractFileNane( Application.ExeNane ) Registro. CloseKey; end; Registro. Free; end; Hay ciertos antivirus como el NOD32 que saltan nada mas compilar nuestroprograma por el simple hecho de tocar la clave Run. Habra que decirle a nuestro antivirus que nuestro programa no es maligno. Pruebas realizadas en Delphi 7. Listar los programas instalados en Windows Windows almacena la lista de programas instalados (Agregar/Quitar programas) en la clave de registro: HREY_LOCAL_MACHINE \ SOFTWARE \Microsoft\Windows\CurrentVersion\Uninstall En esa clave hay tantas subclaves como programas instalados. Pero lo que nos interesa a nosotros no es el nombre de la clave del programa instalado sino el nombre del programa que muestra Windows en Agregar/Quitar programas Para ello entramos en cada clave y leemos el valor DisplayName Lo primero afiadimos la unidad: Windows, Messages, ..., Registry; Y aqui tenemos un procedimiento al cual le pasamos un ListBox y nos lo rellena con la lista de programas instalados en Windows: procedure ListarAplicaciones( Lista: TListBox }; const INSTALADOS = '\SOFTVARE\Microsoft\Windows\CurrentVersion\Uninstall'; Registro: TRegistry; Listal : TStringList; Lista2 : TStringList: 3, n: integer; begin Registro := TRegistry. Create; Listal :+ TStringList.Create; Lista? :+ TStringList.Create; // Guardamos todas las claves en la lista 1 with Registro do begin RootKey := HKEY_LOCAL MACHINE, OpenKey( INSTALADOS, False }; GetKeylames( Listal’); end; // Pecorremos 1a lista 1 y leemos ¢1 nombre del programa instalado for } := 0 to Listal.Count-1 do begin Registro. OpenKey( INSTALADOS + '\* + Listal.Strings[}], False }; Registro.GetValueNanes( Lista? ); // Mostrauos el programa instalado s6lo si tiene DisplayNane t= Lista2,Index0f( 'Displayane' ); if (nO =) and ( Lista2. Index0f(‘Uninstalistring') © -1 )then Lista. Items.Add( ( Registro.ReadString( Lista2.Strings[n] ) ) ) end; Lista. Sorted := True; // Ordenamos 1a lista alfabéticanente Listal. Free; Lista2. Free; Registro. CloseKey, Registro.Destroy; end; Con esto se podria hacer un programa que eliminara de Agregar/Quitar programas aquellas claves de programas mal desinstalados. Pruebas realizadas en Delphi 7. Ejecutar un programa y esperar a que termine Uno de los problemas habituales con los que se enfrenta un programador es que su cliente le pida algo que o bien no sabe como programarlo o no dispone del componente o Libreria necesaria para llevar tu tarea a cabo. Un ejemplo puede ser realizar una copia de seguridad en formatos ZIP, RAR, 72, etc., convertir de un formato de video o sonido a otro e incluso llamar a comandos del sistema para realizar procesos criticos en un servidor. Entonces sélo se nos ocurre llamar a un programa externo que realice la tarea por nosostros (y que soporte pardmetros} 54 lo que estais pensando (la funcién WinExee), pero en este caso no me vale ya que el programa tiene que esperar a que termine de ejecutarse antes de pasar al siguiente proceso Aqui os muestro un procedimiento que ejecuta un programa y se queda esperando a que termine: function EjecutarYEsperar( sPrograma: String; Visibilidad: Integer Integer; sAplicacion: array[0..512] of char; DirectorioActual: array[0..255] of char; DirectorioTrabajo: String; InformacionInicial: TstartupInfo; InformacionProceso: TProcessInformation; ipesultado, iCodigoSalida: DWord; begin ‘StrPCopy( saplicacion, sPrograma }; GetDir( 0, DirectorioTrabajo }; StrPCopy( DirectorioActual, DirectorioTrabajo }; FillChar( InformacionInicial, Sizeof( InformacionInicial ), #0 };InformacionInicial.cb := Sizeof( InformacionInicial ); InformacionInicial. dvFlags := STARTF_USESHOWWINDOW; InformacionInicial.vShowWindow := Visibilidad; CreateProcess( nil, sAplicacion, nil, nil, False, CREATE _NEV_CONSOLE or NOPMAL PRIORITY_CLASS, nil, nil, TnformacionInicial, InformacionProceso }; // Espera hasta que termina 1a ejecucién repeat iCodigoSalida 1000); ‘Application. ProcessMessages; until ( iCodigoSalida < WAIT_TIMEOUT ); WaitForSingleObject( InformacionProceso-hProcess, GetExitCodeProcess( InformacionProceso.hProcess, iResultado }; MessageBeep( 0}; CloseHandle( InformacionProceso-hProcess }; Result := iResultado; end; El pardmetro iVisibilidad puede ser: ‘SV_SHOWNORMAL -> Lo normal SV_SHOWMINIMIZED -> Minimizado (ventanas MS-DOS o ventanas no nodales) S¥_HIDE > Oculto —(ventanas MS-DOS o ventanas no nodales) La funcién devuelve un cero si la ejecucién terminé correctamente Por ejemplo para ¢j termine ecutar la calculadora de Windows y esperar a que procedure EjecutarCalculadora; begin if EjecutarYEsperar( ‘C:\Windows\System32\Calc.exe', SV_SHOWNOPMAL ) = 0 then ShowMessage( 'Ejecucién terminada con éxito.' ) else ‘ShowMessage( 'Ejecucién no terminada correctanente.' ); end; Pruebas realizadas en Delphi 7. Obtener modos de video Ala hora de realizar un programa hay que tener muy presente la resolucién de la pantalla y el area de trabajo donde se pueden colocar las ventanas Para ello tenemos el objeto TSereen que nos devuelve no sdlo la resolucién actual de video sino que ademas nos da el tamajio del escritorio y el area de trabajo del mismo (si esta fija la barra de tareas hay que respetar su espacio y procurar que nuestra ventana no se superponga a la misma). Si utilizamos las propiedades Position o WindowsState del formulario no hay que preocuparse por esto, pero si hemos creado nuestra propia piel y pasamosde las ventanas normales de Windows hay que andarse con ojo y no dejar que el usuario se crea que ha desaparecido la barra de tareas, El siguiente procedimiento vuelca la informacién de la pantalla actual en un objeto Memo llamado PANTALLA: procedure TFInformacion. InfoPantalla; begin PANTALLA. Lines. Clear; PANTALLA.Lines.Add( Format( ‘Resolucién: ‘dxtd ', [Screen.Width, Screen.Height] ) ); PANTALLA.Lines.Add( Format( ‘Escritorio: x: %d y: %d Ancho: %d Alto: aa, [Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopHeight] ) ); PANTALLA.Lines.Add( Format( ‘Area de trabajo: x: %d y: %d Ancho: %d Alto: #4", [Screen.WorkAreaLeft, Screen.WorkAreaTop, Screen.VorkAreaidth, Screen.WorkAreaHeight] ) ); end; Otra informacién interesante seria saber que resoluciones posibles tiene nuestra tarjeta de video. Vamos a mostrar todos los modos de video posible en un ListBox llamado MODOS: procedure TFInformacion. InfoodosVideo; var i: Integer: ModoVideo: TevMode; begin MoDOS. Clear; while EnumDisplaySettings( nil, i, ModoVideo ) do begin ‘with ModoVideo do ‘MODOS. Items. Add(Format( 'tdxtd td Colores’, [dmPelsvidth, dnPelsHeight, Inté4(1) shl dmBitsperPel] ) ); Inc( i} end; end; Esta es la tipica informacion que suelen mostrar los programas tipo TuneUp. Pruebas realizadas en Delphi 7. Utilizar una fuente TTF sin instalarla Uno de los primeros inconvenientes al distribuir nuestras aplicaciones es ver que en otros Windows aparecen nuestras etiquetas y campos desplazados debido a que la fuente que utilizan no es la que tenemos nosotros en nuestro equipo 0 bien utilizamos fuentes estandar tales como Tahoma, Arial, etc. o podemos utilizar el siguiente truco que consiste en afiadir la fuente utilizada al lado de nuestro ejecutable y cargarla al arrancar nuestra aplicacién.El procedimiento para cargar una fuente es: procedure CargarFuente( sFuente: String ); begin AddFontResource( PChar( ExtractFilePath( Application.Exellame } + Fuente ) )? SendMessage( HUND_BROADCAST, WM_FONTCHANGE, 0, 0 ); end; Y en el procedimiento OnCreate de nuestro formulario cargamos la fuente: procedure TFPrincipal.FormCreate( Sender: begin CargarFuente( 'Diner.ctf' ): Etiqueta.Font.Wame := '‘Diner'; end; Tobject }s Donde se supone que el archivo Diner. ttf est al lado de nuestro ejecutable. Antes de cerrar nuestra aplicacién debemos liberar de memoria la fuente utilizada con el procedimiento procedure EliminarFuente( sFuente: String ); begin RenoveFontResource( PChar( ExtractFilePath( Application.Exellame } + Fuente ) )? SendMessage( HUND_BROADCAST, WM_FONTCHANGE, 0, 0 ); end; Este prodecimiento seria llamado en el evento OnDestroy del formulario: procedure TFPrincipal.FormDestroy( Sender: Tobject }+ begin EliminarFuente( ‘Diner. ttf! }; end; Es recomendable hacer esto una sola vez en el formulario principal de la aplicacién y no en cada formulario del programa, a menos que tengamos un, formulario que utiliza exclusivamente una fuente en concreto. Pruebas realizadas en Delphi 7. Convertir un icono en imagen BMP ‘Aunque hay cientos de librerias de iconos por la red que suele utilizar todo el mundo para sus programas, lo ideal seria disefiar nuestros propios iconos utilizando como plantilla los que hay por Internet. Se que hay decenas de programas de disefio que convierten entre distintos formatos, pero lo ideal seria tener nuestro propio conversor. Para ello tenemos el siguiente procedimiento que convierte un archivo ICO en una imagen BMP para que luego podamos utilizarla en nuestras aplicaciones:procedure ConvertirImagen( sIcono, sBMP: String }; Bitmap Imagen: begin Imagen := Timage.Create( nil ); Imagen. Picture. LoadFromFile( sIcono ); Bitaap = TBitllap. Create; ‘Teituap: Timage; with Bitmap do begin PixelFormat := pf24bit; Height := Application. Icon. Height; Width :+ Application. Icon. Width; Canvas.Draw( 0, 0, Inagen.Picture.Graphic }; end; Bitmap.SavetoFile( sBMP ); Inagen. Free; end; El primer parametro es el icono y el segundo la imagen BMP resultante. Lo que hace el procedimiento es cargar el icono en un objeto Timage, para después copiar su contenido en un bitmap antes de guardarlo en un archivo. Pruebas realizadas en Delphi 7. Borrar archivos temporales de Internet Uno de los componentes mas titiles de Delphi hoy en dia es WebBrowser el cual nos permite crear dentro de nuestros programas un navedador web utilizando el motor de Internet Explorer El Unico inconveniente es que al finalizar nuestro programa tenemos que ir a Internet Explorer y vaciar la caché, evitando que se llene el disco duro de basura, Pues vamos a ver un procedimiento que elimina los archivos temporales de Internet Explorer, no sin antes afiadir la unidad WinINet: Windows, Messages, ..., WinInet; procedure BorrarCachelE; IpEntryInfo: PInternetCacheEntryInto; nCacheDir: LongWord; dvEntrySize: LongWord; begin dvEntrySize := 0; FindFirstUr1CacheEntry( nil, TInternetCacheEntryInfo( nil* ), dvEntrySize ); GetMen( lpEntryInfo, dvEntrySize };if dvEntrySize > 0 then ApEntryInfo*. dwStructSize duEntrySize; hCacheDir := FindFirstUriCacheEntry( nil, 1pEntryInfo*, dvEntrySize M Af hCacheDir <> 0 then begin repeat DeleteUrlCacheEntry( 1pEntryInfo~.1pszSourceUrlNane ); FreeMem( IpEntryInfo, dvEntrySize ); dvEntrySize := 0; FindllextUr1CacheEntry( hCacheDir, TInternetCacheEntryInfo( nil* ), dwenerySize }; GetMen( IpEntryInfo, dvEntrySize }; if duEntrySize > 0 then apEntrylnfo*. dvStructSize := dvEncrySize; until not FindNextUrlCacheEntry( hCacheDir, IpEntryInfo*, dvEntrySize ); end; FreeMen( 1pEntryInfo, dvEntrySize ); FindCloseUr1Cache( hCacheDir }; end; Este procedimiento habria que ejecutarlo al cerrar nuestro programa dejando el sistema limpio. Pruebas realizadas en Delphi 7. Deshabilitar el cortafuegos de Windows XP Una de las tareas mas frecuentes a las que se enfrenta un programador es la de crear aplicaciones que automaticen procesos de nuestra aplicacion tales ‘como subir datos por FTP, conectar con otro motor de bases de datos para enviar, etc Y si hay algdn programa que pueda interrumpir el proceso de cara a las ‘comunicaciones TCP/IP es el cortafuegos de Windows. Primero afiadimos a uses: Windows, Messages, ..., WinSve, Shellapi; Este seria un el procedimiento que detiene el servicio: procedure DeshabilitarCortatuegosXP; SCM, BSexvice: LongWord; sStatus: TServiceStatus; begin Sc nService OpenSCManager( nil, nil, SC_MANAGER_ALL_ACCESS ); OpenService( SCM, Pchaz( 'SharedAccess' ),SERVICE_ALL_ACCESS ); ControlSezvice( hService, SERVICE CONTROL STOP, sStatus ); CloseServiceHandle( hService }; end; Para volver a activarlo sélo hay que ir al panel de control y ponerlo en marcha de nuevo. Esto no vale para otros cortafuegos (Panda, Norton, etc.) Pruebas realizadas en Delphi 7. Leer el nimero de serie de una unidad Cuando se vende un programa generalmente se suele poner el precio segun el numero de equipos donde se va a instalar (licencia). Proteger nuestra aplicacién contra copias implica leer algo caracteristico en el PC que lo haga tinico. Pues bien, cuando se formatea una unidad de disco Windows le asigna un numero de serie que no cambiar hasta que vuelva a ser formateada. Lo que vamos a hacer es una funcién que toma como parametro la unidad de disco que le pasemos (C:, D:, ...) ynos devolvera su ntimero de serie: function LeerSerieDisco( cUnidad: Char String? dvLongitudMaxima, VolFlags, dwSerie: Dvord; begin if GetVolumeInformation( PChar( cUnidad + ':\' }, nil, 0, BauSerie, dvLongitudMaxima, VolFlags, nil, 0) then begin // devolvenos el mimero de serie en hexadecimal Result := IntToHex( dwSerie, 8 ); Insert( '-', Result, 5); end else Result i=; end; Nos devolvera algo como esto: D4BD-OEC7 Con ese numero ya podemos crear nuestro propio keygen alterando las letras, el orden 0 utilizando el algoritmo de encriptacién que nos apetezca El Unico inconveniente es que si el usuario vuelve a formatear esa unidadentonces nos tiene que volver a pedir el numero de serie. Hay otros programadores que prefieren leer el numero de la BIOS 0 de la tarjeta de video, ya depende del nivel de proteccién que se dese. Pruebas realizadas en Delphi 7. Leer los archivos del portapapeles El siguiente procedimiento lee el nombre de archivos o directorios del portapapales capturados por el usuario con CTRL + € 6 CTRL + Xylos muestra en un ListBox que le pasamos como parametro: procedure LeerArchivosPortapapeles( Lista: TListBox }; HPortapapeles: THandle; // Handle del portapapeles aNumArc, i: Integer; // N° de archivos Archivo! array [0..MAX PATH - 1] of char; begin if ClipBoard.HasFormat( CF_HDROP } then begin HPortapapeles := ClipBoard.GetAsHandle( CF_HDROP }; aNumare := DragQueryFile( HPortapapeles, §FFFFFFFF, nil, 0); for i t= 0 to iNumAre - 1 do begin DragQueryFile( HPortapapeles, i, @Archivo, MAX_PATH ); Lista. Items.Add( Archivo }; end; end; end; Para poder compilarlo hay que afiadir las unidades externas: Windows, Messages, ..., ClipBrd, ShellAPI; Sélo mostrar archivos o directorios y no imagenes o cualquier otro archivo capturado dentro de un programa. Puede sernos de utilidad para realizar programas de copia de seguridad, conversiones de archivo, etc Pruebas realizadas en Delphi 7. Averiguar los datos del usuario de Windows Una de las mejores cosas que se pueden hacer en un programa cuando da un error es que nos envie automaticamente los datos por correo electrénico. Pero es importante saber que usuario ha enviado el error dentro de la red local. Acontinuacién vamos a ver cuatro procedimientos que nos van a dar el nombre del usuario de Windows, el nombre de su PC en la red, su IP local y su IP publica.Lo primero como siempre es afiadir las unidades: Windows, Messages, ..., WinSock, Idittp, WinInet; Esta funcién nos devuelve el nombre del usuario: function LeerUsuarioWindows: string; sNombreUsuario: String: dyLongitudombre: DWord; begin dvLongitudombre := 255; SetLength( sNombreUsuario, dwLongitudNombre }; if GetUserMame( PChar( sWombreUsuario ), dvlongitudombre ) Then Result := Copy( sNombreUsuario, 1, dvlongitudliombre - 1 ) else Result, end; "Desconocido'; Y esta otra nos da el nombre del PC en la red: function LeerNoubrePC: string: Buffer: array[0..255] of char; dvLongitud: Diora; begin dvLongitud := 256; if GetComputerNane( Buffer, duLongitud ) then Result t= Buffer else Result, end; La siguiente nos da la IP Local en la red function IPLocal: String: PHostEnt; array[0.-128] of char; wsaData: TWSAData; begin // Arranca la Libreria WinSock wVersionRequested := MAKEWORD( 1, 1); WsaStartup( wVersionRequested, wsaData ); // Obtiene 21 nombre del PC GetHostNane( @s, 128 ); p i= GetHostByllame( @s ); // Obtiene 1a direccion IP y Libera la Libreria WinSock p2 i= iNet_ntoa( PInAddr( p*.h_addr_list* )* };Result := Result + p2; WsACLeanup; end; Y esta ultima lo que hace es decirnos nuestra IP ptiblica conectando con el servidor dyndns.org y utiliza el componente Indy HTTP el cual leer el contenido del HTML: function IP Publica: string; function Esliumerico( $: string }: Boolean; begin Result := false; if ( Length( $) > 0) then case S[1] of "ol. '8': Resule end; end; HTMLBody: string; a: Integer? IGHTTP: TIAHTTP ; begin Result True; // ¢Estamos conectados a Internet? Af WinInet. InternecGetConnectedstate( nil, 0 ) then begin IGHTTP := TIUHTTP.Create( Application ); try, HTMLBody := IdHTTP.Get( ‘hetp: //checkip.dyndns.org/* for i := 0 to Length( HTMLBody ) - 1 do begin if EsMumerico( HTMLBody{i] ) or ( HTMLBody[i] Result := Result + HTMLBody[i); end; “then finally IGHTTP. Free; end; end; end; Pruebas realizadas en Delphi 7. Leer la cabecera PE de un programa {Queréis verle las tripas a un archivo EXE? El siguiente procedimiento que voy a mostrar lee la cabecera PE de los archivos ejecutables y nos informa del punto de entrada del programa, el estado de los registros, la pila, etc. Un archivo ejecutable se compone de distintas cabeceras dentro del mismo, ya sea si se va a ejecutar dentro del antiguo sistema operativo MS-DOS 0 en cualquier versién de Windows, El siguiente procedimiento toma como pardmetro un archivo ejecutable y loguarda en un supuesto campo memo llamado INFORMACION que se encuentra en el formulario FPrincipal: procedure TFPrincipal.ExaminarEXE( sArchivo: String }; FS: TFilestream; Firma: DUOPD; Cabecera dos: IMAGE _DOS HEADER; Cabecera pe: IMAGE_FILE HEADER; Cabecera ope: IMAGE OPTIONAL HEADER; begin INFOPMACTON. Clear; Fo: TFilestrean.Create( sArchivo, fmOpenread or fmShareDenylfone }; uy FS.Read( Cabecera dos, SizeOf( Cabecera dos } }; if Cabecera_dos.e magic <> IMAGE_DOS_SIGNATURE then begin INFORMACION. Lines. Add( 'Cabecera DOS invalida’ Exit; end; LeerCabeceraD0S( Cabecera_dos, INFORMACION. Lines ); FS.Seek( Cabecera_dos._Ifanew, soFromBeginning }; FS.Read( Firma, Size0f] Firma’) ); Af Firma <> IMAGE_NT SIGNATURE then begin INFORMACION. Lines. Add( ‘Cabecera PE invalida’ }; Exit; end; FS.Read( Cabecera pe, SizeOf( Cabecera pe } }; LeerCabeceraPE( Cabecera pe, INFORMACION. Lines ); Af Cabecera_pe.Size0foptionalHleader > 0 then begin FS.Read( Cabecera_opc, SizeOf( Cabecera ope } ); LeexCabeceradpcional ( Cabecera_opc, INFORMACION. Lines ); end; finally FS. Free; end; end; Este a su vez llama a cada uno de los procedimientos que leen las cabeceras DOS, PE y opcional dentro del mismo EXE: procedure LeerCabeceraD0S( const h: IMAGE DOS HEADER; Meno: TStrings iD begin Meno-Add( ‘Cabecera DOS del archivo" ); Meno-Add( Format( ‘Mimero magico: 4d", [h.e_magic] } ); Meno-Add( Format( ‘Byes de la ultima pagina del archivo: [hecblp] ) }sMeno.Add( Format( Meno.Add( Format( Meno.Add( Format( Uae_cparhdr] ) ); (eno. Add( Format [h.e_minalloc] ) }; Meno. Add( Format ( [h.e_maxalloc] ) )s eno. Add{ Format ( Meno.Add( Format ( Meno.Add( Format ( Meno.Add( Format ( Meno.Add( Format ( Meno.Add( Format ( relocalizacion: 4d Meno.Add( Format ( Meno.Add( Format ( [h.e_oemid] ) Meno. Add( Format ( [h.e_oeminfol ) eno. Add( Format( [h,_ltanew] ) Wemo.Add( '" ); end: procedure LeerCabeceraPE( const h: ip Fecha: TDateTime; begin Meno.Add( Meno-Add( Format( case h.Machine of ‘Paginas en archivo: sd", [h.e_ep] ) ); ‘Relocalizaciones: %d', [he _cFle] ) “Tamafio de la cabecera en parrato: ) ) aa’, ‘Minimo mimero de parrafos que necesita: ‘d', ‘Maximo mimero de parrafos que necesita: ‘d', ‘Valor inicial (relativo) SS: 4d", [h.e_ss] ) ); ‘Valor inicial SP: $a", M ‘Checksum: $d", [hie ‘Valor imicial IP: 8a", [h.eip] } ); ‘Valor inicial (relativo) CS %d', [h.ecs] ) ); "Dizeccién del archivo de 1a tabla de [helfarle] ) ); ‘thimezo overlay: $d", [h.e_ovno]}}; ‘Identificador OEM (para e_oeminfo) na, ‘Informacion OEM; especifico ¢oemid: %d', "Direccién de 1a nueva cabecera exe: ¥d', IMAGE_FILE_HEADER; Meno: TStrings ‘cabecera PE del archivo’ ); "Maquina: $4x', [h.Machine]}): IMAGE_FILE MACHINE UNKNOWN : Memo.Add(' Maquina desconocida ' ); IMAGE FILE MACHINE 1386: Memo.Add( * Intel 386. ' ); IMAGE_FILE MACHINE P3000: Memo.Add( * MIPS little-endian, Ox1é0 big-endian ' }7 IMAGE_FILEMACHINE_R4000: IMAGE FILE MACHINE R10001 IMAGE_FILE_ MACHINE ALPHA: IMAGE_FILE MACHINE POWERPC: Memo.Add( * IBM PowerPC Little-Endian oe $140: Memo. Add $268: Memo. Add( $260: Memo. Add else Meno. Add ( end; Meno-Add( Format( “Weno.Add( Format( Fecha Meno-Add( Format( Memo.Add( * MIPS little-endian ' }; Memo.Add( * MIPS little-endian * }; Memo.Add( * Alpha AXP ' ); "Intel is6o' ); ' Motorola 68000" ); ' PARISC! )? ' tipo de maquina desconocida’ }; ‘Mkimero de seccione: 4a", [h.MumberofSections] } ‘Fecha y hora: %d', [h-TimeDateStamp] ) ); EncodeDate( 1870, 1, 1) + h.Timedatestamp / SecsPerDay; Meno-Add( FormatDateTine( et, Fecha) ); "puntero a la tabla de simbolos: %d', [h.PointerToSymbolTable] ) ); Meno-Add( Format ( Meno-Add( Format( ‘Mhumero de simbolos: %d', [h.MumberOfSyabols] ) ) “Tamaio de la cabecera opcional: ¥d', [h.SizeOfOptionalHeader] ) );Meno.Add( Format( ‘Caracteristicas: %d', [h.Characteristics] ) ) if ( IMAGE FILE DLL and h.Characteristics ) © 0 then Meno-Add{' el archivo es una’ ) else ‘LE (IMAGE_FILE_EXECUTABLE_IMAGE and h. Characteristics) <> 0 then Meno.Add(! el archivo es un programa’ }; Meno-Add('') end; procedure LeerCabeceraQpcional( const h: IMAGE_OPTIONAL HEADER; Men: strings }; begin Meno.Add( ‘Informacion sobre la cabecera PE de un archivo ejecutable BE! ); Meno-Add( Format( ‘Magi aa", [h.Magic] ) ); case h.Magic of $107: Memo.Add( * Imagen de ROM! ); $10b: Memo.Add( * Imagen de ejecutable' ); else Memo.Add( ' Tipo de imagen desconocido’ }; end; Meno-Add( Format( ‘Versién mayor del enlazador: %d', (h.MajorLinkerVersion] ) ); Meno.Add( Format( 'Versién menor del enlazador: %d', ([h.MinorLinkerVersion])); Meno.Add( Format( 'Tamafio del cédigo: %d', [h.Size0£Code})); Meno-Add( Format( ‘Tamafio de los datos inicializados: %d', [h, SizeOfInitializeaData])) Meno.Add( Format( 'Tamafio de los datos sin inicializar: %d', [h.SizeOeUninitializedData]))? Meno.Add( Format( 'Direccin del punto de entrad [h.addzess0fEntryPoint})); Meno.Add( Format( ‘Base de cédigo: %d', [h.Base0fCode})}; Meno-Add( Format( ‘Base de datos: td‘, [h-BaseOfData])); Meno-Add( Format( ‘Imagen base: 4d", [h.InageBase]}}; Meno-Add( Format( ‘Alineamiento de la seccion: %d', [h.SectionAlignment]) ) Meno.Add( Format( 'Alineaniento del archivo: %d', (h. FileAlignment]}) Meno.Add( Format( 'Versién mayor del sistema operativo: %d', [h.MajorOperatingSystenVersion])) ; Meno.Add( Format( ‘Version mayor del sistema operativo: %d', [h.MinorOperatingSystenVersion]) ); Meno.Add( Format( ‘Version mayor de la imagen: %d', (h.MajorImageVersion])); Meno.Add( Format( 'Versién menor de la imagen: %d', (h.MinorImageVersion])) Meno.Add( Format( ‘Version mayor del subsistema: %d', [h.MajorSubsystemVersion])) ; Meno.Add( Format( ‘Version menor del subsistema: %d', [h.MinorSubsystemVersion]) ); Meno.Add( Format( ‘Valor de la versién Win32: #d', [h.Win32VersionValue})) + Meno-Add( Format( 'Tamafio de la imagen: ¥d', [h.SizeOfTmage]}); Meno-Add( Format( ‘Tamafio d= las cabeceras:'%d', [h. SizeofHeaders]) ) ; Meno.Add( Format( 'CheckSum: ¥d', [h.CheckSum]})+ aa,Meno-Add( Format( ‘Subsistema: ¥d', [h.Subsystem]}); case h. Subsystem of IMAGE_SUBSYSTEM_NATIVE: Mend.Add( ' La imagen no requiere un subsistema. ' ); IMAGE_SUBSYSTEM_VINDOWS_GUI: Meud.Add( ' La imagen se corre en un subsistena GUI de Windows. te TQCE_SUBSYSTEM_VINDOWS_cUT: Mend.Add( ' La imagen corre en un subsistena terminal de Windows. ""); IMAGE_SUBSYSTEM_0S2_cUI Mend.Add( ' La imagen corre sobre un subsistema terminal de os/2. * ys IMAGE_SUBSYSTEM_POSIX_CUI: Mend-Add( ' La imagen corre sobre un subsistema terminal Posix. oe else Meno.Add( ' Subsistema desconocido.' ) end; Meno.Add( Format( 'Caracteristicas DLL: ¥d', [h.DllCharacteristics]) Meno-Add( Format( ‘Tamafio de reserva de la pila: %d', [h.SizeoeStackReserve]) }; Meno.Add( Format( 'Tamafio de trabajo de 1a pila: %d', [h.sizeoeStackCommit]) }; Meno.Add( Format( 'Tamafio del Heap de reserva: $d', (h.SizeotHeapReserve]) }7 Meno.Add( Format( 'Tamafio de trabajo del Heap: %d', [h.SizeOfHeapCommit]) ); Meno.Add( Format ‘Banderas de carga: %d', [h.LoadexFlags] } ); Meno-Add( Format( ‘Nuneros RVA y tanaio: 4d", [h.MumberDfRvadndSizes] ) )? end; Espero que os sea de utilidad si os gusta programar herramientas de administracién de sistemas operativos Windows, Pruebas realizadas en Delphi 7. Leer las dimensiones de imagenes JPG, PNG y GIF Si estdis pensando en crear un visor de fotografias aqui os traigo tres procedimientos que leen al ancho y alto de imagenes con extensién JPG, PNG y GIF leyendo los bytes de su cabecera. No hay para BMP ya que se puede hacer con un componente Timage. Antes de nada hay que incluir una funcién que lee los enteros almacenados en formato del procesador motorola, que guarda los formatos enteros en memoria al contrario de los procesadores Intel/ AMD:function LeerPalabraMotorola( F: TFileStream }: Word; vype ‘TpalabraMlotorola = record case Byte of : (Value: Word ); ( Bytel, Byte2: Byte ); end; MU: TPalabralotorola; begin F.Read( MU.Byte2, SizeOf( Byte) }; F.Read( MU.Bytel, Size0f( Byte } }; Result := MW.Value; end; El siguiente procedimiento toma como pardmetros la ruta y nombre de una imagen JPG, y dos variales enteras donde se almacenara el ancho y alto de la imagen procedure DimensionJPG( sArchivo: string; var wAncho, vAlto: Word }; const ValidSig: array[0..1] of Byte = (SF, $D8); Paraneterless = ($01, §D0, §D1, $D2, $D3, $D4, $DS, $Dé, $D7]: Sig: array[0..1] of byte; Fr Trilestream; x: integer: Seg: byte; Dummy: array[0..15] of byte; Len: vord; iLongitudiinea: Longint; begin Fillchar( Sig, SizeOf( Sig }, #0); F i= TFileStream.Create( sArchivo, fmpenRead ); uy iLongitudLinea := F.Read( Sig[0], Sizedf( Sig) ); for x i= Low( Sig) to High( Sig } do if Siglx] <> ValidSig(x] then ilongitudLinea := 0; if iLongitudLinea > 0 then begin iLongitudLinea := F.Read( Seg, 1}; while ( Seg = $FF ) and ( ilongitudLinea > 0 ) do begin ilongitudLinea := F.Read( Seg, 1); if Sey © SFF then begin if ( Seg = $CO) or ( Seg = $C) then begin ilongitudLinea :+ F.Read( Dumay[0], 3); // Nos saltamos estos bytes LeerPalabraMotorola( F ); LeerPalabraMotorola( F }: wAlto wancho endelse begin if not ( Seg in Parameterless ) then begin Len := LeerPalabraMotorola( F }; F.Seek( Len - 2, 1)? Firead( Seg, 1}; end) else Seg := $FF; ( Fake it to keep looping. } end; end; end; end; finally F.Free; end; end; Lo mismo para una imagen PNG: procedure DimensionPNG( sArchivo: string; var wAncho, vAlto: Word }; type ‘TPNGSig = array[0..7] of Byte; const ValidSig: TPNGSig = (137,80,78,71,13,10,26,10) Sig: TENGSig; Fr TrileStream; x: Integer: begin Fillchar( Sig, SizeOf( Sig }, #0); F r= TFileStream.Create( sArchivo, fm0penRead ); uy Feread( Sig(D], Sizeof( Sig } }s for x i= Low( Sig ) to High( Sig } do if Siglx] <> ValidSig{x] then Exit; F.Seek( 18, 0); whncho := LeexPalabraMotorola( F ): F.Seek( 22, 0); wAlto = LeerPalabraMotorola( F ): finally F.Free; end; end; Y para una imagen GIF: procedure DimensionGIF( sArchivo: string; var wAncho, vAlto: Word }; type ‘TcabeceraGIF = record Sig: array[0..5] of char; ScreenWidth, Screenieight Flags, Background, Aspect: end; Word; Byte; ‘TBloqueImagenGIF = recordLeft, Top, Width, Height: Word; Flags: Byte; end; Fi file; Cabecera: TCabeceraGIF; BloqueImagen: TBloquelmagenGIF; aResultade: Integer; x: Inveger: c: char; bEncontradasDimensiones: Boolean; begin ‘wancho wAlto : Af sArchive = '' then Exit; (sI-) FileMode := 0; // Sélo Lectura AssignFile( F, sArchivo ); Reset( F, 1); Af TOResult <> 0 then Exits // Lee 1a cabecera y se asegura de que sea un archivo valido BlockRead( F, Cabecera, Size0f( TCabeceraGIF ), iResultado ); Af ( iResultado <> SizeOf( TCabeceraGIF ) ) or ( I0Result <> 0 ) or ( SteLComp( 'GIF*, Cabecera.Sig, 3) © 0) then begin Close( F ); Exit; end; ( Skip color map, if there is one } if ( Cabecera.Flags and §80 } > 0 then begin x i= 3" (1 shi ( ( Cabecera.Flags and 7) +1) ); Seek( F, x); Af TOResult <> 0 then begin Close( F ); Exits end; end; bEncontradasDimensiones := False; Fillchar( Bloquelmagen, Size0f( TBloquelmagenGIF ), #0 ): BlockRead( F, c, 1, iResultado ); while (not EOF{ F’) ) and ( not bEncontradasDimensiones ) do begin case c of ",': // Encontrada imagen begin BlockRead( F, Bloquelmagen, SizeOf( TBloqueInagenGIF }, iResultado )? if iResultado <> Sizedf( TBloqueImagenGIF } then begin Close( F );Exit; end; wancho := BloqueImagen. Width; wAlto := BloqueInagen.Height; bEncontradasDinensiones := True; end; tr // esquivar esto begin 7/ Nada end; // Wo hacer nada, ignorar end; BlockRead( F, c, 1, iResultado ); end; Close( F ); (I) end; Asi no sera necesario cargar toda la imagen para averiguar sus dimensiones. Pruebas realizadas en Delphi 7. Descargar un archivo de Internet sin u componentes Afjadiendo a nuestro formulario la libreria WinINet se pueden descargar archivos por HTTP con la siguiente funcién: function DescargarArchivo( sURL, sArchivoLocal: String ): boolean; const Buffersize = 1024; hSession, HURL: HInternet; Buffer: array[1..BufferSize] of Byte; LongitudBuffer: DWORD; F: File; sMiPrograma: String; begin sMiPrograma := ExtractFilellame( Application. ExeName ); hSession := InternetOpen( PChar( sMiPrograna }, INTEPNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 ): uy URL := InternetopenURL( hSession, PChar( sURL ), nil, 0, 0, 0}; uy AssignFile( F, sArchivolocal );Rewrite( F, 1); repeat InternetReadFile( nURL, @Buffer, SizeOf( Buffer ), LongitudBuffer ); Blockirite( F, Buffer, LongitudButfer ); until LongitudButter = 0; CloseFile( F ); Result = True; finally InternetCloseHandle( BURL); end finally InternetCloseHandle( Session ); end end; El primer parametro es la URL completa del archivo a descargar y el segundo la ruta y nombre del archivo donde se va a guardar en nuestro disco duro, Un ejemplo de llamada a la funcién seria DescargarArchivo( ‘htty :\Mis docunentos\ imagen. jpg" ); \miveb.com\imagen. jpg", ' Averiguar el nombre del procesador y su velocidad El registro de Windows suele almacenar gran cantidad de informacién no sélo de la configuracién de los programas instalados, sino también el estado real del hardware de nuestro PC. En esta ocasién vamos a leer el nombre del procesador y su velocidad desde nuestro programa, Antes de nada afiadimos a uses: Windows, Messages, ..., Registry; La siguiente funcién nos devuelve el nombre del procesador: function NoubreProcesador: string: Registro: TRegistry; begin Result i= 11; Registro := TRegistry. Create; uyRegistro.RootKey : HREY_LOCAL_MACHINE; Lf Registro. openKey( ' \Hardware\Description\System\CentralProcessor\0', False ) then Result := Registro.ReadString( ‘Identifier! ’}; finally Registro. Free; end; end; Y esta otra nos da su velocidad (segtin la BIOS y el fabricante): function VelocidadProcesador: string; Registro: TRegistry; begin Registro := TRegistry. Create; uy Registro.RootKey HREY_LOCAL_MACHINE; Lf Registro. openKey( ‘Hardware \Description\System\CentralProcessor\0', False ) then begin Result := IntToStr( Registro.ReadInteger( '-Miz' ) ) + ' Miz!; Registro.CloseKey; end; finally Registro. Free; end; end; Hay veces que dependiendo del procesador y del multiplicador de la BIOS casi nunca coincide la velocidad real que nos da Windows con la de verdad (sobre todo en procesadores AMD). Aqui tenemos otra funcién que calcula en un segundo la velocidad real del procesador con una pequefia rutina en ensamblador: function CalcularVelocidadProcesador: Double; const Retardo = 500; Timer#i, Timerlo: WORD; ClasePrioridad, Prioridad: Integer; begin ClasePrioridad := GetPriorityClass( GetCurrentProcess ); Prioridad := GetThreadPriority( GetCurrentThread }; SetPriorityClass( GetCurrentProcess, REALTIME PRIORITY_CLASS }; SetThreadPriority( GetCurrentThread, THREAD_PRIORITY_TIME CRITICAL Sleep( 10 ); dv 310Fh nov Timerlo, eax mov TimerHi, edx end;Sleep( Retardo ); ‘dy 310Fh sub eax, TimerLo sbb edx, Timeri nov TimerLo, eax mov TimerHi, edx end; SevThreadPriority( GetCurrentThread, Prioridad }; SetPriorityClass( GecCurrentProcess, ClasePrioridad ); Result : end; TimerLo / ( 1000 * Retardo ); Nos devuelve el resultado en una variable double, donde que podriamos sacar la informacién en pantalla de la siguiente manera ShowMessage( Format( ‘Velocidad calculada: %f Mic', [CalcularVelocidadProcesador] ) )? Pruebas realizadas en Delphi 7. Generar claves aleatorias El siguiente procedimiento que voy a mostrar genera una clave aleatoria seguin el numero de silabas y ntimeros que le indiquemos. Por ejemplo: GenerarClave( 3, 2) puede devolver: catanosé dilenal2 catoyes7 Aqui tenemos el generador de claves: function GenerarClave( iSilabas, illumeros: Byte ): const Consonante: array [0..19] of Char = ( ‘b', ‘ct, a a, teh, vt,Vocal: array [0..4] of Char tot, tut ye function Repetir( sCaracter: String; iVeces: Integer ): string; i: Integer? begin Result for i t= 1 to iVeces do Result := Result + sCaracter; end; i: Integer? si, sf: Longint: ni string: begin Result Randomize; Af iSilabas © 0 then for i t= 1 to iSilabas do begin Result := Result + Consonante[Random(19)]; Result != Result + Vocal{Randon(4)]: end; Af iNumeros = 1 then Result := Result + IntToStr(Randon(9)) else Lf iNumeros >= 2 then begin Af iNumeros > 9 then iMlumeros := 9; si StrToInt('1' + Repetir( ‘0*, itfumeros - 1) ); st StrToInt( Repetir( '9', iNumeros ) }: a FloatToStr( si + Random( sf) }; Result i= Result + Copy( n, 0, iNumeros }; end; end; Suele utilizarse en la creacién de cuentas de usuario y departamentos en programas de gestion, dejando que posteriormente el usuario pueda cambiarse la clave Pruebas realizadas en Delphi 7. Meter recursos dentro de un ejecutable Una de las cosas que mas hacen engordar el tamafio de un ejecutable es meter los mismos botones con imagenes en distintos formularios. Si disefiamos nuestros propios botones Aceptar y Cancelar y los vamos replicando en cada formulario el tamafo de nuestro programa puede crecer considerablemente Para evitar esto lo que vamos a hacer es meter la imagen dentro de un recurso compilado y posteriormente accederemos a la misma dentro del programa. La ventaja de utilizar este método es que la imagen slo esta una vez en el programa independientemente del niimero de formularios dondevaya a aparecer. ‘Supongamos que vamos a meter la imagen MiBoton.jpg dentro de nuestro programa. Creamos al lado de la misma el archivo imagenes.re el cual contiene: 1 REDATA MiBoton. 3pg Se pueden meter en un archivo de recursos tantas imagenes como se dese, asi como otros tipos de archivo (sonidos, animaciones flash, etc.). Las siguientes lineas serian: 2 RCDATA imagen2. jpg 3 RCDATA imagen3. 3pg Ahora abrimos una ventana de simbolo del sistema dentro del mismo directorio donde este la imagen y compilamos el recurso: imagenes\bre32. ~ ov imagenes.rc Lo cual nos creara el archivo imagenes. res. Ahora para utilizar el recurso dentro de nuestro programa hay que afiadir debajo de implementation (del formulario principal de la aplicacién) la directiva ($R imagenes.res} implementation (SR tam) (GR imagenes. res) Esto lo que hace es unir todos los recursos de imagenes. res con nuestro ejecutable. Para cargar la imagen dentro de un objeto Timage hacemos lo siguiente: procedure TFPrincipal.FormCreate( Sender: Tobject }+ Recursos: TResourceStream; Imagen: TPegInage; begin Imagen := TJPegImage. Create; Recursos := TResourceStrean.Create( hInstance, '#1', RT_RCDATA ); Recursos.Seek( 0, soFromBeginning ); Imagen. LoadFromStrean( Recursos ); Imagenl.Canvas.Draw( 0, 0, Imagen ); Recursos.Free; Inagen. Free; end; Donde Imagen1 es un objeto image. Aunque pueda parecer algo molesto tiene las siguientes ventajas:- Evita que un usuario cualquiera utilice nuestras imagenes (a menos claro que sepa utilizar un editor de recursos) - Facilita la distribucién de nuestro programa (va todo en el exe). - Se puede afiadir cualquier tipo de archivo o dato dentro del ejecutable. - Ahorramos mucha memoria al cargar una sola vez el recurso. Pruebas realizadas en Delphi 7. Dibujar un gradiente en un formulario Con un sencillo procedimiento podemos hacer que el fondo de nuestros formularios quede con un aspecto profesional con un degradado de color. Para ello escribimos en el evento OnPaint del formulario: procedure TFormulario.FormPaint( Sender: Tobject }+ ‘Fila, wVertical: iRojo! Integer; begin iRo}o := 200; wWertical : Word; ( ClientHeight + 512 ) div 256; for WFila begin with Canvas do begin Brush.Color := RGB( iRojo, 0, wFila ); FLliRect( Rect( 0, wFila * wertical, ClientWidth, ( vFila +1) 0 to S12 do * wertical ) }: Dec{ iRoj0 }; end; end; end; Lo que hace es crear un barrido vertical segtin el ancho y alto de nuestro formulario y va restando de la paleta RGB el componente rojo. Si queremos cambiar el color sélo hay que jugar con los componentes RGB hasta conseguir el efecto deseado. Al maximizar 0 cambiar el ancho y alto de la ventana se quedard el degradado cortado, Para evitar esto le decimos en el evento OnResize que vuelva a pintar la ventana procedure TFormulario. FormResize( Sende! begin Repaint; end; Tobject }s Este efecto suele utilizarse mucho instalaciones 0 en CD-ROM interactivos, catalogos, etc.Pruebas realizadas en Delphi 7. Trocear y unir archivos Una de las utilidades mas famosas que se han asociado a la descarga de archivos es el programa Macha, el cual trocea archivos a un cierto tamafio para luego poder unirlos de nuevo. El siguiente procedimiento parte un archivo a la longitud en bytes que le pasemos: procedure TrocearArchivo( sArchivo: TFileNane; iLongitudTrozo: Integer iD i: Word; FS, Stream: TFileStream; sALchivoPartide: String: begin FS TFileStrean.Create( sArchivo, fm0penRead or fmShareDenyWrite uy for i := 1 to Trunc( FS.Size / ilongitudTrozo ) + 1 do begin sArchivoPartido := ChangeFileExt( sArchivo, '.' + FornatFloat( *ooo', i) )e Stream :+ TFileStream.Create( sArchivoPartido, fmCreate or fmShareExclusive ); uy Lf f9.Size - fs.Position < iLengitudTrozo then ilongitudTrozo := FS.Size - FS.Position; Stream.CopyFrom( FS, iLongitudTrozo }; finally Stream. Free; end; end; finally FS. Free; end; end; Si por ejemplo le pasamos el archivo Documentos. zip crear los archivos: Documentos.001 Documentos.002 Para volver a unirlo tenemos otro procedimiento donde le pasamos el primer trozo y el nombre del archivo original procedure UnirArchivo( sTrozo, sArchivoOriginal: TFileNane ); i: integer;: FileStream; FS := TFileStream.Create( sArchivoOriginal, fmCreate or fmShareExclusive ); uy ‘while FileExists( sTrozo ) do begin Stream := TFileStream.Create( sTrozo, fmOpenRead or fmShareDenylirite ); try. FS.CopyFrom( Stream, 0 ); finally Stream. Free; end; Ine (i) sTrozo + ChangeFileExt( sTrozo, '.' + FormatFloat( ‘000', i ) end; finally FS. Free; end; end; Una ampliacién interesante a estos procedimientos seria meter el nombre del archivo original en el primer o ultimo trozo, asi como un hash (MD4, MD5, SHA, etc.) para saber si algun trozo esta defectuoso. Pruebas realizadas en Delphi 7. Mover componentes en tiempo de ejecuci6én Para darle un toque profesional a un programa no esta mal afiadir un editor que permita al usuario personalizar sus formularios, informes o listados. Por ejemplo en un programa de facturacién seria interesante que el usuario pudiera personalizar el formato de su factura Antes de nada hay que crear en la seccién private del formulario tres variables encargadas de guardar las coordenadas del componente que se esta moviendo asi como una variable booleana que nos dice si en este momento se esta moviendo un componente: private ( Private declarations } iComponenteX, iComponenteY: Integer; bMoviendo: Boolean; Creamos dentro de type la definicién de un control movible: type ‘TMovible = class( TControl );Los siguientes procedimientos hay que asignarlos a un componente para que puedan ser movidos por todo el formulario al ejecutar el programa procedure TFPrincipal.ControlMouseDown( Sender: TObject; Button: ‘TMouseButton; Shift: TShiftState; X, Y: Integer }; begin ‘iComponentex iComponenteY bMoviendo : True; ‘TMovible( Sender ).MouseCapture end; True; procedure TFPrincipal.ControlMouseMove( Sender: TObject; Shift: ‘Tsnigescate: X, Y: Integer ); begin LE boviendo then ‘with Sender as TControl do begin Left := X - iComponenteX + Left; Top := ¥ - iComponenteY + Top; end; end; procedure TFPrincipal.ControlMouseUp( Sender: Tobject; Button: ‘TMouseButton; Shift: TShiftState; X, Y: Integer }7 begin Lf bMoviendo then begin bMoviendo := False; ‘TMovible( Sender ).MouseCapture end; end; False; Por ejemplo, si queremos mover una etiqueta por el formulario habria que asignar los eventos: Label. OnMouseDoun := ControlMouseDown; Label. OnMouseUp := ControlMouseUp; Label. OnMouseMove := ControlMousellove; Con esto ya podemos crear nuestro propio editor de formularios sin tener que utilizar las propiedades Dragking y DragMode de los formularios que resultan algo engorrosas. Pruebas realizadas en Delphi 7. Trabajando con arrays dinamicos Una de las ventajas de los arrays dinamicos respecto a los estaticos es que pueden modificar su tamafio en tiempo de ejecucién y no es necesaria la gestién de memoria para los mismos, ya que se liberan automaticamente al terminar el procedimiento, funcién o clase donde estan alojados. También son ideales para enviar un numero indeterminado de parametros a funciones o procedimientos.Para crear una array dinamico lo que hacemos es declarar el array pero sin especificar su tamafio: public Clientes: array of string; Antes de meter un elemento al array hay que especificar su tamafio con la funcién SetLength. En este ejemplo creamos tres elementos SetLength( Clientes, 3 ); Y ahora introducimos los datos en el mismo: clientes[0} Clientes[1] Clientes[2] ‘guam' "CARLOS" ; nORTa A diferencia de los arrays estiticos el primer elemento es el cero y no el uno. Como he dicho antes no es necesario liberarlos de memoria, pero si alin asi deseamos hacerlo sdlo es necesario hacer lo siguiente Clientes := nil; con lo cual el array queda inicializado para que pueda volver a ser utilizado. Pruebas realizadas en Delphi 7. Clonar las propiedades de un control Cuantas veces hemos deseado en tiempo de ejecucién copiar las caracteristicas de un control a otro segun las acciones del usuario. Por ejemplo si tenemos nuestro propio editor de informes se podrian copiar las caracteristicas de las etiquetas seleccionas por el usuario al resto del formulario (font, color, width, etc.) Para ello tenemos que afiadir la unidad Typinfo: ‘Windows, Dialogs, ..., TypInfo; Asta funcién que voy a mostrar hay que pasarle el control origen y el destino (la copia) asi como que propiedades deseamos copiar: function ClonarPropiedades( Origen, Destino: Tobjects Propiedades: array of string ): Boolean;i: Integer? begin Result := True; uy for i t= Low( Propiedades } to High( Propiedades ) do begin // dBxiste 1a propiedad en el control oxigen? if not IsPublishedProp( Origen, Propiedades[1] ) then Continue; // gBxiste 1a propiedad en el control destino? Af not IsFublishedProp( Destino, Propiedades[I] ) then Continue; // ¢Son del mismo tipo las dos propiedades? Lf PropType( Origen, Propiedades[I]) PropType( Destino, Propiedades[I] ) then Continue; // Copiamos 1a propiedad segin si es variable o método case PropType (Origen, Propiedades[i]) of tkClas: SetObjectProp( Destino, Propiedades[i], GetObjectProp( Origen, Propiedades[i] } }; ekMethod: SetMethodProp( Destino, Propiedades[I], GetMethodProp( Origen, Propiedades[I] } }; else SetPropValue( Destino, Propiedades[i], GetPropValue( Origen, Propiedades[i] ) ); end; end; except Result, end; end; False; Para copiar las caracteristicas principales de una etiqueta habria que llamar a la funcién de la siguiente manera: ClonarPropiedades( Labell, Label2, [‘Font', ‘Color', ‘Alignment’, ‘width’, ‘Height", ‘Layout'] ); ‘También se pueden copiar eventos tales como OnClick, OnMouseDown, etc permitiendo asi abarcar muchos controles con un solo evento. Pruebas realizadas en Delphi 7. Aplicar antialiasing a una imagen El algoritmo antialiasing se suele aplicar a una imagen para evitar los bordes dentados y los degradados bruscos de color. Lo que hace es suavizar toda la imagen En este caso el siguiente procedimiento toma un objeto Timage como primer parametro y como segundo el porcentaje de antialiasing deseado, siendo normal no aplicar mas del 10 0 20%:procedure Antialiasing( Imagen: TImage; iPorcenta}} type Integer); ‘TReBTripleArray = array[0..32767] of TRGBTriple: PRGBTripleArray = “TRGBTriplearray; ‘SL, SL2: PROBTriplearray; 1,'m, p: Integer; B, G, B: TColor; RL, R2, Gl, G2, BL, B2: Byte; begin ‘with Imagen.Canvas do begin Brush. Style Pixels(1, 1] bsClear; Pixels(1, 1]: for 1 begin Sk 0 to Imagen.Height - 1 do Imagen. Picture. Bitmap. ScanLine[1]; for p := 1 to Imagen.Width - 1 do begin Rl := SL(p].robtRed: G1 i= SL[p].rgbeGreen: BL SL[p].rgbtBlue; if (p <1) then Tmagen. Width p-a R2 62 Ba SL[m].rgbtRed; SL[n].rgbeGreen: SL[m].rgbtBlue; if (RL © R2) or ( G1 <> G2) oF ( BL © BZ) then begin Round( RL + ( R2- RL) * 50 / ( iPorcentaje + 50) }s Found( Gl + ( G2 - Gl) * 50 / ( iPorcentaje + 50) }; Found( Bl + ( B2- Bl) * 50 / ( iPorcentaje + 50} }; SL[m].rgbtRed SL[m].rgbtGreen SL[m]. rgbtBlue ena; if ( p > Imagen.Width - 2) then 0 pti: R2 62 Ba SL[m].rgbtRed; SL[n].rgbeGreen: SL[m].rgbtBlue; if (RL © R2) or ( G1 <> G2) oF ( BL © BZ) then begin Round( RL + ( R2- RL) * 50 / ( iPorcentaje + 50) }s Found( Gl + ( G2 - Gl) * 50 / ( iPorcentaje + 50) }; Found( Bl + ( B2- Bl) * 50 / ( iPorcentaje + 50} }; SL[m].rgbtRed SL[m].rgbtGreen :SL[m].rgbtBlue end; if (1<¢1) then m r= Imagen.Height - 1 else misl-1; SL2 := Imagen. Picture.Bituap.ScanLine[m]; R2 r= SL2[p].rgbtRed: 62 := SL2(p].rgbtGreen; B2 i= SL2[p]-rgbtBlue: if (RL © R2) or ( G1 <> G2) oF ( BL © BZ) then begin Round( Pl + ( R2- RL) * $0 / ( iPorcentaje + 50 ) Found( Gl + { G2 - Gl) * 50 / ( iPorcentaje + 50 ) Found( Bl + ( B2 - Bl) * $0 / ( iPorcentaje + 50 ) SL2[p].rgbtRed := Ry SL2[p].rgbtGreen SL2[p].rgbtBlue ena; 6: B: if ( 1> Imagen.Height - 2) then 0 lta: sl: R2 62 BD Imagen. Pictur} SL2[p].rgbtRed; SL2[p].rgbtGreen; SL2[p].rgbtBlue; Bitmap. ScanLine[m]; if (RL © R2) or ( G1 <> G2) oF ( BL © BZ) then begin Round( Pl + Found( Gl + r= Round( Bl + SL2[p].rgbtRed SL2[p].rgbtGreen SL2[p].rgbtBlue end; end; end; end; end; = RL) * 50 / ( iPorcentaje + 50 } = GL) * 50 / ( iPorcentaje + 50 } = BL) * 50 / ( iPorcentaje + 50 } Suponiendo que tengamos en un formulario un objeto Timage llamado Image Wamariamos a este procedimiento de la siguiente manera Antialiasing( Imagel, 10 ); Dibujar varias columnas en un ComboBox Vamos a ver un ejemplo de dibujar tres columnas al desplegar un ComboBox El truco esti en guardar el valor de las tres columnas en el mismo item pero separado por un punto y coma.Después implementamos nuestra propia funcién de dibujado de columnas para que muestre las tres columnas, Para ello metemos en el evento OnDrawltem del ComboBox: procedure TFormulario.ComboBoxDrawIten( Control: TWinControl; Index: Integer; Rect: TRect; State: TownerDrawstate }; sValor, sTodo: string; A, iPos: Integer: re: TRect; AnchoColumma: array[0..3] of Integer: begin ComboBox. Canvas.Brush.Style := bsSolid; ComboBox. Canvas. FillRect| Rect }7 // Las columas deben ir separadas por un ; Todo := ComboBox. Itens[ Index]; // Establecemos ¢1 ancho de las coluanas AnchoColumna[0] := 0; AnchoColuma{1] := 100; // Ancho de 1a columma 1 AnchoColumna{2] := 200; // Ancho de 1a columna 2 AnchoColuma[3] := 300; // Ancho de 1a columma 3 // Weenos el texto de 1a primera columa iPos := Pos( ';', sTodo }; sValor := Copy( STodo, 1, iPos - 1 }; for i t= 0 to 3 do begin // Dibujamos 1a primera columna re. Lett Rect.Left + AnchoColumafi] + 2. re.Right := Rect.Left + AnchoColumnafitl] = ze. Top Rect.Top: re.Bottom := Rect.Bottom; // Escribimos ¢1 texto Combobox. Canvas.TextRect( rc, re.Left, re.Top, sValor ); // Dibujamos las Lineas que separan las columnas Ea <3 then begin Combobox. Canvas.MoveTo( rc.Right, re.Top }; Combobox. Canvas.LineTo( rc-Right, rc.Bottom ); end; // Weenos el texto de la segunda columa sTodo := Copy( sTodo, iPos +1, Length( sTodo } - iPos ); iPos :+ Pos( ';", sTodo }; sValor := Copy( STodo, 1, iPos - 1}; end; end; ‘Modificando el bucle y el array de enteros AnchoColumna podemos crear el numero de columnas que queramos. Ahora sdlo hay que meter los items en el ComboBox separados por punto y comawith Coubobox. Items do begin Add( ‘JOSE; SANCHEZ; GARCTA; Add( ‘MARTA; PEREZ ;GOMEZ;"") ‘Add( ‘ANDRES ;MARTINEZ;RUIZ;' ); end; Por tiltimo hay que decirle al ComboBox que la rutina de pintar los items corre por nuestra cuenta: procedure TFormulario.FormCreate (Sender: Tobject) begin 7/ Le decimos al ComboBox que lo vanos a pintar nosotros Combobox. Style := csOwnerDrauFixed; end; Pruebas realizadas en Delphi 7. Conversiones entre unidades de medida Delphi incorpora una libreria interesante encargada de realizar conversiones entre unidades de tiempo, volumen, distancia, etc. Para ello hay que afiadir las unidades ConvUtils y StdConvs: Windows, Messages, ..., ConvUtils, StdConvs; La funcidn encargada de realizar conversiones es la siguiente: Convert( ValorAConvertir: Double; DesdeUnidad, HastaUnidad: TConvType): Double; \Veamos algunos ejemplos mostrando el resultado en un campo Memo. Para convertir de millas a kilémetros: var @Millas, Kilometros: Double; begin @Millas Kilometros :+ Convert( dMillas, duMiles, dukilometers ); Meno-Lines.Add( Format( ‘¥8.4f Millas = 48.4f Kilometros', [dMillas, @ilometros] ) ); 1s; Esta otra convierte de pulgadas de area a centimetros de area var dPulgadas, dCentinetros: Double; begin dPulgadas dCentimetros := Convert( dPulgadas, auSquareInches, auSquareCentimeters ); Meno.Lines-Add( Format( ‘48.4f Pulgadas de area = %9.4f Centimetros de area‘, [dPulgadas, dCentimetros] ) ); Y si queremos convertir libras en kilogramos:var dLibras, dKilos: Double; begin dLibras := 60; kilos :+ Convert( dLibras, muPounds, muKilograms ); Meno.Lines.Add( Format( ‘%8.4f Libras = 48.4f Kilos', [dLibras, ilos} ) ); ‘También podemos convertir unidades de temperatura: var dFahrenheit, dCelsius: Double; begin Fahrenheit := 94; dcelsius := Convert( dFahrenheit, tuFahrenheit, tuCelsius ); Meno.Lines.Add( Format( ‘¥8.4f° Fahrenheit = %0.4f° Celsius’, (aFahrenheit, Celsius) ) ) Asi como conversion entre unidades de volumen: var dMetrosCubicos, dLitros: Double; begin MetrosCubicos := 43; dLitros := Convert( dMetrosCubicos, vuCubicMeters, vubiters }; Meno.Lines.Add( Format( ‘¥8.4f Metros cubicos = %8.4f° Litros', [dMetrosCubicos, dLitros] ) ); Ahora vamos a ver todos los tipos de conversién segtin las unidades de medida Para convertir entre unidades de drea tenemos: auSquareMillimeters auSquareCentimeters auSquareDecimeters auSquareMeters auSquareDecameters auSquareHectometers auSquareKilometers auSquare Inches auSquareFeet auSquareYards auSquareMiles auacres auCentares auAres auHectares auSquareRods Convertir entre unidades de distancia duicromicrons duangstroms duMillimicrons duMicrons duMillimeters duCentimeters duDecineters duMevers duDecaneters duHectonetersduKiloneters duMeganeters duGiganeters dulnches duFeet duYards duMiles duNauticalMiles duAstronomicalUnits duLightYears duParsecs duCubits duFathous duFurlongs duHands duPaces duRods duChains duLinks duPicas duPoints Convertir entre unidades de masa: ullanograms muMicrograms muMilligrams muCentigrams nuDecigrams muGrans muDecagrams muflectograms mukilograms muMetricTons auDrans muGrains nulongTons muTons mudunces muPounds muStones Convertir entre unidades de temperatura: wucelsius vukelvin vuFahrenheit ‘cuRankine ‘cuReamur Convertir entre unidades de tiempo: ‘vuMilliseconds vuSeconds ‘cuMinutes ‘uHours: cuDays cuveeks vuFortnights ‘cuMfonthswuYears cuDecades vuCenturies cuMillennia cuDateTine ‘vuJulianDace ‘vuModifiedJulianDace Convertir entre unidades de volumen: vuCubicMillimeters vuCubicCentimeters ‘vucubicDecineters vucubicMeters vuCubicDecameters vuCubicHectometers ‘vuCubicKilometers vucubicInches vucubicFeet. vucubicYards vucubiclfiles vuMalliliters vucentiliters vuDeciLiters vubiters vuDecaliters vuectoLiters vuKiloLiters vuacreFeet. vuacreInches vucords vucordFeet. vuDecisteres vusteres vuDecasteres vuFluidGallons vuFluidquarts vuFluiaPints vuFluidcups vuFluidGills ‘vuFluidounces vuFluidTablespoons vuFluidTeaspoons vubryGallons vuDryquarts ‘vubry? ints vubryPecks vuDryBuckets ‘vuDryBushels ‘vulKGallons vuURPottles vulquarts ‘vulRPints ‘vuUKGills ‘vulkounces ‘vulRPecks vulkBuckets ‘vulBushels Pruebas realizadas en Delphi 7.Tipos de puntero Pointer - Es un tipo general de puntero hacia cualquier objeto o variable en memoria - Alno ser de ningtin tipo suele ser bastante peligroso si provoca desbordamientos de memoria PAnsiChar: - Es un tipo de puntero hacia un valor AnsiChar. - También puede ser utilizado para apuntar a caracteres dentro de una cadena AnsiString. - Al igual que otros punteros permite la aritmética, es decir, los procedimientos Ine y Dee pueden utilizarse para mover el puntero en memoria PAnsiString - Apunta hacia una cadena AnsiString - Debido a que AnsiString ya es un puntero hacia si misma, el punter PAnsiString no suele utilizarse mucho. PChar: - Es un tipo de puntero hacia un valor Char. - Puede ser utilizado para apuntar a caracteres dentro de una cadena string - Permite aritmética de punteros mediante los procedimientos Ine y Dee - Suele utilizarse mucho para procesar cadenas de caracteres terminadas en cero, tal como las utilizadas en el lenguaje C/C++ - Los caracteres Char son idénticos a los de las variables AnsiChar, siendo de 8 bits de tamafio. PCurrency: - Apunta hacia un valor Currency. - Permite aritmética de punteros mediante los procedimientos Ine y Dee PDateTime: - Apunta hacia un valor TDateTime. - Permite aritmética de punteros mediante los procedimientos Ine y Dee PExtended: - Apunta hacia un valor Extended - Permite aritmética de punteros mediante los procedimientos Ine y DeePint64: - Apunta hacia un valor Int64 - Permite aritmética de punteros mediante los procedimientos Ine y Dec PShortString - Apunta hacia una cadena ShortString - Debido a que las variables ShortString difieren de las variables string, para apuntar a una variable ShortString es necesario utilizar la funcidn Addr PString: - Apunta hacia una cadena String - Al ser la cadena String un puntero en si misma no suele utilizarse mucho este puntero. PVariant: - Apunta hacia un valor Variant. - Al ser Variant un tipo genérico y variable hay que extremar la precaucién en el manejo de este puntero. PWide Char: - Apunta hacia un valor WideChar. - Puede ser utilizado para apuntar a caracteres dentro de una cadena Widestring - Permite aritmética de punteros mediante los procedimientos Ine y Dee PWideString - Apunta hacia una cadena WideString - Al ser ya cadena WideString un puntero en si misma no suele utilizarse mucho. Pruebas realizadas en Delphi 7. Dando formato a los nimeros reales La unidad SysUtils dispone del tipo TFloatFormat siguiente: type TFloatFormat = (f£General, ffExponent, ffFixed, ffNumber, ffCurrency) 7 Este tipo es utilizado por las funciones CurrToStrF, FloatToStrF y FloatToText para dar formato a los ntimeros reales que pasen a formato texto, Como hemos visto anteriormente, los posibles valores de TFloatFormat sonffGeneral Define el formato general de un ntimero real acercando el valor resultante tanto como sea posible. Quita los ceros que se arrastran y la coma cuando sea necesario, No muestra ninguin separador de miles y utiliza el formato exponencial cuando la mantisa es demasiado grande para el valor especificado segtin el formato, El formato de la coma es determinado por la variable DecimalSeparator. \Veamos un ejemplo mostrando el resultado en un campo Memo: var rCantidad: Extended; // Mimero real para hacer pruebas begin rCantidad := 1234.56; Meno.Lines.Add( ‘General 4,0 = ' + FloatToStrF( rCantidad, f£General, 4, 0 ) ); Meno.Lines.Add( ‘General €,0 = ' + FloatToStrF( rCantidad, ffGeneral, 6, 0 ) ); Meno-Lines.Add( ‘General 6,2 ffGeneral, 6, 2) ); Meno.Lines.Add( ‘General 3,2 = ' + FloatToStrF( rCantidad, ffGeneral, 3, 2) ); \ + FloatToStrF( rCantidad, El resultado que nos muestra es el siguiente: General 4,0 = 1235 General 6,0 = 1234,5¢ General 6,2 = 1234,5¢ General 3,2 = 1,23£03 Como vemos la funcién FloatToStrF toma los siguientes parametros: function FloatToStrF (Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string; overload; Value es el numero real que vamos a pasar a texto, Format es el tipo de formato en coma flotante que vamos a utilizar (en este caso ffGeneral) Precision es el numero maximo de digitos enteros que soporta el formato. Digits es el nimero maximo de decimales que soporta el formato. En el caso anterior cuando forzamos a mostrar menos digitos de precisién de lo que el nlimero real tiene lo que hace la funcién es recortar o bien decimales o si la cantidad entera es superior al formato lo pasa al formato exponencial. Veamos el resto de formatos ffExponent ‘Muestra el ntimero real en formato cientifico cuyo exponente vienerepresentado con la letra Econ base 10. Por ejemplo E+15 significa 1015. El caracter de la coma es representado por la variable DecimalSeparator: Aqui vemos como queda el mismo ntimero en distintos formatos exponenciales Meno.Lines.Add( 'Exponencial 4,0 = ' + FloatToStrF( rCantidad, ffExponent, 4, 0 ) ); Meno.Lines.Add( 'Exponencial 6,0 = ' + FloatToStrF( rCantidad, ffExponent, &, 0 ) ); Meno.Lines.Add( 'Exponencial 6,2 = ' + FloatToStrF( rCantidad, ffExponent, 6, 2) ): Meno.Lines.Add( 'Exponencial 3,2 = ' + FloatToStrF( rCantidad, ffExponent, 3, 2) ); cuyo resultado es Exponencial 4,0 = 1,235E+3 Exponencial 6,0 = 1,2345¢B+3 Exponencial 6,2 = 1,2345€E+03 Exponencial 3,2 = 1,23E+03 El formato ffFixed Este formato no utiliza ningin separador de unidades de millar. Al igual que los formatos anteriores si la precision del numero real es superior al formato entonces muestra el resultado en notacién cientifica. Quedaria de la siguiente manera: © ens. Lines Add ‘Figo 6,0 + | + FloaeTosteF( zCantidad, #fFixed, 6, © ekd.Lines.Add( ‘Figo 6,2 «| + FloatToseer( xCantidad, tfFixed, 6, * feno.Lines.Add( ‘Fijo 3,2 + | + FloatTosteF| rCantidad, ££Fixed, 3, ve dando los valores Fijo Fijo Fijo Fijo El formato ffNumber Es igual al formato ffFixed salvo que también incluye el separador de unidades de millar, el cual viene representado por la variable ThousandSeparator. En nuestro ejemplo: Meno.Lines.Add( 'Mimero 4,0 = ' + FloatToStrF( rCantidad, ffMumber, 4,0) ) Meno.Lines.Add( 'Mimero €,0 = ' + FloatToStrF( rCantidad, f¢Mumber, 6,0) ) Meno.Lines.Add( ‘Mimero €,2 = ' + FloatToStrF( rCantidad, ffMumber,2) ): Meno.Lines.Add( 'Mimero 3,2 = ' + FloatToStrF( rCantidad, ffMumber, 3,2) 08 mostraria Mimero 1.235 Minero 11235 Mimero 1.234, 56 Minero 123803 El formato ffCurrency Es similar al formato ffNumber pero con un simbolo de secuencia agregado, segtin se haya definido en la variable CurrencyString. Este formato también esta influenciado por las variables CurreneyFloat y NegCurtFloat. Sigamos el ejemplo: Meno.Lines.Add( ‘Moneda 4,0 feCurrency, 4, 0 ) ); \ + FloatToStrF( rCantidad, Meno.Lines.Add( ‘Moneda €,0 = ' + FloatToStrF( rCantidad, feCurrency, 6, 0 ) ); Meno.Lines.Add( ‘Moneda €,2 = ' + FloatToStrF( rCantidad, fecurrency, 6, 2) ); Meno.Lines.Add( ‘Moneda 3,2 = ' + FloatToStrF( rCantidad, fecurrency, 3, 2) ): Da como resultado: Moneda 1.235 € Moneda 11235 € Moneda 1.234,56 € Moneda 3,2 = 1,23E03 segtin las variables mencionadas anteriormente que recogen el formato moneda por defecto configurado en Windows. Pruebas realizadas en Delphi 7. Conversiones entre tipos numéricos Hasta ahora hemos visto como pasar cualquier tipo de variable a string o al revés, Ahora vamos a ver funciones para convertir valores de un tipo numérico a otro. PASAR NUMEROS REALES A NUMEROS ENTEROS, function Trune( X: Extended ): Int64; Esta funcién convierte un tipo Extended al tipo entero Int64 truncando los decimales (sin redondeos). Por ejemplo:Teunc( 1234.5678 } devuelve 1234 function Round( X: Extended ): Int64; Esta funcidn convierte un tipo Extended al tipo entero Int64 pero redondeando la parte entera segin la parte decimal. Por ejemplo: Round( 1234.5678 } devuelve 1235 Round( 1234.4678 } devuelve 1234 function Ceil( const X: Extended ): Integer; Convierte un valor Extended en Integer redondeando al ntimero entero que este mas préximo hacia arriba. Por ejemplo Ceil( 1234.5678 ) devuelve 1235 Ceil( 1234.4678 ) devuelve 1235 Ceil( 1235.5€78 ) devuelve 1236 Ceil( 1235.4678 ) devuelve 1236 function Floor( const X: Extended ): Integer; Convierte un valor Extended en Integer redondeando al ntimero entero que este mas préximo hacia abajo. Por ejemplo Floor( 1234. 5678 Floor( 1234. 4678 Floor( 1235.5678 Floor( 1235. 4678 devuelve 1234 devuelve 1234 devuelve 1235 devuelve 1235 ‘También tenemos una funcién un poco rara para extraer el exponente y la mantisa de un niimero real Extended procedure FloatToDecimal( var DecVal: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals: integer ); Convierte un ntimero Extented o Currency a formato decimal guardindolo en la siguiente estructura de datos: type TFloatRec = record Smallint; Boolean; Digits: artay[0..20] of Char; end: Por ejemplo fe: Extended; RegistroFloat: TFloatRec; begin fe r= 1234. 5678; FloatToDecimal( RegistroFloat, ¢, fvExtended, 10, 4); end;Al ejecutarlo da los siguientes valores: RegistroFloat.Digits = 12345678 RegistroFloat.Negative = False RegistroFloat.Exponent = 4 ‘TRUNCANDO NUMEROS REALES funetion Int( X: Extended ): Extended; Aunque esta funcién devuelve sélo la parte entera de un valor Extended, el valor devuelto sigue siendo Extended. El resultado es similar a la funcién Trune (sin redondeos). Por ejemplo Int( 1234.5678 } devuelve 1234 Int( 1234.4678 ) devuelve 1234 function Frac( X: Extended ): Extended; Devuelve la parte fraccionaria de un valor Extended. Por ejemplo Frac( 1234.4678 ) devuelve 0.5678 CONVIRTIENDO VALORES EXTENDED Y CURRENCY Como vimos anteriormente, el tipo Currency no es un auténtico formato en punto flotante sino un entero de punto fijo con 4 decimales como maximo, es decir, los valores Curreney se almacenan como un entero multiplicado por 10000. Veamos de que funciones disponemos para convertir de un tipo a otro: function FloatToCurr( const Value: Extended ): Currency; Esta funcién convierte de tipo Extended a Currency. Por ejemplo: FloatToCurr( 1234.5678 ) devuelve 1234.5€78 (de tipo Currency) FloatToCurr( 123.456789 ) devuelve 123.4568 (de tipo Currency y perdenos 2 decimales) function TryFloatToCurr( const Value: Extended; out AResult: Currency ): Boolean; Esta funcién es similar a FloatToCurr pero sdlo comprueba si se puede convertir a Currency. El procedimiento seria: ce: Currency? begin if TryFloatToCurr( 123.456789, ¢ } then ShowMessage( CurrToStr( ¢ }}; end; CONVIRTIENDO VALORES ENTEROS A VALORES REALESSe puede convertir un valor entero a real convirtiendo la variable directamente: Integer; r: Real; begin 1234; reir // vealiza el casting autonaticanente ShowNessage( FloatToStr( r } end; // muestra 1234 Esto no ocurre en todos los casos pero es cuestidn de probar (aunque es recomendable utilizar los tipos Variant para esa labor) Pruebas realizadas en Delphi 7. Creando un cliente de chat IRC con Indy (I) Aunque MSN es el rey de la comunicacién instanténea atin siguen muy vivos los servidores de chat IRC tales como irc-hispano. IRC define un protocolo de comunicaciones entre clientes y servidores permitiendo incluso el envio de archivos por conexin directa. De todos es conocido el potente programa para Windows llamado MIRC creado hace afios y que atin sigue siendo el cliente mas utilizado para el IRC debido a sus miltiples extensiones. En nuestro caso vamos a ver como utilizar el componente de la clase TIdIRC el cual esta situado en la pestafia de componentes Indy. CONECTANDO CON EL SERVIDOR Antes de comenzar a chatear con el servidor hay que establecer una conexién con el mismo utilizando un apodo (nick) y una contrasefia en el caso de que sea necesaria (la mayoria de los servidores IRC son puiblicos) Supongamos que tenemos en el formulario principal de nuestra aplicacién un componente IdIRC que vamos a llamar IRC. Para conectar con el servidor hay que hacer lo siguiente IRC.Mick = 'juanito33497'; IRC.AltMick := ‘juanito33488'; IRC.Usernane := 'juanito33487'; IRC-RealNlame := ‘Juan'; IRC.Password := '"; IRC.Host := ‘ire. ite-hispano.org'; try IRC.Connect; exceptApplication.MessageBox( ‘No se ha podido conectar con el servidor.', ‘Error de conexién', MB_ICONSTOP ); end; Estos son los parimetros para conectar: Wick > apodo por ¢1 que nos conocerén los demas usuarios Altick -> si el nick que hemos utilizado esta ocupado por otro usuario cogera este otro nick Username -> Nombre del usuario para ¢1 servidor (da lo mismo si no estanos registrados) Realname -> Nombre real del usuario Password -> Clave de acceso para usuarios registrados Host -> Direccion IP del servidor Cualquier persona puede conectarse a un servidor de chat dando sélo el nombre del usuario sin contrasefia. Pero si queremos que nadie utilice nuestro nick nos podemos registrar gratuitamente (en la mayoria de los casos) en el servidor con un usuario y password obteniendo ademas algunas caracteristicas adicionales como entrar a salas de chat restringidas 0 tener nuestro propio servidor de mensajes y correo online 24 horas al dia, Una vez conectados al servidor toca entrar en una sala de chat. Pero, ide que salas de chat dispone el servidor? Para ello utilizamos el comando: IRC.Raw( ‘LIST! }; El método Raw permite mandar cualquier tipo de comando al servidor. Se suele utilizar cuando el componente IRC no contiene métodos para realizar tareas especificas. Los servidores IRC trabajan enviando y recibiendo mensajes de texto continuamente. Para los que les interese saber como funciona por dentro el protocolo IRC disponen de este documento RFC hetp: //uwy. rfc-es. org/rfc/rfcl4se-es. txt Pese a los comandos del IRC estindar algunos servidores disponen de comandos propios para tareas especificas. Para esos casos utilizaremos el método Raw. Hay que tener mucho cuidado cuando se llama al comando LIST ya que hay servidores como los irc-hispano que disponen de miles de canales lo cual puede hacer que el tiempo en sacar el listado llegue a ser desesperante, Por ello seria deseable que tanto la funcién de conectar a un servidor IRC como la de listar los canales estuviera dentro de un hilo de ejecucién, ya que hasta que no conecta da la sensacién de que nuestro programa esta colgado Después de ejecutar dicho comando tenemos que programar el evento OnList para recoger la informacion del listado de canales. En este caso para volcar los canales en un componente ListBox llamado Canales hacemos lo siguiente procedure TFormulario. IRCList( Sender: Tobject; AChans: TStringhist; APosition: Integer; ALast: Boolean }; beginCanales. tens end; AChans; Con esto ya tenemos la lista de canales que dispone el servidor asi como el numero de usuarios que hay conectados por canal y su descripcién. Por ejemplo: famistades 20 Busca nuevos anighs amor 50 Conoce a tu media naranja sexo 80 No te cortes un pelo #musica 34 Comparte 1a pasion por tus artistas preferidos En un servidor de IRC los canales comienzan con el caracter # seguido de su nombre sin espacios. En el préximo articulo veremos como entrar a los canales de chat y hablar con otros usuarios. Pruebas realizadas en Delphi 7. Creando un cliente de chat IRC con Indy (II) Una vez establecida la conexién con el servidor y sabiendo de que salas de chat dispone, vamos a entrar a un canal a chatear. ENTRANDO A UN CANAL Para entrar a un canal se utiliza el método Join: IRC.Join( '#amistades' ); Esto viene a ser lo mismo que hacer IRC.Raw( ‘join famistades' ); Podemos entrar a tantos canales como deseemos pero para hacer un buen cliente de chat hay que crear un formulario por canal, ya que el protocolo IRC nos permite chatear en multiples canales simultaneamente. Una vez se ha enviado el comando JOIN el servidor nos devuelve la lista de usuarios que hay en ese canal. Para recoger dicha lista hay que utilizar elevento OnNames del componente IdIRC, donde volcaremos el contenido de la misma en un ListBox que vamos a llamar Usuarios: procedure TFormulario. IRCNames( Sender: Tobject; AUsers: TIdIRCUsers; AChannel: TIdIRCChannél ); var i: Integer: begin if Assigned( AUsers ) then begin Usuarios.Clear; for i t= 0 to AUsers.Count - 1 do Usuarios. Items. Add( AUsers.Itens[i].Mick }; end; end; Es conveniente que el ListBox este ordenado alfabéticamente activando la propiedad Sorted para no volvernos locos buscando los usuarios por su nombre. LEYENDO LOS MENSAJES DEL SERVIDOR Una vez conectados a un canal, el servidor nos mandar dos tipos de mensajes: lo que hablan todos los usuarios en el canal y lo que un usuario en concreto nos esta diciendo. ;Cémo distinguimos cada cual? Pues para ello el evento OnMessaje nos dice el usuario y canal que nos manda el mensaje procedure TFormulario. IRCMessage( Sender: Tobject; AUser: TIAIRCUser; AChannél: TIdIRCChannel; Content: string ); begin if Assigned( AUser ) then begin if Assigned( AChannel ) then Canal.Lines.Add( AUser.Wick + '> ' + Content ) else Privado.Lines.Add( AUser.Wick + '> ' + Content ); end; end; Como se puede apraciar primero comprobamos si existe el usuario (por si acaso es un mensaje del sistema) y luego si tiene canal metemos el mensaje por el mismo (poniendo el nick delante como MIRC) y si no es asi lo mandamos a una conversacién privada, En este caso he enviado el texto de la conversacién a un componente RichEdit, Seria interesante que nuestro cliente de chat dispusiera de un formulario por cada conversacién privada. Por ello, seria recomendable que nuestro programa de chat utilizara ventanas MDI para permitir el control absoluto cada una de las salas en las que estamos asi como cada una de las conversaciones privadas. En otro articulo escribiré como crear aplicaciones ‘Mol Otra caracteristica que lo haria més profesional seria dibujar el nick y el mensaje del usuario con colores distintos como vimos anteriormente en elarticulo dedicado al componente RichEdit. Y si ademas damos al usuario la posibilidad de seleccionar los colores de fondo, texto, nicks y tipo de fuente, el programa se aproximaria al famoso cliente MRC ENVIANDO MENSAJES AL SERVIDOR Se pueden enviar dos tipos de mensajes: a un canal donde estamos (para el publico en general } 0 a un usuario en concreto, El método say del componente IdIRC cumple dicho cometido. Si quiero enviar un mensaje al canal amistades IRC.Say( ‘#amistades', ‘hola a todos’ ); Y si es para un usuario con el que estamos chateando: IRC.Say( ‘#maria', ‘hola guapa, que tal?' ); A fin y al cabo para el servidor todo son canales, tanto canales ptiblicos como usuarios particulares. Tenemos que ser nosotros los que debemos procesar de donde viene el mensaje y a donde deseamos enviarlo, De ahi la necesidad de crear un formulario por canal y otro por conversacién privada ABANDONANDO UN CANAL Y UN SERVIDOR Para abandonar un canal se utiliza el método Part: IRC.Part( ‘#amistades' ); Si se nos olvida hacer esto y seguimos abriendo canales al final gastaremos mucho ancho de banda, ya que el servidor nos manda todos los mensajes publicos de cada uno de los canales abiertos. Si queremos desconectar del servidor se utiliza el comando: IRC.Disconnect; Esto cancelard la conexién con el servidor cerrando todos los mensajes publicos y privados del mismo. En nuestro programa deberemos cerrar todas las ventanas de conversacién abiertas Todavia quedan algunos puntos importantes para terminar de crear un cliente de chat, tales como saber si un usuario entra o abandona el canal donde estamos, Pruebas realizadas en Delphi 7. Creando un cliente de chat IRC con Indy (1)Después de haber visto la parte basica del componente IdIRC pasemos a ver algunas cosas que hay que controlar en un cliente de chat. QUIEN SALE Y QUIEN ENTRA AUN CANAL ‘Mientras permanezcamos en un canal entrardn y saldran usuarios constantemente, lo cual nos obliga a refrescar la lista de usuarios y notificar los cambios en la misma ventana del canal Ha entrado el usuario lola33 Ha salido el usuario carlos21 Para controlar los usuarios que entran a un canal utilizaremos el evento OnJoin: procedure TFormulario. IRCJoin( Sender: Tobject; AUser: TIAIRCUser; Channel: TIdIRCChannél ); begin if Assigned( AChannel ) and Assigned( AUser ) then Af AChannel.Name = CanalActual.Text then begin Canal.Lines.Add( ‘Ha entrado ¢1 usuario | + AUser.Mick ); if Usuarios. Itens.IndexOf( AUser.Nick ) = -1 then Usuarios. Itens.Add( AUser.Wick ); end; end; Después de informar en el canal actual que ha aparecido un nuevo usuario también lo hemos dado de alta en la lista de usuarios, controlando que no se repitan, ya que a veces suele coincidir que se ejecuta el comando NAMES del servidor y a la vez entra un usuario nuevo. Y cuando un usuario abandona el canal entonces utilizamos el evento OnPart: procedure TFormulario. IRCPart( Sender: Tobject; AUser: TIGIRCUser; AChannel: TIdIRCChannél ); var iUsuario: Integer; begin if Assigned( AChannel ) and Assigned( AUser ) then Af AChannel.Name = CanalActual.Text then begin Canal.Lines.Add( ‘Ha salido el usuario ' + AUser.Mick ); iWsuabio := Usuarios. Items. Index0f( AUser.Mick )? Af iUsuario > -1 then Usuarios. Itens.Delete( isuario }; end; end; La Unica dificultad que hay que controlar es que si tenemos varias ventanas (una por canal) hay que llevar las notificaciones a la ventana correspondiente. Los canales de chat tienen dos clases de usuarios: operadores y usuariosnormales. Los operadores son usuarios que tienen permisos especiales pueden hacer operadores a usuarios normales o echar a un usuario de un canal si esta incumpliendo las normas del mismo. Cuando un operador echa fuera a un usuario entonces nuestro componente IIRC provoca el evento OnKick: procedure TFormulario. IRCKick( Sender: Tobject; AUser, AVictim: TIdIRCUser; AChannel: TIdIRCChannel ); var iUsuario: Integer; begin if Assigned( AChannel ) and Assigned( User ) then Af AChannel.Name = CanalActual.Text then begin Canal.Lines.Add( ‘El usuario ' + Auser.Mick + ' ha expulsado a usuario ' + AVictim.Mick }; aWsuario := Usuarios. Items. Index0f( AUser.Mick ); Af iUsuario > -1 then Usuarios. Itens.Delete( isuario }; end; end; Este evento nos informa del nombre del operador, el de la victima y del canal de donde ha sido expulsado, Y por tiltimo tenemos el problema de que un usuario puede cambiarse el apodo (nick) en cualquier momento. Para ello utilizaremos el evento ‘OnNick Change para notificarlo procedure TFormulario. IRCNickChange( Sender: TObject; AUser: TIdIRCUser; Allewilick: String ); var iUsuario: Integer; begin Canal. Lines.Add( ‘El usuario ' + AUser.Mick + ' ahora se llama! + allewilick |} aWsuario := Usuarios. Itens. Index0f( AUser.Mick ); if isuario > -1 then ‘Usuarios. Items[iUsuario] := ANewllick; end; Aparte de notificarlo le hemos cambiado el nombre en nuestra lista de usuarios. INTERCEPTANDO LOS MENSAJES DEL SISTEMA A pesar de todos los eventos de los que dispone el componente de la clase TIdIRC también podemos interceptar a pelo los mensajes del sistema a través del evento OnSystem, el cual nos dice el usuario, el cddigo de comando y el contenido del mensaje del sistema. Por ejemplo estos son algunos cédigos de comando del servidor: 353 -> Comienzo del comando NAMES 366 -> Fin del comando NAMES376 —> Mensaje del dia ete Para mas informacién hay que ver el documento RFC perteneciente al protocolo IRC que mencione en el articulo anterior. Por ejemplo, para averiguar los datos sobre un usuario en concreto hay que mandarle al servidor el. comando: WHOIS maria Y el servidor devolve lo siguiente 319 - WHOIS - maria is on famistades 312 - WHOIS - maria is using jupiter2.irc-hispano.org Servidor IRC de Lleida Networks 318 - WHOIS - maria :End of /WHOIS list Nos esta diciendo que maria esta en el canal #amistades y que esti conectada utilizando el servidor jupiter2. Si estuviera conectada a mas canales también, lo diria (asi sabemos también sus otras aficiones} {Cémo nos comemos todo eso? Pues supongamos que si yo hago doble clic sobre un usario quiero que me devuelva informacién sobre el mismo en un campo Memo cuyo nombre es DatosUsuario. Lo primero seria procesar el evento OnDbIClick en la lista de usuarios: procedure TFormulario.UsuariosDb1Click( Sender: Tobject ); begin Lf Usuarios. ItemIndex > -1 then IRC.Raw( ‘WHOIS ' + Usuarios. Itens[Usuarios. ItemIndex] }; end; Y ahora en el evento OnSystem del componente IdIRC esperamos a que nos Wegue la informacién: procedure TFormulario. IRCSystem( Sender: Tobject; AUser: TIAIRCUser; ACadCode: Integer; ACommand, AContent: string }7 begin case ACudCode of 312, 318, 319: DatosUsuario.Lines.Add( AContent }; end; end; Asi, estudiando un poco el protocolo IRC y sabiendo algunos comandos podemos hacer mas cosas de las que permite el componente IdIRC. ENVIO Y RECEPCION DE ARCHIVOS POR ACCESO DIRECTO El protocolo IRC permite establecer el envio y recepcién de archivos con conexién punto a punto entre la IP del remitente y la IP del receptor. Esto ya no se suele utilizar hoy en dia por las siguiente razones - Debido a que casi todas las redes locales estén detrs de un router se hace necesario abrir y redireccionar puertos en el mismo, cosa que no todo elmundo sabe hacer. - En cuanto intentemos establecer conexién por puertos que no sean los, estandar los cortafuegos saltaran como liebres pidiendo permiso para conectar. Los novatos siempre dir’n NO por si acaso: - Hay robots autométicos programados en MIRC mediante scripts que no paran de realizar ataques continuamente a conexiones DCC. Por ello no voy a comentar aqui como utilizarlo (para ello tenemos rapidshare, megaupload y demas hierbas que superan con creces este tipo de conexiones y ademas son mas seguros} Con esto finalizamos lo mas importante del componente IdIRC de la paleta de componentes Indy. Pruebas realizadas en Delphi 7. Creando un procesador de textos con RichEdit (I) Para crear un procesador de textos vamos a utilizar el componente RichEdit que se encuentra en la pestafia Win32. Este componente tiene la particularidad de poder definir distintos estilos de texto al contrario de un componente Meme cuya fuente es estatica para todo el documento. El. componente de la clase TRichEdit hereda de TCustomMemo afiadiendo caracteristicas tan interesantes como la de modificar el estilo de la fuente, colorear palabras o frases, etc \Veamos como se podria crear un mini procesador de textos utilizando este componente. Como procesador de textos lo primero que debemos definir son las funciones para la creacién, carga y grabacién de documentos en disco. La programacién la voy a realizar sobre este formulario:‘aetho EoGiN Fem AyutE ml 2s) Beeaq Las opciones del mend son: Archivo -> Nuevo, Abrir, Guardar, Guardar como y Salir. Edicion -> Cortar, Copiar y Pegat. Formato -> Fuente Ayuda -> Acerca de... GUARDANDO EL TEXTO EN UN ARCHIVO Lo primero que vamos a contemplar es la grabacién en un archivo de texto. Para ello vamos a insertar en el formulario un componente de clase TSaveDialog que se encuentra en la pestafia Dialogs y lo vamos a llamar GuadarTexto. Entonces al pulsar la opcién Archive -> Guardar como del ménu ejecutamos lo siguiente: procedure TFormulario.GuardarComoClick( Sender: Tobject ); begin Lf GuardarTexto.Execute then begin RichEdit. Lines. SaveToFile( GuardarTexto.Filelame }; sArchivo := GuardarTexto.Filellame; end; end; La variable sArchivo se va a encargar de guardar la ruta y el nombre archivo que se guardé por primera vez, para que cuando seleccionemos la opcién guardar no haya que volver a decirle de nuevo el nombre. Esta variable la vamos a declarar en la seccién privada de nuestro formulario private ( Private declarations } sArchive: String:Ahora tenemos que hacer que si el usuario pulsa la opcidn Guardar se guarde el archivo sin preguntarnos el nombre si ya lo tiene: procedure TFormulario.GuardarClick( Sender: Tobject }+ begin 7/ Mo tiene nombre? AE SArchivo = '' then GuardarComoClick( Self } else RichEdit. Lines. SaveToFile( sAtchive ); end; Sino tuviera nombre es que es un archivo nuevo, con lo cual lo desviamos a la opcién Guardar como CARGADO EL TEXTO DESDE UN ARCHIVO Para cargar el texto tenemos que afiadir al formulario el componente TOpenDialog y (o llamamos CargarTexto. ¥ al pulsar en el ment la opcién Archivo -> Abrir se ejecutaria procedure TFormulario.AbrizClick( 5 begin if CargarTexto-Execute then begin RichEdit. Lines. LoadFromFile( CargarTexto.Filellame ); skrchivo := CargarTexto. FileNans end; end; \der: Tobject ); ‘También guardamos en la variable sArehivo el nombre del archivo cargado para su posterior utilizacién en la opcién Guardar CREANDO UN NUEVO TEXTO En nuestro programa vamos a hacer que si el usuario selecciona la opcién del ment Archivo -> Nuevo se elimine el texto del componente RichEdit, Lo que si hay que controlar es que si habia un texto anterior le pregunte al usuario si desea guardarlo. procedure TFormulario.NuevoClick( Sender: Tobject }+ begin // Gay algo introducido? LE RichEdit.Text <> '' then Af Application.MessageBox( 'cDesea guardar ©1 texto actual?', ‘avencion', MB_ICONQUESTION OR MB_YESNO ) = 1D_YES then GuardarClick( Self ); RichEdit.Clear; end; CONTROLANDO LA EDICION DEL TEXTOOtra de las cosas basicas que debe llevar todo editor de texto son las funciones de cortar, copiar y pegar. Para ello vamos a implemantar primero la opcién del meni Edicién -> Cortar: procedure TFormulario.CortarClick( Sendex: Tobject )+ begin RAchEdit. CutToCLipboard; end; Después hacemos la opcién de Edieién -> Copiar procedure TFormulario.CopiarClick( Sender: Tobject }; Y por ultimo la opcién de Edicién -> Pegar procedure TFormulario. PegarClick( Sender: Tobject }; begin RichEdit. PasteFromClipboard; end; CAMBIANDO EL ESTILO DEL TEXTO Una vez tenemos implementada la parte basica del editor de texto vamos a darle la posibilidad al usuario de que pueda cambiar la fuente, el estilo, el color, etc Para que el usuario pueda elegir la fuente tenemos que introducir en el formulario el componente de a clase TFontDialog situado en la pestafia Dialogs. Le vamos a dar el nombre de ElegirFuente Ahora en la opcién del ment Formate -> Fuente ejecutamos procedure TFormulario.FuenteClick( Sender: Tobject }; begin if ElegirFuente.Execute then with RichEdit, ElegirFuente do begin ‘SelAttributes.Nane SelAttributes. Size SelAttributes. Color SelAttributes. Pitch SelAttributes. Style SelAttributes.Height : end; end; Font. Name; = Font.Size; FontColor; Font. Pitch; Font. Style; Font. Height; {Por qué no hemos hecho lo siguiente? RichEdit.Font := ElegirFuente. Font; Si hago esto me cambia la fuente de todo el texto, incluso la que he escrito anteriormente y a mi lo que me interesa es modificar la fuente de lo que se vaya a escribir a partir de ahora. Para ello se utilizan las propiedades de