tntdbgrids.pas

TNT Components Source

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink ([e-mail])       }
{                                                                             }
{*****************************************************************************}

unit TntDBGrids;

{$INCLUDE TntCompilers.inc}

interface

uses
  Classes, TntClasses, Controls, Windows, Grids, DBGrids, Messages, DBCtrls, DB, TntStdCtrls;

type
{TNT-WARN TColumnTitle}
  TTntColumnTitle = class(TColumnTitle{TNT-ALLOW TColumnTitle})
  private
    FCaption: WideString;
    procedure SetInheritedCaption(const Value: AnsiString);
    function GetCaption: WideString;
    procedure SetCaption(const Value: WideString);
    function IsCaptionStored: Boolean;
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    procedure Assign(Source: TPersistent); override;
    procedure RestoreDefaults; override;
    function DefaultCaption: WideString;
  published
    property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
  end;

{TNT-WARN TColumn}
type
  TTntColumn = class(TColumn{TNT-ALLOW TColumn})
  private
    FWidePickList: TTntStrings;
    function GetWidePickList: TTntStrings;
    procedure SetWidePickList(const Value: TTntStrings);
    procedure HandlePickListChange(Sender: TObject);
    function GetTitle: TTntColumnTitle;
    procedure SetTitle(const Value: TTntColumnTitle);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function  CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle}; override;
  public
    destructor Destroy; override;
    property WidePickList: TTntStrings read GetWidePickList write SetWidePickList;
  published
{TNT-WARN PickList}
    property PickList{TNT-ALLOW PickList}: TTntStrings read GetWidePickList write SetWidePickList;
    property Title: TTntColumnTitle read GetTitle write SetTitle;
  end;

  { TDBGridInplaceEdit adds support for a button on the in-place editor,
    which can be used to drop down a table-based lookup list, a stringlist-based
    pick list, or (if button style is esEllipsis) fire the grid event
    OnEditButtonClick.  }

type
  TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit} = class(TInplaceEditList)
  private
    {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
    FDataList: TDBLookupListBox; // 1st field - Delphi/BCB 6 TCustomDBGrid assumes this
    FUseDataList: Boolean;       // 2nd field - Delphi/BCB 6 TCustomDBGrid assumes this
    {$ENDIF}
    {$IFDEF DELPHI_7}  // verified against VCL source in Delphi 7
    FDataList: TDBLookupListBox; // 1st field - Delphi 7 TCustomDBGrid assumes this
    FUseDataList: Boolean;       // 2nd field - Delphi 7 TCustomDBGrid assumes this
    {$ENDIF}
    {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
    FDataList: TDBLookupListBox; // 1st field - Delphi 9 TCustomDBGrid assumes this
    FUseDataList: Boolean;       // 2nd field - Delphi 9 TCustomDBGrid assumes this
    {$ENDIF}
    {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
    FDataList: TDBLookupListBox; // 1st field - Delphi 10 TCustomDBGrid assumes this
    FUseDataList: Boolean;       // 2nd field - Delphi 10 TCustomDBGrid assumes this
    {$ENDIF}
    FLookupSource: TDatasource;
    FWidePickListBox: TTntCustomListbox;
    function GetWidePickListBox: TTntCustomListbox;
  protected
    procedure CloseUp(Accept: Boolean); override;
    procedure DoEditButtonClick; override;
    procedure DropDown; override;
    procedure UpdateContents; override;
    property UseDataList: Boolean read FUseDataList;
  public
    constructor Create(Owner: TComponent); override;
    property DataList: TDBLookupListBox read FDataList;
    property WidePickListBox: TTntCustomListbox read GetWidePickListBox;
  end;

type
{TNT-WARN TDBGridInplaceEdit}
  TTntDBGridInplaceEdit = class(TDBGridInplaceEdit{TNT-ALLOW TDBGridInplaceEdit})
  private
    FInDblClick: Boolean;
    FBlockSetText: Boolean;
    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
  protected
    function GetText: WideString; virtual;
    procedure SetText(const Value: WideString); virtual;
  protected
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure UpdateContents; override;
    procedure DblClick; override;
  public
    property Text: WideString read GetText write SetText;
  end;

{TNT-WARN TDBGridColumns}
  TTntDBGridColumns = class(TDBGridColumns{TNT-ALLOW TDBGridColumns})
  private
    function GetColumn(Index: Integer): TTntColumn;
    procedure SetColumn(Index: Integer; const Value: TTntColumn);
  public
    function Add: TTntColumn;
    property Items[Index: Integer]: TTntColumn read GetColumn write SetColumn; default;
  end;

  TTntGridDataLink = class(TGridDataLink)
  private
    OriginalSetText: TFieldSetTextEvent;
    procedure GridUpdateFieldText(Sender: TField; const Text: AnsiString);
  protected
    procedure UpdateData; override;
    procedure RecordChanged(Field: TField); override;
  end;

{TNT-WARN TCustomDBGrid}
  TTntCustomDBGrid = class(TCustomDBGrid{TNT-ALLOW TCustomDBGrid})
  private
    FEditText: WideString;
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsHintStored: Boolean;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
    function GetColumns: TTntDBGridColumns;
    procedure SetColumns(const Value: TTntDBGridColumns);
  protected
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure ShowEditorChar(Ch: WideChar); dynamic;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns}; override;
    property Columns: TTntDBGridColumns read GetColumns write SetColumns;
    function CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit}; override;
    function CreateDataLink: TGridDataLink; override;
    function GetEditText(ACol, ARow: Longint): WideString; reintroduce;
    procedure DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
    procedure SetEditText(ACol, ARow: Longint; const Value: AnsiString); override;
  public
    procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TTntColumn; State: TGridDrawState); dynamic;
    procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState);
  published
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
  end;

{TNT-WARN TDBGrid}
  TTntDBGrid = class(TTntCustomDBGrid)
  public
    property Canvas;
    property SelectedRows;
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Columns stored False; //StoreColumns;
    property Constraints;
    property Ctl3D;
    property DataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Font;
    property ImeMode;
    property ImeName;
    property Options;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TitleFont;
    property Visible;
    property OnCellClick;
    property OnColEnter;
    property OnColExit;
    property OnColumnMoved;
    property OnDrawDataCell;  { obsolete }
    property OnDrawColumnCell;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditButtonClick;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    {$IFDEF COMPILER_9_UP}
    property OnMouseActivate;
    {$ENDIF}
    property OnMouseDown;
    {$IFDEF COMPILER_10_UP}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;
    property OnTitleClick;
  end;

implementation

uses
  SysUtils, TntControls, Math, Variants, Forms,
  TntGraphics, Graphics, TntDB, TntActnList, TntSysUtils, TntWindows;

{ TTntColumnTitle }

procedure TTntColumnTitle.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntColumnTitle.DefaultCaption: WideString;
var
  Field: TField;
begin
  Field := Column.Field;
  if Assigned(Field) then
    Result := Field.DisplayName
  else
    Result := Column.FieldName;
end;

function TTntColumnTitle.IsCaptionStored: Boolean;
begin
  Result := (cvTitleCaption in Column.AssignedValues) and
    (FCaption <> DefaultCaption);
end;

procedure TTntColumnTitle.SetInheritedCaption(const Value: AnsiString);
begin
  inherited Caption := Value;
end;

function TTntColumnTitle.GetCaption: WideString;
begin
  if cvTitleCaption in Column.AssignedValues then
    Result := GetSyncedWideString(FCaption, inherited Caption)
  else
    Result := DefaultCaption;
end;

procedure TTntColumnTitle.SetCaption(const Value: WideString);
begin
  if not (Column as TTntColumn).IsStored then
    inherited Caption := Value
  else begin
    if (cvTitleCaption in Column.AssignedValues) and (Value = FCaption) then Exit;
    SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
  end;
end;

procedure TTntColumnTitle.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TTntColumnTitle then
  begin
    if cvTitleCaption in TTntColumnTitle(Source).Column.AssignedValues then
      Caption := TTntColumnTitle(Source).Caption;
  end;
end;

procedure TTntColumnTitle.RestoreDefaults;
begin
  FCaption := '';
  inherited;
end;

{ TTntColumn }

procedure TTntColumn.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntColumn.CreateTitle: TColumnTitle{TNT-ALLOW TColumnTitle};
begin
  Result := TTntColumnTitle.Create(Self);
end;

function TTntColumn.GetTitle: TTntColumnTitle;
begin
  Result := (inherited Title) as TTntColumnTitle;
end;

procedure TTntColumn.SetTitle(const Value: TTntColumnTitle);
begin
  inherited Title := Value;
end;

function TTntColumn.GetWidePickList: TTntStrings;
begin
  if FWidePickList = nil then begin
    FWidePickList := TTntStringList.Create;
    TTntStringList(FWidePickList).OnChange := HandlePickListChange;
  end;
  Result := FWidePickList;
end;

procedure TTntColumn.SetWidePickList(const Value: TTntStrings);
begin
  if Value = nil then
  begin
    FWidePickList.Free;
    FWidePickList := nil;
    (inherited PickList{TNT-ALLOW PickList}).Clear;
    Exit;
  end;
  WidePickList.Assign(Value);
end;

procedure TTntColumn.HandlePickListChange(Sender: TObject);
begin
  inherited PickList{TNT-ALLOW PickList}.Assign(WidePickList);
end;

destructor TTntColumn.Destroy;
begin
  inherited;
  FWidePickList.Free;
end;

{ TTntPopupListbox }
type
  TTntPopupListbox = class(TTntCustomListbox)
  private
    FSearchText: WideString;
    FSearchTickCount: Longint;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
    procedure KeyPressW(var Key: WideChar);
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

procedure TTntPopupListbox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
    AddBiDiModeExStyle(ExStyle);
    WindowClass.Style := CS_SAVEBITS;
  end;
end;