tntjvdbgrids.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.1.19                                                      }
{                                                                             }
{    Copyright (c) 2002-2005, Troy Wolbrink ([e-mail])       }
{                                                                             }
{*****************************************************************************}
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvExDBGrids.pas, released on 2004-01-04

The Initial Developer of the Original Code is Andreas Hausladen [Andreas dott Hausladen att gmx dott de]
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s): -

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvExDBGrids.pas,v 1.41 2005/03/09 07:25:02 marquardt Exp $

{
DrawColumnCellUTF7 enables to show
shows correctly a calculated UTF7-string fields as WideString

procedure TForm.TTntJvDBGridS1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  with Sender as TTntJvDBGridS do  begin
    if  Column.Field.Index = CalculatedField.Index  then  begin
      DrawColumnCellUTF7 (Rect, DataCol, Column, State);
    end
    else  begin
      DefaultDrawColumnCell (Rect, DataCol, Column, State);
    end;
  end;
end;

03/10/2006: solved bug in DrawColumnCellUTF7 when Application.UseRightToLeftAlignment
}

unit TntJvDBGridS;

{$I jvcl.inc}
{$D+}
{MACROINCLUDE JvExControls.macros}

{*****************************************************************************
 * WARNING: Do not edit this file.
 * This file is autogenerated from the source in devtools/JvExVCL/src.
 * If you do it despite this warning your changes will be discarded by the next
 * update of this file. Do your changes in the template files.
 ****************************************************************************}

{$INCLUDE TntCompilers.inc}

interface

{$I HintEditor.inc}

uses
  Classes, TntClasses, Controls, Windows, Grids, DBGrids, Messages, DBCtrls, DB,
  TntClasses2, JvExControls, Forms,
  Graphics, 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;
  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}
    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;

  {New JMN}
  TGetCellParamsEvent = procedure (Sender: TObject; Field: TField;
    AFont: TFont; var Background: TColor; Highlight: Boolean) of object;

  TJvCustomDBGrid0 = class(TCustomDBGrid, IJvExControl)
  private
    FHintColor: TColor;
    FMouseOver: Boolean;
    {$IFDEF VCL}
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    {$ENDIF VCL}
    FOnParentColorChanged: TNotifyEvent;
    function BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Integer = 0): Integer;
  protected
    procedure WndProc(var Msg: TMessage); override;
    procedure FocusChanged(AControl: TWinControl); dynamic;
    procedure VisibleChanged; reintroduce; dynamic;
    procedure EnabledChanged; reintroduce; dynamic;
    procedure TextChanged; reintroduce; virtual;
    procedure ColorChanged; reintroduce; dynamic;
    procedure FontChanged; reintroduce; dynamic;
    procedure ParentFontChanged; reintroduce; dynamic;
    procedure ParentColorChanged; reintroduce; dynamic;
    procedure ParentShowHintChanged; reintroduce; dynamic;
    function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; reintroduce; virtual;
    function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
    function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
    procedure MouseEnter(AControl: TControl); reintroduce; dynamic;
    procedure MouseLeave(AControl: TControl); reintroduce; dynamic;
    {$IFDEF COMPILER5}
    {$IFNDEF HASAUTOSIZE}
    procedure CMSetAutoSize(var Msg: TMessage); message CM_SETAUTOSIZE;
    procedure SetAutoSize(Value: Boolean); virtual;
    {$ENDIF !HASAUTOSIZE}
    {$ENDIF COMPILER5}
    property MouseOver: Boolean read FMouseOver write FMouseOver;
    property HintColor: TColor read FHintColor write FHintColor default clDefault;
    {$IFDEF VCL}
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    {$ENDIF VCL}
    property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
  public
    constructor Create(AOwner: TComponent); override;
  protected
    procedure BoundsChanged; reintroduce; virtual;
    procedure CursorChanged; reintroduce; dynamic;
    procedure ShowingChanged; reintroduce; dynamic;
    procedure ShowHintChanged; reintroduce; dynamic;
    procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
    procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
    procedure GetDlgCode(var Code: TDlgCodes); virtual;
    procedure FocusSet(PrevWnd: HWND); virtual;
    procedure FocusKilled(NextWnd: HWND); virtual;
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; virtual;
  {$IFDEF JVCLThemesEnabledD56}
  private
    function GetParentBackground: Boolean;
  protected
    procedure SetParentBackground(Value: Boolean); virtual;
    property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
  {$ENDIF JVCLThemesEnabledD56}
  end;

{TNT-WARN TCustomDBGrid}
  TTntJvCustomDBGridS = class(TJvCustomDBGrid0{TNT-ALLOW TCustomDBGrid})
  private
    FEditText: WideString;
   {$IFDEF WithHintEditor}
    FHintEditor: TUnicodeLinesEditor;
   {$ENDIF}
    FOnGetCellParams: TGetCellParamsEvent; {New JMN}
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
   {$IFDEF WithHintEditor}
    function  GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
   {$ENDIF}
    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;
    procedure GetCellProps(Field: TField; AFont: TFont; var Background: TColor;
      Highlight: Boolean); dynamic; {New JMN}
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); dynamic;
    procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState);
    procedure DrawColumnCellUTF7 (const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    property OnGetCellParams: TGetCellParamsEvent read FOnGetCellParams write FOnGetCellParams; {New JMN}
  published
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
   {$IFDEF WithHintEditor}
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
   {$ENDIF}
  end;

{TNT-WARN TDBGrid}
  TTntJvDBGridS = class(TTntJvCustomDBGridS)
  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 HintColor; {Jv}
    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 OnGetCellParams; {New JMN}
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    {$IFDEF VCL}
    property OnMouseEnter; {Jv}
    property OnMouseLeave; {Jv}
    {$ENDIF VCL}
    property OnMouseMove;
    property OnMouseUp;
    property OnParentColorChange; {Jv}
    property OnStartDock;
    property OnStartDrag;
    property OnTitleClick;
  end;

implementation

uses
  SysUtils, TntControls, Math, Variants, TntDBCtrls, TntSystem,
  TntGraphics, {Graphics,JMN} TntDB, TntActnList, TntSysUtils, TntWindows;

{ TTntColumnTitle }

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

function TTntColumnTitle.IsCaptionStored: Boolean;
begin
  Result := (cvTitleCaption in Column.AssignedValues) and
    (FCaption <> WideString(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 := inherited Caption;
end;

procedure TTntColumnTitle.SetCaption(const Value: WideString);
begin
  if not (Column as TTntColumn).IsStored then
    inherited Caption := Value