source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntDBGrids.pas@ 1270

Last change on this file since 1270 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69
File size: 36.1 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntDBGrids;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19 Classes, TntClasses, Controls, Windows, Grids, DBGrids, Messages, DBCtrls, DB, TntStdCtrls;
20
21type
22{TNT-WARN TColumnTitle}
23 TTntColumnTitle = class(TColumnTitle{TNT-ALLOW TColumnTitle})
24 private
25 FCaption: WideString;
26 procedure SetInheritedCaption(const Value: AnsiString);
27 function GetCaption: WideString;
28 procedure SetCaption(const Value: WideString);
29 function IsCaptionStored: Boolean;
30 protected
31 procedure DefineProperties(Filer: TFiler); override;
32 public
33 procedure Assign(Source: TPersistent); override;
34 procedure RestoreDefaults; override;
35 function DefaultCaption: WideString;
36 published
37 property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
38 end;
39
40{TNT-WARN TColumn}
41type
42 TTntColumn = class(TColumn{TNT-ALLOW TColumn})
43 private
44 FWidePickList: TTntStrings;
45 function GetWidePickList: TTntStrings;
46 procedure SetWidePickList(const Value: TTntStrings);
47 procedure HandlePickListChange(Sender: TObject);
48 function GetTitle: TTntColumnTitle;
49 procedure SetTitle(const Value: TTntColumnTitle);
50 protected
51 procedure DefineProperties(Filer: TFiler); override;
52 function CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle}; override;
53 public
54 destructor Destroy; override;
55 property WidePickList: TTntStrings read GetWidePickList write SetWidePickList;
56 published
57{TNT-WARN PickList}
58 property PickList{TNT-ALLOW PickList}: TTntStrings read GetWidePickList write SetWidePickList;
59 property Title: TTntColumnTitle read GetTitle write SetTitle;
60 end;
61
62 { TDBGridInplaceEdit adds support for a button on the in-place editor,
63 which can be used to drop down a table-based lookup list, a stringlist-based
64 pick list, or (if button style is esEllipsis) fire the grid event
65 OnEditButtonClick. }
66
67type
68 TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit} = class(TInplaceEditList)
69 private
70 {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
71 FDataList: TDBLookupListBox; // 1st field - Delphi/BCB 6 TCustomDBGrid assumes this
72 FUseDataList: Boolean; // 2nd field - Delphi/BCB 6 TCustomDBGrid assumes this
73 {$ENDIF}
74 {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
75 FDataList: TDBLookupListBox; // 1st field - Delphi 7 TCustomDBGrid assumes this
76 FUseDataList: Boolean; // 2nd field - Delphi 7 TCustomDBGrid assumes this
77 {$ENDIF}
78 {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
79 FDataList: TDBLookupListBox; // 1st field - Delphi 9 TCustomDBGrid assumes this
80 FUseDataList: Boolean; // 2nd field - Delphi 9 TCustomDBGrid assumes this
81 {$ENDIF}
82 {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
83 FDataList: TDBLookupListBox; // 1st field - Delphi 10 TCustomDBGrid assumes this
84 FUseDataList: Boolean; // 2nd field - Delphi 10 TCustomDBGrid assumes this
85 {$ENDIF}
86 FLookupSource: TDatasource;
87 FWidePickListBox: TTntCustomListbox;
88 function GetWidePickListBox: TTntCustomListbox;
89 protected
90 procedure CloseUp(Accept: Boolean); override;
91 procedure DoEditButtonClick; override;
92 procedure DropDown; override;
93 procedure UpdateContents; override;
94 property UseDataList: Boolean read FUseDataList;
95 public
96 constructor Create(Owner: TComponent); override;
97 property DataList: TDBLookupListBox read FDataList;
98 property WidePickListBox: TTntCustomListbox read GetWidePickListBox;
99 end;
100
101type
102{TNT-WARN TDBGridInplaceEdit}
103 TTntDBGridInplaceEdit = class(TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit})
104 private
105 FInDblClick: Boolean;
106 FBlockSetText: Boolean;
107 procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
108 protected
109 function GetText: WideString; virtual;
110 procedure SetText(const Value: WideString); virtual;
111 protected
112 procedure CreateWindowHandle(const Params: TCreateParams); override;
113 procedure UpdateContents; override;
114 procedure DblClick; override;
115 public
116 property Text: WideString read GetText write SetText;
117 end;
118
119{TNT-WARN TDBGridColumns}
120 TTntDBGridColumns = class(TDBGridColumns{TNT-ALLOW TDBGridColumns})
121 private
122 function GetColumn(Index: Integer): TTntColumn;
123 procedure SetColumn(Index: Integer; const Value: TTntColumn);
124 public
125 function Add: TTntColumn;
126 property Items[Index: Integer]: TTntColumn read GetColumn write SetColumn; default;
127 end;
128
129 TTntGridDataLink = class(TGridDataLink)
130 private
131 OriginalSetText: TFieldSetTextEvent;
132 procedure GridUpdateFieldText(Sender: TField; const Text: AnsiString);
133 protected
134 procedure UpdateData; override;
135 procedure RecordChanged(Field: TField); override;
136 end;
137
138{TNT-WARN TCustomDBGrid}
139 TTntCustomDBGrid = class(TCustomDBGrid{TNT-ALLOW TCustomDBGrid})
140 private
141 FEditText: WideString;
142 function GetHint: WideString;
143 procedure SetHint(const Value: WideString);
144 function IsHintStored: Boolean;
145 procedure WMChar(var Msg: TWMChar); message WM_CHAR;
146 function GetColumns: TTntDBGridColumns;
147 procedure SetColumns(const Value: TTntDBGridColumns);
148 protected
149 procedure CreateWindowHandle(const Params: TCreateParams); override;
150 procedure ShowEditorChar(Ch: WideChar); dynamic;
151 procedure DefineProperties(Filer: TFiler); override;
152 function GetActionLinkClass: TControlActionLinkClass; override;
153 procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
154 function CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns}; override;
155 property Columns: TTntDBGridColumns read GetColumns write SetColumns;
156 function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
157 function CreateDataLink: TGridDataLink; override;
158 function GetEditText(ACol, ARow: Longint): WideString; reintroduce;
159 procedure DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
160 procedure SetEditText(ACol, ARow: Longint; const Value: AnsiString); override;
161 public
162 procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
163 Column: TTntColumn; State: TGridDrawState); dynamic;
164 procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
165 State: TGridDrawState);
166 published
167 property Hint: WideString read GetHint write SetHint stored IsHintStored;
168 end;
169
170{TNT-WARN TDBGrid}
171 TTntDBGrid = class(TTntCustomDBGrid)
172 public
173 property Canvas;
174 property SelectedRows;
175 published
176 property Align;
177 property Anchors;
178 property BiDiMode;
179 property BorderStyle;
180 property Color;
181 property Columns stored False; //StoreColumns;
182 property Constraints;
183 property Ctl3D;
184 property DataSource;
185 property DefaultDrawing;
186 property DragCursor;
187 property DragKind;
188 property DragMode;
189 property Enabled;
190 property FixedColor;
191 property Font;
192 property ImeMode;
193 property ImeName;
194 property Options;
195 property ParentBiDiMode;
196 property ParentColor;
197 property ParentCtl3D;
198 property ParentFont;
199 property ParentShowHint;
200 property PopupMenu;
201 property ReadOnly;
202 property ShowHint;
203 property TabOrder;
204 property TabStop;
205 property TitleFont;
206 property Visible;
207 property OnCellClick;
208 property OnColEnter;
209 property OnColExit;
210 property OnColumnMoved;
211 property OnDrawDataCell; { obsolete }
212 property OnDrawColumnCell;
213 property OnDblClick;
214 property OnDragDrop;
215 property OnDragOver;
216 property OnEditButtonClick;
217 property OnEndDock;
218 property OnEndDrag;
219 property OnEnter;
220 property OnExit;
221 property OnKeyDown;
222 property OnKeyPress;
223 property OnKeyUp;
224 {$IFDEF COMPILER_9_UP}
225 property OnMouseActivate;
226 {$ENDIF}
227 property OnMouseDown;
228 {$IFDEF COMPILER_10_UP}
229 property OnMouseEnter;
230 property OnMouseLeave;
231 {$ENDIF}
232 property OnMouseMove;
233 property OnMouseUp;
234 property OnMouseWheel;
235 property OnMouseWheelDown;
236 property OnMouseWheelUp;
237 property OnStartDock;
238 property OnStartDrag;
239 property OnTitleClick;
240 end;
241
242implementation
243
244uses
245 SysUtils, TntControls, Math, Variants, Forms,
246 TntGraphics, Graphics, TntDB, TntActnList, TntSysUtils, TntWindows;
247
248{ TTntColumnTitle }
249
250procedure TTntColumnTitle.DefineProperties(Filer: TFiler);
251begin
252 inherited;
253 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
254end;
255
256function TTntColumnTitle.DefaultCaption: WideString;
257var
258 Field: TField;
259begin
260 Field := Column.Field;
261 if Assigned(Field) then
262 Result := Field.DisplayName
263 else
264 Result := Column.FieldName;
265end;
266
267function TTntColumnTitle.IsCaptionStored: Boolean;
268begin
269 Result := (cvTitleCaption in Column.AssignedValues) and
270 (FCaption <> DefaultCaption);
271end;
272
273procedure TTntColumnTitle.SetInheritedCaption(const Value: AnsiString);
274begin
275 inherited Caption := Value;
276end;
277
278function TTntColumnTitle.GetCaption: WideString;
279begin
280 if cvTitleCaption in Column.AssignedValues then
281 Result := GetSyncedWideString(FCaption, inherited Caption)
282 else
283 Result := DefaultCaption;
284end;
285
286procedure TTntColumnTitle.SetCaption(const Value: WideString);
287begin
288 if not (Column as TTntColumn).IsStored then
289 inherited Caption := Value
290 else begin
291 if (cvTitleCaption in Column.AssignedValues) and (Value = FCaption) then Exit;
292 SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
293 end;
294end;
295
296procedure TTntColumnTitle.Assign(Source: TPersistent);
297begin
298 inherited Assign(Source);
299 if Source is TTntColumnTitle then
300 begin
301 if cvTitleCaption in TTntColumnTitle(Source).Column.AssignedValues then
302 Caption := TTntColumnTitle(Source).Caption;
303 end;
304end;
305
306procedure TTntColumnTitle.RestoreDefaults;
307begin
308 FCaption := '';
309 inherited;
310end;
311
312{ TTntColumn }
313
314procedure TTntColumn.DefineProperties(Filer: TFiler);
315begin
316 inherited;
317 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
318end;
319
320function TTntColumn.CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle};
321begin
322 Result := TTntColumnTitle.Create(Self);
323end;
324
325function TTntColumn.GetTitle: TTntColumnTitle;
326begin
327 Result := (inherited Title) as TTntColumnTitle;
328end;
329
330procedure TTntColumn.SetTitle(const Value: TTntColumnTitle);
331begin
332 inherited Title := Value;
333end;
334
335function TTntColumn.GetWidePickList: TTntStrings;
336begin
337 if FWidePickList = nil then begin
338 FWidePickList := TTntStringList.Create;
339 TTntStringList(FWidePickList).OnChange := HandlePickListChange;
340 end;
341 Result := FWidePickList;
342end;
343
344procedure TTntColumn.SetWidePickList(const Value: TTntStrings);
345begin
346 if Value = nil then
347 begin
348 FWidePickList.Free;
349 FWidePickList := nil;
350 (inherited PickList{TNT-ALLOW PickList}).Clear;
351 Exit;
352 end;
353 WidePickList.Assign(Value);
354end;
355
356procedure TTntColumn.HandlePickListChange(Sender: TObject);
357begin
358 inherited PickList{TNT-ALLOW PickList}.Assign(WidePickList);
359end;
360
361destructor TTntColumn.Destroy;
362begin
363 inherited;
364 FWidePickList.Free;
365end;
366
367{ TTntPopupListbox }
368type
369 TTntPopupListbox = class(TTntCustomListbox)
370 private
371 FSearchText: WideString;
372 FSearchTickCount: Longint;
373 protected
374 procedure CreateParams(var Params: TCreateParams); override;
375 procedure CreateWnd; override;
376 procedure WMChar(var Message: TWMChar); message WM_CHAR;
377 procedure KeyPressW(var Key: WideChar);
378 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
379 end;
380
381procedure TTntPopupListbox.CreateParams(var Params: TCreateParams);
382begin
383 inherited CreateParams(Params);
384 with Params do
385 begin
386 Style := Style or WS_BORDER;
387 ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
388 AddBiDiModeExStyle(ExStyle);
389 WindowClass.Style := CS_SAVEBITS;
390 end;
391end;
392
393procedure TTntPopupListbox.CreateWnd;
394begin
395 inherited CreateWnd;
396 Windows.SetParent(Handle, 0);
397 CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
398end;
399
400procedure TTntPopupListbox.WMChar(var Message: TWMChar);
401var
402 Key: WideChar;
403begin
404 Key := GetWideCharFromWMCharMsg(Message);
405 KeyPressW(Key);
406 SetWideCharForWMCharMsg(Message, Key);
407 inherited;
408end;
409
410procedure TTntPopupListbox.KeypressW(var Key: WideChar);
411var
412 TickCount: Integer;
413begin
414 case Key of
415 #8, #27: FSearchText := '';
416 #32..High(WideChar):
417 begin
418 TickCount := GetTickCount;
419 if TickCount - FSearchTickCount > 2000 then FSearchText := '';
420 FSearchTickCount := TickCount;
421 if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
422 if IsWindowUnicode(Handle) then
423 SendMessageW(Handle, LB_SelectString, WORD(-1), Longint(PWideChar(FSearchText)))
424 else
425 SendMessageA(Handle, LB_SelectString, WORD(-1), Longint(PAnsiChar(AnsiString(FSearchText))));
426 Key := #0;
427 end;
428 end;
429end;
430
431procedure TTntPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
432 X, Y: Integer);
433begin
434 inherited MouseUp(Button, Shift, X, Y);
435 (Owner as TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}).CloseUp((X >= 0) and (Y >= 0) and
436 (X < Width) and (Y < Height));
437end;
438
439{ TTntPopupDataList }
440type
441 TTntPopupDataList = class(TPopupDataList)
442 protected
443 procedure Paint; override;
444 end;
445
446procedure TTntPopupDataList.Paint;
447var
448 FRecordIndex: Integer;
449 FRecordCount: Integer;
450 FKeySelected: Boolean;
451 FKeyField: TField;
452
453 procedure UpdateListVars;
454 begin
455 if ListActive then
456 begin
457 FRecordIndex := ListLink.ActiveRecord;
458 FRecordCount := ListLink.RecordCount;
459 FKeySelected := not VarIsNull(KeyValue) or
460 not ListLink.DataSet.BOF;
461 end else
462 begin
463 FRecordIndex := 0;
464 FRecordCount := 0;
465 FKeySelected := False;
466 end;
467
468 FKeyField := nil;
469 if ListLink.Active and (KeyField <> '') then
470 FKeyField := GetFieldProperty(ListLink.DataSet, Self, KeyField);
471 end;
472
473 function VarEquals(const V1, V2: Variant): Boolean;
474 begin
475 Result := False;
476 try
477 Result := V1 = V2;
478 except
479 end;
480 end;
481
482var
483 I, J, W, X, TxtWidth, TxtHeight, LastFieldIndex: Integer;
484 S: WideString;
485 R: TRect;
486 Selected: Boolean;
487 Field: TField;
488 AAlignment: TAlignment;
489begin
490 UpdateListVars;
491 Canvas.Font := Font;
492 TxtWidth := WideCanvasTextWidth(Canvas, '0');
493 TxtHeight := WideCanvasTextHeight(Canvas, '0');
494 LastFieldIndex := ListFields.Count - 1;
495 if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
496 Canvas.Pen.Color := clBtnFace else
497 Canvas.Pen.Color := clBtnShadow;
498 for I := 0 to RowCount - 1 do
499 begin
500 if Enabled then
501 Canvas.Font.Color := Font.Color else
502 Canvas.Font.Color := clGrayText;
503 Canvas.Brush.Color := Color;
504 Selected := not FKeySelected and (I = 0);
505 R.Top := I * TxtHeight;
506 R.Bottom := R.Top + TxtHeight;
507 if I < FRecordCount then
508 begin
509 ListLink.ActiveRecord := I;
510 if not VarIsNull(KeyValue) and
511 VarEquals(FKeyField.Value, KeyValue) then
512 begin
513 Canvas.Font.Color := clHighlightText;
514 Canvas.Brush.Color := clHighlight;
515 Selected := True;
516 end;
517 R.Right := 0;
518 for J := 0 to LastFieldIndex do
519 begin
520 Field := ListFields[J];
521 if J < LastFieldIndex then
522 W := Field.DisplayWidth * TxtWidth + 4 else
523 W := ClientWidth - R.Right;
524 S := GetWideDisplayText(Field);
525 X := 2;
526 AAlignment := Field.Alignment;
527 if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
528 case AAlignment of
529 taRightJustify: X := W - WideCanvasTextWidth(Canvas, S) - 3;
530 taCenter: X := (W - WideCanvasTextWidth(Canvas, S)) div 2;
531 end;
532 R.Left := R.Right;
533 R.Right := R.Right + W;
534 if SysLocale.MiddleEast then TControlCanvas(Canvas).UpdateTextFlags;
535 WideCanvasTextRect(Canvas, R, R.Left + X, R.Top, S);
536 if J < LastFieldIndex then
537 begin
538 Canvas.MoveTo(R.Right, R.Top);
539 Canvas.LineTo(R.Right, R.Bottom);
540 Inc(R.Right);
541 if R.Right >= ClientWidth then Break;
542 end;
543 end;
544 end;
545 R.Left := 0;
546 R.Right := ClientWidth;
547 if I >= FRecordCount then Canvas.FillRect(R);
548 if Selected then
549 Canvas.DrawFocusRect(R);
550 end;
551 if FRecordCount <> 0 then ListLink.ActiveRecord := FRecordIndex;
552end;
553
554//-----------------------------------------------------------------------------------------
555// TDBGridInplaceEdit - Delphi 6 and higher
556//-----------------------------------------------------------------------------------------
557
558constructor TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.Create(Owner: TComponent);
559begin
560 inherited Create(Owner);
561 FLookupSource := TDataSource.Create(Self);
562end;
563
564function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.GetWidePickListBox: TTntCustomListBox;
565var
566 PopupListbox: TTntPopupListbox;
567begin
568 if not Assigned(FWidePickListBox) then
569 begin
570 PopupListbox := TTntPopupListbox.Create(Self);
571 PopupListbox.Visible := False;
572 PopupListbox.Parent := Self;
573 PopupListbox.OnMouseUp := ListMouseUp;
574 PopupListbox.IntegralHeight := True;
575 PopupListbox.ItemHeight := 11;
576 FWidePickListBox := PopupListBox;
577 end;
578 Result := FWidePickListBox;
579end;
580
581procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.CloseUp(Accept: Boolean);
582var
583 MasterField: TField;
584 ListValue: Variant;
585begin
586 if ListVisible then
587 begin
588 if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
589 if ActiveList = DataList then
590 ListValue := DataList.KeyValue
591 else
592 if WidePickListBox.ItemIndex <> -1 then
593 ListValue := WidePickListBox.Items[WidePickListBox.ItemIndex];
594 SetWindowPos(ActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
595 SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
596 ListVisible := False;
597 if Assigned(FDataList) then
598 FDataList.ListSource := nil;
599 FLookupSource.Dataset := nil;
600 Invalidate;
601 if Accept then
602 if ActiveList = DataList then
603 with Grid as TTntCustomDBGrid, Columns[SelectedIndex].Field do
604 begin
605 MasterField := DataSet.FieldByName(KeyFields);
606 if MasterField.CanModify and DataLink.Edit then
607 MasterField.Value := ListValue;
608 end
609 else
610 if (not VarIsNull(ListValue)) and EditCanModify then
611 with Grid as TTntCustomDBGrid do
612 SetWideText(Columns[SelectedIndex].Field, ListValue)
613 end;
614end;
615
616procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DoEditButtonClick;
617begin
618 (Grid as TTntCustomDBGrid).EditButtonClick;
619end;
620
621type TAccessTntCustomListbox = class(TTntCustomListbox);
622
623procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DropDown;
624var
625 Column: TTntColumn;
626 I, J, Y: Integer;
627begin
628 if not ListVisible then
629 begin
630 with (Grid as TTntCustomDBGrid) do
631 Column := Columns[SelectedIndex] as TTntColumn;
632 if ActiveList = FDataList then
633 with Column.Field do
634 begin
635 FDataList.Color := Color;
636 FDataList.Font := Font;
637 FDataList.RowCount := Column.DropDownRows;
638 FLookupSource.DataSet := LookupDataSet;
639 FDataList.KeyField := LookupKeyFields;
640 FDataList.ListField := LookupResultField;
641 FDataList.ListSource := FLookupSource;
642 FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
643 end
644 else if ActiveList = WidePickListBox then
645 begin
646 WidePickListBox.Items.Assign(Column.WidePickList);
647 DropDownRows := Column.DropDownRows;
648 // this is needed as inherited doesn't know about our WidePickListBox
649 if (DropDownRows > 0) and (WidePickListBox.Items.Count >= DropDownRows) then
650 WidePickListBox.Height := DropDownRows * TAccessTntCustomListbox(WidePickListBox as TTntCustomListbox).ItemHeight + 4
651 else
652 WidePickListBox.Height := WidePickListBox.Items.Count * TAccessTntCustomListbox(WidePickListBox as TTntCustomListbox).ItemHeight + 4;
653 if Text = '' then
654 WidePickListBox.ItemIndex := -1
655 else
656 WidePickListBox.ItemIndex := WidePickListBox.Items.IndexOf(Text);
657 J := WidePickListBox.ClientWidth;
658 for I := 0 to WidePickListBox.Items.Count - 1 do
659 begin
660 Y := WideCanvasTextWidth(WidePickListBox.Canvas, WidePickListBox.Items[I]);
661 if Y > J then J := Y;
662 end;
663 WidePickListBox.ClientWidth := J;
664 end;
665 end;
666 inherited DropDown;
667end;
668
669procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.UpdateContents;
670var
671 Column: TTntColumn;
672begin
673 inherited UpdateContents;
674 if EditStyle = esPickList then
675 ActiveList := WidePickListBox;
676 if FUseDataList then
677 begin
678 if FDataList = nil then
679 begin
680 FDataList := TTntPopupDataList.Create(Self);
681 FDataList.Visible := False;
682 FDataList.Parent := Self;
683 FDataList.OnMouseUp := ListMouseUp;
684 end;
685 ActiveList := FDataList;
686 end;
687 with (Grid as TTntCustomDBGrid) do
688 Column := Columns[SelectedIndex] as TTntColumn;
689 Self.ReadOnly := Column.ReadOnly;
690 Font.Assign(Column.Font);
691 ImeMode := Column.ImeMode;
692 ImeName := Column.ImeName;
693end;
694
695//-----------------------------------------------------------------------------------------
696
697{ TTntDBGridInplaceEdit }
698
699procedure TTntDBGridInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
700begin
701 TntCustomEdit_CreateWindowHandle(Self, Params);
702end;
703
704function TTntDBGridInplaceEdit.GetText: WideString;
705begin
706 Result := TntControl_GetText(Self);
707end;
708
709procedure TTntDBGridInplaceEdit.SetText(const Value: WideString);
710begin
711 TntControl_SetText(Self, Value);
712end;
713
714procedure TTntDBGridInplaceEdit.WMSetText(var Message: TWMSetText);
715begin
716 if (not FBlockSetText) then
717 inherited;
718end;
719
720procedure TTntDBGridInplaceEdit.UpdateContents;
721var
722 Grid: TTntCustomDBGrid;
723begin
724 Grid := Self.Grid as TTntCustomDBGrid;
725 EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
726 Text := Grid.GetEditText(Grid.Col, Grid.Row);
727 MaxLength := Grid.GetEditLimit;
728
729 FBlockSetText := True;
730 try
731 inherited;
732 finally
733 FBlockSetText := False;
734 end;
735end;
736
737procedure TTntDBGridInplaceEdit.DblClick;
738begin
739 FInDblClick := True;
740 try
741 inherited;
742 finally
743 FInDblClick := False;
744 end;
745end;
746
747{ TTntGridDataLink }
748
749procedure TTntGridDataLink.GridUpdateFieldText(Sender: TField; const Text: AnsiString);
750begin
751 Sender.OnSetText := OriginalSetText;
752 if Assigned(Sender) then
753 SetWideText(Sender, (Grid as TTntCustomDBGrid).FEditText);
754end;
755
756procedure TTntGridDataLink.RecordChanged(Field: TField);
757var
758 CField: TField;
759begin
760 inherited;
761 if Grid.HandleAllocated then begin
762 CField := Grid.SelectedField;
763 if ((Field = nil) or (CField = Field)) and
764 (Assigned(CField) and (GetWideText(CField) <> (Grid as TTntCustomDBGrid).FEditText)) then
765 begin
766 with (Grid as TTntCustomDBGrid) do begin
767 InvalidateEditor;
768 if InplaceEditor <> nil then InplaceEditor.Deselect;
769 end;
770 end;
771 end;
772end;
773
774procedure TTntGridDataLink.UpdateData;
775var
776 Field: TField;
777begin
778 Field := (Grid as TTntCustomDBGrid).SelectedField;
779 // remember "set text"
780 if Field <> nil then
781 OriginalSetText := Field.OnSetText;
782 try
783 // redirect "set text" to self
784 if Field <> nil then
785 Field.OnSetText := GridUpdateFieldText;
786 inherited; // clear modified !
787 finally
788 // redirect "set text" to field
789 if Field <> nil then
790 Field.OnSetText := OriginalSetText;
791 // forget original "set text"
792 OriginalSetText := nil;
793 end;
794end;
795
796{ TTntDBGridColumns }
797
798function TTntDBGridColumns.Add: TTntColumn;
799begin
800 Result := inherited Add as TTntColumn;
801end;
802
803function TTntDBGridColumns.GetColumn(Index: Integer): TTntColumn;
804begin
805 Result := inherited Items[Index] as TTntColumn;
806end;
807
808procedure TTntDBGridColumns.SetColumn(Index: Integer; const Value: TTntColumn);
809begin
810 inherited Items[Index] := Value;
811end;
812
813{ TTntCustomDBGrid }
814
815procedure TTntCustomDBGrid.CreateWindowHandle(const Params: TCreateParams);
816begin
817 CreateUnicodeHandle(Self, Params, '');
818end;
819
820type TAccessCustomGrid = class(TCustomGrid);
821
822procedure TTntCustomDBGrid.WMChar(var Msg: TWMChar);
823begin
824 if (goEditing in TAccessCustomGrid(Self).Options)
825 and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
826 RestoreWMCharMsg(TMessage(Msg));
827 ShowEditorChar(WideChar(Msg.CharCode));
828 end else
829 inherited;
830end;
831
832procedure TTntCustomDBGrid.ShowEditorChar(Ch: WideChar);
833begin
834 ShowEditor;
835 if InplaceEditor <> nil then begin
836 if Win32PlatformIsUnicode then
837 PostMessageW(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0)
838 else
839 PostMessageA(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0);
840 end;
841end;
842
843procedure TTntCustomDBGrid.DefineProperties(Filer: TFiler);
844begin
845 inherited;
846 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
847end;
848
849function TTntCustomDBGrid.IsHintStored: Boolean;
850begin
851 Result := TntControl_IsHintStored(Self);
852end;
853
854function TTntCustomDBGrid.GetHint: WideString;
855begin
856 Result := TntControl_GetHint(Self)
857end;
858
859procedure TTntCustomDBGrid.SetHint(const Value: WideString);
860begin
861 TntControl_SetHint(Self, Value);
862end;
863
864function TTntCustomDBGrid.CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns};
865begin
866 Result := TTntDBGridColumns.Create(Self, TTntColumn);
867end;
868
869function TTntCustomDBGrid.GetColumns: TTntDBGridColumns;
870begin
871 Result := inherited Columns as TTntDBGridColumns;
872end;
873
874procedure TTntCustomDBGrid.SetColumns(const Value: TTntDBGridColumns);
875begin
876 inherited Columns := Value;
877end;
878
879function TTntCustomDBGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
880begin
881 Result := TTntDBGridInplaceEdit.Create(Self);
882end;
883
884function TTntCustomDBGrid.CreateDataLink: TGridDataLink;
885begin
886 Result := TTntGridDataLink.Create(Self);
887end;
888
889function TTntCustomDBGrid.GetEditText(ACol, ARow: Integer): WideString;
890var
891 Field: TField;
892begin
893 Field := GetColField(RawToDataColumn(ACol));
894 if Field = nil then
895 Result := ''
896 else
897 Result := GetWideText(Field);
898 FEditText := Result;
899end;
900
901procedure TTntCustomDBGrid.SetEditText(ACol, ARow: Integer; const Value: AnsiString);
902begin
903 if (InplaceEditor as TTntDBGridInplaceEdit).FInDblClick then
904 FEditText := Value
905 else
906 FEditText := (InplaceEditor as TTntDBGridInplaceEdit).Text;
907 inherited;
908end;
909
910//----------------- DRAW CELL PROCS --------------------------------------------------
911var
912 DrawBitmap: TBitmap = nil;
913
914procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
915 const Text: WideString; Alignment: TAlignment; ARightToLeft: Boolean);
916const
917 AlignFlags : array [TAlignment] of Integer =
918 ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
919 DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
920 DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
921 RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
922var
923 B, R: TRect;
924 Hold, Left: Integer;
925 I: TColorRef;
926begin
927 I := ColorToRGB(ACanvas.Brush.Color);
928 if GetNearestColor(ACanvas.Handle, I) = I then
929 begin { Use ExtTextOutW for solid colors }
930 { In BiDi, because we changed the window origin, the text that does not
931 change alignment, actually gets its alignment changed. }
932 if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
933 ChangeBiDiModeAlignment(Alignment);
934 case Alignment of
935 taLeftJustify:
936 Left := ARect.Left + DX;
937 taRightJustify:
938 Left := ARect.Right - WideCanvasTextWidth(ACanvas, Text) - 3;
939 else { taCenter }
940 Left := ARect.Left + (ARect.Right - ARect.Left) div 2
941 - (WideCanvasTextWidth(ACanvas, Text) div 2);
942 end;
943 WideCanvasTextRect(ACanvas, ARect, Left, ARect.Top + DY, Text);
944 end
945 else begin { Use FillRect and Drawtext for dithered colors }
946 DrawBitmap.Canvas.Lock;
947 try
948 with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
949 begin { brush origin tics in painting / scrolling. }
950 Width := Max(Width, Right - Left);
951 Height := Max(Height, Bottom - Top);
952 R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
953 B := Rect(0, 0, Right - Left, Bottom - Top);
954 end;
955 with DrawBitmap.Canvas do
956 begin
957 Font := ACanvas.Font;
958 Font.Color := ACanvas.Font.Color;
959 Brush := ACanvas.Brush;
960 Brush.Style := bsSolid;
961 FillRect(B);
962 SetBkMode(Handle, TRANSPARENT);
963 if (ACanvas.CanvasOrientation = coRightToLeft) then
964 ChangeBiDiModeAlignment(Alignment);
965 Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), R,
966 AlignFlags[Alignment] or RTL[ARightToLeft]);
967 end;
968 if (ACanvas.CanvasOrientation = coRightToLeft) then
969 begin
970 Hold := ARect.Left;
971 ARect.Left := ARect.Right;
972 ARect.Right := Hold;
973 end;
974 ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
975 finally
976 DrawBitmap.Canvas.Unlock;
977 end;
978 end;
979end;
980
981procedure TTntCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
982 State: TGridDrawState);
983var
984 Alignment: TAlignment;
985 Value: WideString;
986begin
987 Alignment := taLeftJustify;
988 Value := '';
989 if Assigned(Field) then
990 begin
991 Alignment := Field.Alignment;
992 Value := GetWideDisplayText(Field);
993 end;
994 WriteText(Canvas, Rect, 2, 2, Value, Alignment,
995 UseRightToLeftAlignmentForField(Field, Alignment));
996end;
997
998procedure TTntCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
999 DataCol: Integer; Column: TTntColumn; State: TGridDrawState);
1000var
1001 Value: WideString;
1002begin
1003 Value := '';
1004 if Assigned(Column.Field) then
1005 Value := GetWideDisplayText(Column.Field);
1006 WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment,
1007 UseRightToLeftAlignmentForField(Column.Field, Column.Alignment));
1008end;
1009
1010procedure TTntCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
1011var
1012 FrameOffs: Byte;
1013
1014 procedure DrawTitleCell(ACol, ARow: Integer; Column: TTntColumn; var AState: TGridDrawState);
1015 const
1016 ScrollArrows: array [Boolean, Boolean] of Integer =
1017 ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
1018 var
1019 MasterCol: TColumn{TNT-ALLOW TColumn};
1020 TitleRect, TxtRect, ButtonRect: TRect;
1021 I: Integer;
1022 InBiDiMode: Boolean;
1023 begin
1024 TitleRect := CalcTitleRect(Column, ARow, MasterCol);
1025
1026 if MasterCol = nil then
1027 begin
1028 Canvas.FillRect(ARect);
1029 Exit;
1030 end;
1031
1032 Canvas.Font := MasterCol.Title.Font;
1033 Canvas.Brush.Color := MasterCol.Title.Color;
1034 if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
1035 InflateRect(TitleRect, -1, -1);
1036 TxtRect := TitleRect;
1037 I := GetSystemMetrics(SM_CXHSCROLL);
1038 if ((TxtRect.Right - TxtRect.Left) > I) and MasterCol.Expandable then
1039 begin
1040 Dec(TxtRect.Right, I);
1041 ButtonRect := TitleRect;
1042 ButtonRect.Left := TxtRect.Right;
1043 I := SaveDC(Canvas.Handle);
1044 try
1045 Canvas.FillRect(ButtonRect);
1046 InflateRect(ButtonRect, -1, -1);
1047 IntersectClipRect(Canvas.Handle, ButtonRect.Left,
1048 ButtonRect.Top, ButtonRect.Right, ButtonRect.Bottom);
1049 InflateRect(ButtonRect, 1, 1);
1050 { DrawFrameControl doesn't draw properly when orienatation has changed.
1051 It draws as ExtTextOutW does. }
1052 InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
1053 if InBiDiMode then { stretch the arrows box }
1054 Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
1055 DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
1056 ScrollArrows[InBiDiMode, MasterCol.Expanded] or DFCS_FLAT);
1057 finally
1058 RestoreDC(Canvas.Handle, I);
1059 end;
1060 end;
1061 with (MasterCol.Title as TTntColumnTitle) do
1062 WriteText(Canvas, TxtRect, FrameOffs, FrameOffs, Caption, Alignment, IsRightToLeft);
1063 if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
1064 begin
1065 InflateRect(TitleRect, 1, 1);
1066 DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
1067 DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
1068 end;
1069 AState := AState - [gdFixed]; // prevent box drawing later
1070 end;
1071
1072var
1073 OldActive: Integer;
1074 Highlight: Boolean;
1075 Value: WideString;
1076 DrawColumn: TTntColumn;
1077begin
1078 if csLoading in ComponentState then
1079 begin
1080 Canvas.Brush.Color := Color;
1081 Canvas.FillRect(ARect);
1082 Exit;
1083 end;
1084
1085 if (gdFixed in AState) and (RawToDataColumn(ACol) < 0) then
1086 begin
1087 inherited;
1088 exit;
1089 end;
1090
1091 Dec(ARow, FixedRows);
1092 ACol := RawToDataColumn(ACol);
1093
1094 if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
1095 [dgRowLines, dgColLines]) then
1096 begin
1097 InflateRect(ARect, -1, -1);
1098 FrameOffs := 1;
1099 end
1100 else
1101 FrameOffs := 2;
1102
1103 with Canvas do
1104 begin
1105 DrawColumn := Columns[ACol] as TTntColumn;
1106 if not DrawColumn.Showing then Exit;
1107 if not (gdFixed in AState) then
1108 begin
1109 Font := DrawColumn.Font;
1110 Brush.Color := DrawColumn.Color;
1111 end;
1112 if ARow < 0 then
1113 DrawTitleCell(ACol, ARow + FixedRows, DrawColumn, AState)
1114 else if (DataLink = nil) or not DataLink.Active then
1115 FillRect(ARect)
1116 else
1117 begin
1118 Value := '';
1119 OldActive := DataLink.ActiveRecord;
1120 try
1121 DataLink.ActiveRecord := ARow;
1122 if Assigned(DrawColumn.Field) then
1123 Value := GetWideDisplayText(DrawColumn.Field);
1124 Highlight := HighlightCell(ACol, ARow, Value, AState);
1125 if Highlight then
1126 begin
1127 Brush.Color := clHighlight;
1128 Font.Color := clHighlightText;
1129 end;
1130 if not Enabled then
1131 Font.Color := clGrayText;
1132 if DefaultDrawing then
1133 DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);
1134 if Columns.State = csDefault then
1135 DrawDataCell(ARect, DrawColumn.Field, AState);
1136 DrawColumnCell(ARect, ACol, DrawColumn, AState);
1137 finally
1138 DataLink.ActiveRecord := OldActive;
1139 end;
1140 if DefaultDrawing and (gdSelected in AState)
1141 and ((dgAlwaysShowSelection in Options) or Focused)
1142 and not (csDesigning in ComponentState)
1143 and not (dgRowSelect in Options)
1144 and (UpdateLock = 0)
1145 and (ValidParentForm(Self).ActiveControl = Self) then
1146 Windows.DrawFocusRect(Handle, ARect);
1147 end;
1148 end;
1149 if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
1150 [dgRowLines, dgColLines]) then
1151 begin
1152 InflateRect(ARect, 1, 1);
1153 DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
1154 DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
1155 end;
1156end;
1157
1158procedure TTntCustomDBGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1159begin
1160 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1161 inherited;
1162end;
1163
1164function TTntCustomDBGrid.GetActionLinkClass: TControlActionLinkClass;
1165begin
1166 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1167end;
1168
1169initialization
1170 DrawBitmap := TBitmap.Create;
1171
1172finalization
1173 DrawBitmap.Free;
1174
1175end.
Note: See TracBrowser for help on using the repository browser.