Archivo

Entradas Etiquetadas ‘Código’

Google Maps en Delphi – I

jueves, 14 de mayo de 2009 6 comentarios

Después de las dos entradas sobre Codificacióin Geográfica (*), toca entrar de lleno en la Visualización e Integración de Google Maps en nuestro programa, que por otra parte era el objetivo inicial de esta serie de entradas. La Codificación Geográfica (obtención de Latitud y Loingitud a partir de una dirección postal) era un “escollo” a salvar en nuestro camino, hasta nuestro verdadero objetivo.

(*) Lo normal es tener en nuestros programas/aplicaciones una serie de direcciones postales o direcciones de correo que deseamos mostrar o señalar en un Mapa. Para utilizar esas direccones con la API de Google Maps necesitamos obtener las coordenadas de Latitud y Longitud apropiadas. Para ello ya vimos  aquí (Codificación Geográfica – I) y aquí (Codificación Geográfica – II) cómo Google provee métodos para obtener las coordenadas de posicionamiento a partir de direcciones postales.

La idea para conseguir la integración es sencilla. Utilizar un componente TWebBrowser para mostrar una página HTML. Desde Delphi debemos “modificar” esa página para que muestre lo que nosotros deseemos.

Utilizando una sencilla página HTML con un Script, podemos visualizar el mapa correspondiente a coordenadas de Latitud y Longitud.  Con un componente TWebBrowser podemos visualizar esa página dentro de una aplicación delphi.

La página en sí sólo contiene el Script para Visualizar un Mapa.
Dentro del Script vemos cómo se crea un elemento de tipo “map”:

map = new GMap2(document.getElementById("map"));

Se añaden los controles que queremos visualizar en el mapa; En este caso, la selección para el tipo de mapa y control de zoom y posición grande.

        // Controles del mapa
        map.addControl(new GMapTypeControl());
        map.addControl(new GLargeMapControl());

El tipo de mapa que queremos que inicialmente aparezca (Mapa, visión por satélite o lo que Google llama híbrido).

        // Tipo de mapa
        map.setMapType(G_NORMAL_MAP);

Y por último colocamos la posición (latitud y longitud) donde queremos que el mapa salga centrado.

Pero no acaban aquí (ni mucho menos) las posibilidades de Google Maps. Una de las opciones, que dentro de lo sencillo, es muy interesante, es la inclusión de marcas señalando puntos del mapa o incluso ventanas de información no es mucho más complejo.

Para añadir una nueva marca, basta con conocer el punto exacto donde queremos situarla y utilizar un objeto GMarker para mostrarla en el mapa. En cuanto a la ventana, de información, sólo necesitamos el código HTML necesario para crearla.
En este ejemplo la ventana tiene un código sencillo (texto, imagen y link) que se almacena en una variable.

// VENTANA (HTML)
 var html="<img src="http://neftali.clubdelphi.com/images/imagen_neftali_60x54.jpg" alt="" width="60" height="54" />
" + "by Neftalí -Germán Estévez-  2009 <strong>
<a href="http://neftali.clubdelphi.com"
 target="_blank">http://neftali.clubdelphi.com</a>
</strong>
<a href="http://neftali.clubdelphi.com" target="_blank">
    </a>
";

Para mostrarla basta con que utilicemos en método OpenInfoWindowHtml (cuyo nombre es bastante descriptivo, por cierto ;-D ) de la siguiente forma:

    // Visualización de la mrca
    var point = new GLatLng(41.381655,2.122829);
    var marker = new GMarker(point);
    marker.openInfoWindowHtml(html);

Hay más opciones y basta con echarle una vistazo a la API de Google Maps para conocerlas. Además hay muchos ejemplos de utilización que pueden servir para aclarar los conceptos y para ver más cláramente cómo se utilizan los diferentes elementos.

Todo lo visto hasta aquí, está puesto en práctica en un ejemplo Delphi.

Podéis descargar el código completo (incluye EXE -comprimido UPX-) desde aquí:
<Descargar Ejemplo>

Y aquí acabamos esta entrada, que no será la última. Me dejo para una segunda parte, algunos detalles finales, como interactuar con el mapa y obtener datos de él y fusionar los dos conceptos vistos hasta ahora.

Nos vemos.

(Google Maps – API) Codificación Geográfica – I

martes, 5 de mayo de 2009 17 comentarios

Codificación Geográfica Se conoce como Codificación Geográfica, al proceso o sistema de transformar una dirección “o similar” en coordenadas geográficas de Longitud y Latitud, para posteriormente ser utilizadas en sistemas de posicionamiento (por ejemplo).

El API de Google incluye este servicio, que es el que se utiliza cuando buscamos una dirección desde Google Maps.

Normalmente este acceso se hace desde una página web con peticiones HTTP; Lo que vamos a ver es cómo integrar este servicio en un programa Delphi.

Un poco más arriba he comentado que la codificación geográfica se basa en dar una entrada (dirección) para obtener unas coordenadas. También he añadido el “similar”, puesto que en el caso de Google Maps, podemos dar como entrada otras cosas que expresamente no son una dirección.

Así, podemos utilizar como dirección:

  • 08901,Spain
  • c/Balmes,214,Barcelona,Spain
  • Sevilla,Spain
  • Alhambra,Granada,Spain

Para hacer una prueba de lo que podemos obtener, basta con utilizar un componente TidHTTP de las Indy para realizar la petición. Coloca un componente TidHTTP en un formulario y un botón con el siguiente código:

procedure TForm1.btn1Click(Sender: TObject);
const
  STR_WEB = 'http://maps.google.com/maps/geo?q=';
  STR_OUT = '&amp;output=csv';    // formato de salida
var
  Stream: TStringStream;
  Str, res:string;
begin
  // ini
  Stream := TStringStream.Create('');
  // proteccion para liberar
  try
    Str := STR_WEB + edt1.Text + STR_OUT;
    idhttp2.Get(Str, Stream);
    edt2.Text := Stream.DataString;
  finally
    FreeAndNil(Stream);
  end;
end;

Una imagen de lo que obtenemos  una vez realizada la petición es la siguiente:

Se puede descargar el código completo de este ejemplo desde aquí.

Y lo que obtenemos como respuesta en este caso es:

200,8,41.3979638,2.1515206

Los dos últimos parámetros son los que buscabamos y nos indican las coordenadas de ese punto (latitud y longitud).

Para comprobar que so correctas, basta con ir a la web de Google Maps, copiar estas dos coordenadas en el cuadro de búsqueda y pulsar sobre el botón de <Buscar en el Mapa>.

A parte de esto, Google Maps nos devuelve, en este caso, dos números más; El primero corresponde al un “código de Estado” o “código de retorno” de la consulta que hemos realizado; En él se devuelve información por parte del servidor. Y el segundo es lo que se conoce como “Accuracy” o “Exactitud”, que corresponde justamente a eso; Al nivel de exactitud que Google asigna a la respuesta, segun la dirección que le hemos dado.

El código de retorno, en este caso, es un 200, que corresponde a la constante “G_GEO_SUCCESS” (consulta correcta).

El nivel de exactitud, en este caso, es un 8 (máxima precisión).

Los niveles de exactitud con lo que trabaja Google Maps son los siguientes:

  • 0:  Ubicación desconocida.
  • 1:  Precisión a nivel de país.
  • 2:  Precisión a nivel de región.
  • 3: Precisión a nivel de subregión.
  • 4: Precisión a nivel de ciudad o pueblo.
  • 5: Precisión a nivel de código postal.
  • 6: Precisión a nivel de calle.
  • 7: Precisión a nivel de intersección.
  • 8: Precisión a nivel de dirección.

Así en el ejemplo que hemos visto antes obteníamos una Exactitud de 8 (a nivel de dirección), mientras que si íntroducimos una dirección del tipo;

<08905,Barcelona,Spain>

Obtendremos un código 5 (a nivel de C.P.)

NOTA: La descripción detallada de los “códigos de precisión” se puede encontrar aquí; Y la descripción detallada de todos los “códigos de retorno” se puede encontrar aquí.


Evento OnMinimize de un formulario

sábado, 28 de febrero de 2009 1 comentario

Personalmente a veces me sería útil que el formulario que estoy utilizando tuviera algun sistema para detectar cuando se está minimizando el formularo; Y mejor aun que permitiera interactuar con esta acción.

Utilizo a menudo una opción de configuración que llamo: “Minimizar al Tray”. Muchas aplicaciones lo utilizan y se trata simplemente de, en lugar de minimizar la aplicación, ocultarla y mostrar un icono junto al reloj en la barra de tareas de Windows.

Para ellos la forma más sencilla que he encontrado es la que explico a continuación. Hay que decir que estoy usando Delphi 5, así que tal vez en alguna versión posterior (que además cuentan con el componnte para el Tray) habrá alguna solución más sencilla.

1
2
3
// Capturar mensajes al form
procedure WMSysCommand(var Msg: TWMSysCommand);
            message WM_SYSCOMMAND;

Y en la implementación:

1
2
3
4
5
6
7
8
9
10
11
// Capturar mensajes....
procedure TFormMain.WMSysCommand(var Msg: TWMSysCommand);
begin
  // Minimizando?
  if (Msg.CmdType = SC_MINIMIZE) then begin
    actionOcultar.Execute;
  end
  else begin
    DefaultHandler(Msg);
  end;
end;

En mi caso, lo que hago en el procedimiento es llamar al método de ocultar. Importante que en mi caso no deseo que se realice el Minimizar, por eso, la llamada a DefaultHandler está en el else. Si se desea que igualmente se realice esa llamada, esta debe estar fuera del IF.

Categories: Delphi, Trucos Tags: , , ,

Propiedades de una columna en Access utilizando ADOX

martes, 11 de noviembre de 2008 Sin comentarios

Utilizando ADO se puede acceder a casi toda la información de la Base de Datos, Tablas y Columnas, pero no a toda. En el caso de las Bases de datos de Access, por ejemplo, la propiedad descripción, que utilizamos para añadir un texto descriptivo a las columnas de las tablas, no es accesible.

Para obtenerla, hace falta acceder directamente a la información del “catálogo” utiliando ADOX. Para poder utilizar ADOX, lo primero que debemos hacer es importar la librería a en Delphi;
Esto se puede hacer desde el menú de: Proyect/Import Type Library.

La librería en concreto es la llamada “Microsoft ADO Ext. for DDL and Security” y proceso paso a paso, podéis verlo es esta página de Zarko Gajic.

Una vez importada la librería, basta con abrir la Base de Datos, acceder a una tabla y a un columna; A partir de ahí ya tenemos todos los datos(propiedades) referentes a esa columna.

El código es sencillo (basta con tener un formulario con un memo (Memo1) y un botón (button1)):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
procedure TForm1.Button2Click(Sender: TObject);
const
  DB_CONNECTION='Provider=Microsoft.Jet.OLEDB.4.0;' + 
       'Data Source=%s'; 
  DATABASENAME = 'c:\Archivos de ' +
       'programa\Archivos comunes\Borland Shared\Data' + 
       '\dbdemos.mdb';
var
  i, j:Integer;
  Con:OleVariant;
  fCatalog:Catalog;
  Column: _Column;
  Table:_Table;
  Str1, Str2:string;
begin
  // Limpiar la salida
  Memo1.Lines.Clear;
  // Conectar con la Base de Datos
  Con := CreateOleObject('ADODB.Connection');
  // Abrir
  Con.Open(Format(DB_CONNECTION,[DATABASENAME]));
  // proteccion
  try
    // Acceder a la Base de Datos
    fCatalog := CoCatalog.Create;
    fCatalog._Set_ActiveConnection(Con);
    // Acceder a la tabla de empleados
    Table := fCatalog.Tables['employee'];
    // recorrer las columnas
    for i := 0 to (Table.Columns.Count - 1) do begin
      // Acceder a la columna
      Column := Table.Columns[i];
      // Datos de columna
      Memo1.Lines.Add(' ');
      Memo1.Lines.Add(Format('Columna: %s',[Column.Name]));
      Memo1.Lines.Add('---------------------------------');
      Memo1.Lines.Add(Format(' Tamaño: %d',[Column.DefinedSize]));
      Memo1.Lines.Add(Format(' Precisión: %d',[Column.Precision]));
      // recorrer las propiedades de la columna
      for j := 0 to (Column.Properties.Count - 1) do begin
        // Cada propiedad, Nombre y valor
        Str1 := Column.Properties[j].Name;
        Str2 := Column.Properties[j].Value;
        // Saltamos las propiedades Jet...
        if (Length(Str1) > 0) then begin
          // Saltar las Jet
          if (Str1[1] <> 'J') then begin
            Memo1.Lines.Add(Format(' %s: %s',[Str1, Str2]))
          end; //if
        end; //if
      end; // for
    end; // for
  finally
    // Liberar y cerrar
    Column := nil;
    Table := nil;
    fCatalog := nil;
    Con.Close;
  end;
end;
Categories: Delphi, Trucos Tags: , , , ,

Ordenar un TStringGrid por una determinada columna

jueves, 9 de octubre de 2008 2 comentarios

Procedimiento que muestra cómo ordenar un TStringGrid a partir de los datos de una columna. El texto está basado en esta página Web donde hay un algoritmo de ordenación. El problema es que sólo es para datos numéricos. En este truco he añadido un par de parámetros para poder definir columnas de otro tipo (u ordenación de otro tipo) y además marcar si que quiere de forma Ascendente o Descendente (que tampoco está en el truco original).

Yo he añadido métodos para ordenar por enteros y Float, aunque ampliando se pueden añadir para alguno más.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
// Ordena un TStringGrid.
procedure SortStringGrid(var GenStrGrid: TStringGrid;
    ThatCol: Integer;
    ColData:TGridData=gdString;
    SortOrder:TSortOrder=soASC);
const
  TheSeparator = '@';
var
  CountItem, I, J, K, ThePosition: integer;
  MyList: TStringList;
  MyString, TempString: string;
  str:string;
  vali:Integer;
  valf:Double;
begin
  CountItem := GenStrGrid.RowCount;
  MyList := TStringList.Create;
  MyList.Sorted := False;
  try
    begin
      for I := 1 to (CountItem - 1) do begin
        Str := GenStrGrid.Rows[I].Strings[ThatCol];
        if (ColData = gdInteger) then begin
          vali := StrToIntDef(Str, 0);
          Str := Format('%*d', [15,vali]);
        end;
        if (ColData = gdFloat) then begin
          valf := StrToFloat(Str);
          Str := Format('%15.2f',[valf]);
        end;
        MyList.Add(Str + TheSeparator + GenStrGrid.Rows[I].Text);
      end;
      Mylist.Sort;
 
      for K := 1 to Mylist.Count do begin
        MyString := MyList.Strings[(K - 1)];
        ThePosition := Pos(TheSeparator, MyString);
        TempString := '';
        {Eliminate the Text of the column on which we have
          sorted the StringGrid}
        TempString := Copy(MyString, (ThePosition + 1), Length(MyString));
        MyList.Strings[(K - 1)] := '';
        MyList.Strings[(K - 1)] := TempString;
      end;
 
      if (SortOrder = soASC) then begin
        for J := 1 to (CountItem - 1) do begin
            GenStrGrid.Rows[J].Text := MyList.Strings[(J - 1)];
        end;
      end
      else begin
        for J := 1 to (CountItem - 1) do begin
          I := (CountItem - J);
          GenStrGrid.Rows[I].Text := MyList.Strings[(J - 1)];
        end;
      end;
    end;
 
  finally
    MyList.Free;
  end;
end;

AÑADO: Me falta una cosa.
Además habrá que definir en la unit los dos tipos que se utilizan para la ordenación:

1
2
3
4
5
Type
  //: Tipo de Dat de la columna por la que queremos ordenar.
  TGridData = (gdString, gdInteger, gdFloat);
  //: Tipos de ordenación.
  TSortOrder = (soASC, soDESC);

Buscar ficheros en un directorio y guardarlos en un TStringList (recursico)

jueves, 24 de julio de 2008 4 comentarios

Función para buscar ficheros en un directorio de forma recursiva.
Devuelve una lista de nombres de fichero encontrados a partir de la carpeta inicial StartDir, que cumplen el patrón especificado por FileMask.

Mediante recursively se indica si se desea
hacer la busqueda en los subdirectorios.

El resultado se devuelve en FilesList (TStringList), que es la lista que se rellena con los nombres de fichero encontrados.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
{: Devuelve una lista de nombres de fichero encontrados a partir 
de la carpeta inicial StartDir, que cumplen el patrón especificado 
por FileMask.Mediante recursively se indica si se desea hacer la
 busqueda en los subdirectorios.
StartDir Carpeta desde la que empezar a buscar.
FileMask Patrón que han de cumplir los ficheros.
Recursively Si hay que continuar la búsqueda en los subdirectorios.
FilesList Lista con los nombres de fichero encontrados.
}
procedure FindFiles(StartDir, FileMask: string; 
                 recursively: boolean; var FilesList: TStringList);
const
  MASK_ALL_FILES = '*.*';
  CHAR_POINT = '.';
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
 
  if (StartDir[length(StartDir)] <> '\') then begin
    StartDir := StartDir + '\';
  end;
 
  // Crear la lista de ficheos en el dir. StartDir (no directorios!)
  IsFound := FindFirst(StartDir + FileMask, 
                  faAnyFile - faDirectory, SR) = 0;
 
  // MIentras encuentre
  while IsFound do begin
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
 
  FindClose(SR);
 
  // Recursivo?
  if (recursively) then begin
    // Build a list of subdirectories
    DirList := TStringList.Create;
    // proteccion
    try
    IsFound := FindFirst(StartDir + MASK_ALL_FILES, 
                   faAnyFile, SR) = 0;
    while IsFound do begin
      if ((SR.Attr and faDirectory) <> 0) and 
          (SR.Name[1] <>  CHAR_POINT) then begin
        DirList.Add(StartDir + SR.Name);
        IsFound := FindNext(SR) = 0;
      end; // if
    end; // while
    FindClose(SR);
    // Scan the list of subdirectories
    for i := 0 to DirList.Count - 1 do begin
      FindFiles(DirList[i], FileMask, recursively, FilesList);
    end;
 
    finally
      DirList.Free;
    end;
  end;
end;

Utilizar un BMP para cambiar el cursor

martes, 6 de mayo de 2008 1 comentario

Muestra como utilizar un BITMAP (en este caso extraído de un TImage) para modificar el cursor activo. Modificando un poco el Tip/Truco es fácil obtener la imagen de disco o desde un recurso.

Se utiliza la API CreateIconIndirect para generar el cursor que posteriormente se activará.

Se puede usar un color de fondo como transparente para obtener un cursos “opaco” o un segundo BITMAP para combinarlo con el primero y así obtener también efectos de transparencia en el cursor generado.

Imagen del ejemplo

// Crear los bitmaps
BitmapMask := TBitmap.Create;
Bitmap := TBitmap.Create;
// proteccion
try
  // Cargar las imágenes
  BitmapMask.Assign(Image2.Picture.Bitmap);
  Bitmap.Assign(Image1.Picture.Bitmap);
  // Crear el icono del cursor
  with iconInfo do begin
    fIcon := false;
    xHotspot := (Bitmap.Width div 4);
    yHotspot := (Bitmap.Height div 3);
    hbmMask := BitmapMask.Handle;
    hbmColor := Bitmap.Handle;
  end;
 
  // Asignar el icono
  Screen.Cursors[1] := CreateIconIndirect(iconInfo);
  Self.Cursor := 1;
 
finally
  // Liberar
  BitmapMask.Free;
  Bitmap.Free;
end;

Es ejemplo completo se puede descargar <AQUÍ>.
Download Descargar.

Categories: Delphi, Trucos Tags: , , ,

Fechas de un fichero (creación, modificación y últ. acceso)

sábado, 29 de marzo de 2008 2 comentarios

Para cualquier fichero que se encuentra en el sistema de archivos de Windows se almacenan varias fechas. Para acceder a todas ellas puede utilizar el siguiente truco:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
// ================================================================
// Return the three dates (Created,Modified,Accessed)
// of a given filename. Returns FALSE if file cannot
// be found or permissions denied. Results are returned
// in TdateTime VAR parameters
// ================================================================
// ================================================================
// Devuelve las tres fechas (Creación, modificación y último acceso)
// de un fichero que se pasa como parámetro.
// Devuelve FALSO si el fichero no se ha podido acceder, sea porque
// no existe o porque no se tienen permisos. Las fechas se devuelven
// en tres parámetros de ipo DateTime
// ================================================================
function GetFileTimes(FileName : string; var Created : TDateTime;
    var Modified : TDateTime; var Accessed : TDateTime) : boolean;
var
   FileHandle : integer;
   Retvar : boolean;
   FTimeC,FTimeA,FTimeM : TFileTime;
   LTime : TFileTime;
   STime : TSystemTime;
begin
  // Abrir el fichero
  FileHandle := FileOpen(FileName,fmShareDenyNone);
  // inicializar
  Created := 0.0;
  Modified := 0.0;
  Accessed := 0.0;
  // Ha tenido acceso al fichero?
  if FileHandle < 0 then
    RetVar := false
  else begin
 
    // Obtener las fechas
    RetVar := true;
    GetFileTime(FileHandle,@FTimeC,@FTimeA,@FTimeM);
    // Cerrar
    FileClose(FileHandle);
    // Creado
    FileTimeToLocalFileTime(FTimeC,LTime);
 
    if FileTimeToSystemTime(LTime,STime) then begin
      Created := EncodeDate(STime.wYear,STime.wMonth,STime.wDay);
      Created := Created + EncodeTime(STime.wHour,STime.wMinute,
              STime.wSecond, STime.wMilliSeconds);
    end;
 
    // Accedido
    FileTimeToLocalFileTime(FTimeA,LTime);
 
    if FileTimeToSystemTime(LTime,STime) then begin
      Accessed := EncodeDate(STime.wYear,STime.wMonth,STime.wDay);
      Accessed := Accessed + EncodeTime(STime.wHour,STime.wMinute,
              STime.wSecond, STime.wMilliSeconds);
    end;
 
    // Modificado
    FileTimeToLocalFileTime(FTimeM,LTime);
 
    if FileTimeToSystemTime(LTime,STime) then begin
      Modified := EncodeDate(STime.wYear,STime.wMonth,STime.wDay);
      Modified := Modified + EncodeTime(STime.wHour,STime.wMinute,
                     STime.wSecond, STime.wMilliSeconds);
    end;
  end;
  Result := RetVar;
end;

Para llamar a ésta función se puede utilizar un código como éste:

1
2
3
4
5
6
7
8
9
10
var
   CDate,MDate,ADate : TDateTime;
begin
  // Correcto?
  if GetFileTimes('c:\autoexec.bat', CDate, MDate, ADate) then begin
    Label1.Caption := FormatDateTime('dd/mm/yyyy hh:nn',CDate);
    Label2.Caption := FormatDateTime('dd/mm/yyyy hh:nn',MDate);
    Label3.Caption := FormatDateTime('dd/mm/yyyy hh:nn',ADate);
  end;
end;

Dibujar una flecha (ordenación) en el título de un DBGrid

sábado, 15 de marzo de 2008 9 comentarios

A veces nos puede interesar dibujar en el título de un DBGrid una flecha para indicar la ordenación ASCENDENTE o DESCENDENTE sobre esa columna; De forma muy similar a como se muesta aquí, se pueden dibujar otros símbolos e incluso colocar imágenes.

Para conseguir ésto se debe derivar el componente de DBGrid estandard y añadir los dos métodos de dibujo a la parte privada:

{ Private declarations }
procedure __PaintArrowUp(Canvas: TCanvas; var Rect: TRect);
procedure __PaintArrowDown(Canvas: TCanvas; var Rect: TRect);
 
....y la implementación....
 
// Dibuja la línea hacia abajo
procedure TNeftaliDBGrid.__PaintArrowDown(Canvas: TCanvas; var Rect: TRect);
var
  APolyLine: Array[0..2] of TPoint;
  SaveCol, BrushCol : TColor;
begin
  // Utilizamos el canvas pasado como parámetro
  with Canvas do begin
    // Guardar los valores actuales
    SaveCol := Pen.Color;
    BrushCol := Brush.Color;
    // Activar los nuevos valores depintado
    Brush.Style := bsSolid;
    Pen.Color := Self.FixedColor;
    Brush.Color := Self.FixedColor;
    // Dibujar un rectágulo debajo para tapar el título
    Rectangle(Rect.Right-13, Rect.Top+3, Rect.Right-1, Rect.Top+15);
    // Dibujamos la flecha
    Pen.Color := clGray{clBlack};
    APolyLine[0]:=Point(Rect.Right-4, Rect.Top+5);
    APolyLine[1]:=Point(Rect.Right-11, Rect.Top+5);
    APolyLine[2]:=Point(Rect.Right-8, Rect.Top+11);
    PolyLine(APolyLine);
    Pen.Color := clWhite;
    MoveTo(Rect.Right-7, Rect.Top+11);
    LineTo(Rect.Right-4, Rect.Top+5);
    // Restaurar valores guardados
    Brush.Color := BrushCol;
    Pen.Color := SaveCol;
  end;
end;
 
// Dibuja la línea hacia arriba
procedure TNeftaliDBGrid.__PaintArrowUp(Canvas: TCanvas; var Rect: TRect);
var
  SaveCol, BrushCol : TColor;
begin
  // Utilizamos el canvas pasado por parámetro.
  with Canvas do begin
    // Guardar los valores de los colores
    SaveCol := Pen.Color;
    BrushCol := Brush.Color;
    // Nuevo estilo de pintado.
    Brush.Style := bsSolid;
    Pen.Color := Self.FixedColor;
    Brush.Color := Self.FixedColor;
    // Rectangulo por debajo para tapar el título
    Rectangle(Rect.Right-13, Rect.Top+3, Rect.Right-1, Rect.Top+15);
    // Dibujar la flacha
    Pen.Color := clGray{clBlack};
    MoveTo(Rect.Right-11, Rect.Top+11);
    LineTo(Rect.Right-8, Rect.Top+5);
    LineTo(Rect.Right-7, Rect.Top+5);
    Pen.Color:=clWhite;
    MoveTo(Rect.Right-7, Rect.Top+5);
    LineTo(Rect.Right-4, Rect.Top+11);
    LineTo(Rect.Right-11, Rect.Top+11);
    //Restaurar los colores
    Brush.Color := BrushCol;
    Pen.Color := SaveCol;
  end;
end;

Para poder pintar la flecha cuando te interese se debe redefinir el método para dibujar una celda existente en el TCustomDBGrid llamado DrawCell del componente de DBGrid estandard y añadir los dos métodos de dibujo a la parte privada:

procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
	            AState: TGridDrawState); override;
 
....y su implementación...
 
// Método para pintar una celda del DBGrid
procedure TNeftaliDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
	    AState: TGridDrawState);
begin
  inherited; // Importante la llamada al inherited
 
  // No es fila de títulos?
  if (ARow &lt;&gt; 0) then begin
    Exit;
  end;
 
  // Columna 3 (por ejemplo)
  if (ACol = 3) then begin
    __PaintArrowUp(Canvas, ARect);
  end;
 
  // Columna 4 (por ejemplo)
  if (ACol = 4) then begin
    __PaintArrowDown(Canvas, ARect);
  end;
end;

Y en la implementacion se hacen las comprobaciones de fila y columna, para que sólo pinte las flechas en la fila de títulos y en la columna que se desee. En éste ejemplo las columnas están como constantes, pero posiblemente se deberán obtener a partir de alguna variable/propiedad (por ejemplo la que el usuario pulse con el ratón. Puedes descargar el código de ejemplo del componente.

Download Descargar

Categories: Delphi, Trucos Tags: , , ,

Obtener la lista de procesos ejecutándose

domingo, 24 de febrero de 2008 1 comentario

Con ésté trozo de código se puede obtener la lista de los procesos (nombre del ejecutable) que están en marcha en ese momento en la máquina:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
var
  i: Integer;
  bContinue: BOOL;
begin
   // Limpiar la lista
   ListBox1.Items.Clear;
   // Recoge la lista de procesos en éste momento
   aSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   aProcessEntry32.dwSize := SizeOf(aProcessEntry32);
   // Acceder al primer proceso
   bContinue := Process32First(aSnapshotHandle, aProcessEntry32);
   // Recorerr los procesos activos
   while (Integer(bContinue) <> 0) do begin
      // Añadirlo a la lista
      ListBox1.Items.Add(ExtractFileName(aProcessEntry32.szExeFile));
      // Hay más?
      bContinue := Process32Next(aSnapshotHandle, aProcessEntry32);
   end;
   // cerrar la estructura
   CloseHandle(aSnapshotHandle);

Utilizando aProcessEntry32 se puede obtener más información de cada uno de los procesos, como:

* Identificador
* Nombre competo
* …

IntToHex(aProcessEntry32.th32ProcessID, 4)
aProcessEntry32.szExeFile

Categories: Delphi, Trucos Tags: , , ,