1 {
2 DESCRIPCIÓN
3 Incluye la definición del objeto TUtilGrilla, con rutinas comunes para el manejo de
4 grillas.
5 }
6 unit UtilsGrilla;
7 {$mode objfpc}{$H+}
8 interface
9 uses
10 Classes, SysUtils, fgl, Types, Grids, Clipbrd, Menus, Controls,
11 Graphics, LCLProc, LCLType, BasicGrilla, MisUtils;
12 const
13 ALT_FILA_DEF = 22; //Altura por defecto para las grillas de datos
14 type
15
16 TugTipoCol = (
17 ugTipText, //columna de tipo texto
18 ugTipChar, //columna de tipo caracter
19 ugTipNum, //columna de tipo numérico
20 ugTipBol, //columna de tipo booleano
21 ugTipIco, //columna de tipo ícono
22 ugTipDatTim //columna de tipo fecha-hora
23 );
24
25 //Acción a realizar sobre una columna
26 TugColAction = (
27 ucaRead, //Leer el valor de la columna
28 ucaWrite, //Escribir un valor en la columna
29 ucaValid, //Validar si un valor, del tipo nativo (número, boolean, ...), es legal.
30 ucaValidStr //Validar si una cadena (que se desea asignar a la celda) es legal.
31 );
32 TugColRestric = (
33 ucrNotNull, //Columna no nula
34 ucrUnique //Unicidad
35 );
36
37 {Procedimiento asociado a una columna, para permitir realizar una validación del valor
38 que se desea grabar en la columna. Se espera que el valor devuelto, sea el mnesaje de
39 error, en caso de que el valor deseado no sea apropiado parala columna.}
ilnull40 TProcValidacion = function(fil: integer; nuevValor: string): string of object;
41 {Procedimientos asociados a una columna, para permitir realizar acciones diversas,
42 como la asignación o la validación. }
ctTypenull43 TugProcColActionStr = function(actType: TugColAction; AValue: string;
44 col, row: integer): string of object;
ctTypenull45 TugProcColActionChr = function(actType: TugColAction; ValidStr: string;
46 col, row: integer; AValue: char): char of object;
ctTypenull47 TugProcColActionNum = function(actType: TugColAction; ValidStr: string;
48 col, row: integer; AValue: double): double of object;
ctTypenull49 TugProcColActionBool = function(actType: TugColAction; ValidStr: string;
50 col, row: integer; AValue: boolean): boolean of object;
ctTypenull51 TugProcColActionDatTim = function(actType: TugColAction; ValidStr: string;
52 col, row: integer; AValue: TDateTime): TDateTime of object;
53 { TugGrillaCol }
54 {Representa a una columna de la grilla}
55 TugGrillaCol = class
56 nomCampo: string; //Nombre del campo de la grilla
57 ancho : integer; //Ancho físico de la columna de la grilla
58 visible : boolean; //Permite coultar la columna
59 alineam : TAlignment; //Alineamiento del campo
60 iEncab : integer; //índice a columna de la base de datos o texto
61 tipo : TugTipoCol; //Tipo de columna
62 idx : integer; //Índice dentro de su grilla contenedora (0->la columna de la izquierda)
63 public //campos adicionales
64 grilla : TStringGrid; //Referencia a la grilla de trabajo
65 editable: boolean; //Indica si se puede editar
66 valDefec: string; //Valor por defecto
67 formato : string; //Formato para mostrar una celda, cuando es numérica.
68 restric : set of TugColRestric;
69 private
70 nullStr: string; //Cadena nula. Se usa como variable auxiliar.
GetValStrnull71 function GetValStr(iRow: integer): string;
72 procedure SetValStr(iRow: integer; AValue: string);
GetValChrnull73 function GetValChr(iRow: integer): char;
74 procedure SetValChr(iRow: integer; AValue: char);
GetValNumnull75 function GetValNum(iRow: integer): Double;
76 procedure SetValNum(iRow: integer; AValue: Double);
GetValBoolnull77 function GetValBool(iRow: integer): boolean;
78 procedure SetValBool(iRow: integer; AValue: boolean);
GetValDatTimnull79 function GetValDatTim(iRow: integer): TDateTime;
80 procedure SetValDatTim(iRow: integer; AValue: TDateTime);
81 public //Manejo de lectura y asignación de valores
82 {Los siguientes campos, deben asignarse a una función que implemente las acciones
83 TugColAction, de acuerdo al tipo del campo. Si no se implementan estos
84 procedimientos, no se podrá hacer uso de las propiedades ValStr[] y ValNum[], y
85 tampoco se podrá usar la rutina de validación ValidateStr[]. }
86 procActionStr : TugProcColActionStr;
87 procActionChr : TugProcColActionChr;
88 procActionNum : TugProcColActionNum;
89 procActionBool : TugProcColActionBool;
90 procActionDatTim: TugProcColActionDatTim;
91 //Valor como cadena
92 property ValStr[iRow: integer]: string read GetValStr write SetValStr;
93 //Valor como cadena
94 property ValChr[iRow: integer]: char read GetValChr write SetValChr;
95 //Valor como número
96 property ValNum[iRow: integer]: double read GetValNum write SetValNum;
97 //Valor como BOOLEANO
98 property ValBool[iRow: integer]: boolean read GetValBool write SetValBool;
99 //Valor como DateTime
100 property ValDatTim[iRow: integer]: TDateTime read GetValDatTim write SetValDatTim;
101 //Métodos para leer/fijar valor del campo
102 procedure SetValue(iRow: integer; valString: string);
GetValuenull103 function GetValue(iRow: integer): string;
104 //Rutinas de validación
105 procedure ValidateStr(row: integer; NewStr: string);
106 procedure ValidateStr(row: integer);
107 end;
108 TGrillaDBCol_list = specialize TFPGObjectList<TugGrillaCol>;
109
110 TEvMouseGrilla = procedure(Button: TMouseButton; row, col: integer) of object;
111
112 { TUtilGrillaBase }
113 {Este es el objeto principal de la unidad. TUtilGrilla, permite administrar una grilla
114 de tipo TStringGrid, agregándole funcionalidades comunes, como el desplazamiento de
115 teclado o la creación sencilla de encabezados.
116 Para trabajar con una grilla se tiene dos formas:
117
118 1. Asociándola a una grilla desde el inicio:
119
120 UtilGrilla := TUtilGrilla.Create(StringGrid1);
121 UtilGrilla.IniEncab;
122 UtilGrilla.AgrEncab('CAMPO1' , 40); //Con 40 pixeles de ancho
123 UtilGrilla.AgrEncab('CAMPO2' , 60); //Con 60 pixeles de ancho
124 UtilGrilla.AgrEncab('CAMPO3' , 35, -1, taRightJustify); //Justificado a la derecha
125 UtilGrilla.FinEncab;
126
127 2. Sin asociarla a una UtilGrilla:
128
129 UtilGrilla := TUtilGrilla.Create;
130 UtilGrilla.IniEncab;
131 UtilGrilla.AgrEncab('CAMPO1' , 40); //Con 40 pixeles de ancho
132 UtilGrilla.AgrEncab('CAMPO2' , 60); //Con 60 pixeles de ancho
133 UtilGrilla.AgrEncab('CAMPO3' , 35, -1, taRightJustify); //Justificado a la derecha
134 UtilGrilla.FinEncab;
135
136 En esta segunda forma, se debe asociar posteriormente a la UtilGrilla, usando el método:
137 UtilGrilla.AsignarGrilla(MiGrilla);
138
139 , haciendo que la grilla tome los encabezados que se definieron en "UtilGrilla". De esta
140 forma se pueden tener diversos objetos TUtilGrilla, para usarse en un solo objeto
141 TStringGrid.}
142
143 TUtilGrillaBase = class
144 protected //campos privados
145 FMenuCampos : boolean;
146 popX, popY : integer; //posición donde se abre el menú contextual
147 procedure SetMenuCampos(AValue: boolean);
148 procedure grillaKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
149 procedure grillaKeyPress(Sender: TObject; var Key: char); virtual;
150 procedure grillaMouseDown(Sender: TObject; Button: TMouseButton;
151 Shift: TShiftState; X, Y: Integer); virtual;
152 procedure grillaMouseUp(Sender: TObject; Button: TMouseButton;
153 Shift: TShiftState; X, Y: Integer); virtual;
154 procedure grillaPrepareCanvas(sender: TObject; aCol, aRow: Integer;
155 aState: TGridDrawState);
156 procedure itClick(Sender: TObject);
157 private //Getters and Setters
158 FOpOrdenarConClick: boolean;
159 FOpAutoNumeracion: boolean;
160 FOpDimensColumnas: boolean;
161 FOpEncabezPulsable: boolean;
162 FOpResaltarEncabez: boolean;
163 FOpResaltFilaSelec: boolean;
procDefActionBoolnull164 function procDefActionBool(actType: TugColAction; ValidStr: string;
165 col, row: integer; AValue: boolean): boolean;
procDefActionChrnull166 function procDefActionChr(actType: TugColAction; ValidStr: string;
167 col, row: integer; AValue: char): char;
procDefActionDatTimnull168 function procDefActionDatTim(actType: TugColAction; ValidStr: string;
169 col, row: integer; AValue: TDateTime): TDateTime;
procDefActionNumnull170 function procDefActionNum(actType: TugColAction; ValidStr: string;
171 col, row: integer; AValue: double): double;
procDefActionStrnull172 function procDefActionStr(actType: TugColAction; AValue: string;
173 col, row: integer): string;
174 procedure SetOpDimensColumnas(AValue: boolean);
175 procedure SetOpAutoNumeracion(AValue: boolean);
176 procedure SetOpEncabezPulsable(AValue: boolean);
177 procedure SetOpOrdenarConClick(AValue: boolean);
178 procedure SetOpResaltarEncabez(AValue: boolean);
179 procedure SetOpResaltFilaSelec(AValue: boolean);
180 public
181 grilla : TStringGrid; //referencia a la grila de trabajo
182 cols : TGrillaDBCol_list; //Información sobre las columnas
183 PopupHeadInt: TPopupMenu; //Menú contextual interno, para mostrar/ocultar campos
184 PopUpCells : TPopupMenu; //Menú para las celdas
185 OnKeyDown : TKeyEvent; {Se debe usar este evento en lugar de usar directamente
186 el evento de la grilla, ya que TGrillaDB, usa ese evento.}
187 OnKeyPress : TKeyPressEvent; {Se debe usar este evento en lugar de usar directamente
188 el evento de la grilla, ya que TGrillaDB, usa ese evento.}
189 // OnDblClick: TKeyPressEvent; {Se debe usar este evento en lugar de usar directamente
190 // el evento de la grilla, ya que TGrillaDB, usa ese evento.}
191 OnMouseDown : TMouseEvent;
192 OnMouseUp : TMouseEvent;
193 OnMouseUpCell : TEvMouseGrilla;
194 OnMouseUpHeader: TEvMouseGrilla;
195 OnMouseUpFixedCol: TEvMouseGrilla;
196 OnMouseUpNoCell: TEvMouseGrilla;
197 //Definición de encabezados
198 procedure IniEncab;
AgrEncabnull199 function AgrEncab(titulo: string; ancho: integer; indColDat: int16=-1;
200 alineam: TAlignment=taLeftJustify): TugGrillaCol; virtual;
AgrEncabTxtnull201 function AgrEncabTxt(titulo: string; ancho: integer; indColDat: int16=-1
202 ): TugGrillaCol; virtual;
AgrEncabChrnull203 function AgrEncabChr(titulo: string; ancho: integer; indColDat: int16=-1
204 ): TugGrillaCol; virtual;
AgrEncabNumnull205 function AgrEncabNum(titulo: string; ancho: integer; indColDat: int16=-1
206 ): TugGrillaCol; virtual;
AgrEncabBoolnull207 function AgrEncabBool(titulo: string; ancho: integer; indColDat: int16=-1
208 ): TugGrillaCol; virtual;
AgrEncabDatTimnull209 function AgrEncabDatTim(titulo: string; ancho: integer; indColDat: int16=-1
210 ): TugGrillaCol; virtual;
211 procedure FinEncab(actualizarGrilla: boolean=true);
212 procedure AsignarGrilla(grilla0: TStringGrid); virtual; //Configura grilla de trabajo
213 public //Opciones de la grilla
214 property MenuCampos: boolean //Activa el menú contextual
215 read FMenuCampos write SetMenuCampos;
216 property OpDimensColumnas: boolean //activa el dimensionamiento de columnas
217 read FOpDimensColumnas write SetOpDimensColumnas;
218 property OpAutoNumeracion: boolean //activa el autodimensionado en la columna 0
219 read FOpAutoNumeracion write SetOpAutoNumeracion;
220 property OpResaltarEncabez: boolean //Resalta el encabezado, cuando se pasa el mouse
221 read FOpResaltarEncabez write SetOpResaltarEncabez;
222 property OpEncabezPulsable: boolean //Permite pulsar sobre los encabezados como botones
223 read FOpEncabezPulsable write SetOpEncabezPulsable;
224 property OpOrdenarConClick: boolean //Ordenación de filas pulsando en los encabezados
225 read FOpOrdenarConClick write SetOpOrdenarConClick;
226 property OpResaltFilaSelec: boolean //Resaltar fila seleccionada
227 read FOpResaltFilaSelec write SetOpResaltFilaSelec;
228 public //campos auxiliares
229 MsjError : string; //Mensaje de error
230 colError : integer; //Columna con error
231 procedure DimensColumnas;
BuscarColumnanull232 function BuscarColumna(nombColum: string): TugGrillaCol;
233 procedure CopiarCampo; //copia valor de la celda al portapapeles
234 procedure CopiarFila; //copia valor de la fila al portapapeles
PegarACamponull235 function PegarACampo: boolean; //pega del protapapeles al campo
236 public //Constructor y destructor
237 constructor Create(grilla0: TStringGrid); virtual;
238 destructor Destroy; override;
239 end;
240
241 const
242 MAX_UTIL_FILTROS = 10;
243
244 type
onstnull245 TUtilProcFiltro = function(const f: integer):boolean of object;
246 {Se crea una clase derivada, para agregar funcionalidades de filtro, y de búsqueda.}
247 TUtilGrilla = class(TUtilGrillaBase)
248 private
249 procedure FiltrarFila(f: integer);
250 public
251 {Se usa una matriz estática para almacenar a los filtros, para hacer el proceso,
252 de filtrado más rápido, ya que se iterará por cada fila de la grilla .}
253 filtros: array[0..MAX_UTIL_FILTROS-1] of TUtilProcFiltro;
254 numFiltros: integer;
255 filVisibles: integer;
256 procedure LimpiarFiltros;
AgregarFiltronull257 function AgregarFiltro(proc: TUtilProcFiltro): integer;
258 procedure Filtrar;
BuscarTxtnull259 function BuscarTxt(txt: string; col: integer): integer;
260 public
261 constructor Create(grilla0: TStringGrid); override;
262 end;
263
264 { TUtilGrillaFil }
265 {Similar a "TUtilGrilla", pero está orientada a trabajar con datos como filas, más que
266 como celdas.
267 Además permite cambiar atributos de las filas, como color de fondo, color de texto, etc.
268 Para almacenar los atributos de las filas, no crea nuevas variables, sino que usa la
269 propiedad "Object", de las celdas, usando las columnas como campos de propiedades para
270 la fila. El uso de las columnas es como se indica:
271 * Colunna 0-> Almacena el color de fondo de la fila.
272 * Colunna 1-> Almacena el color del texto de la fila.
273 * Colunna 2-> Almacena los atributos del texto de la fila.
274 Por lo tanto se deduce que para manejar estas propiedades, la grilla debe tener las
275 columnas necesarias.
276 }
277 TUtilGrillaFil = class(TUtilGrilla)
278 private
279 FOpSelMultiFila: boolean;
280 protected
281 procedure DibCeldaTexto(aCol, aRow: Integer; const aRect: TRect);
282 procedure DibCeldaIcono(aCol, aRow: Integer; const aRect: TRect);
283 procedure SetOpSelMultiFila(AValue: boolean);
284 procedure grillaDrawCell(Sender: TObject; aCol, aRow: Integer;
285 aRect: TRect; aState: TGridDrawState); virtual;
286 public //Opciones de la grilla
287 property OpSelMultiFila: boolean //activa el dimensionamiento de columnas
288 read FOpSelMultiFila write SetOpSelMultiFila;
289 public
290 ImageList: TImageList; //referecnia a un TInageList, para los íconos
AgrEncabIconull291 function AgrEncabIco(titulo: string; ancho: integer; indColDat: int16=-1
292 ): TugGrillaCol;
293 procedure AsignarGrilla(grilla0: TStringGrid); override; //Configura grilla de trabajo
294 procedure FijColorFondo(fil: integer; color: TColor); //Color de fondo de la fila
295 procedure FijColorFondoGrilla(color: TColor);
296 procedure FijColorTexto(fil: integer; color: TColor); //Color del texto de la fila
297 procedure FijColorTextoGrilla(color: TColor);
298 procedure FijAtribTexto(fil: integer; negrita, cursiva, subrayadao: boolean); //Atributos del texto de la fila
299 procedure FijAtribTextoGrilla(negrita, cursiva, subrayadao: boolean); //Atributos del texto de la fila
EsFilaSeleccionadanull300 function EsFilaSeleccionada(const f: integer): boolean;
301 public //Inicialización
302 constructor Create(grilla0: TStringGrid); override;
303 end;
304
305 implementation
306
307
308 { TugGrillaCol }
TugGrillaCol.GetValStrnull309 function TugGrillaCol.GetValStr(iRow: integer): string;
310 begin
311 Result := procActionStr(ucaRead, nullStr, idx, iRow);
312 end;
313 procedure TugGrillaCol.SetValStr(iRow: integer; AValue: string);
314 begin
315 procActionStr(ucaWrite, AValue, idx, iRow);
316 end;
TugGrillaCol.GetValChrnull317 function TugGrillaCol.GetValChr(iRow: integer): char;
318 begin
319 Result := procActionChr(ucaRead, nullStr, idx, iRow, ' ');
320 end;
321 procedure TugGrillaCol.SetValChr(iRow: integer; AValue: char);
322 begin
323 procActionChr(ucaWrite, nullStr, idx, iRow, AValue);
324 end;
GetValNumnull325 function TugGrillaCol.GetValNum(iRow: integer): Double;
326 begin
327 Result := procActionNum(ucaRead, nullStr, idx, iRow, 0);
328 end;
329 procedure TugGrillaCol.SetValNum(iRow: integer; AValue: Double);
330 begin
331 procActionNum(ucaWrite, nullStr, idx, iRow, AValue);
332 end;
GetValBoolnull333 function TugGrillaCol.GetValBool(iRow: integer): boolean;
334 begin
335 Result := procActionBool(ucaRead, nullStr, idx, iRow, false);
336 end;
337 procedure TugGrillaCol.SetValBool(iRow: integer; AValue: boolean);
338 begin
339 procActionBool(ucaWrite, nullStr, idx, iRow, AValue);
340 end;
GetValDatTimnull341 function TugGrillaCol.GetValDatTim(iRow: integer): TDateTime;
342 begin
343 Result := procActionDatTim(ucaRead, nullStr, idx, iRow, 0);
344 end;
345 procedure TugGrillaCol.SetValDatTim(iRow: integer; AValue: TDateTime);
346 begin
347 procActionDatTim(ucaWrite, nullStr, idx, iRow, AValue);
348 end;
349 procedure TugGrillaCol.SetValue(iRow: integer; valString: string);
350 {Fija el valor de la columna en la fila "iRow", a partir de una cadena.}
351 begin
352 case self.tipo of
353 ugTipText : ValStr[iRow] := valString;
354 ugTipBol : ValBool[iRow] := f2B(valString);
355 ugTipNum : ValNum[iRow] := f2N(valString);
356 ugTipDatTim: ValDatTim[iRow]:= f2D(valString);
357 else
358 //Faltan otros tipos
359 grilla.Cells[idx, iRow] := valString;
360 end;
361 end;
TugGrillaCol.GetValuenull362 function TugGrillaCol.GetValue(iRow: integer): string;
363 {Lee el valor del campo y lo devuelve como cadena, independientemente del tipo que sea.}
364 begin
365 case self.tipo of
366 ugTipText : Result := ValStr[iRow];
367 ugTipBol : Result := B2f(ValBool[iRow]);
368 ugTipNum : Result := N2f(ValNum[iRow]);
369 ugTipDatTim: Result := D2f(ValDatTim[iRow]);
370 else
371 //Faltan otros tipos
372 Result := grilla.Cells[idx, iRow];
373 end;
374
375 end;
376 procedure TugGrillaCol.ValidateStr(row: integer; NewStr: string);
377 {Verifica si el valor indicado, como cadena, es legal para ponerlo en la celda que
378 corresponde. Es aplicable incluisve a celdas que no son del tipo cadena, porque el tipo
379 básico de las celdas del TStringGrid, es cadema.}
380 begin
381 case tipo of
382 ugTipText: begin
383 if procActionStr<>nil then procActionStr(ucaValidStr, NewStr, idx, row);
384 end;
385 ugTipChar: begin
386 if procActionChr<>nil then procActionChr(ucaValidStr, NewStr, idx, row, ' ');
387 end;
388 ugTipNum: begin
389 if procActionNum<>nil then procActionNum(ucaValidStr, NewStr, idx, row, 0);
390 end;
391 ugTipBol: begin
392 if procActionBool<>nil then procActionBool(ucaValidStr, NewStr, idx, row, false);
393 end;
394 ugTipDatTim: begin
395 if procActionDatTim<>nil then procActionDatTim(ucaValidStr, NewStr, idx, row, 0);
396 end;
397 end;
398 end;
399 procedure TugGrillaCol.ValidateStr(row: integer);
400 {Versión que valida el valor que ya existe en la celda.}
401 begin
402 ValidateStr(row, grilla.Cells[idx, row]);
403 end;
404 procedure TUtilGrillaBase.grillaKeyDown(Sender: TObject; var Key: Word;
405 Shift: TShiftState);
406 begin
407 if Key in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT] then begin
408 //Corrige un comportamiento anómalo de la selección: Cuando se tienen seleccionados
409 //varios rangos y se mueve la selecció, los otros rangos no desaparecen.
410 if grilla.SelectedRangeCount>1 then begin
411 grilla.ClearSelections;
412 end;
413 end;
414 ProcTeclasDireccion(grilla, Key, SHift, ALT_FILA_DEF);
415 //Dispara evento
416 if OnKeyDown<>nil then OnKeyDown(Sender, Key, Shift);
417 end;
418 procedure TUtilGrillaBase.grillaKeyPress(Sender: TObject; var Key: char);
419 begin
420 //Dispara evento
421 if OnKeyPress<>nil then OnKeyPress(Sender, Key);
422 end;
423 procedure TUtilGrillaBase.grillaMouseDown(Sender: TObject;
424 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
425 begin
426 if OnMouseDown<>nil then OnMouseDown(Sender, Button, Shift, X, Y);
427 end;
428 procedure TUtilGrillaBase.grillaMouseUp(Sender: TObject; Button: TMouseButton;
429 Shift: TShiftState; X, Y: Integer);
430 var
431 it: TMenuItem;
432 i: Integer;
433 col, row, uf: integer;
434 MaxYCoordCeldas: LongInt;
435 begin
436 //Pasa el evento
437 if OnMouseUp<>nil then OnMouseUp(Sender, Button, Shift, X, Y);
438 //debugln('MouseCoordY=' + IntToStr(grilla.MouseCoord(X,y).y));
439 //Primero analiza si se está más allá de las celdas existentes.
440 {Detectar si el puntero está en una zona sin celdas, no es sencillo, con las funciones
441 de TSTringGrid. Se probó con MouseToCell(), MouseToGridZone(), MouseToLogcell(), pero
442 todas ellas fallaron.}
443 //Valida si escapa de la últiam fila mostrada.
444 uf := UltimaFilaVis(grilla);
445 if uf<>-1 then begin
446 MaxYCoordCeldas := grilla.CellRect(0, uf).Bottom;
447 // debugln('MaxYCoordCeldas=%d', [MaxYCoordCeldas]);
448 if Y>MaxYCoordCeldas then begin
449 //Está fuera de la celda
450 if OnMouseUpNoCell<>nil then OnMouseUpNoCell(Button, -1, -1);
451 exit;
452 end;
453 end;
454 //Debe estar dentro de alguna de las celdas
455 grilla.MouseToCell(X, Y, Col{%H-}, Row{%H-} ); {Verifica la elda en donde se soltó el mouse.
456 Aunque MouseToCell(), parece indciar más bien, la celda
457 seleccionada, cuando se soltó el mouse.}
458 if (Row < grilla.FixedRows) and (Col>=grilla.FixedCols) then begin
459 //Es el encabezado
460 if OnMouseUpHeader<>nil then OnMouseUpHeader(Button, row, col);
461 if FMenuCampos and (Button = mbRight) then begin
462 {Se ha configurado un menú contextual para los campos.}
463 //Configura el menú
464 PopupHeadInt.Items.Clear;
465 for i:=0 to cols.Count-1 do begin
466 it := TMenuItem.Create(PopupHeadInt.Owner);
467 it.Caption:=cols[i].nomCampo;
468 it.Checked := cols[i].visible;
469 it.OnClick:=@itClick;
470 PopupHeadInt.Items.Add(it);
471 end;
472 //Muestra
473 popX := Mouse.CursorPos.x;
474 popY := Mouse.CursorPos.y;
475 PopupHeadInt.PopUp(popX, popY);
476 end;
477 end else if Col<grilla.FixedCols then begin
478 if OnMouseUpFixedCol<>nil then OnMouseUpFixedCol(Button, row, col);
479 //En columnas fijas
480 end else begin
481 //Es una celda común
482 if OnMouseUpCell<>nil then OnMouseUpCell(Button, row, col);
483 if Button = mbRight then begin
484 //Implementa la selección con botón derecho
485 grilla.Row:=row;
486 grilla.Col:=col;
487 if PopUpCells<>nil then PopUpCells.PopUp;
488 end;
489 end;
490 end;
491 procedure TUtilGrillaBase.grillaPrepareCanvas(sender: TObject; aCol, aRow: Integer;
492 aState: TGridDrawState);
493 var
494 MyTextStyle: TTextStyle;
495 begin
496 //Activa el alineamiento
497 if aRow = 0 then exit; //no cambia el encabezado
498 if aCol>=cols.Count then exit;
499 if cols[aCol].alineam <> taLeftJustify then begin
500 MyTextStyle := grilla.Canvas.TextStyle;
501 MyTextStyle.Alignment := cols[aCol].alineam;
502 grilla.Canvas.TextStyle := MyTextStyle;
503 end;
504 end;
505 procedure TUtilGrillaBase.itClick(Sender: TObject);
506 {Se hizo click en un ítem del menú de campos}
507 var
508 it: TMenuItem;
509 i: Integer;
510 begin
511 it := TMenuItem(Sender); //debe ser siempre de este tipo
512 it.Checked := not it.Checked;
513 //Actualiza visibilidad, de acuerdo al menú contextual
514 for i:=0 to PopupHeadInt.Items.Count-1 do begin
515 cols[i].visible := PopupHeadInt.Items[i].Checked;
516 end;
517 DimensColumnas; //dimesiona grillas
518 PopupHeadInt.PopUp(popX, popY); //abre nuevamente, para que no se oculte
519 end;
520 procedure TUtilGrillaBase.DimensColumnas;
521 var
522 c: Integer;
523 begin
524 if grilla=nil then exit;
525 for c:=0 to cols.Count-1 do begin
526 grilla.Cells[c,0] := cols[c].nomCampo;
527 if cols[c].visible then //es visible. Se le asigna ancho
528 grilla.ColWidths[c] := cols[c].ancho
529 else //se oculat poniéndole ancho cero.
530 grilla.ColWidths[c] := 0;
531 end;
532 end;
533 procedure TUtilGrillaBase.SetMenuCampos(AValue: boolean);
534 begin
535 //if FMenuCampos=AValue then Exit;
536 FMenuCampos:=AValue;
537 if grilla<>nil then begin
538 //Ya tiene grilla asignada
539 if AValue=true then begin
540 //Se pide activar el menú contextual
541 if PopupHeadInt<>nil then PopupHeadInt.Destroy; //ya estaba creado
542 PopupHeadInt := TPopupMenu.Create(grilla);
543 end else begin
544 //Se pide desactivar el menú contextual
545 if PopupHeadInt<>nil then PopupHeadInt.Destroy;
546 PopupHeadInt := nil;
547 end;
548 end;
549 end;
550 procedure TUtilGrillaBase.SetOpDimensColumnas(AValue: boolean);
551 begin
552 FOpDimensColumnas:=AValue;
553 if grilla<>nil then begin
554 //Ya tiene asignada una grilla
555 if AValue then grilla.Options:=grilla.Options + [goColSizing]
556 else grilla.Options:=grilla.Options - [goColSizing];
557 end;
558 end;
559 procedure TUtilGrillaBase.SetOpAutoNumeracion(AValue: boolean);
560 begin
561 FOpAutoNumeracion:=AValue;
562 if grilla<>nil then begin
563 //Ya tiene asignada una grilla
564 if AValue then grilla.Options:=grilla.Options+[goFixedRowNumbering]
565 else grilla.Options:=grilla.Options - [goFixedRowNumbering];
566 end;
567 end;
568 procedure TUtilGrillaBase.SetOpResaltarEncabez(AValue: boolean);
569 begin
570 FOpResaltarEncabez:=AValue;
571 if grilla<>nil then begin
572 //Ya tiene asignada una grilla
573 if AValue then grilla.Options:=grilla.Options+[goHeaderHotTracking]
574 else grilla.Options:=grilla.Options - [goHeaderHotTracking];
575 end;
576 end;
577 procedure TUtilGrillaBase.SetOpEncabezPulsable(AValue: boolean);
578 begin
579 FOpEncabezPulsable:=AValue;
580 if grilla<>nil then begin
581 //Ya tiene asignada una grilla
582 if AValue then grilla.Options:=grilla.Options+[goHeaderPushedLook]
583 else grilla.Options:=grilla.Options - [goHeaderPushedLook];
584 end;
585 end;
586 procedure TUtilGrillaBase.SetOpOrdenarConClick(AValue: boolean);
587 begin
588 FOpOrdenarConClick:=AValue;
589 if grilla<>nil then begin
590 //Ya tiene asignada una grilla
591 grilla.ColumnClickSorts:=AValue;
592 end;
593 end;
594 procedure TUtilGrillaBase.SetOpResaltFilaSelec(AValue: boolean);
595 begin
596 FOpResaltFilaSelec:=AValue;
597 if grilla<>nil then begin
598 //Ya tiene asignada una grilla
599 if AValue then grilla.Options:=grilla.Options+[goRowHighlight]
600 else grilla.Options:=grilla.Options - [goRowHighlight];
601 end;
602 end;
procDefActionStrnull603 function TUtilGrillaBase.procDefActionStr(actType: TugColAction;
604 AValue: string; col, row: integer): string;
605 var
606 f: Integer;
607 colum: TugGrillaCol;
608 begin
609 case actType of
610 ucaRead: begin //Se pide leer un valor de la grilla
611 Result := grilla.Cells[col, row]; //es cadena
612 end;
613 ucaWrite: begin //Se pide escribir un valor en la grilla
614 grilla.Cells[col, row] := AValue; //es cadena
615 end;
616 ucaValid, ucaValidStr: begin //Ambas Validaciones son equivalentes.
617 colum := cols[col];
618 if (ucrNotNull in colum.restric) and (AValue = '') then begin
619 MsjError:='Campo "' + colum.nomCampo + '" no puede ser nulo.';
620 exit;
621 end;
622 if ucrUnique in colum.restric then begin //Unicidad
623 for f:=1 to grilla.RowCount-1 do begin
624 if f = row then continue; //No se debe verificar la misma fila
625 if grilla.Cells[col, f] = AValue then begin
626 MsjError := 'Campo: "' + colum.nomCampo + '" debe ser único.';
627 exit;
628 end;
629 end;
630 end;
631 end;
632 end;
633 end;
procDefActionChrnull634 function TUtilGrillaBase.procDefActionChr(actType: TugColAction;
635 ValidStr: string; col, row: integer; AValue: char): char;
636 begin
637 case actType of
638 ucaRead: begin //Se pide leer un valor de la grilla
639 Result := grilla.Cells[col, row][1]; //es cadena
640 end;
641 ucaWrite: begin //Se pide escribir un valor en la grilla
642 grilla.Cells[col, row] := AValue; //es cadena
643 end;
644 ucaValid: begin //Se pide validación en tipo nativo
645 //Todos los valores son válidos
646 exit;
647 end;
648 ucaValidStr: begin //Se pide validación
649 if length(ValidStr) <> 1 then begin
650 MsjError:='Campo "' + cols[col].nomCampo + '" debe ser de un caracter.';
651 end;
652 end;
653 end;
654 end;
TUtilGrillaBase.procDefActionNumnull655 function TUtilGrillaBase.procDefActionNum(actType: TugColAction;
656 ValidStr: string; col, row: integer; AValue: double): double;
657 var
658 n: Double;
659 begin
660 case actType of
661 ucaRead: begin //Se pide leer un valor de la grilla
662 if grilla.Cells[col, row] = '' then begin
663 Result := 0; //Para cadenas nulas, se asume cero
664 end else begin
665 Result := StrToFloat(grilla.Cells[col, row]); //es cadena
666 end;
667 end;
668 ucaWrite: begin //Se pide escribir un valor en la grilla
669 grilla.Cells[col, row] := FloatToStr(AValue); //Se escribe como cadena.
670 end;
671 ucaValid: begin //Se pide validación en tipo nativo
672 //Todos los valores son válidos
673 exit;
674 end;
675 ucaValidStr: begin //Se pide validación en cadena
676 if not TryStrToFloat(ValidStr, n) then begin //debe ser convertible a flotante
677 //Hay error en la conversión
678 if (ValidStr<>'') and (ValidStr[1] in ['a'..'z','A'..'Z','_']) then begin
679 //Parece ser una cadena
680 MsjError := 'Campo "' + cols[col].nomCampo + '" debe ser numérico.';
681 end else begin
682 MsjError := 'Error en formato de: "' + cols[col].nomCampo + '"';
683 end;
684 exit;
685 end;
686 end;
687 end;
688 end;
procDefActionBoolnull689 function TUtilGrillaBase.procDefActionBool(actType: TugColAction;
690 ValidStr: string; col, row: integer; AValue: boolean): boolean;
691 begin
692 case actType of
693 ucaRead: begin //Se pide leer un valor de la grilla
694 Result := (grilla.Cells[col, row] = 'V'); //es cadena
695 end;
696 ucaWrite: begin //Se pide escribir un valor en la grilla
697 if AValue then
698 grilla.Cells[col, row] := 'V' //Se escribe como cadena.
699 else
700 grilla.Cells[col, row] := 'F'; //Se escribe como cadena.
701 end;
702 ucaValid: begin //Se pide validación en tipo nativo
703 //Todos los valores son válidos
704 exit;
705 end;
706 ucaValidStr: begin //Se pide validación en cadena
707 if (ValidStr <> 'V') and (ValidStr <> 'F') then begin
708 MsjError := 'Error en formato de: "' + cols[col].nomCampo + '"';
709 exit;
710 end;
711 end;
712 end;
713 end;
TUtilGrillaBase.procDefActionDatTimnull714 function TUtilGrillaBase.procDefActionDatTim(actType: TugColAction;
715 ValidStr: string; col, row: integer; AValue: TDateTime): TDateTime;
716 var
717 n: TDateTime;
718 begin
719 case actType of
720 ucaRead: begin //Se pide leer un valor de la grilla
721 Result := StrToDateTime(grilla.Cells[col, row]); //es cadena
722 end;
723 ucaWrite: begin //Se pide escribir un valor en la grilla
724 grilla.Cells[col, row] := DateTimeToStr(AValue); //Se escribe como cadena.
725 end;
726 ucaValid: begin //Se pide validación en tipo nativo
727 //Todos los valores son válidos
728 exit;
729 end;
730 ucaValidStr: begin //Se pide validación en cadena
731 if not TryStrToDateTime(ValidStr, n) then begin //debe ser convertible a flotante
732 MsjError := 'Error en formato de: "' + cols[col].nomCampo + '"';
733 exit;
734 end;
735 end;
736 end;
737 end;
738 procedure TUtilGrillaBase.IniEncab;
739 {Inicia el proceso de agregar encabezados a la grilla.}
740 begin
741 cols.Clear; //Limpia información de columnas
742 end;
AgrEncabnull743 function TUtilGrillaBase.AgrEncab(titulo: string; ancho: integer; indColDat: int16 =-1;
744 alineam: TAlignment = taLeftJustify): TugGrillaCol;
745 {Agrega una celda de encabezado a la grilla y devuelve el campo creado. Esta
746 función debe ser llamada después de inicializar los enbezados con IniEncab.
747 Sus parámetros son:
748 * titulo -> Es el título que aparecerá en la fila de encabezados.
749 * ancho -> Ancho en pixeles de la columna a definir.
750 * indColDat -> Número de columna, de una fuente de datos, de donde se leerá este campo}
751 var
752 col: TugGrillaCol;
753 begin
754 //Agrega información de campo
755 col := TugGrillaCol.Create;
756 col.nomCampo:= titulo;
757 col.ancho := ancho;
758 col.visible := true; //visible por defecto
759 col.alineam := alineam;
760 col.iEncab := indColDat;
761 col.tipo := ugTipText; //texto por defecto
762 col.idx := cols.Count;
763 col.editable:= true; //editable por defecto
764 col.grilla := grilla; //referencia a grilla
765 cols.Add(col);
766 Result := col; //columna usada
767 end;
TUtilGrillaBase.AgrEncabTxtnull768 function TUtilGrillaBase.AgrEncabTxt(titulo: string; ancho: integer;
769 indColDat: int16=-1): TugGrillaCol;
770 {Crea encabezado de tipo texto. Devuelve el número de columna usada. }
771 begin
772 Result := AgrEncab(titulo, ancho, indColDat);
773 {Agrega una rutina para procesar las acciones de esta columna numérica. Así se podrá
774 hacer uso del campo ValStr[] y de la rutina ValidateStr(), de TugGrillaCol.
775 Si esta rutina es insuficiente, siempre se puede procesar por uno mismo el evento,
776 personalizándolo de acuerdo a las necesidades particulares, respetando la forma de
777 trabajo.}
778 Result.procActionStr:=@procDefActionStr;
779 end;
TUtilGrillaBase.AgrEncabChrnull780 function TUtilGrillaBase.AgrEncabChr(titulo: string; ancho: integer;
781 indColDat: int16): TugGrillaCol;
782 begin
783 Result := AgrEncab(titulo, ancho, indColDat);
784 Result.tipo := ugTipChar;
785 Result.procActionChr:=@procDefActionChr;
786 end;
TUtilGrillaBase.AgrEncabNumnull787 function TUtilGrillaBase.AgrEncabNum(titulo: string; ancho: integer;
788 indColDat: int16=-1): TugGrillaCol;
789 {Crea encabezado de tipo numérico. Devuelve el número de columna usada. }
790 begin
791 Result := AgrEncab(titulo, ancho, indColDat, taRightJustify);
792 Result.tipo := ugTipNum;
793 {Agrega una rutina para procesar las acciones de esta columna . Así se podrá
794 hacer uso del campo ValNum[] y de la rutina ValidateStr(), de TugGrillaCol.
795 Si esta rutina es insuficiente, siempre se puede procesar por uno mismo el evento,
796 personalizándolo de acuerdo a las necesidades particulares, respetando la forma de
797 trabajo.}
798 Result.procActionNum:=@procDefActionNum;
799 end;
AgrEncabBoolnull800 function TUtilGrillaBase.AgrEncabBool(titulo: string; ancho: integer;
801 indColDat: int16): TugGrillaCol;
802 begin
803 Result := AgrEncab(titulo, ancho, indColDat);
804 Result.tipo := ugTipBol;
805 Result.procActionBool:=@procDefActionBool;
806 end;
AgrEncabDatTimnull807 function TUtilGrillaBase.AgrEncabDatTim(titulo: string; ancho: integer;
808 indColDat: int16): TugGrillaCol;
809 begin
810 Result := AgrEncab(titulo, ancho, indColDat);
811 Result.tipo := ugTipDatTim;
812 Result.procActionDatTim:=@procDefActionDatTim;
813 end;
814 procedure TUtilGrillaBase.FinEncab(actualizarGrilla: boolean = true);
815 begin
816 if actualizarGrilla and (grilla<>nil) then begin
817 //Configura las columnas
818 grilla.FixedCols:= 1; //columna de cuenta de filas
819 grilla.RowCount := 1;
820 grilla.ColCount:=cols.Count; //Hace espacio
821 DimensColumnas;
822 end;
823 end;
824 procedure TUtilGrillaBase.AsignarGrilla(grilla0: TStringGrid);
825 {Asigna una grilla al objeto GrillaDB. Al asignarle una nueva grilla, la configura
826 de acuerdo a los encabezados definidos para este objeto. Se define esta rutina de forma
827 separada al constructor para poder ejecutarla posteroiormente y tener la posibilidad de
828 poder cambiar de grilla. Poder cambiar de grilla, nos permite reutilizar una misma grilla
829 para mostrar información diversa.
830 Si solo se va a trabajar con una grilla. No es necesario usar este método. Bastará con la
831 definición de ña grilla en el constructor.}
832 var
833 c: TugGrillaCol;
834 begin
835 grilla := grilla0;
836 if cols.Count>0 then begin //se han definido columnas
837 FinEncab(true); //configura columnas de la grilla
838 for c in cols do c.grilla := grilla; //Actualiza las referencias
839 end;
840 //Actualiza menú contextual
841 SetMenuCampos(FMenuCampos);
842 //Actualiza opciones
843 SetOpDimensColumnas(FOpDimensColumnas);
844 SetOpAutoNumeracion(FOpAutoNumeracion);
845 SetOpResaltarEncabez(FOpResaltarEncabez);
846 SetOpEncabezPulsable(FOpEncabezPulsable);
847 SetOpOrdenarConClick(FOpOrdenarConClick);
848 SetOpResaltFilaSelec(FOpResaltFilaSelec);
849 //Configura eventos
850 grilla.OnPrepareCanvas:=@grillaPrepareCanvas;
851 grilla.OnKeyDown:=@grillaKeyDown;
852 grilla.OnKeyPress:=@grillaKeyPress;
853 grilla.OnMouseUp:=@grillaMouseUp;
854 grilla.OnMouseDown:=@grillaMouseDown;
855 end;
BuscarColumnanull856 function TUtilGrillaBase.BuscarColumna(nombColum: string): TugGrillaCol;
857 {Busca una columna por su nombre. Si no la encuentra, devuelve NIL.}
858 var
859 col: TugGrillaCol;
860 begin
861 for col in cols do begin
862 if col.nomCampo = nombColum then exit(col);
863 end;
864 exit(nil);
865 end;
866 procedure TUtilGrillaBase.CopiarCampo;
867 begin
868 if (grilla.Row = -1) or (grilla.Col = -1) then exit;
869 Clipboard.AsText:=grilla.Cells[grilla.Col, grilla.Row];
870 end;
871 procedure TUtilGrillaBase.CopiarFila;
872 var
873 tmp: String;
874 c: Integer;
875 begin
876 if (grilla.Row = -1) or (grilla.Col = -1) then exit;
877 tmp := grilla.Cells[1, grilla.Row];
878 for c:=2 to grilla.ColCount-1 do tmp := tmp + #9 + grilla.Cells[c, grilla.Row];
879 Clipboard.AsText:=tmp;
880 end;
TUtilGrillaBase.PegarACamponull881 function TUtilGrillaBase.PegarACampo: boolean;
882 {Pega el valor del portapapeles en la celda. Si hubo cambio, devuelve TRUE.}
PegaEnCeldanull883 function PegaEnCelda(col, row: integer; txt: string): boolean;
884 {Pega un valor en la celda indicada, si es diferente.
885 Si produce cambios, devuelve TRUE.}
886 begin
887 Result := false; //Por defecto, no hay cambios
888 if col>grilla.ColCount-1 then exit;;
889 if row>grilla.RowCount-1 then exit;
890 if not cols[col].editable then exit;
891 //Quita caracteres raros al final
892 while (txt<>'') and (txt[length(txt)] in [#13,#10,#32]) do
893 delete(txt, length(txt), 1);
894 if grilla.Cells[col, row] <> txt then begin
895 grilla.Cells[col, row] := txt;
896 Result := true; //Hubo cambios
897 end;
898 end;
899 var
900 txt: String;
901 c, cIni: Integer;
902 campos: TStringDynArray;
903 begin
904 if (grilla.Row = -1) or (grilla.Col = -1) then exit;
905 txt := Clipboard.AsText;
906 //Verifica, si vienen varios campos, en la cadena (Como suele copiar Excel)
907 if pos(#9, txt) <> 0 then begin
908 //Hay varios campos en el protapapeles
909 Result := false;
910 campos := explode(#9, txt); //separa
911 cIni := grilla.Col; //Columna inicial
912 for c := 0 to high(campos) do begin //pega en las columnas
913 if PegaEnCelda(cIni + c, grilla.Row, campos[c]) then begin
914 Result:= true; //hubo cambios
915 end;
916 end;
917 end else begin
918 //Hay un solo campo
919 Result := PegaEnCelda(grilla.Col, grilla.Row, txt);
920 end;
921 end;
922 //Constructor y destructor
923 constructor TUtilGrillaBase.Create(grilla0: TStringGrid);
924 begin
925 cols:= TGrillaDBCol_list.Create(true);
926 //Configura grilla
927 if grilla0<>nil then AsignarGrilla(grilla0);
928 end;
929 destructor TUtilGrillaBase.Destroy;
930 begin
931 cols.Destroy;
932 //Elimina menú. Si se ha creado
933 if PopupHeadInt<>nil then PopupHeadInt.Destroy;
934 inherited Destroy;
935 end;
936 { TUtilGrilla }
937 procedure TUtilGrilla.LimpiarFiltros;
938 {Elimina todos los filtros}
939 begin
940 numFiltros := 0;
941 end;
AgregarFiltronull942 function TUtilGrilla.AgregarFiltro(proc: TUtilProcFiltro): integer;
943 {Agrega un filtro al arreglo. Devuelve el índice.}
944 begin
945 if numFiltros+1>MAX_UTIL_FILTROS then exit;
946 filtros[numFiltros] := proc;
947 Result := numFiltros;
948 inc(numFiltros);
949 end;
950 procedure TUtilGrilla.FiltrarFila(f: integer);
951 var
952 n: Integer;
953 begin
954 //Los filtros se aplican en modo AND, es decir si alguno falla, se oculta
955 for n:=0 to numFiltros-1 do begin
956 if not Filtros[n](f) then begin
957 grilla.RowHeights[f] := 0;
958 exit;
959 end;
960 end;
961 //Paso por todos los filtros
962 inc(filVisibles);
963 grilla.RowHeights[f] := ALT_FILA_DEF;
964 end;
965 procedure TUtilGrilla.Filtrar;
966 {Ejecuta un filtrado, de las filsa de la grilla, usando los filtros, previamente
967 agregados a TUtilGrilla. Actualza "filVisibles".}
968 var
969 fil: Integer;
970 begin
971 if grilla=nil then exit; //protección
972 if numFiltros = 0 then begin //sin filtros
973 grilla.BeginUpdate;
974 for fil:=1 to grilla.RowCount-1 do begin
975 grilla.RowHeights[fil] := ALT_FILA_DEF;
976 end;
977 grilla.EndUpdate();
978 exit;
979 end;
980 grilla.BeginUpdate;
981 filVisibles := 0;
982 for fil:=1 to grilla.RowCount-1 do begin
983 FiltrarFila(fil);
984 end;
985 grilla.EndUpdate();
986 grilla.row := PrimeraFilaVis(grilla); //selecciona el primero
987 end;
BuscarTxtnull988 function TUtilGrilla.BuscarTxt(txt: string; col: integer): integer;
989 {Realiza la búsqueda de un texto, de forma literal, en la columna indicada. devuelve el
990 número de fila donde se encuentra. SI no encuentra, devuelve -1.
991 No busca en los encabezados.}
992 var
993 f: Integer;
994 begin
995 for f:=grilla.FixedRows to grilla.RowCount-1 do begin
996 if grilla.Cells[col, f] = txt then exit(f);
997 end;
998 exit(-1);
999 end;
1000 constructor TUtilGrilla.Create(grilla0: TStringGrid);
1001 begin
1002 inherited Create(grilla0);
1003 LimpiarFiltros;
1004 end;
1005 { TUtilGrillaFil }
1006 procedure TUtilGrillaFil.DibCeldaIcono(aCol, aRow: Integer; const aRect: TRect);
1007 {Dibuja un ícono alineado en la celda "aRect" de la grilla "Self.grilla", usando el
1008 alineamiento de Self.cols[].}
1009 var
1010 cv: TCanvas;
1011 txt: String;
1012 ancTxt: Integer;
1013 icoIdx: Integer;
1014 begin
1015 cv := grilla.Canvas; //referencia al Lienzo
1016 if ImageList = nil then exit;
1017 //Es una celda de tipo ícono
1018 txt := grilla.Cells[ACol,ARow];
1019 if not TryStrToInt(txt, icoIdx) then begin //obtiene índice
1020 icoIdx := -1
1021 end;
1022 case cols[aCol].alineam of
1023 taLeftJustify: begin
1024 ImageList.Draw(cv, aRect.Left+2, aRect.Top+2, icoIdx);
1025 end;
1026 taCenter: begin
1027 ancTxt := ImageList.Width;
1028 ImageList.Draw(cv, aRect.Left + ((aRect.Right - aRect.Left) - ancTxt) div 2,
1029 aRect.Top + 2, icoIdx);
1030 end;
1031 taRightJustify: begin
1032 ancTxt := ImageList.Width;
1033 ImageList.Draw(cv, aRect.Right - ancTxt - 2, aRect.Top+2, icoIdx);
1034 end;
1035 end;
1036 end;
1037 procedure TUtilGrillaFil.DibCeldaTexto(aCol, aRow: Integer; const aRect: TRect);
1038 {Dibuja un texto alineado en la celda "aRect" de la grilla "Self.grilla", usando el
1039 alineamiento de Self.cols[].}
1040 var
1041 cv: TCanvas;
1042 txt: String;
1043 ancTxt: Integer;
1044 begin
1045 cv := grilla.Canvas; //referencia al Lienzo
1046 txt := grilla.Cells[ACol,ARow];
1047 //escribe texto con alineación
1048 case cols[aCol].alineam of
1049 taLeftJustify: begin
1050 cv.TextOut(aRect.Left + 2, aRect.Top + 2, txt);
1051 end;
1052 taCenter: begin
1053 ancTxt := cv.TextWidth(txt);
1054 cv.TextOut(aRect.Left + ((aRect.Right - aRect.Left) - ancTxt) div 2,
1055 aRect.Top + 2, txt );
1056 end;
1057 taRightJustify: begin
1058 ancTxt := cv.TextWidth(txt);
1059 cv.TextOut(aRect.Right - ancTxt - 2, aRect.Top + 2, txt);
1060 end;
1061 end;
1062 end;
EsFilaSeleccionadanull1063 function TUtilGrillaFil.EsFilaSeleccionada(const f: integer): boolean;
1064 {Indica si la fila "f", está seleccionada.
1065 Se puede usar esta función para determinar las filas seleccionadas de la grilla (en el
1066 caso de que la selección múltiple esté activada), porque hasta la versión actual,
1067 SelectedRange[], puede contener rangos duplicados, si se hace click dos veces en la misma
1068 fila, así que podría dar problemas si se usa SelectedRange[], para hallar las filas
1069 seleccionadas.}
1070 var
1071 i: Integer;
1072 sel: TGridRect;
1073 begin
1074 if not FOpSelMultiFila then begin
1075 //Caso de selección simple
1076 exit(f = grilla.Row);
1077 end;
1078 //Selección múltiple
1079 for i:=0 to grilla.SelectedRangeCount-1 do begin
1080 sel := grilla.SelectedRange[i];
1081 if (f >= sel.Top) and (f <= sel.Bottom) then exit(true);
1082 end;
1083 //No está en ningún rango de selección
1084 exit(false);
1085 end;
1086 procedure TUtilGrillaFil.grillaDrawCell(Sender: TObject; aCol, aRow: Integer;
1087 aRect: TRect; aState: TGridDrawState);
1088 var
1089 cv: TCanvas; //referencia al lienzo
1090 atrib: integer;
1091 begin
1092 cv := grilla.Canvas; //referencia al Lienzo
1093 //txt := grilla.Cells[ACol,ARow];
1094 if gdFixed in aState then begin
1095 //Es una celda fija
1096 cv.Font.Color := clBlack;
1097 cv.Font.Style := [];
1098 cv.Brush.Color := clBtnFace;
1099 cv.FillRect(aRect); //fondo
1100 DibCeldaTexto(aCol, aRow, aRect);
1101 end else begin
1102 //Es una celda común
1103 cv.Font.Color := TColor(PtrUInt(grilla.Objects[1, aRow]));
1104 if grilla.Objects[2, aRow]=nil then begin
1105 //Sin atributos
1106 cv.Font.Style := [];
1107 end else begin
1108 //Hay atributos de texto
1109 atrib := PtrUInt(grilla.Objects[2, aRow]);
1110 if (atrib and 1) = 1 then cv.Font.Style := cv.Font.Style + [fsUnderline];
1111 if (atrib and 2) = 2 then cv.Font.Style := cv.Font.Style + [fsItalic];
1112 if (atrib and 4) = 4 then cv.Font.Style := cv.Font.Style + [fsBold];
1113 end;
1114 if OpResaltFilaSelec and EsFilaSeleccionada(aRow) then begin
1115 //Fila seleccionada. (Debe estar activada la opción "goRowHighligh", para que esto funcione bien.)
1116 cv.Brush.Color := clBtnFace;
1117 end else begin
1118 cv.Brush.Color := TColor(PtrUInt(grilla.Objects[0, aRow]));
1119 end;
1120 cv.FillRect(aRect); //fondo
1121 if cols[aCol].tipo = ugTipIco then
1122 DibCeldaIcono(aCol, aRow, aRect)
1123 else
1124 DibCeldaTexto(aCol, aRow, aRect);
1125 // Dibuja ícono
1126 { if (aCol=0) and (aRow>0) then
1127 ImageList16.Draw(grilla.Canvas, aRect.Left, aRect.Top, 19);}
1128 //Dibuja borde en celda seleccionada
1129 if gdFocused in aState then begin
1130 cv.Pen.Color := clRed;
1131 cv.Pen.Style := psDot;
1132 cv.Frame(aRect.Left, aRect.Top, aRect.Right-1, aRect.Bottom-1); //dibuja borde
1133 end;
1134 end;
1135 end;
1136 procedure TUtilGrillaFil.SetOpSelMultiFila(AValue: boolean);
1137 begin
1138 FOpSelMultiFila:=AValue;
1139 if grilla<>nil then begin
1140 //Ya tiene asignada una grilla
1141 if AValue then grilla.RangeSelectMode := rsmMulti
1142 else grilla.RangeSelectMode := rsmSingle;
1143 end;
1144 end;
TUtilGrillaFil.AgrEncabIconull1145 function TUtilGrillaFil.AgrEncabIco(titulo: string; ancho: integer;
1146 indColDat: int16): TugGrillaCol;
1147 {Agrega una columna de tipo ícono.}
1148 begin
1149 Result := AgrEncab(titulo, ancho, indColDat);
1150 Result.tipo := ugTipIco;
1151 end;
1152 procedure TUtilGrillaFil.AsignarGrilla(grilla0: TStringGrid);
1153 begin
1154 inherited;
1155 SetOpSelMultiFila(FOpSelMultiFila);
1156 //Trabaja con su propia rutina de dibujo
1157 grilla.DefaultDrawing:=false;
1158 grilla.OnDrawCell:=@grillaDrawCell;
1159 end;
1160 procedure TUtilGrillaFil.FijColorFondo(fil: integer; color: TColor);
1161 {Fija el color de fondo de la fila indicada. Por defecto es negro.}
1162 begin
1163 //El color de fondo se almacena en la colunma 1
1164 if grilla.ColCount<2 then exit; //protección
1165 grilla.Objects[0, fil] := TObject(PtrUInt(color));
1166 end;
1167 procedure TUtilGrillaFil.FijColorFondoGrilla(color: TColor);
1168 {Fija el color de fondo de toda la grilla.}
1169 var
1170 f: Integer;
1171 begin
1172 if grilla.ColCount<2 then exit; //protección
1173 for f:=grilla.FixedRows to grilla.RowCount-1 do begin
1174 grilla.Objects[0, f] := TObject(PtrUInt(color));
1175 end;
1176 end;
1177 procedure TUtilGrillaFil.FijColorTexto(fil: integer; color: TColor);
1178 {Fija el color del texto de la fila indicada. Por defecto es negro.}
1179 begin
1180 //El color de fondo se almacena en la colunma 2
1181 if grilla.ColCount<3 then exit; //protección
1182 grilla.Objects[1, fil] := TObject(PtrUInt(color));
1183 end;
1184 procedure TUtilGrillaFil.FijColorTextoGrilla(color: TColor);
1185 {Fija el color del texto de toda la grilla.}
1186 var
1187 f: Integer;
1188 begin
1189 if grilla.ColCount<3 then exit; //protección
1190 for f:=grilla.FixedRows to grilla.RowCount-1 do begin
1191 grilla.Objects[1, f] := TObject(PtrUInt(color));
1192 end;
1193 end;
1194 procedure TUtilGrillaFil.FijAtribTexto(fil: integer; negrita, cursiva,
1195 subrayadao: boolean);
1196 {Fija lo satributos del texto de la fila indicada. Por defecto no tiene atributos.}
1197 begin
1198 //Los atributos se almacenan en la colunma 3
1199 if grilla.ColCount<4 then exit; //protección
1200 grilla.Objects[2, fil] := TObject(ord(negrita)*4+ord(cursiva)*2+ord(subrayadao));
1201 end;
1202 procedure TUtilGrillaFil.FijAtribTextoGrilla(negrita, cursiva,
1203 subrayadao: boolean);
1204 var
1205 f: Integer;
1206 begin
1207 if grilla.ColCount<4 then exit; //protección
1208 for f:=grilla.FixedRows to grilla.RowCount-1 do begin
1209 grilla.Objects[2, f] := TObject(ord(negrita)*4+ord(cursiva)*2+ord(subrayadao));
1210 end;
1211 end;
1212 constructor TUtilGrillaFil.Create(grilla0: TStringGrid);
1213 begin
1214 inherited Create(grilla0);
1215 OpResaltFilaSelec:=true; //Por defecto trabaja en modo fila
1216 end;
1217
1218 end.
1219
1220