source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntDBGrids.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 10 years ago

Adding source to tntControls for compilation

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.