1 |
(*
|
2 |
* IBX For Lazarus (Firebird Express)
|
3 |
*
|
4 |
* The contents of this file are subject to the Initial Developer's
|
5 |
* Public License Version 1.0 (the "License"); you may not use this
|
6 |
* file except in compliance with the License. You may obtain a copy
|
7 |
* of the License here:
|
8 |
*
|
9 |
* http://www.firebirdsql.org/index.php?op=doc&id=idpl
|
10 |
*
|
11 |
* Software distributed under the License is distributed on an "AS
|
12 |
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
13 |
* implied. See the License for the specific language governing rights
|
14 |
* and limitations under the License.
|
15 |
*
|
16 |
* The Initial Developer of the Original Code is Tony Whyman.
|
17 |
*
|
18 |
* The Original Code is (C) 2015 Tony Whyman, MWA Software
|
19 |
* (http://www.mwasoftware.co.uk).
|
20 |
*
|
21 |
* All Rights Reserved.
|
22 |
*
|
23 |
* Contributor(s): ______________________________________.
|
24 |
*
|
25 |
*)
|
26 |
unit IBArrayGrid;
|
27 |
|
28 |
{$mode objfpc} {$H+}
|
29 |
|
30 |
interface
|
31 |
|
32 |
uses
|
33 |
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
|
34 |
Db, DBCtrls, IBCustomDataSet, IB;
|
35 |
|
36 |
type
|
37 |
|
38 |
(*
|
39 |
This is a data aware control derived from TCustomStringGrid and which may be used
|
40 |
to display/edit the contents of a one or two dimensional Firebird array.
|
41 |
|
42 |
Firebird Arrays are defined in the same way as any other database column e.g.
|
43 |
|
44 |
Alter Table MyData (
|
45 |
...
|
46 |
MyArray VarChar(16) [0:16, -1:7] Character Set UTF8
|
47 |
);
|
48 |
|
49 |
An array may have a different set of values for each row. In the above example,
|
50 |
a two dimensional array of strings is defined. The first index may vary from
|
51 |
0 to 16 and the second from -1 to 7.
|
52 |
|
53 |
IBX defines the TField descendent 'TIBArrayField' and this may be used to access
|
54 |
the array element in each row of a query/table when using TQuery, TIBDataSet or
|
55 |
TIBTable. The SQL used to select/update/insert tables with array data is the
|
56 |
same as for any other SQL type. In any given row, the array field may be null or
|
57 |
have a set of values. Note that individual array elements cannot themselves be null.
|
58 |
|
59 |
TIBArrayGrid is a visual control that can be linked to a TIBArrayField and used
|
60 |
to display/edit the contents of a one or two dimensional Firebird array. It may be
|
61 |
found in the “Firebird Data Controls” palette.
|
62 |
|
63 |
To use a TIBArrayGrid, simply drop it onto a form and set the DataSource property
|
64 |
to the source dataset and the DataField property to the name of an array field.
|
65 |
The grid should then be automatically sized to match the dimensions of the array.
|
66 |
Note that the array bounds can be refreshed at any time in the IDE, by right clicking
|
67 |
on the control and selecting "Update Layout" from the pop up menu.
|
68 |
|
69 |
At runtime, the TIBArrayGrid will always display/edit the value of the array element
|
70 |
in the current row. If this element is null then the array is empty. However,
|
71 |
data can be inserted into the array. When the row is posted, the field will be
|
72 |
set to the new/updated array.
|
73 |
|
74 |
Properties
|
75 |
==========
|
76 |
|
77 |
Most TIBArrayGrid properties are the same as for TStringGrid. The following
|
78 |
are specific to TIBArrayGrid. Note that you cannot set the Row or column counts
|
79 |
directly as these are always set to match the array field.
|
80 |
|
81 |
Public:
|
82 |
ArrayIntf: Provides direct access to the array itself.
|
83 |
DataSet: The DataSet provided by the DataSource (read only).
|
84 |
Field: The source field
|
85 |
|
86 |
Published:
|
87 |
DataField: name of array column.
|
88 |
DataSource: The data source providing the source table.
|
89 |
ReadOnly: Set to true to prevent editing
|
90 |
ColumnLabels: A string list that provides the labels for each
|
91 |
column in the grid. Provide one line per column.
|
92 |
If non empty then a column label row is created.
|
93 |
ColumnLabelAlignment: Sets the text alignment for column Labels
|
94 |
ColumnLabelFont: Sets the font used for column labels
|
95 |
RowLabels: A string list that provides the labels for each
|
96 |
row in the grid. Provide one line per row.
|
97 |
If non empty then a row label row is created.
|
98 |
RowLabelAlignment: Sets the text alignment for row Labels
|
99 |
RowLabelFont: Sets the font used for row labels
|
100 |
RowLabelColumnWidth: Width of the Fixed Column used for row labels.
|
101 |
TextAlignment: Alignment of all cells other that those containing
|
102 |
labels.
|
103 |
*)
|
104 |
|
105 |
{ TIBArrayGrid }
|
106 |
|
107 |
TIBArrayGrid = class(TCustomStringGrid)
|
108 |
private
|
109 |
{ Private declarations }
|
110 |
FColumnLabelAlignment: TAlignment;
|
111 |
FColumnLabelFont: TFont;
|
112 |
FDataLink: TFieldDataLink;
|
113 |
FArray: IArray;
|
114 |
FActive: boolean;
|
115 |
FRowLabelAlignment: TAlignment;
|
116 |
FRowLabelColumnWidth: integer;
|
117 |
FRowLabelFont: TFont;
|
118 |
FRowLabels: TStrings;
|
119 |
FColumnLabels: TStrings;
|
120 |
FTextAlignment: TAlignment;
|
121 |
FTextChanged: boolean;
|
122 |
procedure ActiveChange(Sender: TObject);
|
123 |
procedure ColumnLabelChanged(Sender: TObject);
|
124 |
procedure DataChange(Sender: TObject);
|
125 |
function GetDataField: string;
|
126 |
function GetDataSet: TDataSet;
|
127 |
function GetDataSource: TDataSource;
|
128 |
function GetField: TField;
|
129 |
function GetReadOnly: Boolean;
|
130 |
procedure LoadGridData(ArrayDimensions: integer; ArrayBounds: TArrayBounds);
|
131 |
procedure ReadColCount(Reader: TReader);
|
132 |
procedure ReadRowCount(Reader: TReader);
|
133 |
procedure RowLabelChanged(Sender: TObject);
|
134 |
procedure SetColumnLabelAlignment(AValue: TAlignment);
|
135 |
procedure SetColumnLabelFont(AValue: TFont);
|
136 |
procedure SetColumnLabels(AValue: TStrings);
|
137 |
procedure SetDataField(AValue: string);
|
138 |
procedure SetDataSource(AValue: TDataSource);
|
139 |
procedure SetReadOnly(AValue: Boolean);
|
140 |
procedure SetRowLabelAlignment(AValue: TAlignment);
|
141 |
procedure SetRowLabelColumnWidth(AValue: integer);
|
142 |
procedure SetRowLabelFont(AValue: TFont);
|
143 |
procedure SetRowLabels(AValue: TStrings);
|
144 |
procedure UpdateLabels;
|
145 |
procedure UpdateData(Sender: TObject);
|
146 |
procedure WriteColCount(Writer: TWriter);
|
147 |
procedure WriteRowCount(Writer: TWriter);
|
148 |
protected
|
149 |
{ Protected declarations }
|
150 |
procedure DefineProperties(Filer: TFiler); override;
|
151 |
procedure DefineCellsProperty(Filer: TFiler); override;
|
152 |
procedure DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; aText: String); override;
|
153 |
procedure EditorHide; override;
|
154 |
function EditorIsReadOnly: boolean; override;
|
155 |
procedure Loaded; override;
|
156 |
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
157 |
procedure ResetSizes; override;
|
158 |
procedure SetEditText(aCol, aRow: Longint; const aValue: string); override;
|
159 |
public
|
160 |
{ Public declarations }
|
161 |
constructor Create(AOwner: TComponent); override;
|
162 |
destructor Destroy; override;
|
163 |
procedure UpdateLayout;
|
164 |
property ArrayIntf: IArray read FArray;
|
165 |
property DataSet: TDataSet read GetDataSet;
|
166 |
property Field: TField read GetField;
|
167 |
published
|
168 |
{ Published declarations }
|
169 |
property DataField: string read GetDataField write SetDataField;
|
170 |
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
171 |
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
172 |
property ColumnLabelAlignment: TAlignment read FColumnLabelAlignment
|
173 |
write SetColumnLabelAlignment default taCenter;
|
174 |
property ColumnLabels: TStrings read FColumnLabels write SetColumnLabels;
|
175 |
property ColumnLabelFont: TFont read FColumnLabelFont write SetColumnLabelFont;
|
176 |
property RowLabels: TStrings read FRowLabels write SetRowLabels;
|
177 |
property RowLabelAlignment: TAlignment read FRowLabelAlignment
|
178 |
write SetRowLabelAlignment default taLeftJustify;
|
179 |
property RowLabelFont: TFont read FRowLabelFont write SetRowLabelFont;
|
180 |
property RowLabelColumnWidth: integer read FRowLabelColumnWidth write SetRowLabelColumnWidth;
|
181 |
property TextAlignment:TAlignment read FTextAlignment
|
182 |
write FTextAlignment default taLeftJustify;
|
183 |
property Align;
|
184 |
property AlternateColor;
|
185 |
property Anchors;
|
186 |
property AutoAdvance;
|
187 |
property AutoEdit;
|
188 |
property AutoFillColumns;
|
189 |
property BiDiMode;
|
190 |
property BorderSpacing;
|
191 |
property BorderStyle;
|
192 |
property CellHintPriority;
|
193 |
property Color;
|
194 |
property ColumnClickSorts;
|
195 |
property Constraints;
|
196 |
property DefaultColWidth;
|
197 |
property DefaultDrawing;
|
198 |
property DefaultRowHeight;
|
199 |
property DragCursor;
|
200 |
property DragKind;
|
201 |
property DragMode;
|
202 |
property Enabled;
|
203 |
property ExtendedSelect;
|
204 |
property FixedColor;
|
205 |
property Flat;
|
206 |
property Font;
|
207 |
property GridLineWidth;
|
208 |
property HeaderHotZones;
|
209 |
property HeaderPushZones;
|
210 |
property MouseWheelOption;
|
211 |
property Options;
|
212 |
property ParentBiDiMode;
|
213 |
property ParentColor default false;
|
214 |
property ParentFont;
|
215 |
property ParentShowHint;
|
216 |
property PopupMenu;
|
217 |
property RangeSelectMode;
|
218 |
property ScrollBars;
|
219 |
property ShowHint;
|
220 |
property TabAdvance;
|
221 |
property TabOrder;
|
222 |
property TabStop;
|
223 |
property TitleFont;
|
224 |
property TitleImageList;
|
225 |
property TitleStyle;
|
226 |
property UseXORFeatures;
|
227 |
property Visible;
|
228 |
property VisibleColCount;
|
229 |
property VisibleRowCount;
|
230 |
|
231 |
property OnBeforeSelection;
|
232 |
property OnChangeBounds;
|
233 |
property OnCheckboxToggled;
|
234 |
property OnClick;
|
235 |
property OnCompareCells;
|
236 |
property OnContextPopup;
|
237 |
property OnDragDrop;
|
238 |
property OnDragOver;
|
239 |
property OnDblClick;
|
240 |
property OnDrawCell;
|
241 |
property OnButtonClick;
|
242 |
property OnEditingDone;
|
243 |
property OnEndDock;
|
244 |
property OnEndDrag;
|
245 |
property OnEnter;
|
246 |
property OnExit;
|
247 |
property OnGetCellHint;
|
248 |
property OnGetCheckboxState;
|
249 |
property OnGetEditMask;
|
250 |
property OnGetEditText;
|
251 |
property OnHeaderClick;
|
252 |
property OnHeaderSized;
|
253 |
property OnHeaderSizing;
|
254 |
property OnKeyDown;
|
255 |
property OnKeyPress;
|
256 |
property OnKeyUp;
|
257 |
property OnMouseDown;
|
258 |
property OnMouseEnter;
|
259 |
property OnMouseLeave;
|
260 |
property OnMouseMove;
|
261 |
property OnMouseUp;
|
262 |
property OnMouseWheel;
|
263 |
property OnMouseWheelDown;
|
264 |
property OnMouseWheelUp;
|
265 |
property OnPickListSelect;
|
266 |
property OnPrepareCanvas;
|
267 |
property OnResize;
|
268 |
property OnSelectEditor;
|
269 |
property OnSelection;
|
270 |
property OnSelectCell;
|
271 |
property OnSetCheckboxState;
|
272 |
property OnSetEditText;
|
273 |
property OnShowHint;
|
274 |
property OnStartDock;
|
275 |
property OnStartDrag;
|
276 |
property OnTopLeftChanged;
|
277 |
property OnUserCheckboxBitmap;
|
278 |
property OnUTF8KeyPress;
|
279 |
property OnValidateEntry;
|
280 |
end;
|
281 |
|
282 |
|
283 |
implementation
|
284 |
|
285 |
resourcestring
|
286 |
sArrayDimensionsOutofRange = 'Array Dimensions (%d) out of range';
|
287 |
sNotAnArrayField = '%s is not an Array Field';
|
288 |
|
289 |
{ TIBArrayGrid }
|
290 |
|
291 |
procedure TIBArrayGrid.ActiveChange(Sender: TObject);
|
292 |
begin
|
293 |
try
|
294 |
if (DataSet <> nil) and DataSet.Active then
|
295 |
begin
|
296 |
FActive := true;
|
297 |
if Field = nil then
|
298 |
raise Exception.CreateFmt(sNotAnArrayField,['Unknown']);
|
299 |
if not (Field is TIBArrayField) then
|
300 |
raise Exception.CreateFmt(sNotAnArrayField,[Field.Name]);
|
301 |
UpdateLayout;
|
302 |
DataChange(Sender);
|
303 |
end
|
304 |
else
|
305 |
begin
|
306 |
FActive := false;
|
307 |
FArray := nil;
|
308 |
Clean;
|
309 |
end;
|
310 |
except
|
311 |
FActive := false;
|
312 |
raise;
|
313 |
end;
|
314 |
end;
|
315 |
|
316 |
procedure TIBArrayGrid.ColumnLabelChanged(Sender: TObject);
|
317 |
begin
|
318 |
if csLoading in ComponentState then Exit;
|
319 |
if FColumnLabels.Count > 0 then
|
320 |
begin
|
321 |
FixedRows := 1;
|
322 |
RowCount := RowCount + FixedRows;
|
323 |
end
|
324 |
else
|
325 |
begin
|
326 |
RowCount := RowCount - FixedRows;
|
327 |
FixedRows := 0;
|
328 |
end;
|
329 |
UpdateLabels;
|
330 |
end;
|
331 |
|
332 |
procedure TIBArrayGrid.DataChange(Sender: TObject);
|
333 |
begin
|
334 |
if (DataSet <> nil) and DataSet.Active and FActive then
|
335 |
with TIBArrayField(Field) do
|
336 |
begin
|
337 |
FArray := ArrayIntf;
|
338 |
LoadGridData(ArrayDimensions,ArrayBounds);
|
339 |
end;
|
340 |
end;
|
341 |
|
342 |
function TIBArrayGrid.GetDataField: string;
|
343 |
begin
|
344 |
Result := FDataLink.FieldName;
|
345 |
end;
|
346 |
|
347 |
function TIBArrayGrid.GetDataSet: TDataSet;
|
348 |
begin
|
349 |
Result := FDataLink.DataSet;
|
350 |
end;
|
351 |
|
352 |
function TIBArrayGrid.GetDataSource: TDataSource;
|
353 |
begin
|
354 |
Result := FDataLink.DataSource;
|
355 |
end;
|
356 |
|
357 |
function TIBArrayGrid.GetField: TField;
|
358 |
begin
|
359 |
Result := FDataLink.Field;
|
360 |
end;
|
361 |
|
362 |
function TIBArrayGrid.GetReadOnly: Boolean;
|
363 |
begin
|
364 |
Result := FDataLink.ReadOnly;
|
365 |
end;
|
366 |
|
367 |
procedure TIBArrayGrid.LoadGridData(ArrayDimensions: integer;
|
368 |
ArrayBounds: TArrayBounds);
|
369 |
var i, j, k, l: integer;
|
370 |
begin
|
371 |
if (FArray = nil) or (FDataLink.Editing and not FArray.IsEmpty)
|
372 |
then Exit;
|
373 |
case ArrayDimensions of
|
374 |
1:
|
375 |
begin
|
376 |
if RowCount - FixedRows <> 1 then
|
377 |
raise Exception.CreateFmt(sArrayDimensionsOutofRange,[ArrayDimensions]);
|
378 |
|
379 |
with ArrayBounds[0] do
|
380 |
for i := LowerBound to UpperBound do
|
381 |
if (i - LowerBound >= 0) and (i - LowerBound < ColCount) then
|
382 |
Cells[i - LowerBound,FixedRows] := FArray.GetAsString([i]);
|
383 |
end;
|
384 |
|
385 |
2:
|
386 |
begin
|
387 |
with ArrayBounds[0] do
|
388 |
for i := LowerBound to UpperBound do
|
389 |
begin
|
390 |
k := i - LowerBound + FixedCols;
|
391 |
if (k >= 0) and (k < ColCount) then
|
392 |
begin
|
393 |
with ArrayBounds[1] do
|
394 |
for j := LowerBound to UpperBound do
|
395 |
begin
|
396 |
l := j - LowerBound + FixedRows;
|
397 |
if ( l >= 0) and (l < RowCount) then
|
398 |
Cells[k,l] := FArray.GetAsString([i,j]);
|
399 |
end;
|
400 |
end;
|
401 |
end;
|
402 |
end;
|
403 |
|
404 |
else
|
405 |
raise Exception.CreateFmt(sArrayDimensionsOutofRange,[ArrayDimensions]);
|
406 |
end;
|
407 |
end;
|
408 |
|
409 |
procedure TIBArrayGrid.ReadColCount(Reader: TReader);
|
410 |
begin
|
411 |
ColCount := Reader.ReadInteger;
|
412 |
end;
|
413 |
|
414 |
procedure TIBArrayGrid.ReadRowCount(Reader: TReader);
|
415 |
begin
|
416 |
RowCount := Reader.ReadInteger;
|
417 |
end;
|
418 |
|
419 |
procedure TIBArrayGrid.RowLabelChanged(Sender: TObject);
|
420 |
begin
|
421 |
if csLoading in ComponentState then Exit;
|
422 |
if FRowLabels.Count > 0 then
|
423 |
begin
|
424 |
FixedCols := 1;
|
425 |
ColCount := ColCount + FixedCols;
|
426 |
end
|
427 |
else
|
428 |
begin
|
429 |
if ColCount >= FixedCols then
|
430 |
ColCount := ColCount - FixedCols;
|
431 |
FixedCols := 0;
|
432 |
end;
|
433 |
UpdateLabels;
|
434 |
end;
|
435 |
|
436 |
procedure TIBArrayGrid.SetColumnLabelAlignment(AValue: TAlignment);
|
437 |
begin
|
438 |
if FColumnLabelAlignment = AValue then Exit;
|
439 |
FColumnLabelAlignment := AValue;
|
440 |
UpdateLabels;
|
441 |
end;
|
442 |
|
443 |
procedure TIBArrayGrid.SetColumnLabelFont(AValue: TFont);
|
444 |
begin
|
445 |
if FColumnLabelFont = AValue then Exit;
|
446 |
FColumnLabelFont.Assign(AValue);
|
447 |
Invalidate;
|
448 |
end;
|
449 |
|
450 |
procedure TIBArrayGrid.SetColumnLabels(AValue: TStrings);
|
451 |
begin
|
452 |
if FColumnLabels <> AValue then
|
453 |
FColumnLabels.Assign(AValue);
|
454 |
end;
|
455 |
|
456 |
procedure TIBArrayGrid.SetDataField(AValue: string);
|
457 |
begin
|
458 |
FDataLink.FieldName := AValue;
|
459 |
if csDesigning in ComponentState then
|
460 |
UpdateLayout;
|
461 |
end;
|
462 |
|
463 |
procedure TIBArrayGrid.SetDataSource(AValue: TDataSource);
|
464 |
begin
|
465 |
if FDataLink.DataSource = AValue then exit;
|
466 |
if FDataLink.DataSource <> nil then
|
467 |
FDataLink.DataSource.RemoveFreeNotification(self);
|
468 |
FDataLink.DataSource := AValue;
|
469 |
if FDataLink.DataSource <> nil then
|
470 |
FDataLink.DataSource.FreeNotification(self);
|
471 |
if csDesigning in ComponentState then
|
472 |
UpdateLayout;
|
473 |
end;
|
474 |
|
475 |
procedure TIBArrayGrid.SetReadOnly(AValue: Boolean);
|
476 |
begin
|
477 |
FDataLink.ReadOnly := AValue;
|
478 |
end;
|
479 |
|
480 |
procedure TIBArrayGrid.SetRowLabelAlignment(AValue: TAlignment);
|
481 |
begin
|
482 |
if FRowLabelAlignment = AValue then Exit;
|
483 |
FRowLabelAlignment := AValue;
|
484 |
UpdateLabels;
|
485 |
end;
|
486 |
|
487 |
procedure TIBArrayGrid.SetRowLabelColumnWidth(AValue: integer);
|
488 |
begin
|
489 |
if FRowLabelColumnWidth = AValue then Exit;
|
490 |
FRowLabelColumnWidth := AValue;
|
491 |
if (csLoading in ComponentState) or (FixedCols = 0) then Exit;
|
492 |
ColWidths[0] := AValue;
|
493 |
Invalidate;
|
494 |
end;
|
495 |
|
496 |
procedure TIBArrayGrid.SetRowLabelFont(AValue: TFont);
|
497 |
begin
|
498 |
if FRowLabelFont = AValue then Exit;
|
499 |
FRowLabelFont.Assign(AValue);
|
500 |
Invalidate;
|
501 |
end;
|
502 |
|
503 |
procedure TIBArrayGrid.SetRowLabels(AValue: TStrings);
|
504 |
begin
|
505 |
if FRowLabels <> AValue then
|
506 |
FRowLabels.Assign(AValue);
|
507 |
end;
|
508 |
|
509 |
procedure TIBArrayGrid.UpdateLabels;
|
510 |
var i: integer;
|
511 |
begin
|
512 |
Clean;
|
513 |
for i := 0 to FColumnLabels.Count - 1 do
|
514 |
if i < ColCount - FixedCols then
|
515 |
Cells[i+FixedCols,0] := FColumnLabels[i];
|
516 |
|
517 |
for i := 0 to FRowLabels.Count - 1 do
|
518 |
if i < RowCount - FixedRows then
|
519 |
Cells[0,i+FixedRows] := FRowLabels[i];
|
520 |
end;
|
521 |
|
522 |
procedure TIBArrayGrid.UpdateData(Sender: TObject);
|
523 |
begin
|
524 |
EditorHide;
|
525 |
end;
|
526 |
|
527 |
procedure TIBArrayGrid.UpdateLayout;
|
528 |
var i: integer;
|
529 |
begin
|
530 |
if csLoading in ComponentState then Exit;
|
531 |
if (DataSource <> nil) and (DataSet <> nil) and (DataField <> '') then
|
532 |
try
|
533 |
ResetDefaultColWidths;
|
534 |
DataSet.FieldDefs.Update;
|
535 |
if DataSet.FieldDefs.Count > 0 then
|
536 |
for i := 0 to DataSet.FieldDefs.Count - 1 do
|
537 |
if (DataSet.FieldDefs[i] <> nil) and (DataSet.FieldDefs[i].Name = DataField)
|
538 |
and (DataSet.FieldDefs[i] is TIBFieldDef) and (DataSet.FieldDefs[i].DataType = ftArray) then
|
539 |
with TIBFieldDef(DataSet.FieldDefs[i]) do
|
540 |
begin
|
541 |
case ArrayDimensions of
|
542 |
1:
|
543 |
RowCount := 1 + FixedRows;
|
544 |
|
545 |
2:
|
546 |
with ArrayBounds[1] do
|
547 |
RowCount := UpperBound - LowerBound + 1 + FixedRows;
|
548 |
|
549 |
else
|
550 |
raise Exception.CreateFmt(sArrayDimensionsOutofRange,[ArrayDimensions]);
|
551 |
end;
|
552 |
with ArrayBounds[0] do
|
553 |
ColCount := UpperBound - LowerBound + 1 + FixedCols;
|
554 |
UpdateLabels;
|
555 |
Exit;
|
556 |
end;
|
557 |
raise Exception.CreateFmt(sNotAnArrayField,[DataField]);
|
558 |
except
|
559 |
DataField := '';
|
560 |
raise;
|
561 |
end;
|
562 |
end;
|
563 |
|
564 |
procedure TIBArrayGrid.WriteColCount(Writer: TWriter);
|
565 |
begin
|
566 |
Writer.WriteInteger(ColCount);
|
567 |
end;
|
568 |
|
569 |
procedure TIBArrayGrid.WriteRowCount(Writer: TWriter);
|
570 |
begin
|
571 |
Writer.WriteInteger(RowCount);
|
572 |
end;
|
573 |
|
574 |
procedure TIBArrayGrid.DefineProperties(Filer: TFiler);
|
575 |
begin
|
576 |
with Filer do
|
577 |
begin
|
578 |
DefineProperty('ColCount', @ReadColCount, @WriteColCount, true);
|
579 |
DefineProperty('RowCount', @ReadRowCount, @WriteRowCount, true);
|
580 |
end;
|
581 |
inherited DefineProperties(Filer);
|
582 |
end;
|
583 |
|
584 |
procedure TIBArrayGrid.DefineCellsProperty(Filer: TFiler);
|
585 |
begin
|
586 |
//Do Nothing
|
587 |
end;
|
588 |
|
589 |
procedure TIBArrayGrid.DrawCellText(aCol, aRow: Integer; aRect: TRect;
|
590 |
aState: TGridDrawState; aText: String);
|
591 |
var Style: TTextStyle;
|
592 |
oldAlignment: TAlignment;
|
593 |
begin
|
594 |
Style := Canvas.TextStyle;
|
595 |
oldAlignment := Style.Alignment;
|
596 |
if (aRow < FixedRows) then
|
597 |
begin
|
598 |
Style.Alignment := ColumnLabelAlignment;
|
599 |
Canvas.Font.Assign(ColumnLabelFont);
|
600 |
end
|
601 |
else
|
602 |
if aCol < FixedCols then
|
603 |
begin
|
604 |
Style.Alignment := RowLabelAlignment;
|
605 |
Canvas.Font.Assign(RowLabelFont);
|
606 |
end
|
607 |
else
|
608 |
Style.Alignment := TextAlignment;
|
609 |
Canvas.TextStyle := Style;
|
610 |
try
|
611 |
inherited DrawCellText(aCol, aRow, aRect, aState, aText);
|
612 |
finally
|
613 |
Style.Alignment := oldAlignment;
|
614 |
Canvas.TextStyle := Style;
|
615 |
end;
|
616 |
end;
|
617 |
|
618 |
procedure TIBArrayGrid.EditorHide;
|
619 |
var k, l: integer;
|
620 |
begin
|
621 |
inherited EditorHide;
|
622 |
try
|
623 |
if not FTextChanged or (FArray = nil) then Exit;
|
624 |
|
625 |
with TIBArrayField(Field) do
|
626 |
begin
|
627 |
k := Col + ArrayBounds[0].LowerBound - FixedCols;
|
628 |
if ArrayDimensions = 1 then
|
629 |
try
|
630 |
FArray.SetAsString([k],Cells[Col,Row])
|
631 |
except
|
632 |
Cells[Col,Row] := FArray.GetAsString([k]);
|
633 |
raise;
|
634 |
end
|
635 |
else
|
636 |
try
|
637 |
l := Row + ArrayBounds[1].LowerBound - FixedRows;
|
638 |
FArray.SetAsString([k,l],Cells[Col,Row]);
|
639 |
except
|
640 |
Cells[Col,Row] := FArray.GetAsString([k,l]);
|
641 |
raise;
|
642 |
end;
|
643 |
end;
|
644 |
finally
|
645 |
FTextChanged := false;
|
646 |
end;
|
647 |
end;
|
648 |
|
649 |
function TIBArrayGrid.EditorIsReadOnly: boolean;
|
650 |
begin
|
651 |
Result := FActive and inherited EditorIsReadOnly;
|
652 |
|
653 |
if not Result then
|
654 |
begin
|
655 |
if assigned(Field) then
|
656 |
begin
|
657 |
// if field can't be modified, it's assumed readonly
|
658 |
result := not Field.CanModify;
|
659 |
|
660 |
// if it's not readonly and is not already editing, start editing.
|
661 |
if not result and not FDatalink.Editing then
|
662 |
Result := not FDataLink.Edit;
|
663 |
end
|
664 |
else
|
665 |
result := true; // field is nil so it's readonly
|
666 |
end;
|
667 |
end;
|
668 |
|
669 |
procedure TIBArrayGrid.Loaded;
|
670 |
begin
|
671 |
inherited Loaded;
|
672 |
RowLabelChanged(nil);
|
673 |
ColumnLabelChanged(nil);
|
674 |
UpdateLabels;
|
675 |
end;
|
676 |
|
677 |
procedure TIBArrayGrid.Notification(AComponent: TComponent;
|
678 |
Operation: TOperation);
|
679 |
begin
|
680 |
inherited Notification(AComponent, Operation);
|
681 |
if (Operation = opRemove) then
|
682 |
begin
|
683 |
if (FDataLink <> nil) and (AComponent = DataSource) then
|
684 |
DataSource:=nil;
|
685 |
end;
|
686 |
end;
|
687 |
|
688 |
procedure TIBArrayGrid.ResetSizes;
|
689 |
begin
|
690 |
inherited ResetSizes;
|
691 |
if FixedCols > 0 then
|
692 |
begin
|
693 |
ColWidths[0] := RowLabelColumnWidth;
|
694 |
VisualChange;
|
695 |
end;
|
696 |
end;
|
697 |
|
698 |
procedure TIBArrayGrid.SetEditText(aCol, aRow: Longint; const aValue: string);
|
699 |
begin
|
700 |
inherited SetEditText(aCol, aRow, aValue);
|
701 |
if not EditorIsReadOnly then
|
702 |
begin
|
703 |
FDataLink.Modified;
|
704 |
FTextChanged := true;
|
705 |
end;
|
706 |
end;
|
707 |
|
708 |
constructor TIBArrayGrid.Create(AOwner: TComponent);
|
709 |
begin
|
710 |
inherited Create(AOwner);
|
711 |
FDataLink := TFieldDataLink.Create;
|
712 |
FDataLink.Control := Self;
|
713 |
FDataLink.OnDataChange := @DataChange;
|
714 |
FDataLink.OnActiveChange := @ActiveChange;
|
715 |
FDataLink.OnUpdateData := @UpdateData;
|
716 |
FRowLabels := TStringList.Create;
|
717 |
TStringList(FRowLabels).OnChange := @RowLabelChanged;
|
718 |
FColumnLabels := TStringList.Create;
|
719 |
TStringList(FColumnLabels).OnChange := @ColumnLabelChanged;
|
720 |
FixedRows := 0;
|
721 |
FixedCols := 0;
|
722 |
FColumnLabelAlignment := taCenter;
|
723 |
FTextAlignment := taLeftJustify;
|
724 |
FRowLabelAlignment := taLeftJustify;
|
725 |
FRowLabelFont := TFont.Create;
|
726 |
FColumnLabelFont := TFont.Create;
|
727 |
FRowLabelColumnWidth := DefaultColWidth;
|
728 |
Options := Options + [goEditing];
|
729 |
end;
|
730 |
|
731 |
destructor TIBArrayGrid.Destroy;
|
732 |
begin
|
733 |
if assigned(FColumnLabelFont) then FColumnLabelFont.Free;
|
734 |
if assigned(FRowLabelFont) then FRowLabelFont.Free;
|
735 |
if assigned(FColumnLabels) then FColumnLabels.Free;
|
736 |
if assigned(FRowLabels) then FRowLabels.Free;
|
737 |
if assigned(FDataLink) then FDataLink.Free;
|
738 |
inherited Destroy;
|
739 |
end;
|
740 |
|
741 |
end.
|