{********************************************************************} { } { 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 cxLookupGrid; {$I cxVer.inc} interface uses Windows, SysUtils, Classes, Controls, Graphics, Forms, StdCtrls, cxClasses, cxControls, cxContainer, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters, cxDataUtils, cxDataStorage, cxCustomData, cxData, cxEdit, cxEditRepositoryItems; const cxLookupGridColumnDefaultMinWidth = 20; // TODO: Common // cxGridCellTextOffset = 2; // ? cxGridEditOffset = 1; type TcxCustomLookupGrid = class; TcxLookupGridColumn = class; TcxLookupGridHitTest = (htNone, htHeader, htCell); TcxLookupGridScrollMode = (smNone, smTop, smBottom); { TcxLookupGridDataController } TcxLookupGridDataController = class(TcxDataController) private function GetGrid: TcxCustomLookupGrid; public function GetItem(Index: Integer): TObject; override; property Grid: TcxCustomLookupGrid read GetGrid; published property OnCompare; end; { TcxLookupGridViewInfo } TcxLookupGridPartViewInfo = class Bounds: TRect; ContentBounds: TRect; end; // Columns TcxLookupGridColumnViewInfo = class(TcxLookupGridPartViewInfo) private FEditViewData: TcxCustomEditViewData; FStyle: TcxCustomEditStyle; public Alignment: TAlignment; Borders: TcxBorders; Neighbors: TcxNeighbors; SortOrder: TcxDataSortOrder; Text: string; destructor Destroy; override; function CreateEditStyle(AProperties: TcxCustomEditProperties): TcxCustomEditStyle; function CreateEditViewData(AProperties: TcxCustomEditProperties): TcxCustomEditViewData; procedure DestroyEditViewData; property Style: TcxCustomEditStyle read FStyle; end; TcxLookupGridColumnsViewInfo = class(TcxObjectList) private function GetItem(Index: Integer): TcxLookupGridColumnViewInfo; public property Items[Index: Integer]: TcxLookupGridColumnViewInfo read GetItem; default; end; // rows TcxLookupGridCellViewInfo = class(TcxLookupGridPartViewInfo) private FEditViewInfo: TcxCustomEditViewInfo; public Borders: TcxBorders; Index: Integer; IsFocused: Boolean; destructor Destroy; override; function CreateEditViewInfo(AProperties: TcxCustomEditProperties): TcxCustomEditViewInfo; property EditViewInfo: TcxCustomEditViewInfo read FEditViewInfo; end; TcxLookupGridRowViewInfo = class(TcxObjectList) private function GetItem(Index: Integer): TcxLookupGridCellViewInfo; protected function AddCell(AIndex: Integer; const AInitBounds: TRect; AIsFocused: Boolean): TcxLookupGridCellViewInfo; public Borders: TcxBorders; Bounds: TRect; ContentBounds: TRect; IsFocused: Boolean; RecordIndex: Integer; RowIndex: Integer; property Items[Index: Integer]: TcxLookupGridCellViewInfo read GetItem; default; end; TcxLookupGridRowsViewInfo = class(TcxObjectList) private function GetItem(Index: Integer): TcxLookupGridRowViewInfo; public function FindByRowIndex(ARowIndex: Integer): TcxLookupGridRowViewInfo; property Items[Index: Integer]: TcxLookupGridRowViewInfo read GetItem; default; end; TcxLookupGridTopRowIndexCalculation = (ticNone, ticForward, ticBackward); TcxLookupGridViewInfo = class private FColumns: TcxLookupGridColumnsViewInfo; FGrid: TcxCustomLookupGrid; FInternalTopRowIndex: Integer; FTopRowIndexCalculation: TcxLookupGridTopRowIndexCalculation; FRowMinHeight: Integer; FRows: TcxLookupGridRowsViewInfo; function GetBounds: TRect; function GetCanvas: TcxCanvas; function GetClientBounds: TRect; function GetEmptyAreaColor: TColor; function GetGridLines: TcxGridLines; function GetRowCount: Integer; function GetRowHeight: Integer; function GetTopRowIndex: Integer; protected function AddRow(ARowIndex: Integer; const AInitBounds: TRect): TcxLookupGridRowViewInfo; function CalcCellMinHeight(AIndex: Integer): Integer; function CalcRowMinHeight: Integer; procedure CalculateCells(ARowViewInfo: TcxLookupGridRowViewInfo); function GetCellHeight(ARowIndex, AColumnIndex: Integer): Integer; function GetHeaderHeight: Integer; virtual; property TopRowIndexCalculation: TcxLookupGridTopRowIndexCalculation read FTopRowIndexCalculation write FTopRowIndexCalculation; public BorderSize: Integer; HeadersRect: TRect; EmptyRectBottom, EmptyRectRight: TRect; PartialVisibleRowCount, VisibleRowCount: Integer; RowsRect: TRect; VisibleRowsRect: TRect; constructor Create(AGrid: TcxCustomLookupGrid); virtual; destructor Destroy; override; procedure CalcCellColors(ARowIsSelected, ACellIsSelected: Boolean; var AColor, AFontColor: TColor); procedure CalcColumns; virtual; procedure CalcEmptyAreas; virtual; procedure CalcHeaders; virtual; procedure CalcRows; virtual; procedure Calculate; virtual; function CheckTopRowIndex(ANewTopIndex: Integer): Integer; virtual; procedure CreateEditStyle(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn); virtual; function CreateEditViewData(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn): TcxCustomEditViewData; virtual; procedure DestroyEditViewData(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn); virtual; function GetContentColor: TColor; virtual; function GetContentFont: TFont; virtual; function GetContentFontColor: TColor; virtual; function GetGridColor: TColor; virtual; function GetGridLineWidth: Integer; virtual; function GetHeaderColor: TColor; virtual; function GetHeaderFont: TFont; virtual; function GetHeaderFontColor: TColor; virtual; function GetSelectedColor: TColor; virtual; function GetSelectedFontColor: TColor; virtual; property Bounds: TRect read GetBounds; property Canvas: TcxCanvas read GetCanvas; property ClientBounds: TRect read GetClientBounds; property Columns: TcxLookupGridColumnsViewInfo read FColumns; property EmptyAreaColor: TColor read GetEmptyAreaColor; property Grid: TcxCustomLookupGrid read FGrid; property GridLines: TcxGridLines read GetGridLines; property GridLineWidth: Integer read GetGridLineWidth; property RowCount: Integer read GetRowCount; property RowHeight: Integer read GetRowHeight; property Rows: TcxLookupGridRowsViewInfo read FRows; property TopRowIndex: Integer read GetTopRowIndex; end; TcxLookupGridViewInfoClass = class of TcxLookupGridViewInfo; { TcxLookupGridPainter } TcxLookupGridPainter = class private FCanvas: TcxCanvas; FGrid: TcxCustomLookupGrid; FLFPainterClass: TcxCustomLookAndFeelPainterClass; function GetCanvas: TcxCanvas; function GetViewInfo: TcxLookupGridViewInfo; protected procedure DrawBorder; virtual; procedure DrawCell(ACellViewInfo: TcxLookupGridCellViewInfo); virtual; procedure DrawContent; virtual; procedure DrawEmptyArea; virtual; procedure DrawHeaders; virtual; procedure DrawRow(ARowViewInfo: TcxLookupGridRowViewInfo); virtual; procedure DrawRows; virtual; property ViewInfo: TcxLookupGridViewInfo read GetViewInfo; public constructor Create(AGrid: TcxCustomLookupGrid); virtual; destructor Destroy; override; procedure Invalidate; procedure Paint; property Canvas: TcxCanvas read GetCanvas; property Grid: TcxCustomLookupGrid read FGrid; property LFPainterClass: TcxCustomLookAndFeelPainterClass read FLFPainterClass write FLFPainterClass; end; TcxLookupGridPainterClass = class of TcxLookupGridPainter; { TcxLookupGridColumn } TcxLookupGridDefaultValuesProvider = class(TcxCustomEditDefaultValuesProvider) function IsDisplayFormatDefined(AIsCurrencyValueAccepted: Boolean): Boolean; override; end; TcxLookupGridColumn = class(TcxInterfacedCollectionItem, IcxEditRepositoryItemListener) private FCaption: string; FDefaultValuesProvider: TcxCustomEditDefaultValuesProvider; FHeaderAlignment: TAlignment; FInternalDefaultRepositoryItem: TcxEditRepositoryItem; FIsCaptionAssigned: Boolean; FIsWidthAssigned: Boolean; FMinWidth: Integer; FFixed: Boolean; FSorting: Boolean; FRepositoryItem: TcxEditRepositoryItem; FWidth: Integer; function GetCaption: string; function GetDataController: TcxCustomDataController; function GetGrid: TcxCustomLookupGrid; function GetMinWidth: Integer; function GetProperties: TcxCustomEditProperties; function GetSortOrder: TcxDataSortOrder; function GetWidth: Integer; function IsCaptionStored: Boolean; function IsWidthStored: Boolean; procedure SetCaption(const Value: string); procedure SetFixed(Value: Boolean); procedure SetHeaderAlignment(Value: TAlignment); procedure SetMinWidth(Value: Integer); procedure SetRepositoryItem(Value: TcxEditRepositoryItem); procedure SetSorting(Value: Boolean); procedure SetSortOrder(Value: TcxDataSortOrder); procedure SetWidth(Value: Integer); protected // IcxEditRepositoryItemListener procedure ItemRemoved(Sender: TcxEditRepositoryItem); procedure PropertiesChanged(Sender: TcxEditRepositoryItem); // base procedure CheckWidthValue(var Value: Integer); virtual; function GetDefaultValuesProviderClass: TcxCustomEditDefaultValuesProviderClass; virtual; function GetValueTypeClass: TcxValueTypeClass; virtual; procedure SetIndex(Value: Integer); override; procedure SetValueTypeClass(Value: TcxValueTypeClass); virtual; property DataController: TcxCustomDataController read GetDataController; public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; function DefaultCaption: string; virtual; function DefaultRepositoryItem: TcxEditRepositoryItem; virtual; function DefaultWidth: Integer; virtual; function GetContentFont: TFont; virtual; function GetInternalDefaultRepositoryItem: TcxEditRepositoryItem; virtual; function GetRepositoryItem: TcxEditRepositoryItem; virtual; function IsLeft: Boolean; virtual; function IsRight: Boolean; virtual; procedure RestoreDefaults; virtual; property DefaultValuesProvider: TcxCustomEditDefaultValuesProvider read FDefaultValuesProvider; property Properties: TcxCustomEditProperties read GetProperties; property Grid: TcxCustomLookupGrid read GetGrid; property ValueTypeClass: TcxValueTypeClass read GetValueTypeClass write SetValueTypeClass; published property Caption: string read GetCaption write SetCaption stored IsCaptionStored; property Fixed: Boolean read FFixed write SetFixed default False; property HeaderAlignment: TAlignment read FHeaderAlignment write SetHeaderAlignment default taLeftJustify; property MinWidth: Integer read GetMinWidth write SetMinWidth default cxLookupGridColumnDefaultMinWidth; property Sorting: Boolean read FSorting write SetSorting default True; property SortOrder: TcxDataSortOrder read GetSortOrder write SetSortOrder default soNone; property RepositoryItem: TcxEditRepositoryItem read FRepositoryItem write SetRepositoryItem; property Width: Integer read GetWidth write SetWidth stored IsWidthStored; end; TcxLookupGridColumnClass = class of TcxLookupGridColumn; { TcxLookupGridColumns } TcxLookupGridColumns = class(TCollection) private FGrid: TcxCustomLookupGrid; function GetColumn(Index: Integer): TcxLookupGridColumn; procedure SetColumn(Index: Integer; Value: TcxLookupGridColumn); protected function GetOwner: TPersistent; override; procedure Update(Item: TCollectionItem); override; public constructor Create(AGrid: TcxCustomLookupGrid; AColumnClass: TcxLookupGridColumnClass); virtual; function Add: TcxLookupGridColumn; procedure BeginUpdate; override; procedure EndUpdate; override; procedure RestoreDefaults; virtual; property Grid: TcxCustomLookupGrid read FGrid; property Items[Index: Integer]: TcxLookupGridColumn read GetColumn write SetColumn; default; end; TcxLookupGridColumnsClass = class of TcxLookupGridColumns; { TcxCustomLookupGrid } TcxLookupGridChange = (lgcLayout, lgcData, lgcFocusedRow); TcxLookupGridChanges = set of TcxLookupGridChange; TcxLookupGridHitInfo = record HitTest: TcxLookupGridHitTest; RowIndex: Integer; ColumnIndex: Integer; end; TcxLookupGridOptions = class(TPersistent) private FColumnSorting: Boolean; FFocusRowOnMouseMove: Boolean; FGridLines: TcxGridLines; FRowSelect: Boolean; FShowHeader: Boolean; FOnChanged: TNotifyEvent; function GetAnsiSort: Boolean; function GetCaseInsensitive: Boolean; procedure SetAnsiSort(Value: Boolean); procedure SetCaseInsensitive(Value: Boolean); procedure SetGridLines(Value: TcxGridLines); procedure SetRowSelect(Value: Boolean); procedure SetShowHeader(Value: Boolean); protected FGrid: TcxCustomLookupGrid; procedure Changed; virtual; public constructor Create(AGrid: TcxCustomLookupGrid); virtual; procedure Assign(Source: TPersistent); override; property Grid: TcxCustomLookupGrid read FGrid; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; published property AnsiSort: Boolean read GetAnsiSort write SetAnsiSort default False; property CaseInsensitive: Boolean read GetCaseInsensitive write SetCaseInsensitive default False; property ColumnSorting: Boolean read FColumnSorting write FColumnSorting default True; property FocusRowOnMouseMove: Boolean read FFocusRowOnMouseMove write FFocusRowOnMouseMove default True; property GridLines: TcxGridLines read FGridLines write SetGridLines default glBoth; property RowSelect: Boolean read FRowSelect write SetRowSelect default True; property ShowHeader: Boolean read FShowHeader write SetShowHeader default True; end; TcxLookupGridOptionsClass = class of TcxLookupGridOptions; TcxLookupGridCloseUpEvent = procedure (Sender: TObject; AAccept: Boolean) of object; TcxCustomLookupGrid = class(TcxControl) private FChanges: TcxLookupGridChanges; FColumns: TcxLookupGridColumns; FFocusedColumn: TcxLookupGridColumn; FIsPopupControl: Boolean; FLockCount: Integer; FPainter: TcxLookupGridPainter; FRowPressed: Boolean; FScrollMode: TcxLookupGridScrollMode; FScrollTimer: TcxTimer; FTopRowIndex: Integer; FViewInfo: TcxLookupGridViewInfo; FOnClick: TNotifyEvent; FOnCloseUp: TcxLookupGridCloseUpEvent; FOnDataChanged: TNotifyEvent; FOnFocusedRowChanged: TNotifyEvent; procedure CreateScrollTimer; procedure DestroyScrollTimer; function GetDataController: TcxCustomDataController; function GetFocusedColumn: TcxLookupGridColumn; function GetFocusedColumnIndex: Integer; function GetFocusedRowIndex: Integer; function GetRowCount: Integer; procedure SetColumns(Value: TcxLookupGridColumns); procedure SetDataController(Value: TcxCustomDataController); procedure SetFocusedColumn(Value: TcxLookupGridColumn); procedure SetFocusedColumnIndex(Value: Integer); procedure SetFocusedRowIndex(Value: Integer); procedure SetIsPopupControl(Value: Boolean); procedure SetOptions(Value: TcxLookupGridOptions); procedure SetTopRowIndex(Value: Integer); procedure ScrollTimerHandler(Sender: TObject); protected FDataController: TcxCustomDataController; FOptions: TcxLookupGridOptions; procedure ColorChanged; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; function AllowDragAndDropWithoutFocus: Boolean; override; procedure BoundsChanged; override; procedure DoCancelMode; override; procedure FocusChanged; override; procedure FontChanged; override; function GetBorderSize: Integer; override; procedure InitControl; override; procedure InitScrollBarsParameters; override; procedure Scroll(AScrollBarKind: TScrollBarKind; AScrollCode: TScrollCode; var AScrollPos: Integer); override; procedure AddColumn(AColumn: TcxLookupGridColumn); virtual; procedure Change(AChanges: TcxLookupGridChanges); virtual; procedure CheckChanges; procedure CheckSetTopRowIndex(var Value: Integer); procedure CheckTopRowIndex(ATopRowIndex: Integer; ANotUpdate: Boolean); procedure CreateHandlers; virtual; procedure CreateSubClasses; virtual; procedure DestroyHandlers; virtual; procedure DestroySubClasses; virtual; procedure DoCellClick(ARowIndex, AColumnIndex: Integer; AShift: TShiftState); virtual; procedure DoHeaderClick(AColumnIndex: Integer; AShift: TShiftState); virtual; procedure FocusColumn(AColumnIndex: Integer); procedure FocusNextPage; procedure FocusNextRow(AGoForward: Boolean); procedure FocusPriorPage; function GetColumnClass: TcxLookupGridColumnClass; virtual; function GetColumnsClass: TcxLookupGridColumnsClass; virtual; function GetDataControllerClass: TcxCustomDataControllerClass; virtual; function GetLFPainterClass: TcxCustomLookAndFeelPainterClass; virtual; function GetOptionsClass: TcxLookupGridOptionsClass; virtual; function GetPainterClass: TcxLookupGridPainterClass; virtual; function GetScrollBarOffsetBegin: Integer; virtual; function GetScrollBarOffsetEnd: Integer; virtual; function GetViewInfoClass: TcxLookupGridViewInfoClass; virtual; function IsHotTrack: Boolean; virtual; procedure LookAndFeelChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues); override; procedure RemoveColumn(AColumn: TcxLookupGridColumn); virtual; procedure SetScrollMode(Value: TcxLookupGridScrollMode); virtual; procedure ShowNextPage; procedure ShowPrevPage; procedure UpdateFocusing; virtual; procedure UpdateRowInfo(ARowIndex: Integer; ARecalculate: Boolean); virtual; procedure UpdateLayout; virtual; // Data Controller Notifications procedure DataChanged; virtual; procedure DataLayoutChanged; virtual; procedure DoClick; virtual; procedure DoCloseUp(AAccept: Boolean); virtual; procedure DoFocusedRowChanged; virtual; procedure FocusedRowChanged(APrevFocusedRowIndex, AFocusedRowIndex: Integer); virtual; procedure LayoutChanged; virtual; procedure SelectionChanged(AInfo: TcxSelectionChangedInfo); virtual; procedure UpdateControl(AInfo: TcxUpdateControlInfo); virtual; property Color default clWindow; property ParentColor default False; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; procedure CancelUpdate; procedure EndUpdate; function GetHitInfo(P: TPoint): TcxLookupGridHitInfo; function GetNearestPopupHeight(AHeight: Integer): Integer; function GetPopupHeight(ADropDownRowCount: Integer): Integer; function IsMouseOverList(const P: TPoint): Boolean; function IsRowVisible(ARowIndex: Integer): Boolean; procedure LockPopupMouseMove; procedure MakeFocusedRowVisible; procedure MakeRowVisible(ARowIndex: Integer); procedure SyncSelected(ASelected: Boolean); virtual; property Columns: TcxLookupGridColumns read FColumns write SetColumns; property DataController: TcxCustomDataController read GetDataController write SetDataController; property FocusedColumn: TcxLookupGridColumn read GetFocusedColumn write SetFocusedColumn; property FocusedColumnIndex: Integer read GetFocusedColumnIndex write SetFocusedColumnIndex; property FocusedRowIndex: Integer read GetFocusedRowIndex write SetFocusedRowIndex; property IsPopupControl: Boolean read FIsPopupControl write SetIsPopupControl; property LockCount: Integer read FLockCount; property LookAndFeel; property Options: TcxLookupGridOptions read FOptions write SetOptions; property Painter: TcxLookupGridPainter read FPainter; property RowCount: Integer read GetRowCount; property ScrollBarOffsetBegin: Integer read GetScrollBarOffsetBegin; property ScrollBarOffsetEnd: Integer read GetScrollBarOffsetEnd; property TopRowIndex: Integer read FTopRowIndex write SetTopRowIndex; property ViewInfo: TcxLookupGridViewInfo read FViewInfo; property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnCloseUp: TcxLookupGridCloseUpEvent read FOnCloseUp write FOnCloseUp; property OnDataChanged: TNotifyEvent read FOnDataChanged write FOnDataChanged; property OnFocusedRowChanged: TNotifyEvent read FOnFocusedRowChanged write FOnFocusedRowChanged; end; TcxCustomLookupGridClass = class of TcxCustomLookupGrid; { TcxLookupGrid } TcxLookupGrid = class(TcxCustomLookupGrid) published property Align; property Anchors; property Color; property Font; property ParentFont; property Visible; property Columns; property DataController; property Options; property LookAndFeel; end; implementation uses {$IFDEF DELPHI6} Variants, {$ENDIF} cxEditRegisteredRepositoryItems, cxEditDataRegisteredRepositoryItems; const ScrollTimerInterval = 50; var FPrevMousePos: TPoint; function PtInWidth(const R: TRect; P: TPoint): Boolean; begin Result := (R.Left <= P.X) and (P.X < R.Right) end; { TcxLookupGridColumnViewInfo } destructor TcxLookupGridColumnViewInfo.Destroy; begin FreeAndNil(FStyle); inherited Destroy; end; function TcxLookupGridColumnViewInfo.CreateEditStyle(AProperties: TcxCustomEditProperties): TcxCustomEditStyle; begin FStyle := AProperties.GetStyleClass.Create(nil, True) as TcxCustomEditStyle; FStyle.ButtonTransparency := ebtHideInactive; Result := FStyle; end; function TcxLookupGridColumnViewInfo.CreateEditViewData(AProperties: TcxCustomEditProperties): TcxCustomEditViewData; begin FEditViewData := AProperties.CreateViewData(FStyle, True); Result := FEditViewData; end; procedure TcxLookupGridColumnViewInfo.DestroyEditViewData; begin FreeAndNil(FEditViewData); end; { TcxLookupGridColumnsViewInfo } function TcxLookupGridColumnsViewInfo.GetItem(Index: Integer): TcxLookupGridColumnViewInfo; begin Result := TcxLookupGridColumnViewInfo(inherited Items[Index]); end; { TcxLookupGridCellViewInfo } destructor TcxLookupGridCellViewInfo.Destroy; begin FreeAndNil(FEditViewInfo); inherited Destroy; end; function TcxLookupGridCellViewInfo.CreateEditViewInfo(AProperties: TcxCustomEditProperties): TcxCustomEditViewInfo; begin if FEditViewInfo <> nil then FEditViewInfo.Free; FEditViewInfo := AProperties.GetViewInfoClass.Create as TcxCustomEditViewInfo; Result := FEditViewInfo; end; { TcxLookupGridRowViewInfo } function TcxLookupGridRowViewInfo.AddCell(AIndex: Integer; const AInitBounds: TRect; AIsFocused: Boolean): TcxLookupGridCellViewInfo; begin Result := TcxLookupGridCellViewInfo.Create; Add(Result); Result.Index := AIndex; Result.IsFocused := AIsFocused; Result.Bounds := AInitBounds; end; function TcxLookupGridRowViewInfo.GetItem(Index: Integer): TcxLookupGridCellViewInfo; begin Result := TcxLookupGridCellViewInfo(inherited Items[Index]); end; { TcxLookupGridRowsViewInfo } function TcxLookupGridRowsViewInfo.FindByRowIndex(ARowIndex: Integer): TcxLookupGridRowViewInfo; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if Items[I].RowIndex = ARowIndex then begin Result := Items[I]; Break; end; end; function TcxLookupGridRowsViewInfo.GetItem(Index: Integer): TcxLookupGridRowViewInfo; begin Result := TcxLookupGridRowViewInfo(inherited Items[Index]); end; { TcxLookupGridViewInfo } constructor TcxLookupGridViewInfo.Create(AGrid: TcxCustomLookupGrid); begin inherited Create; FGrid := AGrid; FColumns := TcxLookupGridColumnsViewInfo.Create; FRows := TcxLookupGridRowsViewInfo.Create; end; destructor TcxLookupGridViewInfo.Destroy; begin FRows.Free; FColumns.Free; inherited Destroy; end; procedure TcxLookupGridViewInfo.CalcHeaders; procedure CreateItems; var I: Integer; AItem: TcxLookupGridColumnViewInfo; begin for I := 0 to Grid.Columns.Count - 1 do begin AItem := TcxLookupGridColumnViewInfo.Create; with AItem do begin Alignment := Grid.Columns[I].HeaderAlignment; Neighbors := []; if not Grid.Columns[I].IsLeft then Neighbors := Neighbors + [nLeft]; if not Grid.Columns[I].IsRight then Neighbors := Neighbors + [nRight]; Borders := Grid.Painter.LFPainterClass.HeaderBorders(Neighbors); SortOrder := Grid.Columns[I].SortOrder; Text := Grid.Columns[I].Caption; end; CreateEditStyle(AItem, Grid.Columns[I]); FColumns.Add(AItem); end; end; procedure CalcBounds; var I, ALeft: Integer; AAutoWidthObject: TcxAutoWidthObject; AItem: TcxLookupGridColumnViewInfo; begin AAutoWidthObject := TcxAutoWidthObject.Create(Grid.Columns.Count); try for I := 0 to Grid.Columns.Count - 1 do begin with AAutoWidthObject.AddItem do begin MinWidth := Grid.Columns[I].MinWidth; Width := Grid.Columns[I].Width; Fixed := Grid.Columns[I].Fixed; end; end; AAutoWidthObject.AvailableWidth := HeadersRect.Right - HeadersRect.Left; AAutoWidthObject.Calculate; ALeft := HeadersRect.Left; for I := 0 to Grid.Columns.Count - 1 do begin AItem := Columns[I]; with AItem do begin Bounds := Rect(ALeft, HeadersRect.Top, ALeft + AAutoWidthObject[I].AutoWidth, HeadersRect.Bottom); ALeft := Bounds.Right; ContentBounds := Grid.Painter.LFPainterClass.HeaderContentBounds(Bounds, Borders); end; end; if ALeft < HeadersRect.Right then HeadersRect.Right := ALeft; finally AAutoWidthObject.Free; end; end; begin CreateItems; CalcBounds; end; procedure TcxLookupGridViewInfo.CalcEmptyAreas; begin if HeadersRect.Right < ClientBounds.Right then EmptyRectRight := Rect(HeadersRect.Right, ClientBounds.Top, ClientBounds.Right, ClientBounds.Bottom) else SetRectEmpty(EmptyRectRight); if RowsRect.Bottom < ClientBounds.Bottom then EmptyRectBottom := Rect(ClientBounds.Left, RowsRect.Bottom, ClientBounds.Right, ClientBounds.Bottom) else SetRectEmpty(EmptyRectBottom); end; procedure TcxLookupGridViewInfo.CalcCellColors(ARowIsSelected, ACellIsSelected: Boolean; var AColor, AFontColor: TColor); begin if ARowIsSelected and not ACellIsSelected then begin AColor := GetSelectedColor; AFontColor := GetSelectedFontColor; end else begin AColor := GetContentColor; AFontColor := GetContentFontColor; end; end; procedure TcxLookupGridViewInfo.CalcColumns; begin FColumns.Clear; if Grid.Columns.Count > 0 then begin HeadersRect := ClientBounds; if Grid.Options.ShowHeader then HeadersRect.Bottom := HeadersRect.Top + GetHeaderHeight else HeadersRect.Bottom := HeadersRect.Top; CalcHeaders; end else SetRectEmpty(HeadersRect); end; procedure TcxLookupGridViewInfo.CalcRows; procedure CalcCells(ARowIndex: Integer; var ATop: Integer); var I, ACellHeight, ARowHeight: Integer; ARect: TRect; ARowViewInfo: TcxLookupGridRowViewInfo; ACellViewInfo: TcxLookupGridCellViewInfo; function ExistEmptyArea: Boolean; begin Result := (TopRowIndexCalculation = ticNone) and (ARowViewInfo.Bounds.Bottom <> ClientBounds.Bottom); end; begin ARowViewInfo := AddRow(ARowIndex, Rect(RowsRect.Left, ATop, RowsRect.Right, ATop)); // Init Cells ARowHeight := 0; for I := 0 to Grid.Columns.Count - 1 do begin ACellHeight := GetCellHeight(ARowIndex, I); if ACellHeight > ARowHeight then ARowHeight := ACellHeight; with Columns[I].Bounds do ARect := Rect(Left, ATop, Right, ATop); ARowViewInfo.AddCell(I, ARect, Grid.FocusedColumnIndex = I); end; // Correct Bottom + Calc Content ARowViewInfo.Bounds.Bottom := ATop + ARowHeight; ARowViewInfo.ContentBounds := ARowViewInfo.Bounds; for I := 0 to ARowViewInfo.Count - 1 do begin ACellViewInfo := ARowViewInfo[I]; ACellViewInfo.Bounds.Bottom := ARowViewInfo.Bounds.Bottom; ACellViewInfo.ContentBounds := ACellViewInfo.Bounds; if (GridLines in [glBoth, glVertical]) or ((GridLines = glHorizontal) and (I = (ARowViewInfo.Count - 1))) then begin Dec(ACellViewInfo.ContentBounds.Right, GetGridLineWidth); if I = (ARowViewInfo.Count - 1) then begin Dec(ARowViewInfo.ContentBounds.Right, GetGridLineWidth); Include(ARowViewInfo.Borders, bRight); end else Include(ACellViewInfo.Borders, bRight); end; end; if (GridLines in [glBoth, glHorizontal]) or ((GridLines = glVertical) and (ARowIndex = (RowCount - 1)) and ExistEmptyArea) then begin Inc(ARowViewInfo.Bounds.Bottom, GetGridLineWidth); Include(ARowViewInfo.Borders, bBottom); end; RowsRect.Bottom := ARowViewInfo.Bounds.Bottom; ATop := RowsRect.Bottom; CalculateCells(ARowViewInfo); end; var I, ATop: Integer; begin FRows.Clear; SetRectEmpty(RowsRect); SetRectEmpty(VisibleRowsRect); PartialVisibleRowCount := 0; VisibleRowCount := 0; if (HeadersRect.Right - HeadersRect.Left) > 0 then begin FRowMinHeight := CalcRowMinHeight; RowsRect := Rect(HeadersRect.Left, HeadersRect.Bottom, HeadersRect.Right, HeadersRect.Bottom); VisibleRowsRect := RowsRect; ATop := RowsRect.Top; if TopRowIndexCalculation = ticBackward then begin for I := TopRowIndex downto 0 do begin CalcCells(I, ATop); Inc(PartialVisibleRowCount); if RowsRect.Bottom <= ClientBounds.Bottom then begin Inc(VisibleRowCount); VisibleRowsRect.Bottom := RowsRect.Bottom; end else Break; end; end else begin for I := TopRowIndex to RowCount - 1 do begin CalcCells(I, ATop); Inc(PartialVisibleRowCount); if RowsRect.Bottom <= ClientBounds.Bottom then begin Inc(VisibleRowCount); VisibleRowsRect.Bottom := RowsRect.Bottom; end else Break; end; end; if (PartialVisibleRowCount > 0) and (VisibleRowCount = 0) then VisibleRowCount := 1; end; end; procedure TcxLookupGridViewInfo.Calculate; begin BorderSize := FGrid.GetBorderSize; CalcColumns; CalcRows; CalcEmptyAreas; end; function TcxLookupGridViewInfo.CheckTopRowIndex(ANewTopIndex: Integer): Integer; begin TopRowIndexCalculation := ticForward; try FInternalTopRowIndex := ANewTopIndex; Calculate; if not IsRectEmpty(EmptyRectBottom) then begin TopRowIndexCalculation := ticBackward; try FInternalTopRowIndex := ANewTopIndex + VisibleRowCount - 1; if FInternalTopRowIndex > (RowCount - 1) then FInternalTopRowIndex := RowCount - 1; Calculate; ANewTopIndex := FInternalTopRowIndex - VisibleRowCount + 1; finally TopRowIndexCalculation := ticNone; end; end; finally TopRowIndexCalculation := ticNone; end; Result := ANewTopIndex; end; function TcxLookupGridViewInfo.AddRow(ARowIndex: Integer; const AInitBounds: TRect): TcxLookupGridRowViewInfo; begin Result := TcxLookupGridRowViewInfo.Create; FRows.Add(Result); Result.RowIndex := ARowIndex; Result.RecordIndex := Grid.FDataController.GetRowInfo(ARowIndex).RecordIndex; Result.IsFocused := ARowIndex = Grid.FocusedRowIndex; Result.Bounds := AInitBounds; end; function TcxLookupGridViewInfo.CalcCellMinHeight(AIndex: Integer): Integer; var AEditViewData: TcxCustomEditViewData; begin AEditViewData := CreateEditViewData(Columns[AIndex], Grid.Columns[AIndex]); try Result := 2 * cxGridEditOffset + AEditViewData.GetEditSize(Canvas, Null, DefaultcxEditSizeProperties).cy; finally DestroyEditViewData(Columns[AIndex], Grid.Columns[AIndex]); end; end; function TcxLookupGridViewInfo.CalcRowMinHeight: Integer; var I, ACellHeight: Integer; begin Result := 0; for I := 0 to Grid.Columns.Count - 1 do begin ACellHeight := CalcCellMinHeight(I); if ACellHeight > Result then Result := ACellHeight; end; end; procedure TcxLookupGridViewInfo.CalculateCells(ARowViewInfo: TcxLookupGridRowViewInfo); procedure CalcCell(ACellViewInfo: TcxLookupGridCellViewInfo); var AColor, AFontColor: TColor; ADisplayValue: Variant; AEditViewData: TcxCustomEditViewData; AEditViewInfo: TcxCustomEditViewInfo; ARect: TRect; ASelected: Boolean; begin // Style ASelected := Grid.DataController.IsRowSelected(ARowViewInfo.RowIndex); CalcCellColors(ASelected and ARowViewInfo.IsFocused, ASelected and ACellViewInfo.IsFocused, AColor, AFontColor); with Columns[ACellViewInfo.Index].Style do begin StyleData.Color := AColor; StyleData.FontColor := AFontColor; end; // Calculate AEditViewInfo := ACellViewInfo.CreateEditViewInfo(Grid.Columns[ACellViewInfo.Index].Properties); AEditViewData := CreateEditViewData(Columns[ACellViewInfo.Index], Grid.Columns[ACellViewInfo.Index]); try // Value if Grid.Columns[ACellViewInfo.Index].Properties.GetEditValueSource(False) = evsValue then ADisplayValue := Grid.FDataController.Values[ARowViewInfo.RecordIndex, ACellViewInfo.Index] else ADisplayValue := Grid.FDataController.DisplayTexts[ARowViewInfo.RecordIndex, ACellViewInfo.Index]; // Calculate ARect := ACellViewInfo.ContentBounds; InflateRect(ARect, -cxGridEditOffset, -cxGridEditOffset); AEditViewData.EditValueToDrawValue(Canvas, ADisplayValue, AEditViewInfo); AEditViewData.Calculate(Canvas, ARect, Point(-1, -1), cxmbNone, [], AEditViewInfo, False); finally DestroyEditViewData(Columns[ACellViewInfo.Index], Grid.Columns[ACellViewInfo.Index]); end; end; var I: Integer; begin for I := 0 to ARowViewInfo.Count - 1 do CalcCell(ARowViewInfo[I]); end; function TcxLookupGridViewInfo.GetCellHeight(ARowIndex, AColumnIndex: Integer): Integer; begin Result := FRowMinHeight; end; function TcxLookupGridViewInfo.GetContentColor: TColor; begin Result := Grid.Color; end; function TcxLookupGridViewInfo.GetContentFont: TFont; begin Result := Grid.Font; end; function TcxLookupGridViewInfo.GetContentFontColor: TColor; begin Result := GetContentFont.Color; end; procedure TcxLookupGridViewInfo.CreateEditStyle(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn); begin AColumnViewInfo.CreateEditStyle(AColumn.Properties); with AColumnViewInfo.Style do StyleData.Font := AColumn.GetContentFont; end; function TcxLookupGridViewInfo.CreateEditViewData(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn): TcxCustomEditViewData; begin with AColumn.Properties do begin LockUpdate(True); try IDefaultValuesProvider := AColumn.DefaultValuesProvider; finally LockUpdate(False); end; end; Result := AColumnViewInfo.CreateEditViewData(AColumn.Properties); end; procedure TcxLookupGridViewInfo.DestroyEditViewData(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn); begin AColumnViewInfo.DestroyEditViewData; with AColumn.Properties do begin LockUpdate(True); try IDefaultValuesProvider := nil; finally LockUpdate(False); end; end; end; function TcxLookupGridViewInfo.GetGridColor: TColor; begin Result := clBtnFace; // TODO: style end; function TcxLookupGridViewInfo.GetGridLineWidth: Integer; begin Result := 1; end; function TcxLookupGridViewInfo.GetHeaderColor: TColor; begin Result := Grid.Painter.LFPainterClass.DefaultHeaderColor; end; function TcxLookupGridViewInfo.GetHeaderFont: TFont; begin Result := Grid.Font; // TODO: style end; function TcxLookupGridViewInfo.GetHeaderFontColor: TColor; begin Result := Grid.Painter.LFPainterClass.DefaultHeaderTextColor; end; function TcxLookupGridViewInfo.GetSelectedColor: TColor; begin Result := Grid.Painter.LFPainterClass.DefaultSelectionColor; // clHighlight; end; function TcxLookupGridViewInfo.GetSelectedFontColor: TColor; begin Result := Grid.Painter.LFPainterClass.DefaultSelectionTextColor; // clHighlightText; end; function TcxLookupGridViewInfo.GetHeaderHeight: Integer; begin Result := Grid.Painter.LFPainterClass.HeaderHeight(Canvas.FontHeight(GetHeaderFont)); end; function TcxLookupGridViewInfo.GetBounds: TRect; begin Result := FGrid.Bounds; end; function TcxLookupGridViewInfo.GetCanvas: TcxCanvas; begin Result := FGrid.Painter.Canvas; end; function TcxLookupGridViewInfo.GetClientBounds: TRect; begin Result := FGrid.ClientBounds; end; function TcxLookupGridViewInfo.GetEmptyAreaColor: TColor; begin Result := FGrid.Color; end; function TcxLookupGridViewInfo.GetGridLines: TcxGridLines; begin Result := FGrid.Options.GridLines; end; function TcxLookupGridViewInfo.GetRowCount: Integer; begin Result := Grid.RowCount; end; function TcxLookupGridViewInfo.GetRowHeight: Integer; begin // TODO: RowAutoHeight Result := FRowMinHeight; if (Grid.Options.GridLines in [glBoth, glHorizontal]) then Inc(Result, GetGridLineWidth); end; function TcxLookupGridViewInfo.GetTopRowIndex: Integer; begin if TopRowIndexCalculation <> ticNone then Result := FInternalTopRowIndex else Result := Grid.TopRowIndex; end; { TcxLookupGridPainter } constructor TcxLookupGridPainter.Create(AGrid: TcxCustomLookupGrid); begin inherited Create; FGrid := AGrid; end; destructor TcxLookupGridPainter.Destroy; begin FreeAndNil(FCanvas); inherited Destroy; end; procedure TcxLookupGridPainter.Invalidate; begin Grid.Invalidate; end; procedure TcxLookupGridPainter.Paint; begin DrawBorder; DrawContent; end; procedure TcxLookupGridPainter.DrawBorder; begin with ViewInfo do if BorderSize <> 0 then begin LFPainterClass.DrawBorder(Canvas, Bounds); Canvas.IntersectClipRect(ClientBounds); end; end; procedure TcxLookupGridPainter.DrawContent; begin DrawHeaders; DrawEmptyArea; DrawRows; end; procedure TcxLookupGridPainter.DrawCell(ACellViewInfo: TcxLookupGridCellViewInfo); begin ACellViewInfo.EditViewInfo.Paint(Canvas); Canvas.FrameRect(ACellViewInfo.ContentBounds, ACellViewInfo.EditViewInfo.BackgroundColor, cxGridEditOffset); Canvas.FrameRect(ACellViewInfo.Bounds, ViewInfo.GetGridColor, ViewInfo.GetGridLineWidth, ACellViewInfo.Borders); end; procedure TcxLookupGridPainter.DrawEmptyArea; begin with ViewInfo do if not IsRectEmpty(EmptyRectBottom) or not IsRectEmpty(EmptyRectRight) then begin Canvas.Brush.Color := EmptyAreaColor; if not IsRectEmpty(EmptyRectBottom) then Canvas.FillRect(EmptyRectBottom); if not IsRectEmpty(EmptyRectRight) then Canvas.FillRect(EmptyRectRight); end; end; procedure TcxLookupGridPainter.DrawHeaders; var R, ASortRect, ATextRect: TRect; ASortOrder: TcxDataSortOrder; I: Integer; begin with ViewInfo do if not IsRectEmpty(HeadersRect) then begin for I := 0 to Columns.Count - 1 do begin R := Columns[I].Bounds; ATextRect := LFPainterClass.HeaderContentBounds(R, Columns[I].Borders); InflateRect(ATextRect, -cxHeaderTextOffset, -cxHeaderTextOffset); ASortOrder := Columns[I].SortOrder; if ASortOrder <> soNone then begin ASortRect := Rect(ATextRect.Right - LFPainterClass.SortingMarkAreaSize.X, ATextRect.Top, ATextRect.Right, ATextRect.Bottom); ATextRect.Right := ASortRect.Left; if ATextRect.Right < ATextRect.Left then ATextRect.Right := ATextRect.Left; end; LFPainterClass.DrawHeader(Canvas, R, ATextRect, Columns[I].Neighbors, Columns[I].Borders, cxbsNormal, Columns[I].Alignment, vaCenter, False, True, Columns[I].Text, GetHeaderFont, GetHeaderFontColor, GetHeaderColor); if ASortOrder <> soNone then LFPainterClass.DrawSortingMark(Canvas, ASortRect, ASortOrder = soAscending); end; end; end; procedure TcxLookupGridPainter.DrawRow(ARowViewInfo: TcxLookupGridRowViewInfo); var I: Integer; ACellViewInfo: TcxLookupGridCellViewInfo; begin for I := 0 to ARowViewInfo.Count - 1 do begin ACellViewInfo := ARowViewInfo[I]; Canvas.FrameRect(ACellViewInfo.Bounds, ViewInfo.GetGridColor, ViewInfo.GetGridLineWidth, ACellViewInfo.Borders); DrawCell(ACellViewInfo); end; Canvas.FrameRect(ARowViewInfo.Bounds, ViewInfo.GetGridColor, ViewInfo.GetGridLineWidth, ARowViewInfo.Borders); if ARowViewInfo.IsFocused and (Grid.Focused or Grid.IsPopupControl) then Canvas.DrawFocusRect(ARowViewInfo.ContentBounds); end; procedure TcxLookupGridPainter.DrawRows; var I: Integer; begin with ViewInfo do if not IsRectEmpty(RowsRect) then for I := 0 to PartialVisibleRowCount - 1 do DrawRow(Rows[I]); end; function TcxLookupGridPainter.GetCanvas: TcxCanvas; begin if Grid.HandleAllocated then begin if FCanvas <> nil then FreeAndNil(FCanvas); Result := Grid.Canvas; end else begin if FCanvas = nil then FCanvas := TcxScreenCanvas.Create; Result := FCanvas; end; end; function TcxLookupGridPainter.GetViewInfo: TcxLookupGridViewInfo; begin Result := Grid.ViewInfo; end; { TcxLookupGridDefaultValuesProvider } function TcxLookupGridDefaultValuesProvider.IsDisplayFormatDefined(AIsCurrencyValueAccepted: Boolean): Boolean; begin with TcxLookupGridColumn(Owner) do Result := DataController.GetItemTextStored(Index); end; { TcxLookupGridColumn } constructor TcxLookupGridColumn.Create(Collection: TCollection); var AGrid: TcxCustomLookupGrid; begin if Assigned(Collection) and (Collection is TcxLookupGridColumns) then AGrid := TcxLookupGridColumns(Collection).Grid else AGrid := nil; if Assigned(AGrid) then AGrid.BeginUpdate; try inherited Create(Collection); FDefaultValuesProvider := GetDefaultValuesProviderClass.Create(Self); FMinWidth := cxLookupGridColumnDefaultMinWidth; FSorting := True; Changed(False); if AGrid <> nil then AGrid.AddColumn(Self); finally if Assigned(AGrid) then AGrid.EndUpdate; end; end; destructor TcxLookupGridColumn.Destroy; var AGrid: TcxCustomLookupGrid; AGridNotify: Boolean; begin AGrid := Grid; AGridNotify := False; if AGrid <> nil then begin AGridNotify := not (csDestroying in AGrid.ComponentState) {and not TcxLookupGridColumns(Collection).Locked}; if AGridNotify then AGrid.BeginUpdate; AGrid.RemoveColumn(Self); end; try RepositoryItem := nil; FreeAndNil(FInternalDefaultRepositoryItem); FDefaultValuesProvider.Free; FDefaultValuesProvider := nil; inherited Destroy; finally if (AGrid <> nil) and AGridNotify then AGrid.EndUpdate; end; end; procedure TcxLookupGridColumn.Assign(Source: TPersistent); begin if Source is TcxLookupGridColumn then begin if Assigned(Collection) then Collection.BeginUpdate; try RestoreDefaults; if TcxLookupGridColumn(Source).IsCaptionStored then Caption := TcxLookupGridColumn(Source).Caption; HeaderAlignment := TcxLookupGridColumn(Source).HeaderAlignment; MinWidth := TcxLookupGridColumn(Source).MinWidth; Fixed := TcxLookupGridColumn(Source).Fixed; Sorting := TcxLookupGridColumn(Source).Sorting; SortOrder := TcxLookupGridColumn(Source).SortOrder; RepositoryItem := TcxLookupGridColumn(Source).RepositoryItem; if TcxLookupGridColumn(Source).IsWidthStored then Width := TcxLookupGridColumn(Source).Width; finally if Assigned(Collection) then Collection.EndUpdate; end; end else inherited Assign(Source); end; function TcxLookupGridColumn.DefaultCaption: string; begin Result := ''; end; function TcxLookupGridColumn.DefaultRepositoryItem: TcxEditRepositoryItem; begin Result := GetDefaultEditDataRepositoryItems.GetDefaultItem; end; function TcxLookupGridColumn.DefaultWidth: Integer; begin Result := 64; end; function TcxLookupGridColumn.GetContentFont: TFont; begin if Grid <> nil then Result := Grid.ViewInfo.GetContentFont else Result := nil; end; function TcxLookupGridColumn.GetInternalDefaultRepositoryItem: TcxEditRepositoryItem; begin Result := DefaultRepositoryItem; if Result = nil then begin if FInternalDefaultRepositoryItem = nil then FInternalDefaultRepositoryItem := TcxEditRepositoryTextItem.Create(nil); Result := FInternalDefaultRepositoryItem; end; end; function TcxLookupGridColumn.GetRepositoryItem: TcxEditRepositoryItem; begin if RepositoryItem <> nil then Result := RepositoryItem else Result := GetInternalDefaultRepositoryItem; end; function TcxLookupGridColumn.IsLeft: Boolean; begin Result := Index = 0; end; function TcxLookupGridColumn.IsRight: Boolean; begin Result := Index = Collection.Count - 1; end; procedure TcxLookupGridColumn.RestoreDefaults; begin FIsCaptionAssigned := False; FIsWidthAssigned := False; FHeaderAlignment := taLeftJustify; FMinWidth := cxLookupGridColumnDefaultMinWidth; FFixed := False; FSorting := True; Changed(False); end; // IcxEditRepositoryItemListener procedure TcxLookupGridColumn.ItemRemoved(Sender: TcxEditRepositoryItem); begin RepositoryItem := nil; end; procedure TcxLookupGridColumn.PropertiesChanged(Sender: TcxEditRepositoryItem); begin Changed(False); end; procedure TcxLookupGridColumn.CheckWidthValue(var Value: Integer); begin if Value < FMinWidth then Value := FMinWidth; end; function TcxLookupGridColumn.GetDefaultValuesProviderClass: TcxCustomEditDefaultValuesProviderClass; begin Result := TcxLookupGridDefaultValuesProvider; end; function TcxLookupGridColumn.GetValueTypeClass: TcxValueTypeClass; begin if Grid <> nil then Result := Grid.FDataController.GetItemValueTypeClass(Index) else Result := nil; end; procedure TcxLookupGridColumn.SetIndex(Value: Integer); begin inherited SetIndex(Value); if Grid <> nil then Grid.FDataController.UpdateItemIndexes; end; procedure TcxLookupGridColumn.SetValueTypeClass(Value: TcxValueTypeClass); begin if Grid <> nil then Grid.FDataController.ChangeValueTypeClass(Index, Value); end; function TcxLookupGridColumn.GetCaption: string; begin if FIsCaptionAssigned then Result := FCaption else Result := DefaultCaption; end; function TcxLookupGridColumn.GetDataController: TcxCustomDataController; begin Result := TcxCustomDataController(Grid.FDataController) end; function TcxLookupGridColumn.GetGrid: TcxCustomLookupGrid; begin Result := TcxLookupGridColumns(Collection).Grid; end; function TcxLookupGridColumn.GetMinWidth: Integer; begin Result := FMinWidth; end; function TcxLookupGridColumn.GetProperties: TcxCustomEditProperties; begin Result := GetRepositoryItem.Properties; end; function TcxLookupGridColumn.GetSortOrder: TcxDataSortOrder; begin if Grid <> nil then Result := Grid.FDataController.GetItemSortOrder(Index) else Result := soNone; end; function TcxLookupGridColumn.GetWidth: Integer; begin if FIsWidthAssigned then Result := FWidth else Result := DefaultWidth; end; function TcxLookupGridColumn.IsCaptionStored: Boolean; begin Result := FIsCaptionAssigned; end; function TcxLookupGridColumn.IsWidthStored: Boolean; begin Result := FIsWidthAssigned; end; procedure TcxLookupGridColumn.SetCaption(const Value: string); begin FCaption := Value; FIsCaptionAssigned := True; Changed(False); end; procedure TcxLookupGridColumn.SetFixed(Value: Boolean); begin if FFixed <> Value then begin FFixed := Value; Changed(False); end; end; procedure TcxLookupGridColumn.SetHeaderAlignment(Value: TAlignment); begin if FHeaderAlignment <> Value then begin FHeaderAlignment := Value; Changed(False); end; end; procedure TcxLookupGridColumn.SetMinWidth(Value: Integer); begin if Value < 0 then Value := 0; if FMinWidth <> Value then begin FMinWidth := Value; if Width < FMinWidth then Width := FMinWidth; Changed(False); end; end; procedure TcxLookupGridColumn.SetRepositoryItem(Value: TcxEditRepositoryItem); begin if FRepositoryItem <> Value then begin if FRepositoryItem <> nil then FRepositoryItem.RemoveListener(Self); FRepositoryItem := Value; if FRepositoryItem <> nil then FRepositoryItem.AddListener(Self); PropertiesChanged(FRepositoryItem); end; end; procedure TcxLookupGridColumn.SetSorting(Value: Boolean); begin if FSorting <> Value then begin FSorting := Value; Changed(False); end; end; procedure TcxLookupGridColumn.SetSortOrder(Value: TcxDataSortOrder); begin if Grid <> nil then Grid.FDataController.ChangeSorting(Index, Value); end; procedure TcxLookupGridColumn.SetWidth(Value: Integer); begin CheckWidthValue(Value); FWidth := Value; FIsWidthAssigned := True; Changed(False); end; { TcxLookupGridColumns } constructor TcxLookupGridColumns.Create(AGrid: TcxCustomLookupGrid; AColumnClass: TcxLookupGridColumnClass); begin inherited Create(AColumnClass); FGrid := AGrid; end; function TcxLookupGridColumns.Add: TcxLookupGridColumn; begin Result := TcxLookupGridColumn(inherited Add); end; procedure TcxLookupGridColumns.BeginUpdate; begin if (Grid <> nil) and not (csDestroying in Grid.ComponentState) then Grid.BeginUpdate; inherited; end; procedure TcxLookupGridColumns.EndUpdate; begin inherited; if (Grid <> nil) and not (csDestroying in Grid.ComponentState) then Grid.EndUpdate; end; procedure TcxLookupGridColumns.RestoreDefaults; var I: Integer; begin BeginUpdate; try for I := 0 to Count-1 do Items[I].RestoreDefaults; finally EndUpdate; end; end; function TcxLookupGridColumns.GetOwner: TPersistent; begin Result := FGrid; end; procedure TcxLookupGridColumns.Update(Item: TCollectionItem); begin if (FGrid = nil) or (csLoading in FGrid.ComponentState) then Exit; Grid.Change([lgcLayout]); end; function TcxLookupGridColumns.GetColumn(Index: Integer): TcxLookupGridColumn; begin Result := TcxLookupGridColumn(inherited Items[Index]); end; procedure TcxLookupGridColumns.SetColumn(Index: Integer; Value: TcxLookupGridColumn); begin Items[Index].Assign(Value); end; { TcxLookupGridDataController } function TcxLookupGridDataController.GetItem(Index: Integer): TObject; begin Result := Grid.Columns[Index]; end; function TcxLookupGridDataController.GetGrid: TcxCustomLookupGrid; begin Result := GetOwner as TcxCustomLookupGrid; end; { TcxLookupGridOptions } constructor TcxLookupGridOptions.Create(AGrid: TcxCustomLookupGrid); begin inherited Create; FGrid := AGrid; FColumnSorting := True; FFocusRowOnMouseMove := True; FGridLines := glBoth; FRowSelect := True; FShowHeader := True; end; procedure TcxLookupGridOptions.Assign(Source: TPersistent); begin if Source is TcxLookupGridOptions then begin if Assigned(Grid) then Grid.BeginUpdate; try AnsiSort := TcxLookupGridOptions(Source).AnsiSort; CaseInsensitive := TcxLookupGridOptions(Source).CaseInsensitive; ColumnSorting := TcxLookupGridOptions(Source).ColumnSorting; FocusRowOnMouseMove := TcxLookupGridOptions(Source).FocusRowOnMouseMove; GridLines := TcxLookupGridOptions(Source).GridLines; RowSelect := TcxLookupGridOptions(Source).RowSelect; ShowHeader := TcxLookupGridOptions(Source).ShowHeader; finally if Assigned(Grid) then Grid.EndUpdate; end; end else inherited Assign(Source); end; procedure TcxLookupGridOptions.Changed; begin if Assigned(Grid) then Grid.Change([lgcLayout]); if Assigned(FOnChanged) then FOnChanged(Self); end; function TcxLookupGridOptions.GetAnsiSort: Boolean; begin if Assigned(Grid) then Result := dcoAnsiSort in Grid.DataController.Options else Result := False; end; function TcxLookupGridOptions.GetCaseInsensitive: Boolean; begin if Assigned(Grid) then Result := dcoCaseInsensitive in Grid.DataController.Options else Result := False; end; procedure TcxLookupGridOptions.SetAnsiSort(Value: Boolean); begin if Assigned(Grid) then begin if Value then Grid.DataController.Options := Grid.DataController.Options + [dcoAnsiSort] else Grid.DataController.Options := Grid.DataController.Options - [dcoAnsiSort]; end; end; procedure TcxLookupGridOptions.SetCaseInsensitive(Value: Boolean); begin if Assigned(Grid) then begin if Value then Grid.DataController.Options := Grid.DataController.Options + [dcoCaseInsensitive] else Grid.DataController.Options := Grid.DataController.Options - [dcoCaseInsensitive]; end; end; procedure TcxLookupGridOptions.SetGridLines(Value: TcxGridLines); begin if FGridLines <> Value then begin FGridLines := Value; Changed; end; end; procedure TcxLookupGridOptions.SetRowSelect(Value: Boolean); begin if FRowSelect <> Value then begin FRowSelect := Value; if Value and Assigned(Grid) then Grid.FocusedColumn := nil; end; end; procedure TcxLookupGridOptions.SetShowHeader(Value: Boolean); begin if FShowHeader <> Value then begin FShowHeader := Value; Changed; end; end; { TcxCustomLookupGrid } constructor TcxCustomLookupGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); FColumns := GetColumnsClass.Create(Self, GetColumnClass); FOptions := GetOptionsClass.Create(Self); CreateHandlers; CreateSubClasses; Color := clWindow; ParentColor := False; Width := 250; Height := 200; Keys := [kArrows]; end; destructor TcxCustomLookupGrid.Destroy; begin SetScrollMode(smNone); DestroySubClasses; DestroyHandlers; FOptions.Free; FColumns.Free; inherited Destroy; end; procedure TcxCustomLookupGrid.BeginUpdate; begin Inc(FLockCount); FDataController.BeginUpdate; end; procedure TcxCustomLookupGrid.CancelUpdate; begin Dec(FLockCount); end; procedure TcxCustomLookupGrid.EndUpdate; begin FDataController.EndUpdate; Dec(FLockCount); CheckChanges; end; function TcxCustomLookupGrid.GetHitInfo(P: TPoint): TcxLookupGridHitInfo; function CalcColumnIndex(out AColumnIndex: Integer): Boolean; var I: Integer; begin Result := False; for I := 0 to ViewInfo.Columns.Count - 1 do if PtInRect(ViewInfo.Columns[I].Bounds, P) then begin AColumnIndex := I; Result := True; Break; end; end; function CalcCellIndex(out ARowIndex, AColumnIndex: Integer): Boolean; var I, J: Integer; begin Result := False; for I := 0 to ViewInfo.Rows.Count - 1 do if PtInRect(ViewInfo.Rows[I].Bounds, P) then begin ARowIndex := ViewInfo.Rows[I].RowIndex; for J := 0 to ViewInfo.Rows[I].Count - 1 do if PtInWidth(ViewInfo.Rows[I][J].Bounds, P) then begin AColumnIndex := ViewInfo.Rows[I][J].Index; Result := True; Break; end; Break; end; end; begin Result.HitTest := htNone; Result.RowIndex := -1; Result.ColumnIndex := -1; if not PtInRect(ViewInfo.ClientBounds, P) then Exit; if PtInRect(ViewInfo.HeadersRect, P) then begin if CalcColumnIndex(Result.ColumnIndex) then Result.HitTest := htHeader; end else if PtInRect(ViewInfo.RowsRect, P) then begin if CalcCellIndex(Result.RowIndex, Result.ColumnIndex) then Result.HitTest := htCell; end; end; function TcxCustomLookupGrid.GetNearestPopupHeight(AHeight: Integer): Integer; var AHeaderHeight, ARowHeight, ARowCount: Integer; begin AHeaderHeight := ViewInfo.HeadersRect.Bottom - ViewInfo.HeadersRect.Top; ARowHeight := ViewInfo.RowHeight; ARowCount := (AHeight - AHeaderHeight) div ARowHeight; if ARowCount <= 0 then ARowCount := 1 else if ARowCount > GetRowCount then ARowCount := GetRowCount; if ARowCount < 1 then ARowCount := 1; Result := AHeaderHeight + ARowHeight * ARowCount; end; function TcxCustomLookupGrid.GetPopupHeight(ADropDownRowCount: Integer): Integer; begin Result := ViewInfo.HeadersRect.Bottom - ViewInfo.HeadersRect.Top + ViewInfo.RowHeight * ADropDownRowCount; end; function TcxCustomLookupGrid.IsMouseOverList(const P: TPoint): Boolean; begin Result := GetHitInfo(P).RowIndex <> -1; end; function TcxCustomLookupGrid.IsRowVisible(ARowIndex: Integer): Boolean; begin with ViewInfo do Result := (VisibleRowCount > 0) and (Rows[0].RowIndex <= ARowIndex) and (ARowIndex <= Rows[VisibleRowCount - 1].RowIndex); end; procedure TcxCustomLookupGrid.LockPopupMouseMove; begin FPrevMousePos := InternalGetCursorPos; end; procedure TcxCustomLookupGrid.MakeFocusedRowVisible; begin if FocusedRowIndex <> -1 then MakeRowVisible(FocusedRowIndex); end; procedure TcxCustomLookupGrid.MakeRowVisible(ARowIndex: Integer); procedure SetBottomRowIndex(ARowIndex: Integer); begin TopRowIndex := ARowIndex - ViewInfo.VisibleRowCount + 1; // TODO: AutoHeight end; begin if ViewInfo.VisibleRowCount > 0 then begin if ARowIndex < ViewInfo.Rows[0].RowIndex then TopRowIndex := ARowIndex else if ARowIndex > ViewInfo.Rows[ViewInfo.VisibleRowCount - 1].RowIndex then SetBottomRowIndex(ARowIndex); end; end; procedure TcxCustomLookupGrid.SyncSelected(ASelected: Boolean); begin DataController.SyncSelected(ASelected); end; procedure TcxCustomLookupGrid.ColorChanged; begin LayoutChanged; inherited ColorChanged; end; procedure TcxCustomLookupGrid.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); case Key of VK_LEFT: FocusColumn(FocusedColumnIndex - 1); VK_RIGHT: FocusColumn(FocusedColumnIndex + 1); VK_UP: FocusNextRow(False); // Grid mode VK_DOWN: FocusNextRow(True); // Grid mode VK_HOME: if (ssCtrl in Shift) or Options.RowSelect then DataController.GotoFirst else FocusColumn(0); VK_END: if (ssCtrl in Shift) or Options.RowSelect then DataController.GotoLast else FocusColumn(Columns.Count - 1); VK_PRIOR: FocusPriorPage; VK_NEXT: FocusNextPage; VK_RETURN: DoCloseUp(FocusedRowIndex <> -1); end; end; procedure TcxCustomLookupGrid.Loaded; begin inherited Loaded; Change([lgcLayout]); end; procedure TcxCustomLookupGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var AHitInfo: TcxLookupGridHitInfo; begin inherited MouseDown(Button, Shift, X, Y); AHitInfo := GetHitInfo(Point(X, Y)); if AHitInfo.HitTest = htHeader then DoHeaderClick(AHitInfo.ColumnIndex, Shift) else if AHitInfo.HitTest = htCell then begin DoCellClick(AHitInfo.RowIndex, AHitInfo.ColumnIndex, Shift); FRowPressed := True; end; end; procedure TcxCustomLookupGrid.MouseMove(Shift: TShiftState; X, Y: Integer); const ScrollModeA: array[Boolean] of TcxLookupGridScrollMode = (smTop, smBottom); var AHitInfo: TcxLookupGridHitInfo; P: TPoint; begin inherited MouseMove(Shift, X, Y); P := InternalGetCursorPos; if (P.X = FPrevMousePos.X) and (P.Y = FPrevMousePos.Y) then Exit; FPrevMousePos := P; if MouseCapture or IsHotTrack then begin AHitInfo := GetHitInfo(Point(X, Y)); if FRowPressed and MouseCapture and ((Y < ViewInfo.VisibleRowsRect.Top) or (Y > ViewInfo.VisibleRowsRect.Bottom)) then SetScrollMode(ScrollModeA[Y > ViewInfo.VisibleRowsRect.Bottom]) else begin SetScrollMode(smNone); if AHitInfo.HitTest = htCell then begin FocusedRowIndex := AHitInfo.RowIndex; SyncSelected(True); end; end; end; end; procedure TcxCustomLookupGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var AHitInfo: TcxLookupGridHitInfo; begin inherited MouseUp(Button, Shift, X, Y); SetScrollMode(smNone); AHitInfo := GetHitInfo(Point(X, Y)); if FRowPressed then DoCloseUp(AHitInfo.HitTest = htCell); FRowPressed := False; end; procedure TcxCustomLookupGrid.Paint; begin inherited Paint; FPainter.Paint; end; function TcxCustomLookupGrid.AllowDragAndDropWithoutFocus: Boolean; begin Result := True; end; procedure TcxCustomLookupGrid.BoundsChanged; begin LayoutChanged; inherited BoundsChanged; end; procedure TcxCustomLookupGrid.DoCancelMode; begin DestroyScrollTimer; FRowPressed := False; end; procedure TcxCustomLookupGrid.FocusChanged; begin UpdateFocusing; inherited FocusChanged; end; procedure TcxCustomLookupGrid.FontChanged; begin inherited FontChanged; LayoutChanged; end; function TcxCustomLookupGrid.GetBorderSize: Integer; begin if IsPopupControl then Result := 0 else Result := Painter.LFPainterClass.BorderSize; end; procedure TcxCustomLookupGrid.InitControl; begin inherited InitControl; LayoutChanged; end; procedure TcxCustomLookupGrid.InitScrollBarsParameters; begin SetScrollBarInfo(sbVertical, 0, ViewInfo.RowCount - 1 + ScrollBarOffsetBegin + ScrollBarOffsetEnd, 1, ViewInfo.VisibleRowCount, ScrollBarOffsetBegin + ViewInfo.TopRowIndex, True, True); end; procedure TcxCustomLookupGrid.Scroll(AScrollBarKind: TScrollBarKind; AScrollCode: TScrollCode; var AScrollPos: Integer); begin if AScrollBarKind = sbVertical then begin case AScrollCode of scLineUp: TopRowIndex := TopRowIndex - 1; scLineDown: TopRowIndex := TopRowIndex + 1; scPageUp: ShowPrevPage; scPageDown: ShowNextPage; scTrack: if not DataController.IsGridMode then TopRowIndex := AScrollPos; // check in CLX!!! scPosition: if DataController.IsGridMode then TopRowIndex := AScrollPos - ScrollBarOffsetBegin; end; AScrollPos := ScrollBarOffsetBegin + TopRowIndex; end; end; procedure TcxCustomLookupGrid.AddColumn(AColumn: TcxLookupGridColumn); begin if FDataController <> nil then FDataController.AddItem(AColumn); end; procedure TcxCustomLookupGrid.Change(AChanges: TcxLookupGridChanges); begin FChanges := FChanges + AChanges; CheckChanges; end; procedure TcxCustomLookupGrid.CheckChanges; begin if (FChanges <> []) and (LockCount = 0) then try if FChanges * [lgcData, lgcLayout, lgcFocusedRow] <> [] then LayoutChanged; finally FChanges := []; end; end; procedure TcxCustomLookupGrid.CheckSetTopRowIndex(var Value: Integer); var AMaxValue: Integer; begin if DataController.IsGridMode then begin if Value < 0 then begin if not DataController.IsBOF then DataController.Scroll(Value); Value := 0; end else if Value >= RowCount then begin if not DataController.IsEOF then DataController.Scroll(Value - (RowCount - 1)); Value := RowCount - 1; end else begin AMaxValue := RowCount - ViewInfo.VisibleRowCount; // TODO if Value > AMaxValue then begin if not DataController.IsEOF then DataController.Scroll(Value - AMaxValue); // AMaxValue := GetMaxValue; Value := AMaxValue; end; end; end; if Value >= RowCount then Value := RowCount - 1; if Value < 0 then Value := 0; end; procedure TcxCustomLookupGrid.CheckTopRowIndex(ATopRowIndex: Integer; ANotUpdate: Boolean); var APrevTopRowIndex, ANewTopRowIndex: Integer; begin APrevTopRowIndex := TopRowIndex; ANewTopRowIndex := ViewInfo.CheckTopRowIndex(ATopRowIndex); if APrevTopRowIndex <> ANewTopRowIndex then begin FTopRowIndex := ANewTopRowIndex; if not ANotUpdate then UpdateLayout; end else ViewInfo.Calculate; end; procedure TcxCustomLookupGrid.CreateHandlers; begin FPainter := GetPainterClass.Create(Self); FPainter.LFPainterClass := GetLFPainterClass; FViewInfo := GetViewInfoClass.Create(Self); end; function TcxCustomLookupGrid.GetDataControllerClass: TcxCustomDataControllerClass; begin Result := TcxLookupGridDataController; end; procedure TcxCustomLookupGrid.CreateSubClasses; begin FDataController := GetDataControllerClass.Create(Self); FDataController.OnUpdateControl := UpdateControl; end; procedure TcxCustomLookupGrid.DestroyHandlers; begin FreeAndNil(FViewInfo); FreeAndNil(FPainter); end; procedure TcxCustomLookupGrid.DestroySubClasses; begin FreeAndNil(FDataController); end; procedure TcxCustomLookupGrid.DoCellClick(ARowIndex, AColumnIndex: Integer; AShift: TShiftState); begin if ARowIndex <> -1 then FocusedRowIndex := ARowIndex; if AColumnIndex <> -1 then FocusedColumnIndex := AColumnIndex; end; procedure TcxCustomLookupGrid.DoHeaderClick(AColumnIndex: Integer; AShift: TShiftState); var ASortOrder: TcxDataSortOrder; begin if not Options.ColumnSorting or (AColumnIndex = -1) or not Columns[AColumnIndex].Sorting then Exit; try BeginUpdate; try with Columns[AColumnIndex] do if ssCtrl in AShift then SortOrder := soNone else begin if SortOrder = soAscending then ASortOrder := soDescending else ASortOrder := soAscending; if not (ssShift in AShift) then FDataController.ClearSorting(True); SortOrder := ASortOrder; end; finally EndUpdate; end; finally MakeFocusedRowVisible; end; end; procedure TcxCustomLookupGrid.FocusColumn(AColumnIndex: Integer); begin FocusedColumnIndex := AColumnIndex; MakeFocusedRowVisible; end; procedure TcxCustomLookupGrid.FocusNextPage; begin MakeFocusedRowVisible; if FocusedRowIndex = TopRowIndex + ViewInfo.VisibleRowCount - 1 then ShowNextPage; FocusedRowIndex := TopRowIndex + ViewInfo.VisibleRowCount - 1; end; procedure TcxCustomLookupGrid.FocusNextRow(AGoForward: Boolean); var AFocusedRowIndex: Integer; begin AFocusedRowIndex := FocusedRowIndex; if DataController.IsGridMode then begin if AGoForward then begin if not DataController.IsEOF and (AFocusedRowIndex = (RowCount - 1)) then begin DataController.Scroll(1); if not DataController.IsEOF then Dec(AFocusedRowIndex); end; end else begin if (AFocusedRowIndex = 0) and not DataController.IsBOF then begin DataController.Scroll(-1); if not DataController.IsBOF then Inc(AFocusedRowIndex); end; end; end; if AGoForward then AFocusedRowIndex := AFocusedRowIndex + 1 else AFocusedRowIndex := AFocusedRowIndex - 1; if AFocusedRowIndex < 0 then AFocusedRowIndex := 0; if AFocusedRowIndex >= RowCount then AFocusedRowIndex := RowCount - 1; FocusedRowIndex := AFocusedRowIndex; SyncSelected(True); end; procedure TcxCustomLookupGrid.FocusPriorPage; begin MakeFocusedRowVisible; if FocusedRowIndex = TopRowIndex then ShowPrevPage; FocusedRowIndex := TopRowIndex; end; function TcxCustomLookupGrid.GetColumnClass: TcxLookupGridColumnClass; begin Result := TcxLookupGridColumn; end; function TcxCustomLookupGrid.GetColumnsClass: TcxLookupGridColumnsClass; begin Result := TcxLookupGridColumns; end; function TcxCustomLookupGrid.GetLFPainterClass: TcxCustomLookAndFeelPainterClass; begin Result := LookAndFeel.Painter; end; function TcxCustomLookupGrid.GetOptionsClass: TcxLookupGridOptionsClass; begin Result := TcxLookupGridOptions; end; function TcxCustomLookupGrid.GetPainterClass: TcxLookupGridPainterClass; begin Result := TcxLookupGridPainter; end; function TcxCustomLookupGrid.GetScrollBarOffsetBegin: Integer; begin if DataController.IsGridMode then Result := Ord(not DataController.IsBOF) else Result := 0; end; function TcxCustomLookupGrid.GetScrollBarOffsetEnd: Integer; begin if DataController.IsGridMode then Result := Ord(not DataController.IsEOF) else Result := 0; end; function TcxCustomLookupGrid.GetViewInfoClass: TcxLookupGridViewInfoClass; begin Result := TcxLookupGridViewInfo; end; function TcxCustomLookupGrid.IsHotTrack: Boolean; begin Result := IsPopupControl and Options.FocusRowOnMouseMove; end; procedure TcxCustomLookupGrid.LookAndFeelChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues); begin inherited; Painter.LFPainterClass := GetLFPainterClass; Change([lgcLayout]); end; procedure TcxCustomLookupGrid.RemoveColumn(AColumn: TcxLookupGridColumn); begin if FDataController <> nil then FDataController.RemoveItem(AColumn); if FFocusedColumn = AColumn then FFocusedColumn := nil; // TODO: prev/next end; procedure TcxCustomLookupGrid.SetScrollMode(Value: TcxLookupGridScrollMode); begin if FScrollMode <> Value then begin DestroyScrollTimer; FScrollMode := Value; if FScrollMode <> smNone then CreateScrollTimer; end; end; procedure TcxCustomLookupGrid.ShowNextPage; begin if ViewInfo.VisibleRowCount > 1 then TopRowIndex := TopRowIndex + ViewInfo.VisibleRowCount - 1 else TopRowIndex := TopRowIndex + 1; end; procedure TcxCustomLookupGrid.ShowPrevPage; begin if ViewInfo.VisibleRowCount > 1 then TopRowIndex := TopRowIndex - (ViewInfo.VisibleRowCount - 1) // TODO: AutoHeight else TopRowIndex := TopRowIndex - 1; end; procedure TcxCustomLookupGrid.UpdateFocusing; begin UpdateRowInfo(FocusedRowIndex, False); end; procedure TcxCustomLookupGrid.UpdateRowInfo(ARowIndex: Integer; ARecalculate: Boolean); var ARowViewInfo: TcxLookupGridRowViewInfo; begin ARowViewInfo := ViewInfo.Rows.FindByRowIndex(ARowIndex); if ARowViewInfo <> nil then begin if ARecalculate then begin ARowViewInfo.IsFocused := ARowViewInfo.RowIndex = FocusedRowIndex; ViewInfo.CalculateCells(ARowViewInfo); end; InvalidateRect(ARowViewInfo.Bounds, False); end; end; procedure TcxCustomLookupGrid.UpdateLayout; begin if HandleAllocated then begin ViewInfo.Calculate; Painter.Invalidate; UpdateScrollBars; end; end; procedure TcxCustomLookupGrid.DataChanged; begin // TODO: LayoutChanged; if Assigned(FOnDataChanged) then FOnDataChanged(Self); end; procedure TcxCustomLookupGrid.DataLayoutChanged; begin // TODO: LayoutChanged; end; procedure TcxCustomLookupGrid.DoClick; begin if Assigned(FOnClick) then FOnClick(Self); end; procedure TcxCustomLookupGrid.DoCloseUp(AAccept: Boolean); begin if Assigned(FOnCloseUp) then FOnCloseUp(Self, AAccept); end; procedure TcxCustomLookupGrid.DoFocusedRowChanged; begin if Assigned(FOnFocusedRowChanged) then FOnFocusedRowChanged(Self); end; procedure TcxCustomLookupGrid.FocusedRowChanged(APrevFocusedRowIndex, AFocusedRowIndex: Integer); begin if IsRowVisible(AFocusedRowIndex) then begin UpdateRowInfo(APrevFocusedRowIndex, True); UpdateRowInfo(AFocusedRowIndex, True); end else begin LayoutChanged; MakeFocusedRowVisible; end; end; procedure TcxCustomLookupGrid.LayoutChanged; begin CheckTopRowIndex(TopRowIndex, True); UpdateLayout; end; procedure TcxCustomLookupGrid.SelectionChanged(AInfo: TcxSelectionChangedInfo); var I: Integer; begin if AInfo.Count = 0 then LayoutChanged else for I := 0 to AInfo.Count - 1 do UpdateRowInfo(AInfo.RowIndexes[I], True); end; procedure TcxCustomLookupGrid.UpdateControl(AInfo: TcxUpdateControlInfo); begin if AInfo is TcxDataChangedInfo then DataChanged else if AInfo is TcxLayoutChangedInfo then DataLayoutChanged else if AInfo is TcxFocusedRowChangedInfo then with TcxFocusedRowChangedInfo(AInfo) do FocusedRowChanged(PrevFocusedRowIndex, FocusedRowIndex) else if AInfo is TcxSelectionChangedInfo then SelectionChanged(TcxSelectionChangedInfo(AInfo)); end; procedure TcxCustomLookupGrid.CreateScrollTimer; begin if FScrollTimer <> nil then Exit; FScrollTimer := TcxTimer.Create(nil); with FScrollTimer do begin Interval := ScrollTimerInterval; OnTimer := ScrollTimerHandler; end; end; procedure TcxCustomLookupGrid.DestroyScrollTimer; begin FreeAndNil(FScrollTimer); end; function TcxCustomLookupGrid.GetDataController: TcxCustomDataController; begin Result := TcxCustomDataController(FDataController); end; function TcxCustomLookupGrid.GetFocusedColumn: TcxLookupGridColumn; begin // if (FFocusedColumn = nil) and (Columns.Count > 0) then // FFocusedColumn := Columns[0]; Result := FFocusedColumn; end; function TcxCustomLookupGrid.GetFocusedColumnIndex: Integer; begin if FocusedColumn <> nil then Result := FocusedColumn.Index else Result := -1; end; function TcxCustomLookupGrid.GetFocusedRowIndex: Integer; begin Result := FDataController.GetFocusedRowIndex; end; function TcxCustomLookupGrid.GetRowCount: Integer; begin Result := FDataController.GetRowCount; end; procedure TcxCustomLookupGrid.SetColumns(Value: TcxLookupGridColumns); begin FColumns.Assign(Value); end; procedure TcxCustomLookupGrid.SetDataController(Value: TcxCustomDataController); begin FDataController.Assign(Value); end; procedure TcxCustomLookupGrid.SetFocusedColumn(Value: TcxLookupGridColumn); begin if Options.RowSelect then Value := nil; if FocusedColumn <> Value then begin FFocusedColumn := Value; Change([lgcLayout]); end; end; procedure TcxCustomLookupGrid.SetFocusedColumnIndex(Value: Integer); begin if Columns.Count = 0 then Exit; if Value >= Columns.Count then Value := Columns.Count - 1; if Value < 0 then Value := 0; if FocusedColumnIndex <> Value then FocusedColumn := Columns[Value]; end; procedure TcxCustomLookupGrid.SetFocusedRowIndex(Value: Integer); begin FDataController.ChangeFocusedRowIndex(Value); end; procedure TcxCustomLookupGrid.SetIsPopupControl(Value: Boolean); begin if FIsPopupControl <> Value then begin FIsPopupControl := Value; Change([lgcLayout]); end; end; procedure TcxCustomLookupGrid.SetOptions(Value: TcxLookupGridOptions); begin FOptions.Assign(Value); end; procedure TcxCustomLookupGrid.SetTopRowIndex(Value: Integer); begin CheckSetTopRowIndex(Value); if TopRowIndex <> Value then begin CheckTopRowIndex(Value, False); end; end; procedure TcxCustomLookupGrid.ScrollTimerHandler(Sender: TObject); procedure ChangeFocusedRow(Value: Integer); begin if Value >= RowCount then Value := RowCount - 1; if Value < 0 then Value := 0; FocusedRowIndex := Value; MakeFocusedRowVisible; SyncSelected(False); end; var P: TPoint; begin GetCursorPos(P); P := ScreenToClient(P); if P.Y < ViewInfo.VisibleRowsRect.Top then ChangeFocusedRow(TopRowIndex - 1) else if P.Y > ViewInfo.VisibleRowsRect.Bottom then ChangeFocusedRow(TopRowIndex + ViewInfo.VisibleRowCount + 1); end; end.