/*Prog*/ Delphi-Neftalí /*finProg*/

{: 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;

// 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;

// ================================================================
// 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;

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;

{ 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;

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 <> 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;