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

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

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

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

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

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

procedure TForm1.btn1Click(Sender: TObject);
const
  STR_WEB = 'http://maps.google.com/maps/geo?q=';
  STR_OUT = '&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;

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

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

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;

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

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

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

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