Ahora voy a poner las funciones usadas
Archivo: FUN_DBGRID
La siguiente función no tiene descripción, pero lo que hace es colocar el grid con dos colores, ver en el código de los módulos para que quede más claro
Código Delphi
[-]function Zebrado(DST:TDataSource; GridsDb:TDBGrid; Rect:TRect; Column:TColumn; State:TGridDrawState; ColorA:TColor=clWhite; Colorb:TColor=clMoneyGreen; ColorSelect:TColor=clAqua):Boolean;
begin
if not odd(DST.dataSet.RecNo) then GridsDb.Canvas.Brush.Color := Colorb
else GridsDb.Canvas.Brush.Color := Colora;
TDbGrid(GridsDb).Canvas.font.Color:= clBlack;
if gdSelected in State then
with (GridsDb as TDBGrid).Canvas do
begin
Brush.Color := ColorSelect;
FillRect(Rect);
Font.Style := [fsbold]
end;
TDbGrid(GridsDb).DefaultDrawDataCell(Rect,TDbGrid(GridsDb).columns[Column.ID].field, State);
Result:=True;
End;
Ahora pongo el módulo completo Fun_Errores:
Código Delphi
[-]unit Fun_Errores;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;
function ErrorDetail(Error:string):string;
function ErrorX(ID:string='';
Unidad:string='';
Modulo:STring='';
Mensaje:string='';
Clase_Error:string='';
Mensaje_Error:string='';
B_Salir:Boolean=False;
Color:TColor=clBtnFace;
FontColor:TColor=clMaroon;
Delay:Integer=500):string;
implementation
uses UErrores;
function ErrorX(ID:string='';
Unidad:string='';
Modulo:STring='';
Mensaje:string='';
Clase_Error:string='';
Mensaje_Error:string='';
B_Salir:Boolean=False;
Color:TColor=clBtnFace;
FontColor:TColor=clMaroon;
Delay:Integer=500):string;
begin
try if not Assigned(FError) then Ferror := TFerror.Create(nil);
begin
FError.LabeledEdit1.Font.Color:=FontColor;
FError.LabeledEdit2.Font.Color:=FontColor;
FError.LabeledEdit3.Font.Color:=FontColor;
FError.LabeledEdit4.Font.Color:=FontColor;
FError.Memo1.Font.Color:=FontColor;
FError.Memo2.Font.Color:=FontColor;
if (ID='') then Ferror.LabeledEdit1.visible:=False
else
begin
FError.LabeledEdit1.visible:=True;
FError.LabeledEdit1.text:=ID;
end;
if (Unidad='') then FError.LabeledEdit2.visible:=False
else
begin
FError.LabeledEdit2.visible:=True;
FError.LabeledEdit2.text:=Unidad;
end;
if (Modulo='') then FError.LabeledEdit3.visible:=False
else
begin
FError.LabeledEdit3.visible:=True;
FError.LabeledEdit3.text:=Modulo;
end;
if (Clase_Error='') then FError.LabeledEdit4.visible:=False
else
begin
FError.LabeledEdit4.visible:=True;
FError.LabeledEdit4.text:=Clase_Error;
end;
FError.Memo1.lines.Clear;
FError.Memo1.lines.Add(Mensaje);
if (Mensaje_Error='') then
begin
FError.Memo1.Height:=265;
FError.Memo2.Visible:=False;
end
else
begin
FError.Memo1.Height:=105;
FError.Memo2.Visible:=True;
FError.memo2.lines.Clear;
if errorDetail(Clase_Error)<>Clase_Error then FError.Memo2.lines.Add(errorDetail(Clase_Error)+#13#10+'---Mensaje Original---------------------------------------'+#13#10+Mensaje_Error)
else FError.Memo2.lines.Add(Mensaje_Error);
end;
if (B_Salir=False) then FError.SpeedButton1.visible:=false
else FError.SpeedButton1.visible:=True;
FError.Panel1.Color:=Color;
FError.Panel2.Color:=Color;
FError.Timer1.interval:=Delay;
FError.ShowModal;
end
finally
Result:=FError.VarSFErrorResult;
end;
end;
function ErrorDetail(Error:string):string;
begin
Result:=Error;
if Trim(UpperCase(Error))=Trim(UpperCase('EAbort')) then Result:='Finaliza la secuencia de eventos sin mostrar el mensaje de error.';
if Trim(UpperCase(Error))=Trim(UpperCase('EAccessViolation')) then Result:='Comprueba errores de acceso a memoria inválidos.';
if Trim(UpperCase(Error))=Trim(UpperCase('EBitsError')) then Result:='Previene intentos para acceder a arrays de elementos booleanos. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EComponentError')) then Result:='Nos informa de un intento inválido de registrar o renombrar un componente. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EConvertError')) then Result:='Muestra un error al convertir objetos o cadenas de texto string. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EDatabaseError')) then Result:='Especifica un error de acceso a bases de datos. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EDBEditError')) then Result:='Error al introducir datos incompatibles con una máscara de texto. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EDivByZero')) then Result:='Errores de división por cero. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EExternalException')) then Result:='Significa que no reconoce el tipo de excepción (viene de fuera). ';
if Trim(UpperCase(Error))=Trim(UpperCase('EIntOutError')) then Result:='Representa un error de entrada/salida a archivos. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EIntOverflow')) then Result:='Especifica que se ha provocado un desbordamiento de un tipo de dato. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidCast')) then Result:='Comprueba un error de conversión de tipos ';
if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidGraphic')) then Result:='Indica un intento de trabajar con gráficos que tienen un formato desconocido. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidOperation')) then Result:='Ocurre cuando se ha intentado realizar una operación inválida sobre un componente.';
if Trim(UpperCase(Error))=Trim(UpperCase('EInvalidPointer')) then Result:='Se produce en operaciones con punteros inválidos.';
if Trim(UpperCase(Error))=Trim(UpperCase('EMenuError')) then Result:='Controla todos los errores relacionados con componentes de menú.';
if Trim(UpperCase(Error))=Trim(UpperCase('EOleCtrlError')) then Result:='Detecta problemas con controles ActiveX.';
if Trim(UpperCase(Error))=Trim(UpperCase('EOleError')) then Result:='Especifica errores de automatización de objetos OLE.';
if Trim(UpperCase(Error))=Trim(UpperCase('EPrinterError')) then Result:='Errores al imprimir.';
if Trim(UpperCase(Error))=Trim(UpperCase('EPropertyError')) then Result:=' Ocurre cuando se intenta asignar un valor erroneo a una propiedad del componente.';
if Trim(UpperCase(Error))=Trim(UpperCase('ERangeError')) then Result:='Indica si se intenta asignar un número entero demasiado grande a una propiedad. ';
if Trim(UpperCase(Error))=Trim(UpperCase('ERegistryExcepcion')) then Result:='Controla los errores en el registro. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EZeroDivide')) then Result:='Controla los errores de división para valores reales. ';
if Trim(UpperCase(Error))=Trim(UpperCase('ArgumentException')) then Result:='Pasado argumento no válido (base de excepciones de argumentos) ';
if Trim(UpperCase(Error))=Trim(UpperCase('ArgumentNullException')) then Result:='Pasado argumento nulo';
if Trim(UpperCase(Error))=Trim(UpperCase('ArgumentOutOfRangeException')) then Result:='Pasado argumento fuera de rango ';
if Trim(UpperCase(Error))=Trim(UpperCase('ArrayTypeMistmatchException')) then Result:='Asignación a tabla de elemento que no es de su tipo';
if Trim(UpperCase(Error))=Trim(UpperCase('COMException')) then Result:='Excepción de objeto COM ';
if Trim(UpperCase(Error))=Trim(UpperCase('DivideByZeroException')) then Result:='División por cero ';
if Trim(UpperCase(Error))=Trim(UpperCase('IndexOutOfRangeException')) then Result:='Índice de acceso a elemento de tabla fuera del rango válido (menor que cero o mayor que el tamaño de la tabla) ';
if Trim(UpperCase(Error))=Trim(UpperCase('InvalidCastException')) then Result:='Conversión explícita entre tipos no válida ';
if Trim(UpperCase(Error))=Trim(UpperCase('InvalidOperationException')) then Result:='Operación inválida en estado actual del objeto ';
if Trim(UpperCase(Error))=Trim(UpperCase('InteropException')) then Result:='Base de excepciones producidas en comunicación con código inseguro ';
if Trim(UpperCase(Error))=Trim(UpperCase('NullReferenceException')) then Result:='Acceso a miembro de objeto que vale null ';
if Trim(UpperCase(Error))=Trim(UpperCase('OverflowException')) then Result:='Desbordamiento dentro de contexto donde se ha de comprobar los desbordamientos (expresión constante, instrucción checked, operación checked u opción del compilador /checked)';
if Trim(UpperCase(Error))=Trim(UpperCase('OutOfMemoryException')) then Result:='Falta de memoria para crear un objeto con new ';
if Trim(UpperCase(Error))=Trim(UpperCase('SEHException')) then Result:='Excepción SHE del API Win32 ';
if Trim(UpperCase(Error))=Trim(UpperCase('StackOverflowException')) then Result:='Desbordamiento de la pila, generalmente debido a un excesivo número de llamadas recurrentes. ';
if Trim(UpperCase(Error))=Trim(UpperCase('EConvertError')) then Result:='No se puede convertir esa cadena';
if Trim(UpperCase(Error))=Trim(UpperCase('TypeInizializationException')) then Result:='Ha ocurrido alguna excepción al inicializar los campos estáticos o el constructor estático de un tipo. En InnerException se indica cuál es.';
end;
end.