cxlookupdbgrid.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 526 行 · 第 1/2 页

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressEditors                                               }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSEDITORS AND ALL                }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxLookupDBGrid;

{$I cxVer.inc}

interface

uses
  Windows,
  SysUtils, Classes, Controls, Graphics, Forms, StdCtrls, DB,
  cxClasses, cxControls, cxGraphics, cxLookAndFeelPainters,
  cxEdit, cxDBEdit, cxCustomData, cxDB, cxDBData, cxEditRepositoryItems,
  cxLookupGrid;

const
  DefaultSyncMode = False;

type
  TcxCustomLookupDBGrid = class;

  { TcxLookupGridDBDataController }

  TcxLookupGridDBDataController = class(TcxDBDataController)
  private
    function GetGrid: TcxCustomLookupDBGrid;
  protected
    procedure UpdateScrollBars; override;
  public
    constructor Create(AOwner: TComponent); override;
    function GetItem(Index: Integer): TObject; override;
    property Grid: TcxCustomLookupDBGrid read GetGrid;
  published
    property OnCompare;
  end;

  { TcxLookupDBGridColumn }

  TcxLookupDBGridDefaultValuesProvider = class(TcxCustomDBEditDefaultValuesProvider)
    function IsDisplayFormatDefined(AIsCurrencyValueAccepted: Boolean): Boolean; override;
  end;

  TcxLookupDBGridColumn = class(TcxLookupGridColumn)
  private
    function GetDataController: TcxLookupGridDBDataController;
    function GetField: TField;
    function GetFieldName: string;
    procedure SetFieldName(const Value: string);
  protected
    function GetDefaultValuesProviderClass: TcxCustomEditDefaultValuesProviderClass; override;
    procedure InitDefaultValuesProvider;
    property DataController: TcxLookupGridDBDataController read GetDataController;
  public
    procedure Assign(Source: TPersistent); override;
    function DefaultCaption: string; override;
    function DefaultRepositoryItem: TcxEditRepositoryItem; override;
    function DefaultWidth: Integer; override;
    property Field: TField read GetField;
  published
    property FieldName: string read GetFieldName write SetFieldName;
  end;

  { TcxLookupDBGridColumns }

  TcxLookupDBGridColumns = class(TcxLookupGridColumns)
  private
    function GetColumn(Index: Integer): TcxLookupDBGridColumn;
    procedure SetColumn(Index: Integer; Value: TcxLookupDBGridColumn);
  public
    function Add: TcxLookupDBGridColumn;
    function ColumnByFieldName(const AFieldName: string): TcxLookupDBGridColumn;
    property Items[Index: Integer]: TcxLookupDBGridColumn read GetColumn write SetColumn; default;
  end;

  { TcxLookupDBGridOptions }

  TcxLookupDBGridOptions = class(TcxLookupGridOptions)
  private
    function GetGrid: TcxCustomLookupDBGrid;
    function GetSyncMode: Boolean;
    procedure SetSyncMode(Value: Boolean);
  public
    procedure Assign(Source: TPersistent); override;
    property Grid: TcxCustomLookupDBGrid read GetGrid;
  published
    property SyncMode: Boolean read GetSyncMode write SetSyncMode
      default DefaultSyncMode;
  end;

  { TcxCustomLookupDBGrid }

  TcxCustomLookupDBGrid = class(TcxCustomLookupGrid)
  private
    function GetColumns: TcxLookupDBGridColumns;
    function GetDataController: TcxLookupGridDBDataController;
    function GetDataSource: TDataSource;
    function GetKeyFieldNames: string;
    function GetOptions: TcxLookupDBGridOptions;
    procedure SetColumns(Value: TcxLookupDBGridColumns);
    procedure SetDataController(Value: TcxLookupGridDBDataController);
    procedure SetDataSource(Value: TDataSource);
    procedure SetKeyFieldNames(const Value: string);
    procedure SetOptions(Value: TcxLookupDBGridOptions);
  protected
    procedure CreateColumnsByFields(AFieldNames: TStrings); virtual;
    procedure DataChanged; override;
    function GetColumnClass: TcxLookupGridColumnClass; override;
    function GetColumnsClass: TcxLookupGridColumnsClass; override;
    function GetDataControllerClass: TcxCustomDataControllerClass; override;
    function GetOptionsClass: TcxLookupGridOptionsClass; override;
    procedure InitScrollBarsParameters; override;
    procedure Scroll(AScrollBarKind: TScrollBarKind; AScrollCode: TScrollCode; var AScrollPos: Integer); override;
    procedure UpdateScrollBars; override; // for Delphi .NET
  public
    procedure CreateAllColumns;
    procedure CreateColumnsByFieldNames(const AFieldNames: string);
    property Align;
    property Anchors;
    property Color;
    property Columns: TcxLookupDBGridColumns read GetColumns write SetColumns;
    property DataController: TcxLookupGridDBDataController read GetDataController write SetDataController;
    property Font;
    property LookAndFeel;
    property Options: TcxLookupDBGridOptions read GetOptions write SetOptions;
    property ParentFont;
    property Visible;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property KeyFieldNames: string read GetKeyFieldNames write SetKeyFieldNames;
  end;

  TcxCustomLookupDBGridClass = class of TcxCustomLookupDBGrid;

implementation

uses
  cxEditDBRegisteredRepositoryItems;

function TcxLookupDBGridDefaultValuesProvider.IsDisplayFormatDefined(AIsCurrencyValueAccepted: Boolean): Boolean;
begin
  with TcxLookupDBGridColumn(Owner) do
    Result := DataController.GetItemTextStored(Index);
end;

{ TcxLookupDBGridColumn }

procedure TcxLookupDBGridColumn.Assign(Source: TPersistent);
begin
  if Source is TcxLookupDBGridColumn then
    FieldName := TcxLookupDBGridColumn(Source).FieldName;
  inherited Assign(Source);
end;

function TcxLookupDBGridColumn.DefaultCaption: string;
var
  AField: TField;
begin
  AField := Field;
  if AField = nil then
    Result := FieldName
  else
    Result := AField.DisplayName;
end;

function TcxLookupDBGridColumn.DefaultRepositoryItem: TcxEditRepositoryItem;
begin
  Result := GetDefaultEditDBRepositoryItems.GetItemByField(Field);
end;

function TcxLookupDBGridColumn.DefaultWidth: Integer;
var
  AField: TField;
  ACanvas: TcxCanvas;
  W: Integer;
begin
  AField := Field;
  if AField = nil then
    Result := inherited DefaultWidth
  else
  begin
    ACanvas := Grid.ViewInfo.Canvas;
    ACanvas.Font := GetContentFont; 
    Result := AField.DisplayWidth * ACanvas.TextWidth('0') + 4;
    if Grid.Options.ShowHeader then
    begin
      W := Grid.Painter.LFPainterClass.HeaderWidth(ACanvas, cxBordersAll, Caption,
        Grid.ViewInfo.GetHeaderFont);
      if W > Result then Result := W;
    end;
  end;
  CheckWidthValue(Result);
end;

function TcxLookupDBGridColumn.GetDefaultValuesProviderClass: TcxCustomEditDefaultValuesProviderClass;
begin
  Result := TcxLookupDBGridDefaultValuesProvider;
end;

procedure TcxLookupDBGridColumn.InitDefaultValuesProvider;
begin
  TcxCustomDBEditDefaultValuesProvider(DefaultValuesProvider.GetInstance).Field := Field;
end;

function TcxLookupDBGridColumn.GetDataController: TcxLookupGridDBDataController;
begin
  Result := TcxLookupGridDBDataController(inherited DataController);
end;

function TcxLookupDBGridColumn.GetField: TField;
begin
  Result := DataController.GetItemField(Index);
end;

function TcxLookupDBGridColumn.GetFieldName: string;
begin
  Result := DataController.GetItemFieldName(Index);
end;

procedure TcxLookupDBGridColumn.SetFieldName(const Value: string);
begin
  DataController.ChangeFieldName(Index, Value);
end;

{ TcxLookupDBGridColumns }

function TcxLookupDBGridColumns.Add: TcxLookupDBGridColumn;
begin
  Result := inherited Add as TcxLookupDBGridColumn;
end;