Source/TntDBGrids.pas

   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
  12 unit TntDBGrids;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Classes, TntClasses, Controls, Windows, Grids, DBGrids, Messages, DBCtrls, DB, TntStdCtrls;
  20
  21 type
  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}
  41 type
  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
  67 type
  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
 101 type
 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
 242 implementation
 243
 244 uses
 245   SysUtils, TntControls, Math, Variants, Forms,
 246   TntGraphics, Graphics, TntDB, TntActnList, TntSysUtils, TntWindows;
 247
 248 { TTntColumnTitle }
 249
 250 procedure TTntColumnTitle.DefineProperties(Filer: TFiler);
 251 begin
 252   inherited;
 253   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 254 end;
 255
 256 function TTntColumnTitle.DefaultCaption: WideString;
 257 var
 258   Field: TField;
 259 begin
 260   Field := Column.Field;
 261   if Assigned(Field) then
 262     Result := Field.DisplayName
 263   else
 264     Result := Column.FieldName;
 265 end;
 266
 267 function TTntColumnTitle.IsCaptionStored: Boolean;
 268 begin
 269   Result := (cvTitleCaption in Column.AssignedValues) and
 270     (FCaption <> DefaultCaption);
 271 end;
 272
 273 procedure TTntColumnTitle.SetInheritedCaption(const Value: AnsiString);
 274 begin
 275   inherited Caption := Value;
 276 end;
 277
 278 function TTntColumnTitle.GetCaption: WideString;
 279 begin
 280   if cvTitleCaption in Column.AssignedValues then
 281     Result := GetSyncedWideString(FCaption, inherited Caption)
 282   else
 283     Result := DefaultCaption;
 284 end;
 285
 286 procedure TTntColumnTitle.SetCaption(const Value: WideString);
 287 begin
 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;
 294 end;
 295
 296 procedure TTntColumnTitle.Assign(Source: TPersistent);
 297 begin
 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;
 304 end;
 305
 306 procedure TTntColumnTitle.RestoreDefaults;
 307 begin
 308   FCaption := '';
 309   inherited;
 310 end;
 311
 312 { TTntColumn }
 313
 314 procedure TTntColumn.DefineProperties(Filer: TFiler);
 315 begin
 316   inherited;
 317   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 318 end;
 319
 320 function TTntColumn.CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle};
 321 begin
 322   Result := TTntColumnTitle.Create(Self);
 323 end;
 324
 325 function TTntColumn.GetTitle: TTntColumnTitle;
 326 begin
 327   Result := (inherited Title) as TTntColumnTitle;
 328 end;
 329
 330 procedure TTntColumn.SetTitle(const Value: TTntColumnTitle);
 331 begin
 332   inherited Title := Value;
 333 end;
 334
 335 function TTntColumn.GetWidePickList: TTntStrings;
 336 begin
 337   if FWidePickList = nil then begin
 338     FWidePickList := TTntStringList.Create;
 339     TTntStringList(FWidePickList).OnChange := HandlePickListChange;
 340   end;
 341   Result := FWidePickList;
 342 end;
 343
 344 procedure TTntColumn.SetWidePickList(const Value: TTntStrings);
 345 begin
 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);
 354 end;
 355
 356 procedure TTntColumn.HandlePickListChange(Sender: TObject);
 357 begin
 358   inherited PickList{TNT-ALLOW PickList}.Assign(WidePickList);
 359 end;
 360
 361 destructor TTntColumn.Destroy;
 362 begin
 363   inherited;
 364   FWidePickList.Free;
 365 end;
 366
 367 { TTntPopupListbox }
 368 type
 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
 381 procedure TTntPopupListbox.CreateParams(var Params: TCreateParams);
 382 begin
 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;
 391 end;
 392
 393 procedure TTntPopupListbox.CreateWnd;
 394 begin
 395   inherited CreateWnd;
 396   Windows.SetParent(Handle, 0);
 397   CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
 398 end;
 399
 400 procedure TTntPopupListbox.WMChar(var Message: TWMChar);
 401 var
 402   Key: WideChar;
 403 begin
 404   Key := GetWideCharFromWMCharMsg(Message);
 405   KeyPressW(Key);
 406   SetWideCharForWMCharMsg(Message, Key);
 407   inherited;
 408 end;
 409
 410 procedure TTntPopupListbox.KeypressW(var Key: WideChar);
 411 var
 412   TickCount: Integer;
 413 begin
 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;
 429 end;
 430
 431 procedure TTntPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
 432   X, Y: Integer);
 433 begin
 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));
 437 end;
 438
 439 { TTntPopupDataList }
 440 type
 441   TTntPopupDataList = class(TPopupDataList)
 442   protected
 443     procedure Paint; override;
 444   end;
 445
 446 procedure TTntPopupDataList.Paint;
 447 var
 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
 482 var
 483   I, J, W, X, TxtWidth, TxtHeight, LastFieldIndex: Integer;
 484   S: WideString;
 485   R: TRect;
 486   Selected: Boolean;
 487   Field: TField;
 488   AAlignment: TAlignment;
 489 begin
 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;
 552 end;
 553
 554 //-----------------------------------------------------------------------------------------
 555 //                   TDBGridInplaceEdit - Delphi 6 and higher
 556 //-----------------------------------------------------------------------------------------
 557
 558 constructor TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.Create(Owner: TComponent);
 559 begin
 560   inherited Create(Owner);
 561   FLookupSource := TDataSource.Create(Self);
 562 end;
 563
 564 function TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.GetWidePickListBox: TTntCustomListBox;
 565 var
 566   PopupListbox: TTntPopupListbox;
 567 begin
 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;
 579 end;
 580
 581 procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.CloseUp(Accept: Boolean);
 582 var
 583   MasterField: TField;
 584   ListValue: Variant;
 585 begin
 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;
 614 end;
 615
 616 procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DoEditButtonClick;
 617 begin
 618   (Grid as TTntCustomDBGrid).EditButtonClick;
 619 end;
 620
 621 type TAccessTntCustomListbox = class(TTntCustomListbox);
 622
 623 procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.DropDown;
 624 var
 625    Column: TTntColumn;
 626    I, J, Y: Integer;
 627 begin
 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;
 667 end;
 668
 669 procedure TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit}.UpdateContents;
 670 var
 671   Column: TTntColumn;
 672 begin
 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;
 693 end;
 694
 695 //-----------------------------------------------------------------------------------------
 696
 697 { TTntDBGridInplaceEdit }
 698
 699 procedure TTntDBGridInplaceEdit.CreateWindowHandle(const Params: TCreateParams);
 700 begin
 701   TntCustomEdit_CreateWindowHandle(Self, Params);
 702 end;
 703
 704 function TTntDBGridInplaceEdit.GetText: WideString;
 705 begin
 706   Result := TntControl_GetText(Self);
 707 end;
 708
 709 procedure TTntDBGridInplaceEdit.SetText(const Value: WideString);
 710 begin
 711   TntControl_SetText(Self, Value);
 712 end;
 713
 714 procedure TTntDBGridInplaceEdit.WMSetText(var Message: TWMSetText);
 715 begin
 716   if (not FBlockSetText) then
 717     inherited;
 718 end;
 719
 720 procedure TTntDBGridInplaceEdit.UpdateContents;
 721 var
 722   Grid: TTntCustomDBGrid;
 723 begin
 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;
 735 end;
 736
 737 procedure TTntDBGridInplaceEdit.DblClick;
 738 begin
 739   FInDblClick := True;
 740   try
 741     inherited;
 742   finally
 743     FInDblClick := False;
 744   end;
 745 end;
 746
 747 { TTntGridDataLink }
 748
 749 procedure TTntGridDataLink.GridUpdateFieldText(Sender: TField; const Text: AnsiString);
 750 begin
 751   Sender.OnSetText := OriginalSetText;
 752   if Assigned(Sender) then
 753     SetWideText(Sender, (Grid as TTntCustomDBGrid).FEditText);
 754 end;
 755
 756 procedure TTntGridDataLink.RecordChanged(Field: TField);
 757 var
 758   CField: TField;
 759 begin
 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;
 772 end;
 773
 774 procedure TTntGridDataLink.UpdateData;
 775 var
 776   Field: TField;
 777 begin
 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;
 794 end;
 795
 796 { TTntDBGridColumns }
 797
 798 function TTntDBGridColumns.Add: TTntColumn;
 799 begin
 800   Result := inherited Add as TTntColumn;
 801 end;
 802
 803 function TTntDBGridColumns.GetColumn(Index: Integer): TTntColumn;
 804 begin
 805   Result := inherited Items[Index] as TTntColumn;
 806 end;
 807
 808 procedure TTntDBGridColumns.SetColumn(Index: Integer; const Value: TTntColumn);
 809 begin
 810   inherited Items[Index] := Value;
 811 end;
 812
 813 { TTntCustomDBGrid }
 814
 815 procedure TTntCustomDBGrid.CreateWindowHandle(const Params: TCreateParams);
 816 begin
 817   CreateUnicodeHandle(Self, Params, '');
 818 end;
 819
 820 type TAccessCustomGrid = class(TCustomGrid);
 821
 822 procedure TTntCustomDBGrid.WMChar(var Msg: TWMChar);
 823 begin
 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;
 830 end;
 831
 832 procedure TTntCustomDBGrid.ShowEditorChar(Ch: WideChar);
 833 begin
 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;
 841 end;
 842
 843 procedure TTntCustomDBGrid.DefineProperties(Filer: TFiler);
 844 begin
 845   inherited;
 846   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 847 end;
 848
 849 function TTntCustomDBGrid.IsHintStored: Boolean;
 850 begin
 851   Result := TntControl_IsHintStored(Self);
 852 end;
 853
 854 function TTntCustomDBGrid.GetHint: WideString;
 855 begin
 856   Result := TntControl_GetHint(Self)
 857 end;
 858
 859 procedure TTntCustomDBGrid.SetHint(const Value: WideString);
 860 begin
 861   TntControl_SetHint(Self, Value);
 862 end;
 863
 864 function TTntCustomDBGrid.CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns};
 865 begin
 866   Result := TTntDBGridColumns.Create(Self, TTntColumn);
 867 end;
 868
 869 function TTntCustomDBGrid.GetColumns: TTntDBGridColumns;
 870 begin
 871   Result := inherited Columns as TTntDBGridColumns;
 872 end;
 873
 874 procedure TTntCustomDBGrid.SetColumns(const Value: TTntDBGridColumns);
 875 begin
 876   inherited Columns := Value;
 877 end;
 878
 879 function TTntCustomDBGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
 880 begin
 881   Result := TTntDBGridInplaceEdit.Create(Self);
 882 end;
 883
 884 function TTntCustomDBGrid.CreateDataLink: TGridDataLink;
 885 begin
 886   Result := TTntGridDataLink.Create(Self);
 887 end;
 888
 889 function TTntCustomDBGrid.GetEditText(ACol, ARow: Integer): WideString;
 890 var
 891   Field: TField;
 892 begin
 893   Field := GetColField(RawToDataColumn(ACol));
 894   if Field = nil then
 895     Result := ''
 896   else
 897     Result := GetWideText(Field);
 898   FEditText := Result;
 899 end;
 900
 901 procedure TTntCustomDBGrid.SetEditText(ACol, ARow: Integer; const Value: AnsiString);
 902 begin
 903   if (InplaceEditor as TTntDBGridInplaceEdit).FInDblClick then
 904     FEditText := Value
 905   else
 906     FEditText := (InplaceEditor as TTntDBGridInplaceEdit).Text;
 907   inherited;
 908 end;
 909
 910 //----------------- DRAW CELL PROCS --------------------------------------------------
 911 var
 912   DrawBitmap: TBitmap = nil;
 913
 914 procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
 915   const Text: WideString; Alignment: TAlignment; ARightToLeft: Boolean);
 916 const
 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);
 922 var
 923   B, R: TRect;
 924   Hold, Left: Integer;
 925   I: TColorRef;
 926 begin
 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;
 979 end;
 980
 981 procedure TTntCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
 982   State: TGridDrawState);
 983 var
 984   Alignment: TAlignment;
 985   Value: WideString;
 986 begin
 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));
 996 end;
 997
 998 procedure TTntCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
 999   DataCol: Integer; Column: TTntColumn; State: TGridDrawState);
1000 var
1001   Value: WideString;
1002 begin
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));
1008 end;
1009
1010 procedure TTntCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
1011 var
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
1072 var
1073   OldActive: Integer;
1074   Highlight: Boolean;
1075   Value: WideString;
1076   DrawColumn: TTntColumn;
1077 begin
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;
1156 end;
1157
1158 procedure TTntCustomDBGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1159 begin
1160   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1161   inherited;
1162 end;
1163
1164 function TTntCustomDBGrid.GetActionLinkClass: TControlActionLinkClass;
1165 begin
1166   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1167 end;
1168
1169 initialization
1170   DrawBitmap := TBitmap.Create;
1171
1172 finalization
1173   DrawBitmap.Free;
1174
1175 end.