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 formprocedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;
// 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;
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.
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
Ya están actualizados en la nueva web los trucos que tenía en la antigua; Tal vez las fechas y el orden no coincidan del todo, pero creo que es lo menos importante.
Están accesible por el Tag: Trucos o desde el acceso de la página principal donde hay creado un pequeño índice de todos los existentes.
Si detectáis algun error (que seguro los hay) os ruego que me lo comuniquéis.
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
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)):
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]));// protecciontry// 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 columnasfor i :=0to(Table.Columns.Count-1)dobegin// 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 columnafor j :=0to(Column.Properties.Count-1)dobegin// Cada propiedad, Nombre y valor
Str1 := Column.Properties[j].Name;
Str2 := Column.Properties[j].Value;// Saltamos las propiedades Jet...if(Length(Str1) > 0)thenbegin// Saltar las Jetif(Str1[1] <> 'J')thenbegin
Memo1.Lines.Add(Format(' %s: %s',[Str1, Str2]))end;//ifend;//ifend;// forend;// forfinally// Liberar y cerrar
Column :=nil;
Table :=nil;
fCatalog :=nil;
Con.Close;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;
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
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.
// 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;trybeginfor I :=1to(CountItem -1)dobegin
Str := GenStrGrid.Rows[I].Strings[ThatCol];if(ColData = gdInteger)thenbegin
vali :=StrToIntDef(Str,0);
Str :=Format('%*d',[15,vali]);end;if(ColData = gdFloat)thenbegin
valf :=StrToFloat(Str);
Str :=Format('%15.2f',[valf]);end;
MyList.Add(Str + TheSeparator + GenStrGrid.Rows[I].Text);end;
Mylist.Sort;for K :=1to Mylist.Countdobegin
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)thenbeginfor J :=1to(CountItem -1)dobegin
GenStrGrid.Rows[J].Text:= MyList.Strings[(J -1)];end;endelsebeginfor J :=1to(CountItem -1)dobegin
I :=(CountItem - J);
GenStrGrid.Rows[I].Text:= MyList.Strings[(J -1)];end;end;end;finally
MyList.Free;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;
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);
Type
//: Tipo de Dat de la columna por la que queremos ordenar.
TGridData = (gdString, gdInteger, gdFloat);
//: Tipos de ordenación.
TSortOrder = (soASC, soDESC);
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
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.
{: 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;beginif(StartDir[length(StartDir)] <> '\')thenbegin
StartDir := StartDir +'\';end;// Crear la lista de ficheos en el dir. StartDir (no directorios!)
IsFound :=FindFirst(StartDir + FileMask,
faAnyFile - faDirectory, SR)=0;// MIentras encuentrewhile IsFound dobegin
FilesList.Add(StartDir + SR.Name);
IsFound :=FindNext(SR)=0;end;FindClose(SR);// Recursivo?if(recursively)thenbegin// Build a list of subdirectories
DirList := TStringList.Create;// protecciontry
IsFound :=FindFirst(StartDir + MASK_ALL_FILES,
faAnyFile, SR)=0;while IsFound dobeginif((SR.Attrand faDirectory) <> 0)and(SR.Name[1] <> CHAR_POINT)thenbegin
DirList.Add(StartDir + SR.Name);
IsFound :=FindNext(SR)=0;end;// ifend;// whileFindClose(SR);// Scan the list of subdirectoriesfor i :=0to DirList.Count-1dobegin
FindFiles(DirList[i], FileMask, recursively, FilesList);end;finally
DirList.Free;end;end;end;
{: 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;
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
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.
// Crear los bitmaps
BitmapMask := TBitmap.Create;
Bitmap := TBitmap.Create;// protecciontry// Cargar las imágenes
BitmapMask.Assign(Image2.Picture.Bitmap);
Bitmap.Assign(Image1.Picture.Bitmap);// Crear el icono del cursorwith iconInfo dobegin
fIcon :=false;
xHotspot :=(Bitmap.Widthdiv4);
yHotspot :=(Bitmap.Heightdiv3);
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;
// 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Í>. Descargar.
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
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:
// ================================================================// 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 < 0then
RetVar :=falseelsebegin// Obtener las fechas
RetVar :=true;
GetFileTime(FileHandle,@FTimeC,@FTimeA,@FTimeM);// CerrarFileClose(FileHandle);// Creado
FileTimeToLocalFileTime(FTimeC,LTime);if FileTimeToSystemTime(LTime,STime)thenbegin
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)thenbegin
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)thenbegin
Modified :=EncodeDate(STime.wYear,STime.wMonth,STime.wDay);
Modified := Modified +EncodeTime(STime.wHour,STime.wMinute,
STime.wSecond, STime.wMilliSeconds);end;end;
Result := RetVar;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;
Para llamar a ésta función se puede utilizar un código como éste:
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
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 abajoprocedure TNeftaliDBGrid.__PaintArrowDown(Canvas: TCanvas;var Rect: TRect);var
APolyLine:Array[0..2]of TPoint;
SaveCol, BrushCol : TColor;begin// Utilizamos el canvas pasado como parámetrowith Canvas dobegin// 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 arribaprocedure TNeftaliDBGrid.__PaintArrowUp(Canvas: TCanvas;var Rect: TRect);var
SaveCol, BrushCol : TColor;begin// Utilizamos el canvas pasado por parámetro.with Canvas dobegin// 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;
{ 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 DBGridprocedure TNeftaliDBGrid.DrawCell(ACol, ARow:Integer; ARect: TRect;
AState: TGridDrawState);begininherited;// Importante la llamada al inherited// No es fila de títulos?if(ARow <>0)thenbegin
Exit;end;// Columna 3 (por ejemplo)if(ACol =3)thenbegin
__PaintArrowUp(Canvas, ARect);end;// Columna 4 (por ejemplo)if(ACol =4)thenbegin
__PaintArrowDown(Canvas, ARect);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;
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.
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
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 activoswhile(Integer(bContinue) <> 0)dobegin// Añadirlo a la lista
ListBox1.Items.Add(ExtractFileName(aProcessEntry32.szExeFile));// Hay más?
bContinue := Process32Next(aSnapshotHandle, aProcessEntry32);end;// cerrar la estructura
CloseHandle(aSnapshotHandle);
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
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
Creando tres sencillos procedimientos en un formulario se pueden mover controles visuales en Runtime colocados en un form siempre que deriven de TControl. Basta con definir los siguientes procedimientos y asignarlos a todos los controles que queramos mover; Además se deben definir dos variables en la parte privada del form:
NOTA: Los procedimientos se deben definir no en la parte privada, sino como eventos del form.
En la parte final de artículo se puede descargar un ejemplo compilado con Delphi 6.
procedure MouseMove;
procedure MouseUp;
procedure MouseDown;
// Definirlos como ventos del formprocedure MouseMove(Sender:TObject; Shift: TShiftState; X, Y:Integer);procedure MouseUp(Sender:TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);procedure MouseDown(Sender:TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);...// Definir éstas variables en la parte privada...private
Capturing:Boolean;
MouseDownSpot:TPoint;....// IMPLEMENTACION// Procedimintos a asignar a los eventos de los controles...procedure TForm1.MouseMove(Sender:TObject; Shift: TShiftState; X,Y:Integer);begin// Estamos capturando?if Capturing thenbegin// Mover el componente
TControl(Sender).Left:= TControl(Sender).Left-(MouseDownSpot.x- x);
TControl(Sender).Top:= TControl(Sender).Top-(MouseDownSpot.y- y);end;end;procedure TForm1.MouseUp(Sender:TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);begin// Estamos capturando?if Capturing thenbegin
ReleaseCapture;// Liberar la captura
Capturing :=false;
TControl(Sender).Left:= TControl(Sender).Left-(MouseDownSpot.x- x);
TControl(Sender).Top:= TControl(Sender).Top-(MouseDownSpot.y- y);end;end;procedure TForm1.MouseDown(Sender:TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);begin// Comenzar la captura y movimiento
Capturing :=true;
MouseDownSpot.X:= x;
MouseDownSpot.Y:= Y;end;
// Definirlos como ventos del form
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
...
// Definir éstas variables en la parte privada...
private
Capturing:Boolean;
MouseDownSpot:TPoint;
....
// IMPLEMENTACION
// Procedimintos a asignar a los eventos de los controles...
procedure TForm1.MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
// Estamos capturando?
if Capturing then begin
// Mover el componente
TControl(Sender).Left := TControl(Sender).Left - (MouseDownSpot.x - x);
TControl(Sender).Top := TControl(Sender).Top - (MouseDownSpot.y - y);
end;
end;
procedure TForm1.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Estamos capturando?
if Capturing then begin
ReleaseCapture; // Liberar la captura
Capturing := false;
TControl(Sender).Left := TControl(Sender).Left - (MouseDownSpot.x - x);
TControl(Sender).Top := TControl(Sender).Top - (MouseDownSpot.y - y);
end;
end;
procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Comenzar la captura y movimiento
Capturing := true;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
Embarcadero MVP.
Analista y Programador de Sistemas Informáticos.
Estudios de Informática (Ingeniería Técnica Superior) en la UPC (Universidad Politécnica de Barcelona).
Llevo utilizando Delphi desde su versión 3. Especialista en diseño de componentes, Bases de Datos, Frameworks de Persistencia, Integración Continua, Desarrollo móvil,…
Usamos cookies para asegurar que te damos la mejor experiencia en nuestra web. Si continúas usando este sitio, asumiremos que estás de acuerdo con ello.Aceptar