ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/IBDynamicGrid.pas
Revision: 35
Committed: Tue Jan 26 14:38:47 2016 UTC (8 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 37316 byte(s)
Log Message:
Committing updates for Release R1-3-2

File Contents

# Content
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
27 unit IBDynamicGrid;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 uses
34 Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DBGrids, DB,
35 IBSQLParser, Grids, IBLookupComboEditBox, LMessages, StdCtrls, ExtCtrls,
36 IBCustomDataSet;
37
38 type
39 {
40 TIBDynamicGrid is a TDBGrid descendent that provides for:
41 - automatic resizing of selected columns to fill the available row length
42 - automatic positioning and sizing of a "totals" control, typically at the
43 column footer, on a per column basis.
44 - DataSet resorting on header row click, sorting the dataset by the selected column.
45 A second click on the same header cell reversed the sort order.
46 - Reselection of the same row following resorting.
47 - A new cell editor that provides the same functionality as TIBLookupComboEditBox.
48 Its properties are specified on a per column basis and allows for one or more
49 columns to have their values selected from a list provided by a dataset.
50 Autocomplete and autoinsert are also available. The existing picklist editor
51 is unaffected by the extension.
52 }
53
54 TIBDynamicGrid = class;
55
56 TOnColumnHeaderClick = procedure(Sender: TObject; var ColIndex: integer) of object;
57 TOnUpdateSortOrder = procedure (Sender: TObject; ColIndex: integer; var OrderBy: string) of Object;
58 TKeyDownHandler = procedure (Sender: TObject; var Key: Word; Shift: TShiftState; var Done: boolean) of object;
59
60 { TDBDynamicGridColumn }
61
62 TDBDynamicGridColumn = class(TColumn)
63 private
64 FAutoSizeColumn: boolean;
65 FColumnTotalsControl: TControl;
66 FDesignWidth: integer;
67 function GetWidth: integer;
68 procedure SetWidth(AValue: integer);
69 public
70 property DesignWidth: integer read FDesignWidth;
71 published
72 property ColumnTotalsControl: TControl read FColumnTotalsControl write FColumnTotalsControl;
73 property AutoSizeColumn: boolean read FAutoSizeColumn write FAutoSizeColumn;
74 property Width: integer read GetWidth write SetWidth;
75 end;
76
77 TIBDynamicGridColumn = class;
78
79 { TDBLookupProperties }
80
81 TDBLookupProperties = class(TPersistent)
82 private
83 FAutoComplete: boolean;
84 FAutoCompleteText: TComboBoxAutoCompleteText;
85 FAutoInsert: boolean;
86 FDataFieldName: string;
87 FItemHeight: integer;
88 FItemWidth: integer;
89 FKeyField: string;
90 FKeyPressInterval: integer;
91 FListField: string;
92 FListSource: TDataSource;
93 FOnAutoInsert: TAutoInsert;
94 FOnCanAutoInsert: TCanAutoInsert;
95 FOnCloseUp: TNotifyEvent;
96 FOnDrawItem: TDrawItemEvent;
97 FOwner: TIBDynamicGridColumn;
98 FRelationName: string;
99 FStyle: TComboBoxStyle;
100 function GetAutoCompleteText: TComboBoxAutoCompleteText;
101 procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
102 public
103 constructor Create(aOwner: TIBDynamicGridColumn);
104 property Owner: TIBDynamicGridColumn read FOwner;
105 published
106 property DataFieldName: string read FDataFieldName write FDataFieldName;
107 property KeyField: string read FKeyField write FKeyField;
108 property ItemHeight: integer read FItemHeight write FItemHeight;
109 property ItemWidth: integer read FItemWidth write FItemWidth;
110 property ListSource: TDataSource read FListSource write FListSource;
111 property ListField: string read FListField write FListField;
112 property AutoInsert: boolean read FAutoInsert write FAutoInsert default true;
113 property AutoComplete: boolean read FAutoComplete write FAutoComplete default true;
114 property AutoCompleteText: TComboBoxAutoCompleteText
115 read GetAutoCompleteText write SetAutoCompleteText
116 default DefaultComboBoxAutoCompleteText;
117 property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
118 property RelationName: string read FRelationName write FRelationName;
119 property Style: TComboBoxStyle read FStyle write FStyle default csDropDown;
120 property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
121 property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
122 property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
123 property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
124 end;
125
126 TDBLookupCellEditor = class;
127
128 { TIBDynamicGridColumn }
129
130 TIBDynamicGridColumn = class(TDBDynamicGridColumn)
131 private
132 FDBLookupProperties: TDBLookupProperties;
133 FInitialSortColumn: boolean;
134 procedure DoSetupEditor(Data: PtrInt);
135 procedure DoSetDataSources(Data: PtrInt);
136 procedure SetInitialSortColumn(AValue: boolean);
137 public
138 procedure SetupEditor(Editor: TDBlookupCellEditor);
139 constructor Create(ACollection: TCollection); override;
140 destructor Destroy; override;
141 published
142 property InitialSortColumn: boolean read FInitialSortColumn write SetInitialSortColumn;
143 property DBLookupProperties: TDBLookupProperties read FDBLookupProperties write FDBLookupProperties;
144 end;
145
146 { TDBLookupCellEditor }
147
148 TDBLookupCellEditor = class(TIBLookupComboEditBox)
149 private
150 FGrid: TCustomGrid;
151 FCol,FRow: Integer;
152 FEditText: string;
153 protected
154 procedure WndProc(var TheMessage : TLMessage); override;
155 procedure CloseUp; override;
156 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
157 procedure Loaded; override;
158 procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
159 procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
160 procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE;
161 procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
162 procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
163 public
164 procedure EditingDone; override;
165 property BorderStyle;
166 property OnEditingDone;
167 end;
168
169 TDBDynamicGrid = class(TDBGrid)
170 private
171 { Private declarations }
172 FExpandEditorPanelBelowRow: boolean;
173 FEditorPanel: TWinControl;
174 FExpandedRow: integer;
175 FOnBeforeEditorHide: TNotifyEvent;
176 FOnEditorPanelHide: TNotifyEvent;
177 FOnEditorPanelShow: TNotifyEvent;
178 FOnKeyDownHander: TKeyDownHandler;
179 FResizing: boolean;
180 FWeHaveFocus: boolean;
181 FHidingEditorPanel: boolean;
182 FAllowHide: boolean;
183 FMouseDown: boolean;
184 function ActiveControl: TControl;
185 procedure DoShowEditorPanel(Data: PtrInt);
186 procedure PositionTotals;
187 procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState);
188 procedure PerformEditorHide(Data: PtrInt);
189 procedure SetEditorPanel(AValue: TWinControl);
190 protected
191 procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); override;
192 procedure DoEnter; override;
193 procedure DoExit; override;
194 procedure DoGridResize;
195 procedure DoEditorHide; override;
196 procedure DoEditorShow; override;
197 procedure DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; aText: String); override;
198 Function EditingAllowed(ACol : Integer = -1) : Boolean; override;
199 procedure EditorHide; override;
200 procedure IndicatorClicked(Button: TMouseButton; Shift:TShiftState); virtual;
201 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
202 procedure Loaded; override;
203 procedure DoOnResize; override;
204 function CreateColumns: TGridColumns; override;
205 procedure HeaderSized(IsColumn: Boolean; Index: Integer); override;
206 procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
207 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
208 procedure TopLeftChanged; override;
209 procedure UpdateActive; override;
210 procedure UpdateEditorPanelBounds;
211 procedure UpdateShowing; override;
212 public
213 procedure HideEditorPanel;
214 procedure ShowEditorPanel;
215 constructor Create(TheComponent: TComponent); override;
216 destructor Destroy ;override;
217 procedure ResizeColumns;
218 property VisibleRowCount;
219 published
220 property EditorPanel: TWinControl read FEditorPanel write SetEditorPanel;
221 property ExpandEditorPanelBelowRow: boolean read FExpandEditorPanelBelowRow write FExpandEditorPanelBelowRow;
222 property OnBeforeEditorHide: TNotifyEvent read FOnBeforeEditorHide write FOnBeforeEditorHide;
223 property OnEditorPanelShow: TNotifyEvent read FOnEditorPanelShow write FOnEditorPanelShow;
224 property OnEditorPanelHide: TNotifyEvent read FOnEditorPanelHide write FOnEditorPanelHide;
225 property OnKeyDownHander: TKeyDownHandler read FOnKeyDownHander write FOnKeyDownHander;
226 end;
227
228 {TIBGridControlLink}
229
230 TIBGridControlLink = class(TIBControlLink)
231 private
232 FOwner: TIBDynamicGrid;
233 protected
234 procedure UpdateSQL(Sender: TObject); override;
235 public
236 constructor Create(AOwner: TIBDynamicGrid);
237 end;
238
239 TLocationArray = array of variant;
240 PLocationArray = ^TLocationArray;
241 TOnRestorePosition = procedure(Sender: TObject; Location: PLocationArray) of object;
242
243 { TIBDynamicGrid }
244
245 TIBDynamicGrid = class(TDBDynamicGrid)
246 private
247 { Private declarations }
248 FAllowColumnSort: boolean;
249 FIBControlLink: TIBGridControlLink;
250 FOnColumnHeaderClick: TOnColumnHeaderClick;
251 FOnRestorePosition: TOnRestorePosition;
252 FOnUpdateSortOrder: TOnUpdateSortOrder;
253 FDefaultPositionAtEnd: boolean;
254 FDescending: boolean;
255 FColHeaderClick: boolean;
256 FLastColIndex: integer;
257 FIndexFieldNames: string;
258 FIndexFieldsList: TStringList;
259 FBookmark: TLocationArray;
260 FDBLookupCellEditor: TDBLookupCellEditor;
261 FActive: boolean;
262 procedure ColumnHeaderClick(Index: integer);
263 function GetDataSource: TDataSource;
264 function GetEditorBorderStyle: TBorderStyle;
265 procedure IBControlLinkChanged;
266 procedure SetDataSource(AValue: TDataSource);
267 procedure SetEditorBorderStyle(AValue: TBorderStyle);
268 procedure ProcessColumns;
269 procedure SetIndexFieldNames(AValue: string);
270 procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
271 procedure UpdateSortColumn(Sender: TObject);
272 procedure RestorePosition;
273 procedure SavePosition;
274 procedure DoReOpen(Data: PtrInt);
275 procedure SetupEditor(aEditor: TDBLookupCellEditor; aCol: integer);
276 protected
277 { Protected declarations }
278 procedure DoEditorHide; override;
279 procedure Loaded; override;
280 function CreateColumns: TGridColumns; override;
281 procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
282 procedure LinkActive(Value: Boolean); override;
283 procedure MoveSelection; override;
284 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
285 procedure UpdateActive; override;
286 public
287 { Public declarations }
288 constructor Create(TheComponent: TComponent); override;
289 destructor Destroy; override;
290 function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
291 property LastSortColumn: integer read FLastColIndex;
292 published
293 { Published declarations }
294 property AllowColumnSort: boolean read FAllowColumnSort write FAllowColumnSort default true;
295 property DataSource: TDataSource read GetDataSource write SetDataSource;
296 property Descending: boolean read FDescending write FDescending;
297 property EditorBorderStyle: TBorderStyle read GetEditorBorderStyle write SetEditorBorderStyle;
298 property DefaultPositionAtEnd: boolean read FDefaultPositionAtEnd write FDefaultPositionAtEnd;
299 property IndexFieldNames: string read FIndexFieldNames write SetIndexFieldNames;
300 property OnColumnHeaderClick: TOnColumnHeaderClick read FOnColumnHeaderClick write FOnColumnHeaderClick;
301 property OnRestorePosition: TOnRestorePosition read FOnRestorePosition write FOnRestorePosition;
302 property OnUpdateSortOrder: TOnUpdateSortOrder read FOnUpdateSortOrder write FOnUpdateSortOrder;
303 end;
304
305 implementation
306
307 uses Math, IBQuery, LCLType;
308
309 { TIBGridControlLink }
310
311 constructor TIBGridControlLink.Create(AOwner: TIBDynamicGrid);
312 begin
313 inherited Create;
314 FOwner := AOwner;
315 end;
316
317 procedure TIBGridControlLink.UpdateSQL(Sender: TObject);
318 begin
319 FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
320 end;
321
322 { TDBLookupProperties }
323
324 function TDBLookupProperties.GetAutoCompleteText: TComboBoxAutoCompleteText;
325 begin
326 Result := FAutoCompleteText;
327 if AutoComplete then
328 Result := Result + [cbactEnabled]
329 end;
330
331 procedure TDBLookupProperties.SetAutoCompleteText(
332 AValue: TComboBoxAutoCompleteText);
333 begin
334 if AValue <> AutoCompleteText then
335 begin
336 FAutoComplete := cbactEnabled in AValue;
337 FAutoCompleteText := AValue - [cbactEnabled]
338 end;
339 end;
340
341 constructor TDBLookupProperties.Create(aOwner: TIBDynamicGridColumn);
342 begin
343 inherited Create;
344 FOwner := aOwner;
345 FAutoInsert := true;
346 FAutoComplete := true;
347 FAutoCompleteText := DefaultComboBoxAutoCompleteText;
348 FKeyPressInterval := 500;
349 FListSource := nil;
350 FStyle := csDropDown;
351 end;
352
353 { TDBDynamicGrid }
354
355 procedure TDBDynamicGrid.DoGridResize;
356 var ColSum: integer;
357 ResizeColCount: integer;
358 I: integer;
359 adjustment: integer;
360 n: integer;
361 begin
362 if (csDesigning in ComponentState) or (Columns.Count = 0) then Exit;
363
364 FResizing := true;
365 try
366 ColSum := 0;
367
368 if (ColCount = 1) and TDBDynamicGridColumn(Columns[0]).AutoSizeColumn then
369 Columns[0].Width := ClientWidth
370 else
371 begin
372 for I := 0 to ColCount - 1 do
373 ColSum := ColSum + ColWidths[I];
374
375 if Colsum <> ClientWidth then
376 begin
377 ResizeColCount := 0;
378 for I := 0 to Columns.Count -1 do
379 if TDBDynamicGridColumn(Columns[I]).AutoSizeColumn then
380 begin
381 Inc(ResizeColCount);
382 Colsum := Colsum + TDBDynamicGridColumn(Columns[I]).DesignWidth - Columns[I].Width;
383 Columns[I].Width := TDBDynamicGridColumn(Columns[I]).DesignWidth;
384 end;
385
386 if (Colsum < ClientWidth) and (ResizeColCount > 0) then
387 begin
388 adjustment := (ClientWidth - ColSum) div ResizeColCount;
389 n := (ClientWidth - ColSum) mod ResizeColCount;
390
391 for I := 0 to Columns.Count -1 do
392 if TDBDynamicGridColumn(Columns[I]).AutoSizeColumn then
393 begin
394 if I = 0 then
395 Columns[I].Width := Columns[I].Width + adjustment + n
396 else
397 Columns[I].Width := Columns[I].Width + adjustment;
398 end;
399 end;
400 end;
401 end;
402 PositionTotals;
403 UpdateEditorPanelBounds;
404 finally
405 FResizing := false
406 end;
407 end;
408
409 procedure TDBDynamicGrid.DoEditorHide;
410 begin
411 inherited DoEditorHide;
412 if Editor = FEditorPanel then
413 begin
414 if FMouseDown then
415 Application.QueueAsyncCall(@PerformEditorHide,FExpandedRow)
416 else
417 PerformEditorHide(FExpandedRow);
418 FExpandedRow := -1;
419 end;
420 end;
421
422 procedure TDBDynamicGrid.DoEditorShow;
423 begin
424 if assigned(DataSource) and assigned(DataSource.DataSet) and
425 DataSource.DataSet.Active then
426 begin
427 if (DataSource.DataSet.RecordCount = 0) and (DataSource.DataSet.State <> dsInsert) then
428 DataSource.DataSet.Append
429 end;
430 if Editor = FEditorPanel then
431 begin
432 if ExpandEditorPanelBelowRow then
433 RowHeights[Row] := FEditorPanel.Height + DefaultRowHeight
434 else
435 RowHeights[Row] := FEditorPanel.Height;
436 FExpandedRow := Row;
437 inherited DoEditorShow;
438 UpdateEditorPanelBounds; {Position Editor Panel over expanded Row}
439 FEditorPanel.PerformTab(true); {Select First Control}
440 if assigned(FOnEditorPanelShow) then
441 OnEditorPanelShow(self);
442 if assigned(Editor) and Editor.Visible then
443 Editor.SetFocus;
444 end
445 else
446 inherited DoEditorShow;
447 end;
448
449 procedure TDBDynamicGrid.DrawCellText(aCol, aRow: Integer; aRect: TRect;
450 aState: TGridDrawState; aText: String);
451 var Style: TTextStyle;
452 OldStyle: TTextStyle;
453 begin
454 if ExpandEditorPanelBelowRow and assigned(FEditorPanel) and FEditorPanel.Visible and (aRow = FExpandedRow) then
455 begin
456 {Draw the text at the top of the cell}
457 Style := Canvas.TextStyle;
458 OldStyle := Style;
459 try
460 Style.Layout := tlTop;
461 Canvas.TextStyle := Style;
462 inherited DrawCellText(aCol, aRow, aRect, aState, aText);
463 finally
464 Canvas.TextStyle := OldStyle;
465 end;
466
467 end
468 else
469 inherited DrawCellText(aCol, aRow, aRect, aState, aText);
470 end;
471
472 function TDBDynamicGrid.EditingAllowed(ACol: Integer): Boolean;
473 begin
474 Result := ((FEditorPanel <> nil) and (FEditorPanel = Editor))
475 or inherited EditingAllowed(ACol);
476 end;
477
478 procedure TDBDynamicGrid.EditorHide;
479 begin
480 if assigned(FOnBeforeEditorHide) then
481 OnBeforeEditorHide(self);
482 inherited EditorHide;
483 end;
484
485 procedure TDBDynamicGrid.IndicatorClicked(Button: TMouseButton;
486 Shift: TShiftState);
487 begin
488 if assigned(FEditorPanel) then
489 begin
490 if FEditorPanel.Visible then
491 HideEditorPanel
492 else
493 ShowEditorPanel;
494 end;
495 end;
496
497 procedure TDBDynamicGrid.KeyDown(var Key: Word; Shift: TShiftState);
498 begin
499 if (Key = VK_F2) and (Shift = []) and assigned(FEditorPanel) then
500 begin
501 if not FEditorPanel.Visible then
502 ShowEditorPanel
503 end
504 else
505 inherited KeyDown(Key, Shift);
506 end;
507
508 function TDBDynamicGrid.ActiveControl: TControl;
509 var AParent: TWinControl;
510 begin
511 Result := nil;
512 AParent := Parent;
513 while (AParent <> nil) and not (AParent is TCustomForm) do
514 AParent := AParent.Parent;
515 if (AParent <> nil) and (AParent is TCustomForm)then
516 Result := TCustomForm(AParent).ActiveControl;
517 end;
518
519 procedure TDBDynamicGrid.DoShowEditorPanel(Data: PtrInt);
520 begin
521 if AppDestroying in Application.Flags then Exit;
522 ShowEditorPanel;
523 end;
524
525 procedure TDBDynamicGrid.PositionTotals;
526 var I: integer;
527 acol: TDBDynamicGridColumn;
528 LPos: integer;
529 begin
530 LPos := Left;
531 for I := 0 to FirstGridColumn - 1 do
532 LPos := LPos + ColWidths[I];
533
534 for I := 0 to Columns.Count - 1 do
535 begin
536 acol := TDBDynamicGridColumn(Columns[I]);
537 if assigned(acol.FColumnTotalsControl) then
538 begin
539 acol.FColumnTotalsControl.AutoSize := false;
540 acol.FColumnTotalsControl.Left := LPos;
541 acol.FColumnTotalsControl.Width := acol.Width
542 end;
543 LPos := LPos + acol.Width;
544 end;
545 end;
546
547 procedure TDBDynamicGrid.KeyDownHandler(Sender: TObject; var Key: Word;
548 Shift: TShiftState);
549 var Done: boolean;
550 AControl: TControl;
551 begin
552 if Visible and assigned(FEditorPanel) and FEditorPanel.Visible and FWeHaveFocus then
553 begin
554 Done := false;
555 AControl := ActiveControl;
556 if (AControl <> nil) and (AControl is TCustomComboBox)
557 and ((Key in [VK_UP,VK_DOWN]) or
558 (TCustomComboBox(AControl).DroppedDown and (Key = VK_RETURN)) or
559 ((TCustomComboBox(AControl).Text <> '') and (Key = VK_ESCAPE))) then
560 Exit; {ignore these keys if we are in a combobox}
561
562 if (AControl <> nil) and (AControl is TCustomMemo)
563 and (Key in [VK_RETURN,VK_UP,VK_DOWN]) then Exit; {Ignore Return in a CustomMemo}
564
565 if (AControl <> nil) and (AControl is TCustomGrid)
566 and (Key in [VK_RETURN,VK_UP,VK_DOWN,VK_TAB]) then Exit; {Ignore Return in a CustomMemo}
567
568 if assigned(FOnKeyDownHander) then
569 OnKeyDownHander(Sender,Key,Shift,Done);
570 if Done then Exit;
571
572 {Allow Scrolling}
573 if Key in [VK_UP,VK_DOWN] then
574 KeyDown(Key,Shift)
575 else
576 {Cancel Editor}
577 if Key = VK_ESCAPE then
578 begin
579 if DataLink.DataSet.State in [dsInsert,dsEdit] then
580 DataLink.DataSet.Cancel;
581 KeyDown(Key,Shift);
582 end
583 {save}
584 else
585 if Key = VK_F2 then
586 HideEditorPanel;
587 end
588 end;
589
590 procedure TDBDynamicGrid.PerformEditorHide(Data: PtrInt);
591 var ExpandedRow: integer;
592 begin
593 if AppDestroying in Application.Flags then Exit;
594 ExpandedRow := integer(Data);
595 if (ExpandedRow >= 0) and (ExpandedRow < RowCount) then
596 RowHeights[ExpandedRow] := DefaultRowHeight;
597 if CanFocus then SetFocus;
598 DoOnResize;
599 ResetSizes;
600 DoOnChangeBounds;
601 if assigned(FOnEditorPanelHide) then
602 OnEditorPanelHide(self);
603 end;
604
605 procedure TDBDynamicGrid.SetEditorPanel(AValue: TWinControl);
606 begin
607 if FEditorPanel = AValue then Exit;
608 if FEditorPanel <> nil then
609 RemoveFreeNotification(FEditorPanel);
610 FEditorPanel := AValue;
611 FreeNotification(FEditorPanel);
612 end;
613
614 procedure TDBDynamicGrid.ChangeBounds(ALeft, ATop, AWidth, AHeight: integer;
615 KeepBase: boolean);
616 begin
617 if assigned(FEditorPanel) and FEditorPanel.Visible then
618 Application.QueueAsyncCall(@DoShowEditorPanel,0); {Restore afterwards if necessary}
619 inherited ChangeBounds(ALeft, ATop, AWidth, AHeight, KeepBase);
620 end;
621
622 procedure TDBDynamicGrid.DoEnter;
623 begin
624 inherited DoEnter;
625 FWeHaveFocus := true;
626 end;
627
628 procedure TDBDynamicGrid.DoExit;
629 begin
630 FWeHaveFocus := false;
631 inherited DoExit;
632 end;
633
634 procedure TDBDynamicGrid.Loaded;
635 begin
636 inherited Loaded;
637 if assigned(FEditorPanel) and not (csDesigning in ComponentState)then
638 FEditorPanel.Visible := false;
639 if Visible then
640 DoGridResize
641 end;
642
643 procedure TDBDynamicGrid.DoOnResize;
644 begin
645 inherited DoOnResize;
646 DoGridResize
647 end;
648
649 function TDBDynamicGrid.CreateColumns: TGridColumns;
650 begin
651 result := TDBGridColumns.Create(Self, TDBDynamicGridColumn);
652 end;
653
654 procedure TDBDynamicGrid.HeaderSized(IsColumn: Boolean; Index: Integer);
655 begin
656 inherited HeaderSized(IsColumn, Index);
657 PositionTotals
658 end;
659
660 procedure TDBDynamicGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
661 Y: Integer);
662 var Coord: TGridCoord;
663 begin
664 FMouseDown := true;
665 try
666 inherited MouseDown(Button, Shift, X, Y);
667 finally
668 FMouseDown := false;
669 end;
670
671 Coord := MouseCoord(X,Y);
672 if (Coord.X = 0) and (Coord.Y > 0) then
673 IndicatorClicked(Button,Shift);
674 end;
675
676 procedure TDBDynamicGrid.Notification(AComponent: TComponent;
677 Operation: TOperation);
678 begin
679 inherited Notification(AComponent, Operation);
680 if (Operation = opRemove) and
681 (AComponent = FEditorPanel) then FEditorPanel := nil;
682 end;
683
684 procedure TDBDynamicGrid.TopLeftChanged;
685 begin
686 inherited TopLeftChanged;
687 UpdateEditorPanelBounds;
688 end;
689
690 procedure TDBDynamicGrid.UpdateActive;
691 begin
692 inherited UpdateActive;
693
694 if not (csLoading in ComponentState) and assigned(DataLink) and
695 assigned(FEditorPanel) and not FEditorPanel.Visible and
696 assigned(DataLink.DataSet) and (DataLink.DataSet.State = dsInsert) then
697 Application.QueueAsyncCall(@DoShowEditorPanel,0);
698 end;
699
700 procedure TDBDynamicGrid.UpdateEditorPanelBounds;
701 var R: TRect;
702 Dummy: integer;
703 begin
704 if assigned(FEditorPanel) and FEditorPanel.Visible and
705 (FExpandedRow >= 0) and (FExpandedRow < RowCount) then
706 begin
707 // Upper and Lower bounds for this row
708 ColRowToOffSet(False, True, FExpandedRow, R.Top, R.Bottom);
709 //Left Bound for visible Columns
710 ColRowToOffSet(True,True,1,R.Left,Dummy);
711 //Right Bound for visible columns
712 ColRowToOffSet(True,True,ColCount - 1,Dummy,R.Right);
713 if ExpandEditorPanelBelowRow then
714 R.Top := R.Top + DefaultRowHeight;
715 FEditorPanel.BoundsRect := R;
716 end;
717 end;
718
719 procedure TDBDynamicGrid.UpdateShowing;
720 begin
721 inherited UpdateShowing;
722 DoGridResize
723 end;
724
725 procedure TDBDynamicGrid.HideEditorPanel;
726 begin
727 if Editor = FEditorPanel then
728 EditorMode := false;
729 end;
730
731 procedure TDBDynamicGrid.ShowEditorPanel;
732 begin
733 if (csDesigning in ComponentState) or
734 (DataSource = nil) or (DataSource.DataSet = nil)
735 or ((DataSource.DataSet.RecordCount = 0) and (DataSource.DataSet.State <> dsInsert)) then
736 Exit;
737 Editor := FEditorPanel;
738 EditorMode := true;
739 end;
740
741 constructor TDBDynamicGrid.Create(TheComponent: TComponent);
742 begin
743 inherited Create(TheComponent);
744 ScrollBars := ssAutoVertical;
745 if not (csDesigning in ComponentState) then
746 Application.AddOnKeyDownBeforeHandler(@KeyDownHandler,false);
747 end;
748
749 destructor TDBDynamicGrid.Destroy;
750 begin
751 if not (csDesigning in ComponentState) then
752 Application.RemoveOnKeyDownBeforeHandler(@KeyDownHandler);
753 inherited Destroy;
754 end;
755
756 procedure TDBDynamicGrid.ResizeColumns;
757 begin
758 DoGridResize;
759 end;
760
761 { TDBDynamicGridColumn }
762
763 procedure TDBDynamicGridColumn.SetWidth(AValue: integer);
764 begin
765 if Width = AValue then Exit;
766 inherited Width := AValue;
767 if not TDBDynamicGrid(Grid).FResizing then
768 FDesignWidth := Width
769 end;
770
771 function TDBDynamicGridColumn.GetWidth: integer;
772 begin
773 Result := inherited Width
774 end;
775
776 { TDBLookupCellEditor }
777
778 procedure TDBLookupCellEditor.WndProc(var TheMessage: TLMessage);
779 begin
780 if TheMessage.msg=LM_KILLFOCUS then begin
781 if HWND(TheMessage.WParam) = HWND(Handle) then begin
782 // lost the focus but it returns to ourselves
783 // eat the message.
784 TheMessage.Result := 0;
785 exit;
786 end;
787 end;
788 inherited WndProc(TheMessage);
789 end;
790
791 procedure TDBLookupCellEditor.CloseUp;
792 begin
793 UpdateData(nil); {Force Record Update}
794 if FGrid<>nil then
795 Begin
796 (FGrid as TIBDynamicGrid).EditorTextChanged(FCol, FRow, Trim(Text));
797 (FGrid as TIBDynamicGrid).UpdateData;
798 end;
799 inherited CloseUp;
800 end;
801
802 procedure TDBLookupCellEditor.KeyDown(var Key: Word; Shift: TShiftState);
803 begin
804 if (Key = VK_TAB) and assigned(FGrid) then
805 TIBDynamicGrid(FGrid).KeyDown(Key,Shift)
806 else
807 inherited KeyDown(Key, Shift);
808 end;
809
810 procedure TDBLookupCellEditor.Loaded;
811 begin
812 inherited Loaded;
813 Text := '';
814 end;
815
816 procedure TDBLookupCellEditor.msg_GetValue(var Msg: TGridMessage);
817 begin
818 CheckAndInsert;
819 Msg.Col := FCol;
820 Msg.Row := FRow;
821 Msg.Value:= Trim(Text);
822 end;
823
824 procedure TDBLookupCellEditor.msg_SetGrid(var Msg: TGridMessage);
825 begin
826 FGrid:=Msg.Grid;
827 Msg.Options:=EO_AUTOSIZE or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
828 end;
829
830 procedure TDBLookupCellEditor.msg_SetValue(var Msg: TGridMessage);
831 begin
832 FGrid := Msg.Grid;
833 FCol := Msg.Col;
834 FRow := Msg.Row;
835 FEditText := Msg.Value;
836 TIBDynamicGrid(FGrid).SetupEditor(self,FCol);
837 end;
838
839 procedure TDBLookupCellEditor.msg_SetPos(var Msg: TGridMessage);
840 begin
841 FCol := Msg.Col;
842 FRow := Msg.Row;
843 end;
844
845 procedure TDBLookupCellEditor.msg_GetGrid(var Msg: TGridMessage);
846 begin
847 Msg.Grid := FGrid;
848 Msg.Options:= EO_IMPLEMENTED;
849 end;
850
851 procedure TDBLookupCellEditor.EditingDone;
852 begin
853 inherited EditingDone;
854 if FGrid<>nil then
855 FGrid.EditingDone;
856 end;
857
858 { TIBDynamicGridColumn }
859
860 procedure TIBDynamicGridColumn.DoSetupEditor(Data: PtrInt);
861 var Editor: TDBlookupCellEditor;
862 begin
863 if AppDestroying in Application.Flags then Exit;
864
865 Editor := TDBlookupCellEditor(Data);
866 Editor.DataSource := nil;
867 Editor.ListSource := nil; {Allows change without causing an error}
868 Editor.KeyValue := NULL;
869
870 with DBLookupProperties do
871 begin
872 {Setup Properties}
873 Editor.AutoInsert := AutoInsert;
874 Editor.AutoComplete := AutoComplete;
875 Editor.AutoCompleteText := AutoCompleteText;
876 Editor.KeyPressInterval := KeyPressInterval;
877 Editor.Style := Style;
878 Editor.ItemHeight := ItemHeight;
879 Editor.ItemWidth := ItemWidth;
880 Editor.RelationName := RelationName;
881 Editor.OnAutoInsert := OnAutoInsert;
882 Editor.OnCanAutoInsert := OnCanAutoInsert;
883 Editor.OnDrawItem := OnDrawItem;
884 Editor.OnCloseUp := OnCloseUp;
885
886 {Setup Data Links}
887 if KeyField <> '' then
888 Editor.KeyField := KeyField
889 else
890 Editor.KeyField := ListField;
891 Editor.ListField := ListField;
892 Editor.DataField := DataFieldName;
893 end;
894 Application.QueueAsyncCall(@DoSetDataSources,PtrInt(Editor));
895 end;
896
897 procedure TIBDynamicGridColumn.DoSetDataSources(Data: PtrInt);
898 var Editor: TDBlookupCellEditor;
899 begin
900 if AppDestroying in Application.Flags then Exit;
901
902 Editor := TDBlookupCellEditor(Data);
903 with DBLookupProperties do
904 begin
905 Editor.ListSource := ListSource;
906 if DataFieldName <> '' then
907 Editor.DataSource := TDBGrid(Grid).DataSource;
908 end;
909 Editor.Text := Editor.FEditText;
910 Editor.SelStart := Length(Editor.Text);
911 end;
912
913 procedure TIBDynamicGridColumn.SetInitialSortColumn(AValue: boolean);
914 begin
915 if FInitialSortColumn = AValue then Exit;
916 FInitialSortColumn := AValue;
917 (Grid as TIBDynamicGrid).UpdateSortColumn(self)
918 end;
919
920 procedure TIBDynamicGridColumn.SetupEditor(Editor: TDBlookupCellEditor);
921 begin
922 Application.QueueAsyncCall(@DoSetupEditor,PtrInt(Editor));
923 end;
924
925 constructor TIBDynamicGridColumn.Create(ACollection: TCollection);
926 begin
927 inherited Create(ACollection);
928 FDBLookupProperties := TDBLookupProperties.Create(self);
929 end;
930
931 destructor TIBDynamicGridColumn.Destroy;
932 begin
933 if assigned(FDBLookupProperties) then FDBLookupProperties.Free;
934 inherited Destroy;
935 end;
936
937
938 { TIBDynamicGrid }
939
940 procedure TIBDynamicGrid.ColumnHeaderClick(Index: integer);
941 begin
942 FColHeaderClick := true;
943 try
944 if Index = FLastColIndex then
945 FDescending := not FDescending;
946
947 if assigned(FOnColumnHeaderClick) then
948 OnColumnHeaderClick(self,Index);
949
950 FLastColIndex := Index;
951 if assigned(DataSource) and assigned(DataSource.DataSet) and DataSource.DataSet.Active then
952 begin
953 DataSource.DataSet.Active := false;
954 Application.QueueAsyncCall(@DoReopen,0)
955 end;
956 finally
957 FColHeaderClick := false
958 end;
959 end;
960
961 function TIBDynamicGrid.GetDataSource: TDataSource;
962 begin
963 if assigned(DataLink) then
964 Result := inherited DataSource
965 else
966 Result := nil;
967 end;
968
969 function TIBDynamicGrid.GetEditorBorderStyle: TBorderStyle;
970 begin
971 if Editor = FDBLookupCellEditor then
972 Result := FDBLookupCellEditor.BorderStyle
973 else
974 Result := inherited EditorBorderStyle
975 end;
976
977 procedure TIBDynamicGrid.SetDataSource(AValue: TDataSource);
978 begin
979 inherited DataSource := AValue;
980 IBControlLinkChanged;
981 end;
982
983 procedure TIBDynamicGrid.SetEditorBorderStyle(AValue: TBorderStyle);
984 begin
985 inherited EditorBorderStyle := AValue;
986 if FDBLookupCellEditor.BorderStyle <> AValue then
987 begin
988 FDBLookupCellEditor.BorderStyle := AValue;
989 if (Editor = FDBLookupCellEditor) and EditorMode then
990 EditorWidthChanged(Col,FDBLookupCellEditor.Width);
991 end;
992 end;
993
994 procedure TIBDynamicGrid.ProcessColumns;
995 var i: integer;
996 begin
997 for i := 0 to Columns.Count - 1 do
998 begin
999 if TIBDynamicGridColumn(columns[i]).InitialSortColumn then
1000 FLastColIndex := i
1001 end
1002 end;
1003
1004 procedure TIBDynamicGrid.SetIndexFieldNames(AValue: string);
1005 var idx: integer;
1006 begin
1007 if FIndexFieldNames = AValue then Exit;
1008 FIndexFieldNames := AValue;
1009 idx := 1;
1010 FIndexFieldsList.Clear;
1011 while idx <= Length(AValue) do
1012 FIndexFieldsList.Add(ExtractFieldName(AValue,idx));
1013 end;
1014
1015 procedure TIBDynamicGrid.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
1016 var OrderBy: string;
1017 FieldPosition: integer;
1018 begin
1019 if assigned(DataSource) and assigned(DataSource.DataSet)
1020 and (DataSource.DataSet is TIBCustomDataSet) then
1021 begin
1022 if (FLastColIndex < 0) or (FLastColIndex >= Columns.Count) then Exit;
1023 FieldPosition := Parser.GetFieldPosition(Columns[FLastColIndex].FieldName);
1024 if FieldPosition > 0 then
1025 begin
1026 if Descending then
1027 Parser.OrderByClause := IntToStr(FieldPosition) + ' desc'
1028 else
1029 Parser.OrderByClause := IntToStr(FieldPosition) + ' asc';
1030 end;
1031
1032 if assigned(FOnUpdateSortOrder) then
1033 begin
1034 OrderBy := Parser.OrderByClause;
1035 OnUpdateSortOrder(self,FLastColIndex,OrderBy);
1036 Parser.OrderByClause := OrderBy
1037 end
1038 end;
1039 end;
1040
1041 procedure TIBDynamicGrid.UpdateSortColumn(Sender: TObject);
1042 var i: integer;
1043 begin
1044 if Sender is TIBDynamicGridColumn then
1045 begin
1046 for i := 0 to Columns.Count -1 do
1047 if TObject(Columns[i]) <> Sender then
1048 TIBDynamicGridColumn(Columns[i]).InitialSortColumn := false
1049 end
1050
1051 end;
1052
1053 procedure TIBDynamicGrid.RestorePosition;
1054 begin
1055 if assigned(DataSource) and assigned(DataSource.DataSet) and DataSource.DataSet.Active then
1056 begin
1057 if assigned(FOnRestorePosition) then
1058 OnRestorePosition(self,@FBookmark);
1059 if (Length(FBookmark) > 0) and
1060 DataSource.DataSet.Locate(FIndexFieldNames,FBookmark,[]) then Exit;
1061
1062 if FDefaultPositionAtEnd then
1063 DataSource.DataSet.Last
1064 end;
1065 end;
1066
1067 procedure TIBDynamicGrid.SavePosition;
1068 var i: integer;
1069 F: TField;
1070 begin
1071 if FIndexFieldsList = nil then Exit;
1072
1073 SetLength(FBookmark,FIndexFieldsList.Count);
1074 for i := 0 to FIndexFieldsList.Count - 1 do
1075 begin
1076 F := DataSource.DataSet.FindField(FIndexFieldsList[i]);
1077 if assigned(F) then
1078 FBookmark[i] := F.AsVariant;
1079 end;
1080 end;
1081
1082 procedure TIBDynamicGrid.DoReOpen(Data: PtrInt);
1083 begin
1084 DataSource.DataSet.Active := true;
1085 end;
1086
1087 procedure TIBDynamicGrid.IBControlLinkChanged;
1088 begin
1089 if (DataSource <> nil) and (DataSource.DataSet <> nil) and (DataSource.DataSet is TIBParserDataSet) then
1090 FIBControlLink.IBDataSet := TIBCustomDataSet(DataSource.DataSet)
1091 else
1092 FIBControlLink.IBDataSet := nil;
1093 end;
1094
1095 procedure TIBDynamicGrid.SetupEditor(aEditor: TDBLookupCellEditor; aCol: integer
1096 );
1097 var C: TIBDynamicGridColumn;
1098 begin
1099 C := ColumnFromGridColumn(aCol) as TIBDynamicGridColumn;
1100 if (c <> nil) then
1101 C.SetupEditor(aEditor);
1102 end;
1103
1104 procedure TIBDynamicGrid.DoEditorHide;
1105 var i: integer;
1106 begin
1107 inherited DoEditorHide;
1108 if assigned(EditorPanel) then
1109 for i := 0 to EditorPanel.ControlCount -1 do
1110 if EditorPanel.Controls[i] is TIBLookupComboEditBox then
1111 EditorPanel.Controls[i].Perform(CM_VISIBLECHANGED, WParam(ord(false)), 0);
1112 end;
1113
1114 procedure TIBDynamicGrid.Loaded;
1115 begin
1116 inherited Loaded;
1117 IBControlLinkChanged;
1118 ProcessColumns;
1119 end;
1120
1121 function TIBDynamicGrid.CreateColumns: TGridColumns;
1122 begin
1123 result := TDBGridColumns.Create(Self, TIBDynamicGridColumn);
1124 end;
1125
1126 procedure TIBDynamicGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
1127 Y: Integer);
1128 var Coord: TGridCoord;
1129 obe: boolean;
1130 function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
1131
1132 begin
1133 PtInRect:=(p.y>=Rect.Top) and
1134 (p.y<Rect.Bottom) and
1135 (p.x>=Rect.Left) and
1136 (p.x<Rect.Right);
1137 end;
1138 begin
1139 if (Editor is TDBLookupCellEditor) and Editor.Visible
1140 and not PtInRect(Editor.BoundsRect,Point(X,Y)) then
1141 Editor.Perform(CM_EXIT,0,0); {Do insert new value if necessary}
1142 inherited MouseDown(Button, Shift, X, Y);
1143 obe := AllowOutboundEvents;
1144 AllowOutboundEvents := false;
1145 try
1146 Coord := MouseCoord(X,Y);
1147 if AllowColumnSort and (Coord.X <> -1) and (FixedRows > 0) and
1148 (Coord.Y = 0) and (MouseCoord(X+5,Y).X = Coord.X) {not on boundary}
1149 and (MouseCoord(X-5,Y).X = Coord.X) then
1150 ColumnHeaderClick(Coord.X-1);
1151 finally
1152 AllowOutboundEvents := obe
1153 end;
1154 end;
1155
1156 procedure TIBDynamicGrid.MoveSelection;
1157 begin
1158 inherited MoveSelection;
1159 SavePosition;
1160 end;
1161
1162 procedure TIBDynamicGrid.LinkActive(Value: Boolean);
1163 begin
1164 IBControlLinkChanged;
1165 inherited LinkActive(Value);
1166 if (FActive <> Value) and Value then
1167 RestorePosition;
1168 FActive := Value
1169 end;
1170
1171 procedure TIBDynamicGrid.Notification(AComponent: TComponent;
1172 Operation: TOperation);
1173 begin
1174 inherited Notification(AComponent, Operation);
1175 if (Operation = opRemove) and
1176 (FIBControlLink <> nil) and (AComponent = DataSource) then FIBControlLink.IBDataSet := nil;
1177 end;
1178
1179 procedure TIBDynamicGrid.UpdateActive;
1180 begin
1181 inherited UpdateActive;
1182 if assigned(DataLink) and assigned(DataLink.DataSet) and
1183 DataLink.DataSet.Active and (DataLink.DataSet.State = dsInsert) then
1184 SavePosition;
1185 end;
1186
1187 constructor TIBDynamicGrid.Create(TheComponent: TComponent);
1188 begin
1189 inherited Create(TheComponent);
1190 FAllowColumnSort := true;
1191 FIBControlLink := TIBGridControlLink.Create(self);
1192 FIndexFieldsList := TStringList.Create;
1193 FIndexFieldsList.Delimiter := ';';
1194 FIndexFieldsList.StrictDelimiter := true;
1195 FDBLookupCellEditor := TDBLookupCellEditor.Create(nil);
1196 FDBLookupCellEditor.Name := 'DBLookupCellEditor';
1197 FDBLookupCellEditor.Visible := False;
1198 FDBLookupCellEditor.AutoSize := false;
1199 end;
1200
1201 destructor TIBDynamicGrid.Destroy;
1202 begin
1203 if assigned(FIBControlLink) then FIBControlLink.Free;
1204 if assigned(FIndexFieldsList) then FIndexFieldsList.Free;
1205 if assigned(FDBLookupCellEditor) then FDBLookupCellEditor.Free;
1206 inherited Destroy;
1207 end;
1208
1209 function TIBDynamicGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
1210 var C: TIBDynamicGridColumn;
1211 bs: TColumnButtonStyle;
1212 begin
1213 C := ColumnFromGridColumn(Col) as TIBDynamicGridColumn;
1214 if C <> nil then
1215 begin
1216 bs := C.ButtonStyle;
1217 if (bs in [cbsAuto,cbsPickList]) and assigned(C.DBLookupProperties.ListSource) then
1218 begin
1219 Result := FDBLookupCellEditor;
1220 Exit;
1221 end;
1222 end;
1223 Result := inherited EditorByStyle(Style);
1224 end;
1225
1226 end.