526 lines
16 KiB
ObjectPascal
526 lines
16 KiB
ObjectPascal
|
|
{********************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressEditors }
|
|
{ }
|
|
{ Copyright (c) 1998-2009 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;
|
|
|
|
function TcxLookupDBGridColumns.ColumnByFieldName(const AFieldName: string): TcxLookupDBGridColumn;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
Result := Items[I];
|
|
if AnsiCompareText(Result.FieldName, AFieldName) = 0 then
|
|
Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TcxLookupDBGridColumns.GetColumn(Index: Integer): TcxLookupDBGridColumn;
|
|
begin
|
|
Result := inherited Items[Index] as TcxLookupDBGridColumn;
|
|
end;
|
|
|
|
procedure TcxLookupDBGridColumns.SetColumn(Index: Integer; Value: TcxLookupDBGridColumn);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
{ TcxLookupGridDBDataController }
|
|
|
|
constructor TcxLookupGridDBDataController.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
DataModeController.SyncMode := DefaultSyncMode;
|
|
DataModeController.SyncInsert := False;
|
|
end;
|
|
|
|
function TcxLookupGridDBDataController.GetItem(Index: Integer): TObject;
|
|
begin
|
|
Result := Grid.Columns[Index];
|
|
end;
|
|
|
|
procedure TcxLookupGridDBDataController.UpdateScrollBars;
|
|
begin
|
|
Grid.UpdateScrollBars;
|
|
end;
|
|
|
|
function TcxLookupGridDBDataController.GetGrid: TcxCustomLookupDBGrid;
|
|
begin
|
|
Result := GetOwner as TcxCustomLookupDBGrid;
|
|
end;
|
|
|
|
{ TcxLookupDBGridOptions }
|
|
|
|
procedure TcxLookupDBGridOptions.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TcxLookupDBGridOptions then
|
|
begin
|
|
if Assigned(Grid) then
|
|
Grid.BeginUpdate;
|
|
try
|
|
inherited Assign(Source);
|
|
SyncMode := TcxLookupDBGridOptions(Source).SyncMode;
|
|
finally
|
|
if Assigned(Grid) then
|
|
Grid.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TcxLookupDBGridOptions.GetGrid: TcxCustomLookupDBGrid;
|
|
begin
|
|
Result := TcxCustomLookupDBGrid(FGrid);
|
|
end;
|
|
|
|
function TcxLookupDBGridOptions.GetSyncMode: Boolean;
|
|
begin
|
|
if Assigned(Grid) then
|
|
Result := Grid.DataController.DataModeController.SyncMode
|
|
else
|
|
Result := DefaultSyncMode;
|
|
end;
|
|
|
|
procedure TcxLookupDBGridOptions.SetSyncMode(Value: Boolean);
|
|
begin
|
|
if Assigned(Grid) then
|
|
Grid.DataController.DataModeController.SyncMode := Value;
|
|
end;
|
|
|
|
{ TcxCustomLookupDBGrid }
|
|
|
|
procedure TcxCustomLookupDBGrid.CreateAllColumns;
|
|
var
|
|
ADataSet: TDataSet;
|
|
AFieldNames: TStrings;
|
|
begin
|
|
Columns.Clear;
|
|
ADataSet := DataController.DataSet;
|
|
if ADataSet <> nil then
|
|
begin
|
|
AFieldNames := TStringList.Create;
|
|
try
|
|
{$WARNINGS OFF} { for Borland Delphi 10 }
|
|
ADataSet.GetFieldNames(AFieldNames);
|
|
{$WARNINGS ON}
|
|
CreateColumnsByFields(AFieldNames);
|
|
finally
|
|
AFieldNames.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.CreateColumnsByFieldNames(const AFieldNames: string);
|
|
var
|
|
AFieldNamesList: TStrings;
|
|
begin
|
|
Columns.Clear;
|
|
AFieldNamesList := TStringList.Create;
|
|
try
|
|
GetFieldNames(AFieldNames, AFieldNamesList);
|
|
CreateColumnsByFields(AFieldNamesList);
|
|
finally
|
|
AFieldNamesList.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.CreateColumnsByFields(AFieldNames: TStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
for I := 0 to AFieldNames.Count - 1 do
|
|
Columns.Add.FieldName := AFieldNames[I];
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.DataChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Columns.Count - 1 do
|
|
Columns[I].InitDefaultValuesProvider;
|
|
inherited DataChanged;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetColumnClass: TcxLookupGridColumnClass;
|
|
begin
|
|
Result := TcxLookupDBGridColumn;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetColumnsClass: TcxLookupGridColumnsClass;
|
|
begin
|
|
Result := TcxLookupDBGridColumns;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetDataControllerClass: TcxCustomDataControllerClass;
|
|
begin
|
|
Result := TcxLookupGridDBDataController;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetOptionsClass: TcxLookupGridOptionsClass;
|
|
begin
|
|
Result := TcxLookupDBGridOptions;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.InitScrollBarsParameters;
|
|
begin
|
|
if DataController.IsGridMode and DataController.IsSequenced then
|
|
begin
|
|
SetScrollBarInfo(sbVertical, 0,
|
|
(DataController.DataSetRecordCount - 1) + (ViewInfo.VisibleRowCount - 1),
|
|
1, ViewInfo.VisibleRowCount, DataController.RecNo - 1, True, True);
|
|
end
|
|
else
|
|
inherited InitScrollBarsParameters;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.Scroll(AScrollBarKind: TScrollBarKind;
|
|
AScrollCode: TScrollCode; var AScrollPos: Integer);
|
|
begin
|
|
if DataController.IsGridMode and DataController.IsSequenced then
|
|
begin
|
|
if AScrollBarKind = sbVertical then
|
|
begin
|
|
case AScrollCode of
|
|
scLineUp:
|
|
FocusNextRow(False);
|
|
scLineDown:
|
|
FocusNextRow(True);
|
|
scPageUp:
|
|
FocusPriorPage;
|
|
scPageDown:
|
|
FocusNextPage;
|
|
scTrack: ;
|
|
scPosition:
|
|
DataController.RecNo := AScrollPos + 1;
|
|
end;
|
|
end
|
|
else
|
|
inherited Scroll(AScrollBarKind, AScrollCode, AScrollPos);
|
|
AScrollPos := DataController.RecNo - 1;
|
|
end
|
|
else
|
|
inherited Scroll(AScrollBarKind, AScrollCode, AScrollPos);
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.UpdateScrollBars;
|
|
begin
|
|
inherited UpdateScrollBars;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetColumns: TcxLookupDBGridColumns;
|
|
begin
|
|
Result := inherited Columns as TcxLookupDBGridColumns;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetDataController: TcxLookupGridDBDataController;
|
|
begin
|
|
Result := TcxLookupGridDBDataController(FDataController);
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetDataSource: TDataSource;
|
|
begin
|
|
Result := DataController.DataSource;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetKeyFieldNames: string;
|
|
begin
|
|
Result := DataController.KeyFieldNames;
|
|
end;
|
|
|
|
function TcxCustomLookupDBGrid.GetOptions: TcxLookupDBGridOptions;
|
|
begin
|
|
Result := TcxLookupDBGridOptions(FOptions);
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.SetColumns(Value: TcxLookupDBGridColumns);
|
|
begin
|
|
inherited Columns := Value;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.SetDataController(Value: TcxLookupGridDBDataController);
|
|
begin
|
|
FDataController.Assign(Value);
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.SetDataSource(Value: TDataSource);
|
|
begin
|
|
DataController.DataSource := Value;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.SetKeyFieldNames(const Value: string);
|
|
begin
|
|
DataController.KeyFieldNames := Value;
|
|
end;
|
|
|
|
procedure TcxCustomLookupDBGrid.SetOptions(Value: TcxLookupDBGridOptions);
|
|
begin
|
|
FOptions.Assign(Value);
|
|
end;
|
|
|
|
end.
|