{ rxdbgrid unit Copyright (C) 2005-2010 Lagunov Aleksey alexs@hotbox.ru and Lazarus team original conception from rx library for Delphi (c) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version with the following modification: As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions of the license of that module. An independent module is a module which is not derived from or based on this library. If you modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } unit rxdbgrid; {$I rx.inc} interface uses Classes, SysUtils, LResources, LCLType, LCLIntf, Forms, Controls, Graphics, Dialogs, Grids, dbutils, DBGrids, DB, PropertyStorage, vclutils, LMessages, types, StdCtrls, Menus; const CBadQuickSearchSymbols = [VK_UNKNOWN..VK_HELP]+[VK_LWIN..VK_SLEEP]+[VK_NUMLOCK..VK_SCROLL]+[VK_LSHIFT..VK_OEM_102]+[VK_PROCESSKEY]+[VK_ATTN..VK_UNDEFINED]; CCancelQuickSearchKeys = [VK_ESCAPE,VK_CANCEL,VK_DELETE,VK_INSERT,VK_DOWN,VK_UP,VK_NEXT,VK_PRIOR,VK_TAB,VK_RETURN,VK_HOME,VK_END,VK_SPACE,VK_MULTIPLY]; type TRxQuickSearchNotifyEvent = procedure(Sender: TObject; Field : TField; var AValue : string) of object; TSortMarker = (smNone, smDown, smUp); TGetBtnParamsEvent = procedure (Sender: TObject; Field: TField; AFont: TFont; var Background: TColor; var SortMarker: TSortMarker; IsDown: Boolean) of object; TGetCellPropsEvent = procedure (Sender: TObject; Field: TField; AFont: TFont; var Background: TColor) of object; TRxDBGridAllowedOperation = (aoInsert, aoUpdate, aoDelete, aoAppend); TRxDBGridAllowedOperations = set of TRxDBGridAllowedOperation; TFooterValueType = (fvtNon, fvtSum, fvtAvg, fvtCount, fvtFieldValue, fvtStaticText, fvtMax, fvtMin, fvtRecNo); TOptionRx = (rdgAllowColumnsForm, rdgAllowDialogFind, rdgHighlightFocusCol, //TODO: rdgHighlightFocusRow, //TODO: rdgDblClickOptimizeColWidth, rdgFooterRows, rdgXORColSizing, rdgFilter, rdgMultiTitleLines, rdgMrOkOnDblClik, rdgAllowQuickSearch, rdgAllowQuickFilter, rdgAllowFilterForm, rdgAllowSortForm, rdgAllowToolMenu, rdgCaseInsensitiveSort ); TOptionsRx = set of TOptionRx; TCreateLookup = TNotifyEvent; TDisplayLookup = TNotifyEvent; // TDataSetClass = class of TDataSet; TRxColumn = class; { TRxDBGridSortEngine } TRxSortEngineOption = (seoCaseInsensitiveSort); TRxSortEngineOptions = set of TRxSortEngineOption; TRxDBGridSortEngine = class private FDataSetClass:TDataSetClass; public procedure Sort(Field:TField; ADataSet:TDataSet; Asc:boolean; SortOptions:TRxSortEngineOptions);virtual;abstract; procedure SortList(ListField:string; ADataSet:TDataSet; Asc:boolean);virtual; end; TRxDBGridSortEngineClass = class of TRxDBGridSortEngine; TMLCaptionItem = class Caption:string; Width:integer; Hegth:integer; Next:TMLCaptionItem; Prior:TMLCaptionItem; Col:TGridColumn; end; { TRxColumnTitle } TRxColumnTitle = class(TColumnTitle) private FHint: string; FOrientation: TTextOrientation; FShowHint: boolean; FCaptionLines:TFPList; function GetCaptionLinesCount: integer; procedure SetOrientation(const AValue: TTextOrientation); procedure ClearCaptionML; protected procedure SetCaption(const AValue: TCaption); override; public constructor Create(TheColumn: TGridColumn); override; destructor Destroy; override; property CaptionLinesCount:integer read GetCaptionLinesCount; function CaptionLine(ALine:integer):TMLCaptionItem; published property Orientation:TTextOrientation read FOrientation write SetOrientation; property Hint: string read FHint write FHint; property ShowHint: boolean read FShowHint write FShowHint default false; end; { TRxColumnFooter } TRxColumnFooter = class(TPersistent) private FLayout: TTextLayout; FOwner:TRxColumn; FAlignment: TAlignment; FDisplayFormat: String; FFieldName: String; FValue: String; FValueType: TFooterValueType; FTestValue:Double; procedure SetAlignment(const AValue: TAlignment); procedure SetDisplayFormat(const AValue: String); procedure SetFieldName(const AValue: String); procedure SetLayout(const AValue: TTextLayout); procedure SetValue(const AValue: String); procedure SetValueType(const AValue: TFooterValueType); function DisplayText:string; function GetFieldValue:string; function GetRecordsCount:string; function GetRecNo:string; function GetStatTotal:string; procedure ResetTestValue; procedure UpdateTestValue; function DeleteTestValue: boolean; function PostTestValue: boolean; function ErrorTestValue: boolean; public constructor Create(Owner:TRxColumn); property Owner:TRxColumn read FOwner; property NumericValue:Double read FTestValue; published property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; property Layout:TTextLayout read FLayout write SetLayout default tlCenter; property DisplayFormat: String read FDisplayFormat write SetDisplayFormat; property FieldName: String read FFieldName write SetFieldName; property Value: String read FValue write SetValue; property ValueType: TFooterValueType read FValueType write SetValueType default fvtNon; end; { TRxColumnFilter } TRxColumnFilter = class(TPersistent) private FOwner:TRxColumn; FValue: string; FValueList: TStringList; FEmptyValue: string; FEmptyFont: TFont; FFont: TFont; FAlignment: TAlignment; FDropDownRows: Integer; FColor: TColor; function GetItemIndex: integer; procedure SetColor(const AValue: TColor); procedure SetFont(const AValue: TFont); procedure SetItemIndex(const AValue: integer); public constructor Create(Owner:TRxColumn); virtual; destructor Destroy; override; published property Value: String read FValue write FValue; property Font: TFont read FFont write SetFont; property Alignment: TAlignment read FAlignment write FAlignment default taLeftJustify; property DropDownRows: Integer read FDropDownRows write FDropDownRows; property Color: TColor read FColor write SetColor default clWhite; property ValueList: TStringList read FValueList write FValueList; property EmptyValue: String read FEmptyValue write FEmptyValue; property EmptyFont: TFont read FEmptyFont write FEmptyFont; property ItemIndex:integer read GetItemIndex write SetItemIndex; end; { TRxColumn } TRxColumn = class(TColumn) private FFooter: TRxColumnFooter; FFilter : TRxColumnFilter; FImageList: TImageList; FKeyList:TStrings; FNotInKeyListIndex: Integer; function GetFooter: TRxColumnFooter; function GetKeyList: TStrings; procedure SetFilter(const AValue: TRxColumnFilter); procedure SetFooter(const AValue: TRxColumnFooter); procedure SetImageList(const AValue: TImageList); procedure SetKeyList(const AValue: TStrings); procedure SetNotInKeyListIndex(const AValue: Integer); protected function CreateTitle: TGridColumnTitle; override; public constructor Create(ACollection: TCollection); override; destructor destroy; override; procedure OptimizeWidth; published property Footer:TRxColumnFooter read GetFooter write SetFooter; property ImageList:TImageList read FImageList write SetImageList; property KeyList: TStrings read GetKeyList write SetKeyList; property NotInKeyListIndex: Integer read FNotInKeyListIndex write SetNotInKeyListIndex default -1; property Filter : TRxColumnFilter read FFilter write SetFilter; end; { TRxDbGridColumns } TRxDbGridColumns = class(TDbGridColumns) protected public function Add: TRxColumn; end; { TFilterListCellEditor } TFilterListCellEditor = class(TComboBox) private FGrid: TCustomGrid; FCol: Integer; FMouseFlag : boolean; protected procedure WndProc(var TheMessage : TLMessage); override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; public procedure Show(Grid : TCustomGrid; Col : Integer); property Grid: TCustomGrid read FGrid; property Col: Integer read FCol; property MouseFlag : boolean read FMouseFlag write FMouseFlag; end; { TRxDBGrid } TRxDBGrid = class(TCustomDBGrid) private FInProcessCalc:integer; FAllowedOperations: TRxDBGridAllowedOperations; FFooterColor: TColor; FFooterRowCount: integer; FOnGetCellProps: TGetCellPropsEvent; FOptionsRx: TOptionsRx; // FTitleLines: Integer; FAutoSort: boolean; FMarkerUp, FMarkerDown: TBitmap; FOnGetBtnParams: TGetBtnParamsEvent; FOnFiltred : TNotifyEvent; //auto sort support FSortField:TField; FSortOrder:TSortMarker; FSortEngine:TRxDBGridSortEngine; FPressedCol: TColumn; FPressed: Boolean; FSwapButtons: Boolean; FTracking: Boolean; F_Clicked : Boolean; F_PopupMenu : TPopupMenu; F_MenuBMP : TBitmap; F_EventOnFilterRec : TFilterRecordEvent; F_EventOnBeforeDelete: TDataSetNotifyEvent; F_EventOnBeforePost : TDataSetNotifyEvent; F_EventOnDeleteError : TDataSetErrorEvent; F_EventOnPostError : TDataSetErrorEvent; F_LastFilter : TStringList; F_SortListField : TStringList; F_CreateLookup : TCreateLookup; F_DisplayLookup : TDisplayLookup; //storage //Column resize FColumnResizing : Boolean; // FFilterListEditor : TFilterListCellEditor; FVersion: Integer; FPropertyStorageLink:TPropertyStorageLink; FRxDbGridLookupComboEditor:TCustomControl; FRxDbGridDateEditor:TWinControl; FAfterQuickSearch : TRxQuickSearchNotifyEvent; FBeforeQuickSearch : TRxQuickSearchNotifyEvent; FQuickUTF8Search : String; procedure DoCreateJMenu; function GetColumns: TRxDbGridColumns; function GetPropertyStorage: TCustomPropertyStorage; function GetTitleButtons: boolean; function IsColumnsStored: boolean; procedure SetAutoSort(const AValue: boolean); procedure SetColumns(const AValue: TRxDbGridColumns); procedure SetFooterColor(const AValue: TColor); procedure SetFooterRowCount(const AValue: integer); procedure SetOptionsRx(const AValue: TOptionsRx); procedure SetPropertyStorage(const AValue: TCustomPropertyStorage); procedure SetTitleButtons(const AValue: boolean); procedure TrackButton(X, Y: Integer); procedure StopTracking; procedure CalcTitle; procedure ClearMLCaptionPointers; function getFilterRect(bRect : TRect):TRect; function getTitleRect(bRect : TRect):TRect; procedure OutCaptionCellText(aCol,aRow: Integer;const aRect: TRect; aState: TGridDrawState;const ACaption:string); procedure OutCaptionCellText90(aCol,aRow: Integer;const aRect: TRect; aState: TGridDrawState;const ACaption:string;const TextOrient:TTextOrientation); procedure OutCaptionSortMarker(const aRect: TRect; ASortMarker: TSortMarker); procedure OutCaptionMLCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; MLI:TMLCaptionItem); procedure UpdateJMenuStates; function SortEngineOptions:TRxSortEngineOptions; //storage procedure OnIniSave(Sender: TObject); procedure OnIniLoad(Sender: TObject); protected function DatalinkActive:boolean; procedure DefaultDrawCellA(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); procedure DefaultDrawTitle(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); procedure DefaultDrawFilter(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); procedure DefaultDrawCellData(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override; procedure LinkActive(Value: Boolean); override; procedure DrawFooterRows; virtual; procedure DoTitleClick(ACol: Longint; AField: TField); virtual; procedure MouseMove(Shift: TShiftState; X, Y: Integer);override; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override; function CreateColumns: TGridColumns; override; procedure DrawCellBitmap(RxColumn:TRxColumn; aRect: TRect; aState: TGridDrawState; AImageIndex:integer); virtual; procedure SetEditText(ACol, ARow: Longint; const Value: string); override; procedure CheckNewCachedSizes(var AGCache:TGridDataCache); override; procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override; procedure Paint;override; procedure UpdateActive;override; procedure UpdateData;override; procedure MoveSelection; override; procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW; procedure FFilterListEditorOnChange(Sender: TObject); procedure FFilterListEditorOnCloseUp(Sender: TObject); procedure InternalOptimizeColumnsWidth(AColList:TList); function IsDefaultRowHeightStored:boolean; procedure VisualChange; override; procedure SetQuickUTF8Search(AValue : String); procedure BeforeDel(DataSet: TDataSet); procedure BeforePo(DataSet: TDataSet); procedure ErrorDel(DataSet: TDataSet; E: EDatabaseError;var DataAction: TDataAction); procedure ErrorPo(DataSet: TDataSet; E: EDatabaseError;var DataAction: TDataAction); Procedure OnFind(Sender: TObject); Procedure OnFilterBy(Sender: TObject); Procedure OnFilter(Sender: TObject); Procedure OnFilterClose(Sender: TObject); Procedure OnSortBy(Sender: TObject); Procedure OnChooseVisibleFields(Sender: TObject); public procedure FilterRec(DataSet : TDataSet;var Accept: Boolean); constructor Create(AOwner: TComponent); override; destructor Destroy; override; function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override; procedure LayoutChanged; override; procedure ShowFindDialog; procedure ShowColumnsDialog; function ColumnByFieldName(AFieldName:string):TRxColumn; function ColumnByCaption(ACaption:string):TRxColumn; property Canvas; property DefaultTextStyle; property EditorBorderStyle; property EditorMode; property ExtendedColSizing; property FastEditing; property FocusRectVisible; property SelectedRows; procedure CalcStatTotals; procedure OptimizeColumnsWidth(AColList:String); procedure OptimizeColumnsWidthAll; procedure UpdateTitleHight; property QuickUTF8Search:String read FQuickUTF8Search write SetQuickUTF8Search; procedure GetOnCreateLookup; procedure GetOnDisplayLookup; published property AfterQuickSearch: TRxQuickSearchNotifyEvent read FAfterQuickSearch write FAfterQuickSearch; property BeforeQuickSearch: TRxQuickSearchNotifyEvent read FBeforeQuickSearch write FBeforeQuickSearch; property OnGetBtnParams: TGetBtnParamsEvent read FOnGetBtnParams write FOnGetBtnParams; property TitleButtons: boolean read GetTitleButtons write SetTitleButtons; property AutoSort:boolean read FAutoSort write SetAutoSort; property OnGetCellProps: TGetCellPropsEvent read FOnGetCellProps write FOnGetCellProps; property Columns: TRxDbGridColumns read GetColumns write SetColumns stored IsColumnsStored; //storage property PropertyStorage:TCustomPropertyStorage read GetPropertyStorage write SetPropertyStorage; property Version: Integer read FVersion write FVersion default 0; property AllowedOperations:TRxDBGridAllowedOperations read FAllowedOperations write FAllowedOperations default [aoInsert, aoUpdate, aoDelete, aoAppend]; property OptionsRx:TOptionsRx read FOptionsRx write SetOptionsRx; property FooterColor:TColor read FFooterColor write SetFooterColor default clWindow; property FooterRowCount:integer read FFooterRowCount write SetFooterRowCount default 0; property OnFiltred : TNotifyEvent read FOnFiltred write FOnFiltred; //from DBGrid property Align; property AlternateColor; property Anchors; property AutoAdvance default aaRightDown; property AutoFillColumns; property AutoEdit; property BiDiMode; property BorderSpacing; property BorderStyle; property Color; property BorderColor; property FocusColor; property FixedHotColor; property SelectedColor; property GridLineColor; property GridLineStyle; property Constraints; property DataSource; property DefaultDrawing; property DefaultRowHeight stored IsDefaultRowHeightStored default 18 ; property DragCursor; property DragKind; property DragMode; property Enabled; property FixedColor; property FixedCols; property Flat; property Font; property HeaderHotZones; property HeaderPushZones; //property ImeMode; //property ImeName; property Options; property OptionsExtra; property ParentBiDiMode; property ParentColor; //property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property Scrollbars default ssBoth; property ShowHint; property TabOrder; property TabStop; property TitleFont; property TitleImageList; property TitleStyle; property UseXORFeatures; property Visible; property OnCellClick; property OnColEnter; property OnColExit; property OnColumnMoved; property OnColumnSized; property OnDragDrop; property OnDragOver; property OnDrawColumnCell; property OnDblClick; property OnEditButtonClick; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnFieldEditMask; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnPrepareCanvas; property OnSelectEditor; property OnStartDock; property OnStartDrag; property OnTitleClick; property OnUserCheckboxBitmap; property OnUTF8KeyPress; property OnCreateLookup: TCreateLookup read F_CreateLookup write F_CreateLookup; property OnDisplayLookup: TDisplayLookup read F_DisplayLookup write F_DisplayLookup; end; procedure RegisterRxDBGridSortEngine(RxDBGridSortEngineClass:TRxDBGridSortEngineClass; DataSetClass:TDataSetClass); implementation uses Math, rxdconst, rxstrutils, rxdbgrid_findunit, rxdbgrid_columsunit, rxlookup, tooledit, LCLProc, rxfilterby, rxsortby; var RxDBGridSortEngineList:TStringList; procedure RegisterRxDBGridSortEngine(RxDBGridSortEngineClass:TRxDBGridSortEngineClass; DataSetClass:TDataSetClass); var Pos:integer; RxDBGridSortEngine:TRxDBGridSortEngine; begin if not RxDBGridSortEngineList.Find(DataSetClass.ClassName, Pos) then begin RxDBGridSortEngine:=RxDBGridSortEngineClass.Create; RxDBGridSortEngine.FDataSetClass:=DataSetClass; RxDBGridSortEngineList.AddObject(DataSetClass.ClassName, RxDBGridSortEngine); end end; procedure GridInvalidateRow(Grid: TRxDBGrid; Row: Longint); var I: Longint; begin for I := 0 to Grid.ColCount - 1 do Grid.InvalidateCell(I, Row); end; type { TRxDBGridLookupComboEditor } TRxDBGridLookupComboEditor = class(TRxCustomDBLookupCombo) private FGrid: TRxDBGrid; FCol,FRow: Integer; FLDS:TDataSource; protected procedure WndProc(var TheMessage : TLMessage); override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID; procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE; procedure ShowList; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; { TRxDBGridDateEditor } TRxDBGridDateEditor = class(TCustomRxDateEdit) private FGrid: TRxDBGrid; FCol,FRow: Integer; protected procedure Change; override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure WndProc(var TheMessage : TLMessage); override; procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID; procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE; procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE; procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL; public // procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override; procedure EditingDone; override; end; { TRxDBGridDateEditor } procedure TRxDBGridDateEditor.Change; begin inherited Change; if Assigned(FGrid) and FGrid.DatalinkActive and not FGrid.EditorIsReadOnly then begin if not (FGrid.DataSource.DataSet.State in dsEditModes) then FGrid.DataSource.Edit; if Self.Text <> '' then FGrid.SelectedField.AsDateTime:=Self.Date else FGrid.SelectedField.Clear; if FGrid<>nil then FGrid.SetEditText(FCol, FRow, Text); end; end; procedure TRxDBGridDateEditor.KeyDown(var Key: Word; Shift: TShiftState); function AllSelected: boolean; begin result := (SelLength>0) and (SelLength=UTF8Length(Text)); end; function AtStart: Boolean; begin Result:= (SelStart=0); end; function AtEnd: Boolean; begin result := ((SelStart+1)>UTF8Length(Text)) or AllSelected; end; procedure doEditorKeyDown; begin if FGrid<>nil then FGrid.EditorkeyDown(Self, key, shift); end; procedure doGridKeyDown; begin if FGrid<>nil then FGrid.KeyDown(Key, shift); end; function GetFastEntry: boolean; begin if FGrid<>nil then Result := FGrid.FastEditing else Result := False; end; procedure CheckEditingKey; begin if (FGrid=nil) or FGrid.EditorIsReadOnly then Key := 0; end; var IntSel: boolean; begin inherited KeyDown(Key,Shift); case Key of VK_F2: if AllSelected then begin SelLength := 0; SelStart := Length(Text); end; VK_DELETE: CheckEditingKey; VK_UP, VK_DOWN: doGridKeyDown; VK_LEFT, VK_RIGHT: if GetFastEntry then begin IntSel:= ((Key=VK_LEFT) and not AtStart) or ((Key=VK_RIGHT) and not AtEnd); if not IntSel then begin doGridKeyDown; end; end; VK_END, VK_HOME: ; else doEditorKeyDown; end; end; procedure TRxDBGridDateEditor.WndProc(var TheMessage: TLMessage); begin if TheMessage.msg=LM_KILLFOCUS then begin if HWND(TheMessage.WParam) = HWND(Handle) then begin // lost the focus but it returns to ourselves // eat the message. TheMessage.Result := 0; exit; end; end; inherited WndProc(TheMessage); end; procedure TRxDBGridDateEditor.msg_SetGrid(var Msg: TGridMessage); begin FGrid:=Msg.Grid as TRxDBGrid; Msg.Options:=EO_AUTOSIZE or EO_SELECTALL {or EO_HOOKEXIT or EO_HOOKKEYPRESS or EO_HOOKKEYUP}; end; procedure TRxDBGridDateEditor.msg_SetValue(var Msg: TGridMessage); begin Self.Date:=FGrid.SelectedField.AsDateTime; end; procedure TRxDBGridDateEditor.msg_GetValue(var Msg: TGridMessage); var sText:string; begin sText:=Text; Msg.Value:=sText; end; procedure TRxDBGridDateEditor.msg_SelectAll(var Msg: TGridMessage); begin SelectAll; end; {procedure TRxDBGridDateEditor.SetBounds(aLeft, aTop, aWidth, aHeight: integer); begin BeginUpdateBounds; Dec(aWidth, 25); inherited SetBounds(aLeft, aTop, aWidth, aHeight); EndUpdateBounds; end;} procedure TRxDBGridDateEditor.EditingDone; begin inherited EditingDone; if FGrid<>nil then FGrid.EditingDone; end; { TRxDBGridLookupComboEditor } procedure TRxDBGridLookupComboEditor.WndProc(var TheMessage: TLMessage); begin if TheMessage.msg=LM_KILLFOCUS then begin if HWND(TheMessage.WParam) = HWND(Handle) then begin // lost the focus but it returns to ourselves // eat the message. TheMessage.Result := 0; exit; end; end; inherited WndProc(TheMessage); end; procedure TRxDBGridLookupComboEditor.KeyDown(var Key: Word; Shift: TShiftState ); procedure doGridKeyDown; begin if Assigned(FGrid) then FGrid.KeyDown(Key, shift); end; procedure doEditorKeyDown; begin if FGrid<>nil then FGrid.EditorkeyDown(Self, key, shift); end; function GetFastEntry: boolean; begin if FGrid<>nil then Result := FGrid.FastEditing else Result := False; end; begin case Key of VK_UP, VK_DOWN : if (not PopupVisible) and (not (ssAlt in Shift)) then begin doGridKeyDown; exit; end; VK_LEFT, VK_RIGHT: if GetFastEntry then begin doGridKeyDown; exit; end; else begin inherited KeyDown(Key, Shift); doEditorKeyDown; exit; end; end; inherited KeyDown(Key, Shift); end; procedure TRxDBGridLookupComboEditor.msg_SetGrid(var Msg: TGridMessage); begin FGrid:=Msg.Grid as TRxDBGrid; Msg.Options:=EO_AUTOSIZE; end; procedure TRxDBGridLookupComboEditor.msg_SetValue(var Msg: TGridMessage); var F:TField; begin FCol := Msg.Col; FRow := Msg.Row; F:=FGrid.SelectedField; DataSource:=FGrid.DataSource; if Assigned(F) then begin // DataField:=F.FieldName; DataField:=F.KeyFields; LookupDisplay:=F.LookupResultField; LookupField:=F.LookupKeyFields; FLDS.DataSet:=F.LookupDataSet; FGrid.GetOnCreateLookup; end; end; procedure TRxDBGridLookupComboEditor.ShowList; begin FGrid.GetOnDisplayLookup; inherited ShowList; end; constructor TRxDBGridLookupComboEditor.Create(AOwner: TComponent); begin inherited Create(AOwner); FLDS:=TDataSource.Create(nil); LookupSource:=FLDS; end; destructor TRxDBGridLookupComboEditor.Destroy; begin FreeAndNil(FLDS); inherited Destroy; end; { TRxDBGrid } const ALIGN_FLAGS: array[TAlignment] of Integer = (DT_LEFT or DT_SINGLELINE {or DT_EXPANDTABS} or DT_NOPREFIX, DT_RIGHT or DT_SINGLELINE {or DT_EXPANDTABS} or DT_NOPREFIX, DT_CENTER or DT_SINGLELINE {or DT_EXPANDTABS} or DT_NOPREFIX); const ALIGN_FLAGS_HEADER: array[TAlignment] of Integer = (DT_LEFT or {DT_EXPANDTABS or} DT_NOPREFIX, DT_RIGHT or {DT_EXPANDTABS or }DT_NOPREFIX, DT_CENTER or {DT_EXPANDTABS or }DT_NOPREFIX); { TITLE_SUBHEADER = 2; TITLE_DEFAULT = 1; const EdgeFlag: array[Boolean] of UINT = (BDR_RAISEDINNER, BDR_SUNKENINNER);} procedure WriteTextHeader(ACanvas: TCanvas; ARect: TRect; const Text: string; Alignment: TAlignment); var DrawRect: TRect; W, CnvW:integer; begin DrawRect := Rect(ARect.Left + 1, ARect.Top + 1, ARect.Right, ARect.Bottom); CnvW:=Max(DrawRect.Right - DrawRect.Left, 1); W:=(ACanvas.TextWidth(Text) div CnvW) + 1; DrawRect.Top:=((ARect.Top + ARect.Bottom) div 2) - W * ACanvas.TextHeight('W') div 2; if DrawRect.Top < ARect.Top + 1 then DrawRect.Top := ARect.Top + 1; DrawText(ACanvas.Handle, PChar(Text), Length(Text), DrawRect, // DT_VCENTER or DT_WORDBREAK or DT_CENTER ALIGN_FLAGS_HEADER[Alignment] {or DT_VCENTER or DT_END_ELLIPSIS }or DT_WORDBREAK ); end; procedure TRxDBGrid.SetTitleButtons(const AValue: boolean); begin if AValue then Options:=Options + [dgHeaderPushedLook] else Options:=Options - [dgHeaderPushedLook]; end; procedure TRxDBGrid.SetAutoSort(const AValue: boolean); var S:string; Pos:integer; begin if FAutoSort=AValue then exit; FAutoSort:=AValue; if Assigned(DataSource) and Assigned(DataSource.DataSet) and DataSource.DataSet.Active then begin S:=DataSource.DataSet.ClassName; if RxDBGridSortEngineList.Find(S, Pos) then FSortEngine:=RxDBGridSortEngineList.Objects[Pos] as TRxDBGridSortEngine else FSortEngine:=nil; FSortField:=nil; FSortOrder:=smNone; end end; function TRxDBGrid.GetColumns: TRxDbGridColumns; begin result := TRxDbGridColumns(TCustomDrawGrid(Self).Columns); end; procedure TRxDBGrid.DoCreateJMenu; procedure CreateMenuItem(ShortCut:Char; const ACaption:string; MenuAction:TNotifyEvent); var R:TMenuItem; begin R:=TMenuItem.Create(F_PopupMenu); F_PopupMenu.Items.Add(R); R.Caption := ACaption; if ShortCut<>#0 then R.ShortCut:=KeyToShortCut(ord(ShortCut), [ssCtrl]); R.OnClick :=MenuAction; end; begin F_PopupMenu := TPopupMenu.Create(Self); F_PopupMenu.Name := 'OptionsMenu'; CreateMenuItem('F', sRxDBGridFind, @OnFind); CreateMenuItem('T', sRxDBGridFilter, @OnFilterBy); CreateMenuItem('E', sRxDBGridFilterSimple, @OnFilter); CreateMenuItem('Q', sRxDBGridFilterClear, @OnFilterClose); CreateMenuItem(#0, '-', nil); CreateMenuItem('C', sRxDBGridSortByColumns, @OnSortBy); CreateMenuItem('W', sRxDBGridSelectColumns, @OnChooseVisibleFields); end; function TRxDBGrid.GetPropertyStorage: TCustomPropertyStorage; begin Result:=FPropertyStorageLink.Storage; end; function TRxDBGrid.GetTitleButtons: boolean; begin Result:=dgHeaderPushedLook in Options; end; function TRxDBGrid.IsColumnsStored: boolean; begin result := TRxDbGridColumns(TCustomDrawGrid(Self).Columns).Enabled; end; procedure TRxDBGrid.SetColumns(const AValue: TRxDbGridColumns); begin TRxDbGridColumns(TCustomDrawGrid(Self).Columns).Assign(Avalue); end; procedure TRxDBGrid.SetFooterColor(const AValue: TColor); begin if FFooterColor=AValue then exit; FFooterColor:=AValue; Invalidate; end; procedure TRxDBGrid.SetFooterRowCount(const AValue: integer); begin if FFooterRowCount=AValue then exit; FFooterRowCount:=AValue; VisualChange; // Invalidate; end; procedure TRxDBGrid.SetOptionsRx(const AValue: TOptionsRx); var OldOpt:TOptionsRx; begin if FOptionsRx=AValue then exit; OldOpt:=FOptionsRx; FOptionsRx:=AValue; UseXORFeatures:=rdgXORColSizing in AValue; if (rdgFilter in AValue) and not (rdgFilter in OldOpt) then begin LayoutChanged; BeginUpdate; CalcTitle; EndUpdate; end else if rdgFilter in OldOpt then begin FFilterListEditor.Hide; LayoutChanged; BeginUpdate; CalcTitle; EndUpdate; end; VisualChange; end; procedure TRxDBGrid.SetPropertyStorage(const AValue: TCustomPropertyStorage); begin FPropertyStorageLink.Storage:=AValue; end; function TRxDBGrid.DatalinkActive: boolean; begin Result:=Assigned(DataSource) and Assigned(DataSource.DataSet) and DataSource.DataSet.Active; end; procedure TRxDBGrid.TrackButton(X, Y: Integer); var Cell: TGridCoord; NewPressed: Boolean; I, Offset: Integer; begin Cell := MouseCoord(X, Y); Offset := RowCount;//[0]; NewPressed := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y)) and (FPressedCol = TColumn(ColumnFromGridColumn(Cell.X))) and (Cell.Y < Offset); if FPressed <> NewPressed then begin FPressed := NewPressed; for I := 0 to Offset - 1 do GridInvalidateRow(Self, I); end; end; procedure TRxDBGrid.StopTracking; begin if FTracking then begin TrackButton(-1, -1); FTracking := False; MouseCapture := False; end; end; procedure TRxDBGrid.CalcTitle; var i, j:integer; H, H1, W, H2:integer; rxCol, rxColNext:TRxColumn; rxTit, rxTitleNext:TRxColumnTitle; MLRec1:TMLCaptionItem; MLRec2:TMLCaptionItem; tmpCanvas: TCanvas; begin { TODO -oalexs : need rewrite code - split to 2 step: 1. make links between column 2. calc title width for all linked column series } if RowCount = 0 then exit; tmpCanvas := GetWorkingCanvas(Canvas); try H:=1; ClearMLCaptionPointers; for i:=0 to Columns.Count-1 do begin rxCol:=TRxColumn(Columns[i]); if Assigned(rxCol) and rxCol.Visible then begin rxTit:=TRxColumnTitle(rxCol.Title); if Assigned(rxTit) then begin if rxTit.Orientation in [toVertical270, toVertical90] then H:=Max((tmpCanvas.TextWidth(Columns[i].Title.Caption)+ tmpCanvas.TextWidth('W')) div DefaultRowHeight, H) else begin rxColNext:=nil; rxTitleNext:=nil; if i < Columns.Count-1 then begin rxColNext:=TRxColumn(Columns[i+1]); rxTitleNext:=TRxColumnTitle(rxColNext.Title); end; { TODO -oalexs : Тут необходимо также обработать скрытые столбцы } { j:=i; while j < Columns.Count-1 then begin if inc(j); end; } W:=Max(rxCol.Width-6, 1); if rxTit.CaptionLinesCount > 0 then begin H2:=0; H1:=0; for j:=0 to rxTit.CaptionLinesCount-1 do begin MLRec1:=rxTit.CaptionLine(j); if Assigned(rxTitleNext) and (rxTitleNext.CaptionLinesCount>j) then begin //make links to next column (and in the next column set linc to prior-current) MLRec2:=rxTitleNext.CaptionLine(j); if MLRec1.Caption = MLRec2.Caption then begin MLRec1.Next:=MLRec2; MLRec2.Prior:=MLRec1; end; end; MLRec1.Width:=tmpCanvas.TextWidth(MLRec1.Caption)+2; if W > MLRec1.Width then H2:=1 else H2:=MLRec1.Width div W + 1; if H2>WordCount(MLRec1.Caption, [' ']) then H2:=WordCount(MLRec1.Caption, [' ']); H1:=H1+H2; end end else begin H1:=Max((tmpCanvas.TextWidth(rxTit.Caption)+2) div W + 1, H); if H1>WordCount(rxTit.Caption, [' ']) then H1:=WordCount(rxTit.Caption, [' ']); end; H:=Max(H1, H); end; for j:=0 to rxTit.CaptionLinesCount-1 do begin MLRec1:=rxTit.CaptionLine(j); if MLRec1.Width < rxTit.Column.Width then MLRec1.Width:=rxTit.Column.Width; end; end; end; end; RowHeights[0] := DefaultRowHeight * ({FTitleLines+}H); if rdgFilter in OptionsRx then begin if Assigned(FFilterListEditor) then RowHeights[0] := RowHeights[0] + FFilterListEditor.Height else RowHeights[0] := RowHeights[0] + DefaultRowHeight; end; finally if TmpCanvas<>Canvas then FreeWorkingCanvas(tmpCanvas); end; end; procedure TRxDBGrid.ClearMLCaptionPointers; var i, j:integer; rxCol:TRxColumn; rxTit:TRxColumnTitle; begin for i:=0 to Columns.Count-1 do begin rxCol:=TRxColumn(Columns[i]); if Assigned(rxCol) then begin rxTit:= TRxColumnTitle(rxCol.Title); if Assigned(rxTit) then begin for j:=0 to rxTit.CaptionLinesCount - 1 do begin rxTit.CaptionLine(j).Next:=nil; rxTit.CaptionLine(j).Prior:=nil; end; end end end; end; function TRxDBGrid.getFilterRect(bRect: TRect): TRect; begin Result := bRect; if Assigned(FFilterListEditor) then Result.Top := bRect.Bottom - FFilterListEditor.Height else Result.Top := bRect.Bottom - DefaultRowHeight; end; function TRxDBGrid.getTitleRect(bRect: TRect): TRect; begin Result := bRect; if Assigned(FFilterListEditor) then Result.Bottom := bRect.Bottom - FFilterListEditor.Height else Result.Bottom := bRect.Bottom - DefaultRowHeight; end; procedure TRxDBGrid.OutCaptionCellText(aCol, aRow: Integer;const aRect: TRect; aState: TGridDrawState; const ACaption: string); begin Canvas.FillRect(aRect); DrawCellGrid(aCol, aRow, aRect, aState); if ACaption <> '' then WriteTextHeader(Canvas, aRect, ACaption, GetColumnAlignment(aCol, true)) end; procedure TRxDBGrid.OutCaptionCellText90(aCol,aRow: Integer;const aRect: TRect; aState: TGridDrawState;const ACaption:string; const TextOrient:TTextOrientation); var dW, dY:integer; begin Canvas.FillRect(aRect); DrawCellGrid(aCol,aRow,aRect,aState); if TextOrient in [toVertical90, toVertical270] then begin dW:=((aRect.Bottom - aRect.Top) - Canvas.TextWidth(ACaption)) div 2; dY:=((aRect.Right - aRect.Left) - Canvas.TextHeight(ACaption)) div 2; end else begin dW:=0; dY:=0; end; OutTextXY90(Canvas, aRect.Left + dY, aRect.Top+dw, ACaption, TextOrient); end; procedure TRxDBGrid.OutCaptionSortMarker(const aRect: TRect; ASortMarker: TSortMarker); var X,Y:integer; begin if (dgHeaderPushedLook in Options) then begin if ASortMarker = smDown then begin X:=aRect.Right - FMarkerDown.Width - 6; Y:=Trunc((aRect.Top+aRect.Bottom-FMarkerDown.Height)/2); Canvas.Draw(X, Y, FMarkerDown); end else if ASortMarker = smUp then begin X:=aRect.Right - FMarkerUp.Width - 6; Y:=Trunc((aRect.Top+aRect.Bottom-FMarkerUp.Height)/2); Canvas.Draw(X, Y, FMarkerUp); end; end; end; procedure TRxDBGrid.OutCaptionMLCellText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState; MLI: TMLCaptionItem); var MLINext: TMLCaptionItem; Rgn: HRGN; begin MLINext:=MLI.Next; while Assigned(MLINext) do begin aRect.Right:=aRect.Right + MLINext.Col.Width; MLINext:=MLINext.Next; end; // OutCaptionCellText(aCol, aRow, aRect, aState, MLI.Caption); Rgn := CreateRectRgn(aRect.Left, aRect.Top, aRect.Right, aRect.Bottom); SelectClipRgn(Canvas.Handle, Rgn); OutCaptionCellText(aCol, aRow, aRect, aState, MLI.Caption); SelectClipRgn(Canvas.Handle, 0); DeleteObject(Rgn); end; procedure TRxDBGrid.UpdateJMenuStates; begin F_PopupMenu.Items[0].Enabled:=rdgAllowDialogFind in FOptionsRx; F_PopupMenu.Items[1].Enabled:=rdgAllowFilterForm in FOptionsRx; F_PopupMenu.Items[2].Enabled:=rdgAllowQuickFilter in FOptionsRx; F_PopupMenu.Items[3].Enabled:=(rdgFilter in FOptionsRx) or (rdgAllowFilterForm in FOptionsRx); F_PopupMenu.Items[5].Enabled:=rdgAllowSortForm in FOptionsRx; F_PopupMenu.Items[6].Enabled:=rdgAllowColumnsForm in FOptionsRx; end; function TRxDBGrid.SortEngineOptions: TRxSortEngineOptions; begin Result:=[]; if rdgCaseInsensitiveSort in FOptionsRx then Include(Result, seoCaseInsensitiveSort); end; procedure TRxDBGrid.OnIniSave(Sender: TObject); var i:integer; S, S1:string; C:TRxColumn; begin S:=Owner.Name+'.'+Name; FPropertyStorageLink.Storage.WriteInteger(S+sVersion, FVersion); FPropertyStorageLink.Storage.WriteInteger(S+sCount, Columns.Count); S:=S+sItem; for i:=0 to Columns.Count-1 do begin S1:=S+IntToStr(i); C:=TRxColumn(Columns[i]); FPropertyStorageLink.Storage.WriteString(S1+sCaption, StrToHexText(C.Title.Caption)); FPropertyStorageLink.Storage.WriteInteger(S1+sWidth, C.Width); FPropertyStorageLink.Storage.WriteInteger(S1+sIndex, C.Index); FPropertyStorageLink.Storage.WriteInteger(S1+sVisible, Ord(C.Visible)); end; if Assigned(FSortField) then begin FPropertyStorageLink.Storage.WriteInteger(S1+sSortMarker, Ord(FSortOrder)); FPropertyStorageLink.Storage.WriteString(S1+sSortField, FSortField.FieldName); end else FPropertyStorageLink.Storage.WriteInteger(S1+sSortMarker, Ord(smNone)); end; procedure TRxDBGrid.OnIniLoad(Sender: TObject); var i, ACount:integer; S, S1, ColumName:string; C:TRxColumn; begin S:=Owner.Name+'.'+Name; ACount:=FPropertyStorageLink.Storage.ReadInteger(S+sVersion, FVersion); //Check cfg version if ACount = FVersion then begin ACount:=FPropertyStorageLink.Storage.ReadInteger(S+sCount, 0); S:=S+sItem; for i:=0 to ACount-1 do begin S1:=S+IntToStr(i); ColumName:=HexTextToStr(FPropertyStorageLink.Storage.ReadString(S1+sCaption, '')); if ColumName<>'' then begin C:=ColumnByCaption(ColumName); if Assigned(C) then begin C.Width:=FPropertyStorageLink.Storage.ReadInteger(S1+sWidth, C.Width); C.Visible:=FPropertyStorageLink.Storage.ReadInteger(S1+sVisible, Ord(C.Visible)) = 1; C.Index:=Min(FPropertyStorageLink.Storage.ReadInteger(S1+sIndex, C.Index), Columns.Count-1); end; end; end; FSortOrder:=TSortMarker(FPropertyStorageLink.Storage.ReadInteger(S1+sSortMarker, Ord(smNone))); if Assigned(FSortEngine) and (FSortOrder<>smNone) and DatalinkActive then begin ColumName:=FPropertyStorageLink.Storage.ReadString(S1+sSortField, ''); if ColumName<>'' then begin FSortField:=DataSource.DataSet.FindField(ColumName); if Assigned(FSortField) then FSortEngine.Sort(FSortField, DataSource.DataSet, FSortOrder=smUp, SortEngineOptions); end; end end; end; procedure TRxDBGrid.DefaultDrawCellA(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); begin PrepareCanvas(aCol, aRow, aState); if rdgFilter in OptionsRx then begin DefaultDrawFilter(aCol, aRow, getFilterRect(aRect), aState); DefaultDrawTitle(aCol, aRow, getTitleRect(aRect), aState); end else DefaultDrawTitle(aCol, aRow, aRect, aState); end; procedure TRxDBGrid.DefaultDrawTitle(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); var ASortMarker: TSortMarker; Background: TColor; i:integer; Down:boolean; aRect2: TRect; FTitle :TRxColumnTitle; GrdCol:TGridColumn; MLI, MLINext:TMLCaptionItem; begin if (dgIndicator in Options) and (aCol=0) then begin Canvas.FillRect(aRect); if F_Clicked then aState:= aState + [gdPushed]; DrawCellGrid(aCol,aRow, aRect, aState); if DatalinkActive and (rdgAllowToolMenu in FOptionsRx) then Canvas.Draw((ARect.Left+ARect.Right-F_MenuBMP.Width) div 2,(ARect.Top + ARect.Bottom - F_MenuBMP.Height) div 2, F_MenuBMP); exit; end; Down := FPressed and (dgHeaderPushedLook in Options) and (FPressedCol = TColumn(ColumnFromGridColumn(aCol))); ASortMarker := smNone; if (FSortField = GetFieldFromGridColumn(aCol)) then ASortMarker := FSortOrder; if Assigned(FOnGetBtnParams) and Assigned(GetFieldFromGridColumn(aCol)) then begin Background:=Canvas.Brush.Color; FOnGetBtnParams(Self, GetFieldFromGridColumn(aCol), Canvas.Font, Background, ASortMarker, Down); Canvas.Brush.Color:=Background; end; if (gdFixed in aState) and (aRow=0) and (ACol>=FixedCols) then begin GrdCol:=ColumnFromGridColumn(aCol); if Assigned(GrdCol) then FTitle:=TRxColumnTitle(GrdCol.Title) else FTitle:=nil; if Assigned(FTitle) then begin if FTitle.Orientation <> toHorizontal then begin OutCaptionCellText90(aCol, aRow, aRect, aState, FTitle.Caption, FTitle.Orientation); if Down then aState:= aState + [gdPushed]; end else if (FTitle.CaptionLinesCount>0) then begin aRect2.Left:=aRect.Left; aRect2.Right:=aRect.Right; aRect2.Top:=aRect.Top; for i:=0 to FTitle.CaptionLinesCount - 1 do begin MLI:=FTitle.CaptionLine(i); aRect2.Right:=aRect.Right; if i = FTitle.CaptionLinesCount - 1 then begin aRect2.Bottom:=aRect.Bottom; aRect.Top:=ARect2.Top; if Down then aState:= aState + [gdPushed]; end else begin aRect2.Bottom:=aRect2.Top + DefaultRowHeight; end; if Assigned(MLI.Next) then begin if Assigned(MLI.Prior) then begin if aCol = LeftCol then OutCaptionMLCellText(aCol, aRow, aRect2, aState, MLI); end else OutCaptionMLCellText(aCol, aRow, aRect2, aState, MLI); end else begin if not Assigned(MLI.Prior) then begin OutCaptionCellText(aCol, aRow, aRect2, aState, MLI.Caption); end else if aCol = LeftCol then OutCaptionMLCellText(aCol, aRow, aRect2, aState, MLI); end; aRect2.Top:=aRect2.Bottom; end; end else begin if Down then aState:= aState + [gdPushed]; OutCaptionCellText(aCol, aRow, aRect, aState, FTitle.Caption); end; end else begin OutCaptionCellText(aCol, aRow, aRect, aState, GetDefaultColumnTitle(aCol)); end; OutCaptionSortMarker(aRect, ASortMarker); end else begin if Down then aState:= aState + [gdPushed]; OutCaptionCellText(aCol, aRow, aRect, aState, ''); end; end; procedure TRxDBGrid.DefaultDrawFilter(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); var bg : TColor; al : TAlignment; ft : TFont; MyCol : integer; TxS:TTextStyle; begin if (dgIndicator in Options) and (aCol=0) then begin Canvas.FillRect(aRect); DrawCellGrid(aCol,aRow, aRect, aState); exit; end; DrawCellGrid(aCol,aRow,aRect,aState); Inc(aRect.Left, 1); Dec(aRect.Right, 1); Inc(aRect.Top, 1); Dec(aRect.Bottom, 1); if Columns.Count > (aCol-1) then begin bg := Canvas.Brush.Color; al := Canvas.TextStyle.Alignment; ft := Canvas.Font; TxS:=Canvas.TextStyle; MyCol := Columns.RealIndex(aCol-1); with TRxColumn(Columns[MyCol]).Filter do begin Canvas.Brush.Color := Color; Canvas.FillRect(aRect); if Value<>'' then begin Canvas.Font := Font; if (aRect.Right - aRect.Left) >= Canvas.TextWidth(Value) then TxS.Alignment := Alignment else TxS.Alignment := taLeftJustify; Canvas.TextStyle:=TxS; DrawCellText(aCol, aRow, aRect, aState, Value) end else begin Canvas.Font := TRxColumn(Columns[MyCol]).Filter.EmptyFont; if (aRect.Right - aRect.Left) >= Canvas.TextWidth(Value) then TxS.Alignment := Alignment else TxS.Alignment := taLeftJustify; Canvas.TextStyle:=TxS; DrawCellText(aCol, aRow, aRect, aState, TRxColumn(Columns[MyCol]).Filter.EmptyValue); end; end; Canvas.Font := ft; Canvas.Brush.Color := bg; // Canvas.TextStyle.Alignment := al; TxS.Alignment := al; Canvas.TextStyle:=TxS; end else begin bg := Canvas.Brush.Color; Canvas.Brush.Color := Color; Canvas.FillRect(aRect); Canvas.Brush.Color := bg; end; end; procedure TRxDBGrid.DefaultDrawCellData(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); var S: string; F: TField; C:TRxColumn; j:integer; begin if Assigned(OnDrawColumnCell) and not(CsDesigning in ComponentState) then OnDrawColumnCell(Self, aRect, aCol, TColumn(ColumnFromGridColumn(aCol)), aState) else begin F := GetFieldFromGridColumn(aCol); C := ColumnFromGridColumn(aCol) as TRxColumn; case ColumnEditorStyle(aCol, F) of cbsCheckBoxColumn : DrawCheckBoxBitmaps(aCol, aRect, F); else if F<>nil then begin if F.dataType <> ftBlob then begin { if Assigned(F.LookupDataSet) and (F.LookupResultField<>'') then S := F.LookupDataSet.FieldByName(F.LookupResultField).DisplayText else} S := F.DisplayText; if Assigned(C) and (C.KeyList.Count > 0) and (C.PickList.Count>0) then begin J:=C.KeyList.IndexOf(S); if (J>=0) and (J -1) and (AImageIndex < RxColumn.ImageList.Count) then DrawCellBitmap(RxColumn, aRect, aState, AImageIndex); end else DefaultDrawCellData(aCol, aRow, aRect, aState); // inherited DrawCell(aCol, aRow, aRect, aState); end else inherited DrawCell(aCol, aRow, aRect, aState); end; procedure TRxDBGrid.LinkActive(Value: Boolean); var S:string; Pos:integer; begin inherited LinkActive(Value); if Value then begin S:=DataSource.DataSet.ClassName; if RxDBGridSortEngineList.Find(S, Pos) then FSortEngine:=RxDBGridSortEngineList.Objects[Pos] as TRxDBGridSortEngine else FSortEngine:=nil; end else begin FSortEngine:=nil; if SelectedRows.Count>0 then SelectedRows.Clear; end; FSortField:=nil; FSortOrder:=smNone; F_SortListField.Clear; if not (csDestroying in ComponentState) and not (csDesigning in ComponentState) then begin if Value then begin if DataSource.DataSet.OnFilterRecord<>@FilterRec then begin F_EventOnFilterRec:=DataSource.DataSet.OnFilterRecord; DataSource.DataSet.OnFilterRecord:=@FilterRec; end; if DataSource.DataSet.BeforeDelete<>@BeforeDel then begin F_EventOnBeforeDelete:=DataSource.DataSet.BeforeDelete; DataSource.DataSet.BeforeDelete:=@BeforeDel; end; if DataSource.DataSet.BeforePost<>@BeforePo then begin F_EventOnBeforePost:=DataSource.DataSet.BeforePost; DataSource.DataSet.BeforePost:=@BeforePo; end; if DataSource.DataSet.OnDeleteError<>@ErrorDel then begin F_EventOnDeleteError:=DataSource.DataSet.OnDeleteError; DataSource.DataSet.OnDeleteError:=@ErrorDel; end; if DataSource.DataSet.OnPostError<>@ErrorPo then begin F_EventOnPostError:=DataSource.DataSet.OnPostError; DataSource.DataSet.OnPostError:=@ErrorPo; end; CalcStatTotals; end else begin if Assigned(DataSource) and Assigned(DataSource.DataSet) then begin DataSource.DataSet.OnFilterRecord:=F_EventOnFilterRec; F_EventOnFilterRec:=nil; DataSource.DataSet.BeforeDelete:=F_EventOnBeforeDelete; F_EventOnBeforeDelete:=nil; DataSource.DataSet.BeforePost:=F_EventOnBeforePost; F_EventOnBeforePost:=nil; DataSource.DataSet.OnDeleteError:=F_EventOnDeleteError; F_EventOnDeleteError:=nil; DataSource.DataSet.OnPostError:=F_EventOnPostError; F_EventOnPostError:=nil; OptionsRx:=OptionsRx - [rdgFilter]; end; F_LastFilter.Clear; end; end; end; procedure TRxDBGrid.DrawFooterRows; var FooterRect: TRect; R : TRect; TotalYOffs: integer; TotalWidth: integer; i : integer; C :TRxColumn; Background : TColor; ClipArea: Trect; TxS:TTextStyle; begin TotalWidth := GetClientRect.Right; TotalYOffs:= GCache.ClientHeight; FooterRect := Rect(0, TotalYOffs, TotalWidth, TotalYOffs + DefaultRowHeight * FooterRowCount + 2); Background := Canvas.Brush.Color; Canvas.Brush.Color:=Color; Canvas.FillRect(FooterRect); R.Top:=TotalYOffs; R.Bottom:=TotalYOffs + DefaultRowHeight * FooterRowCount + 2; Canvas.Brush.Color := FFooterColor; if (Columns.Count > 0) then begin TxS:=Canvas.TextStyle; for i := GCache.VisibleGrid.Left to GCache.VisibleGrid.Right do begin ColRowToOffset(True, True, i, R.Left, R.Right); Canvas.FillRect(R); DrawCellGrid(i, 0, R, []); C := ColumnFromGridColumn(i) as TRxColumn; if Assigned(C) then begin TxS.Alignment:=C.Footer.Alignment; TxS.Layout:=C.Footer.Layout; Canvas.TextStyle:=TxS; DrawCellText(i, 0, R, [], C.Footer.DisplayText); end; end; ClipArea := Canvas.ClipRect; for i:=0 to FixedCols-1 do begin ColRowToOffset(True, True, i, R.Left, R.Right); DrawCellGrid(i, 0, R, [gdFixed]); if ((R.Left < ClipArea.Right) and (R.Right > ClipArea.Left)) then DrawCell(i, 0, R, [gdFixed]); end; end; Canvas.Brush.Color := Background; end; procedure TRxDBGrid.DoTitleClick(ACol: Longint; AField: TField); begin if FAutoSort and (FSortEngine<>nil) and (AField<>nil) then begin if AField=FSortField then begin if FSortOrder=smUp then FSortOrder:=smDown else FSortOrder:=smUp; end else begin FSortField:=AField; FSortOrder:=smUp; end; FSortEngine.Sort(FSortField, DataSource.DataSet, FSortOrder=smUp, SortEngineOptions); end else HeaderClick(true, ACol); end; procedure TRxDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer); var Cell: TGridCoord; Rect : TRect; begin if FTracking then TrackButton(X, Y); inherited MouseMove(Shift, X, Y); if (rdgFilter in OptionsRx) and (dgColumnResize in Options) and (Cursor = crHSplit) then begin Cell := MouseCoord(X, Y); Rect := getFilterRect(CellRect(Cell.x,Cell.y)); if (Cell.Y=0) and (Cell.X >= ord(dgIndicator in Options)) and (Rect.Top < Y) then begin Cursor := crDefault; end; end; if FColumnResizing and (MouseToGridZone(X,Y) = gzFixedCols) then begin CalcTitle; if (rdgFooterRows in OptionsRx) and (dgColumnResize in Options) and (FooterRowCount > 0) then DrawFooterRows; end; end; procedure TRxDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Cell: TGridCoord; Rect : TRect; begin Cell := MouseCoord(X, Y); if (DatalinkActive) and (DataSource.DataSet.State = dsBrowse) and (Button = mbLeft) and (Cell.X =0 ) and (Cell.Y = 0) and (dgIndicator in Options) and (rdgAllowToolMenu in FOptionsRx) then begin F_Clicked := True; InvalidateCell(0, 0); end else if (Cell.Y=0) and (Cell.X >= ord(dgIndicator in Options)) then begin if (rdgFilter in OptionsRx) and DatalinkActive then begin Cell := MouseCoord(X, Y); Rect := getFilterRect(CellRect(Cell.x,Cell.y)); if (Cell.Y=0) and (Cell.X >= ord(dgIndicator in Options)) and (Rect.Top < Y) then begin if TRxColumn(Columns[Columns.RealIndex(Cell.x-1)]).Filter.ValueList.Count >0 then with FFilterListEditor do begin Items.Clear; Items.AddStrings(TRxColumn(Columns[Columns.RealIndex(Cell.x-1)]).Filter.ValueList); Parent:=Self; Width := Rect.Right-Rect.Left; Height := Rect.Bottom - Rect.Top; BoundsRect := Rect; Style := csDropDownList; DropDownCount := TRxColumn(Columns[Columns.RealIndex(Cell.x-1)]).Filter.DropDownRows; Text:=TRxColumn(Columns[Columns.RealIndex(Cell.x-1)]).Filter.Value; Show(Self,Cell.x-1); end; exit; end; end; if dgColumnResize in Options then begin FColumnResizing:=true; end; if FAutoSort then begin Cell := MouseCoord(X, Y); if (Cell.Y=0) and (Cell.X >= ord(dgIndicator in Options)) then begin if (dgColumnResize in Options) and (Button = mbRight) then begin Button := mbLeft; FSwapButtons := True; MouseCapture := True; Shift:=Shift + [ssLeft]; inherited MouseDown(Button, Shift, X, Y); end else if Button = mbLeft then begin if (MouseToGridZone(X,Y) = gzFixedCols) and (dgColumnResize in Options) and (Cursor=crHSplit) then begin if (ssDouble in Shift) and (rdgDblClickOptimizeColWidth in FOptionsRx) then begin if Assigned(ColumnFromGridColumn(Cell.X)) then TRxColumn(ColumnFromGridColumn(Cell.X)).OptimizeWidth; end else inherited MouseDown(Button, Shift, X, Y); end else begin MouseCapture := True; FTracking := True; FPressedCol := TColumn(ColumnFromGridColumn(Cell.X)); TrackButton(X, Y); end; end end else inherited MouseDown(Button, Shift, X, Y); end else inherited MouseDown(Button, Shift, X, Y); end else begin if rdgMrOkOnDblClik in FOptionsRx then begin if (Cell.Y > 0) and (Cell.X >= ord(dgIndicator in Options)) and (ssDouble in Shift) then begin if Owner is TCustomForm then TCustomForm(Owner).ModalResult:=mrOk; end; end; inherited MouseDown(Button, Shift, X, Y); end; end; procedure TRxDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Cell: TGridCoord; ACol: Longint; DoClick: Boolean; ShowMenu : Boolean; MPT : TPoint; Rct : TRect; begin ShowMenu := false; FColumnResizing := false; if (dgHeaderPushedLook in Options) and FTracking and (FPressedCol <> nil) then begin Cell := MouseCoord(X, Y); DoClick := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y)) and (Cell.Y < RowHeights[0]) and (FPressedCol = TColumn(ColumnFromGridColumn(Cell.X))); StopTracking; if DoClick then begin ACol := Cell.X; if (dgIndicator in Options) then Dec(ACol); if DataLinkActive and (ACol >= 0) and (ACol < Columns.Count ) then begin FPressedCol := ColumnFromGridColumn(Cell.X) as TColumn; if Assigned(FPressedCol) then begin F_SortListField.Clear; DoTitleClick(FPressedCol.Index, FPressedCol.Field); end; end; end; end else if FSwapButtons then begin FSwapButtons := False; MouseCapture := False; if Button = mbRight then Button := mbLeft; end; if (DatalinkActive) and (DataSource.DataSet.State = dsBrowse) and (rdgAllowToolMenu in FOptionsRx) then begin Cell := MouseCoord(X,Y); if ((Button = mbLeft) and (Cell.X =0 ) and (Cell.Y = 0) and (dgIndicator in Options)) or (F_Clicked) then begin F_Clicked := False; InvalidateCell(0, 0); ShowMenu := True; Button:=mbRight; end; end; inherited MouseUp(Button, Shift, X, Y); if (DatalinkActive) and (DataSource.DataSet.State = dsBrowse) and (ShowMenu) then begin Rct:=CellRect(0, 0); MPT.X := Rct.Left; if rdgFilter in FOptionsRx then MPT.Y := Rct.Bottom - DefaultRowHeight else MPT.Y := Rct.Bottom; MPT := ClientToScreen(MPT); // DrawCell(0,0,F_TopRect,[gdFixed]); UpdateJMenuStates; F_PopupMenu.Popup(MPT.X,MPT.Y); end; end; procedure TRxDBGrid.SetQuickUTF8Search(AValue : String); var ClearSearchValue : Boolean; OldSearchString : String; begin if ( rdgAllowQuickSearch in OptionsRx ) then begin OldSearchString := Self.FQuickUTF8Search; if (OldSearchString <> AValue ) and Assigned(Self.FBeforeQuickSearch) then Self.FBeforeQuickSearch(Self, SelectedField, AValue); if OldSearchString <> AValue then begin ClearSearchValue := True; if ( Length(AValue) > 0 ) and ( Self.DatalinkActive ) then begin if (DataSource.DataSet.State = dsBrowse) and (not (DataSource.DataSet.EOF and DataSource.DataSet.BOF)) then begin //1.Вызываем процедурку поиска... if DataSetLocateThrough(Self.DataSource.DataSet, Self.SelectedField.FieldName,AValue,[loPartialKey,loCaseInsensitive]) then Self.FQuickUTF8Search := AValue; ClearSearchValue := False; end; end; if ClearSearchValue then begin Self.FQuickUTF8Search := ''; end; if (OldSearchString <> Self.FQuickUTF8Search ) and Assigned(Self.FAfterQuickSearch) then Self.FAfterQuickSearch(Self, SelectedField, OldSearchString); end end; //TODO: сделать отображение ищущейся буквы/строки. end; procedure TRxDBGrid.UTF8KeyPress(var UTF8Key: TUTF8Char); var CheckUp : Boolean; begin inherited UTF8KeyPress(UTF8Key); if ReadOnly then begin //0. Проверяем что это кнопка значащая, увеличиваем "строку поиска" if Length(UTF8Key) = 1 then begin //DebugLn('Ord Of Key:',IntToStr(Ord(UTF8Key[1]))); CheckUp := not ( Ord(UTF8Key[1]) in CBadQuickSearchSymbols ) end else CheckUp := True; // DebugLn('RxDBGrid.UTF8KeyPress check',IfThen(CheckUp,'True','False'),'INIT UTF8Key= ',UTF8Key,' Selected Field: ', Self.SelectedField.FieldName); if CheckUp then QuickUTF8Search := QuickUTF8Search + Trim(UTF8Key); end; end; procedure TRxDBGrid.KeyDown(var Key: Word; Shift: TShiftState); var FTmpReadOnly:boolean; begin //DebugLn('RxDBGrid.KeyDown ',Name,' INIT Key= ',IntToStr(Key)); if (Key in CCancelQuickSearchKeys) then if Length(QuickUTF8Search) > 0 then QuickUTF8Search := ''; case Key of ord('F'):begin if (ssCtrl in Shift) and (rdgAllowDialogFind in OptionsRx) then begin if Length(QuickUTF8Search) > 0 then QuickUTF8Search := ''; ShowFindDialog; exit; end; end; ord('W'):begin if (ssCtrl in Shift) and (rdgAllowColumnsForm in OptionsRx) then begin if Length(QuickUTF8Search) > 0 then QuickUTF8Search := ''; ShowColumnsDialog; exit; end; end; VK_DELETE:if not (aoDelete in FAllowedOperations) then exit; VK_INSERT:if not (aoInsert in FAllowedOperations) then exit; ord('T'):begin if ssCtrl in Shift then begin OnFilterBy(Self); exit; end; end; ord('E'):begin if (ssCtrl in Shift) and (rdgAllowQuickFilter in FOptionsRx) then begin OnFilter(Self); exit; end; end; ord('Q'):begin if ssCtrl in Shift then begin OnFilterClose(Self); exit; end; end; ord('C'):begin if ssCtrl in Shift then begin OnSortBy(Self); exit; end; end; VK_RETURN:if (aoAppend in FAllowedOperations) and (EditorMode) and (Col=ColCount-1) and (Row=RowCount-1) then if DataSource.DataSet.State=dsInsert then begin DataSource.DataSet.Post; Col:=0; Key:=VK_DOWN; inherited KeyDown(Key, Shift); exit; end else begin Col:=0; Key:=VK_DOWN; inherited KeyDown(Key, Shift); exit; end; VK_DOWN:if not (aoAppend in FAllowedOperations) then begin FTmpReadOnly:=ReadOnly; ReadOnly:=true; inherited KeyDown(Key, Shift); ReadOnly:=FTmpReadOnly; exit; end; end; inherited KeyDown(Key, Shift); end; function TRxDBGrid.CreateColumns: TGridColumns; begin Result := TRxDbGridColumns.Create(Self, TRxColumn); end; procedure TRxDBGrid.DrawCellBitmap(RxColumn: TRxColumn; aRect: TRect; aState: TGridDrawState; AImageIndex: integer); var ClientSize: TSize; H, W: Integer; begin InflateRect(aRect, -1, -1); H := RxColumn.ImageList.Height; W := RxColumn.ImageList.Width; ClientSize.cx:= Min(aRect.Right - aRect.Left, W); ClientSize.cy:= Min(aRect.Bottom - aRect.Top, H); if ClientSize.cx = W then begin aRect.Left:= (aRect.Left + aRect.Right - W) div 2; aRect.Right:=aRect.Left + W; end; if ClientSize.cy = H then begin aRect.Top:= (aRect.Top + aRect.Bottom - H) div 2; aRect.Bottom:=aRect.Top + H; end; RxColumn.ImageList.StretchDraw(Canvas, AImageIndex, aRect); end; procedure TRxDBGrid.SetEditText(ACol, ARow: Longint; const Value: string); var C:TRxColumn; j:integer; S:string; begin C := ColumnFromGridColumn(aCol) as TRxColumn; S:=Value; if Assigned(C) and (C.KeyList.Count>0) and (C.PickList.Count>0) then begin J:=C.PickList.IndexOf(S); if (J>=0) and (J 0) then Dec(GCache.ClientHeight, DefaultRowHeight * FooterRowCount + 2); end; procedure TRxDBGrid.ColRowMoved(IsColumn: Boolean; FromIndex, ToIndex: Integer ); begin inherited ColRowMoved(IsColumn, FromIndex, ToIndex); if IsColumn then CalcTitle; end; procedure TRxDBGrid.Paint; begin inherited Paint; if (rdgFooterRows in OptionsRx) and (FooterRowCount > 0) then DrawFooterRows; end; procedure TRxDBGrid.UpdateActive; begin if FInProcessCalc>0 then exit; inherited UpdateActive; if FInProcessCalc<0 then begin FInProcessCalc:=0; CalcStatTotals; end else if (rdgFooterRows in OptionsRx) and (FooterRowCount > 0) and DatalinkActive and (DataSource.DataSet.State = dsBrowse) then CalcStatTotals; end; procedure TRxDBGrid.UpdateData; begin inherited UpdateData; end; procedure TRxDBGrid.MoveSelection; begin inherited MoveSelection; if (rdgFooterRows in OptionsRx) and (FooterRowCount > 0) then DrawFooterRows; end; procedure TRxDBGrid.CMHintShow(var Message: TLMessage); var Cell : TGridCoord; tCol : TRxColumn; begin if Assigned(TCMHintShow(Message).HintInfo) then begin with TCMHintShow(Message).HintInfo^ do begin Cell := MouseCoord(CursorPos.X, CursorPos.Y); if (Cell.Y=0) and (Cell.X >= ord(dgIndicator in Options)) then begin tCol:=TRxColumn(ColumnFromGridColumn(Cell.X)); if Assigned(tCol) and (TRxColumnTitle(tCol.Title).Hint <> '') and (TRxColumnTitle(tCol.Title).FShowHint) then HintStr:=TRxColumnTitle(tCol.Title).Hint; end; end; end; inherited CMHintShow(Message); end; procedure TRxDBGrid.FFilterListEditorOnChange(Sender: TObject); begin FFilterListEditor.Hide; with TRxColumn(Columns[Columns.RealIndex(FFilterListEditor.Col)]).Filter do begin if FFilterListEditor.Text = EmptyValue then Value := '' else Value := FFilterListEditor.Text end; DataSource.DataSet.Refresh; CalcStatTotals; if Assigned(FOnFiltred) then FOnFiltred(Self); end; procedure TRxDBGrid.FFilterListEditorOnCloseUp(Sender: TObject); begin FFilterListEditor.Hide; FFilterListEditor.Changed; SetFocus; end; procedure TRxDBGrid.InternalOptimizeColumnsWidth(AColList: TList); var P:TBookmark; i, W, n:integer; WA:PIntegerArray; S:String; begin GetMem(WA, SizeOf(Integer) * AColList.Count); for I := 0 to AColList.Count-1 do begin if TRxColumnTitle(TRxColumn(AColList[i]).Title).CaptionLinesCount>1 then WA^[i]:=Max(Canvas.TextWidth(TRxColumnTitle(TRxColumn(AColList[i]).Title).CaptionLine(TRxColumnTitle(TRxColumn(AColList[i]).Title).CaptionLinesCount - 1).Caption ) + 8, 20) else WA^[i]:=Max(Canvas.TextWidth(TRxColumn(AColList[i]).Title.Caption) + 8, 20); end; with DataSource.DataSet do begin DisableControls; P:=GetBookmark; First; try while not Eof do begin for I := 0 to AColList.Count-1 do begin S:=TRxColumn(AColList[i]).Field.DisplayText; with TRxColumn(AColList[i]) do if (KeyList.Count > 0) and (PickList.Count > 0) then begin n:=KeyList.IndexOf(S); if (n<>-1) and (n < PickList.Count) then S:=PickList.Strings[n]; end; W:=Canvas.TextWidth(S) + 6; if WA^[i]0 then TRxColumn(AColList[i]).Width:=WA^[i]; FreeMem(WA, SizeOf(Integer) * AColList.Count); end; function TRxDBGrid.IsDefaultRowHeightStored: boolean; begin Result:=DefaultRowHeight = Canvas.TextHeight('W'); end; procedure TRxDBGrid.VisualChange; begin inherited VisualChange; // if Canvas.HandleAllocated then CalcTitle; end; function TRxDBGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl; var F:TField; begin if Style = cbsAuto then begin F:=SelectedField; if Assigned(F) then begin if Assigned(F.LookupDataSet) and (F.LookupKeyFields<>'') and (F.LookupResultField<>'') and (F.KeyFields<>'') then begin Result:=FRxDbGridLookupComboEditor; exit; end else if F.DataType in [ftDate, ftDateTime] then begin Result:=FRxDbGridDateEditor; exit; end; end end; Result:=inherited EditorByStyle(Style); end; procedure TRxDBGrid.CalcStatTotals; var P:TBookmark; DS:TDataSet; i:integer; APresent:boolean; begin if (not ((rdgFooterRows in OptionsRx) and DatalinkActive)) or (Columns.Count = 0) then Exit; //Дополнительно проверим - а стоит ли делать пробег по данным - есть ли агрегатные функции APresent:=false; for i:=0 to Columns.Count - 1 do begin APresent:=TRxColumn(Columns[i]).Footer.FValueType in [fvtSum, fvtAvg, fvtMax, fvtMin]; if APresent then break; end; if not APresent then exit; inc(FInProcessCalc); DS:=DataSource.DataSet;; P := Ds.GetBookMark; DS.DisableControls; try DS.First; for i:=0 to Columns.Count - 1 do TRxColumn(Columns[i]).Footer.ResetTestValue; while not DS.EOF do begin for i:=0 to Columns.Count - 1 do TRxColumn(Columns[i]).Footer.UpdateTestValue; DS.Next; end; finally DS.GotoBookmark(P); DS.FreeBookmark(P); DS.EnableControls; end; Dec(FInProcessCalc); if FInProcessCalc<0 then FInProcessCalc:=0; end; procedure TRxDBGrid.OptimizeColumnsWidth(AColList: String); var ColList:TList; procedure DoFillColList; var L:integer; begin L:=Pos(';', AColList); while L>0 do begin if AColList<>'' then ColList.Add(ColumnByFieldName(Copy(AColList, 1, L-1))); Delete(AColList, 1, L); L:=Pos(';', AColList); end; if AColList<>'' then ColList.Add(ColumnByFieldName(AColList)); end; begin if (not DatalinkActive) or (Columns.Count = 0) then Exit; ColList:=TList.Create; DoFillColList; InternalOptimizeColumnsWidth(ColList); ColList.Free; end; procedure TRxDBGrid.OptimizeColumnsWidthAll; var ColList:TList; i:integer; begin if (not DatalinkActive) or (Columns.Count = 0) then Exit; ColList:=TList.Create; for i:=0 to Columns.Count-1 do ColList.Add(Columns[i]); InternalOptimizeColumnsWidth(ColList); ColList.Free; end; procedure TRxDBGrid.UpdateTitleHight; begin CalcTitle; end; procedure TRxDBGrid.FilterRec(DataSet : TDataSet;var Accept: Boolean); var i:integer; begin Accept:=true; for i:=0 to Columns.Count-1 do begin with TRxColumn(Columns[i]) do if (Filter.Value<>'') and (Filter.Value<>Field.DisplayText) then begin Accept:=false; break; end; end; if Assigned(F_EventOnFilterRec) then F_EventOnFilterRec(DataSet,Accept); end; procedure TRxDBGrid.BeforeDel(DataSet: TDataSet); var i:integer; begin if (rdgFooterRows in OptionsRx) and (DatalinkActive) then for i:=0 to Columns.Count - 1 do if not TRxColumn(Columns[i]).Footer.DeleteTestValue then begin FInProcessCalc:=-1; Break; end; if Assigned(F_EventOnBeforeDelete) then F_EventOnBeforeDelete(DataSet); end; procedure TRxDBGrid.BeforePo(DataSet: TDataSet); var i:integer; begin if (rdgFooterRows in OptionsRx) and (DatalinkActive) then for i:=0 to Columns.Count - 1 do if not TRxColumn(Columns[i]).Footer.PostTestValue then begin FInProcessCalc:=-1; Break; end; if Assigned(F_EventOnBeforePost) then F_EventOnBeforePost(DataSet); end; procedure TRxDBGrid.ErrorDel(DataSet: TDataSet; E: EDatabaseError;var DataAction: TDataAction); var i:integer; begin if (rdgFooterRows in OptionsRx) and (DatalinkActive) then for i:=0 to Columns.Count - 1 do if not TRxColumn(Columns[i]).Footer.ErrorTestValue then begin FInProcessCalc:=-1; Break; end; if Assigned(F_EventOnDeleteError) then F_EventOnDeleteError(DataSet,E,DataAction); end; procedure TRxDBGrid.ErrorPo(DataSet: TDataSet; E: EDatabaseError;var DataAction: TDataAction); var i:integer; begin if (rdgFooterRows in OptionsRx) and (DatalinkActive) then for i:=0 to Columns.Count - 1 do if not TRxColumn(Columns[i]).Footer.ErrorTestValue then begin FInProcessCalc:=-1; Break; end; if Assigned(F_EventOnPostError) then F_EventOnPostError(DataSet,E,DataAction); end; procedure TRxDBGrid.OnFind(Sender: TObject); begin if rdgAllowDialogFind in OptionsRx then ShowFindDialog; end; procedure TRxDBGrid.OnFilterBy(Sender: TObject); var NewFilter : String; begin if DataLinkActive then begin OptionsRx:=OptionsRx - [rdgFilter]; rxFilterByForm:=TrxFilterByForm.Create(Application); NewFilter:=DataSource.DataSet.Filter; if rxFilterByForm.Execute(DataSource.DataSet, NewFilter, F_LastFilter) then begin if NewFilter <> '' then begin DataSource.DataSet.Filter := NewFilter; DataSource.DataSet.Filtered := True; end else begin DataSource.DataSet.Filtered := False; end; CalcStatTotals; end; FreeAndNil(rxFilterByForm); end; End; procedure TRxDBGrid.OnFilter(Sender: TObject); var C:TRxColumn; i:integer; begin OptionsRx:=OptionsRx + [rdgFilter]; for i:=0 to Columns.Count-1 do begin C:=TRxColumn(Columns[i]); C.Filter.ValueList.Clear; C.Filter.Value:=''; C.Filter.ItemIndex:=-1; C.Filter.ValueList.Add(C.Filter.EmptyValue); end; DataSource.DataSet.DisableControls; DataSource.DataSet.Filtered:=true; DataSource.DataSet.First; while not DataSource.DataSet.EOF do begin for i:=0 to Columns.Count-1 do begin C:=TRxColumn(Columns[i]); if (C.Field<>nil) and (C.Filter.ValueList.IndexOf(C.Field.DisplayText)<0) then C.Filter.ValueList.Add(C.Field.DisplayText); end; DataSource.DataSet.Next; end; DataSource.DataSet.First; DataSource.DataSet.EnableControls; End; procedure TRxDBGrid.OnFilterClose(Sender: TObject); var C:TRxColumn; i:integer; Begin OptionsRx:=OptionsRx - [rdgFilter]; DataSource.DataSet.Filtered:=false; CalcStatTotals; End; Procedure TRxDBGrid.OnSortBy(Sender: TObject); var i:integer; s:string; o:boolean; begin if DatalinkActive then begin FSortField:=nil; rxSortByForm:=TrxSortByForm.Create(Application); rxSortByForm.CheckBox1.Checked:=rdgCaseInsensitiveSort in FOptionsRx; o:=not (FSortOrder=smDown); if rxSortByForm.Execute(DataSource.DataSet,F_SortListField,o) then begin for i:=0 to F_SortListField.Count-1 do begin s:=s+F_SortListField.Strings[i]+';'; end; s:=Copy(s,1,Length(s)-1); if o then FSortOrder:=smUp else FSortOrder:=smDown; if rxSortByForm.CheckBox1.Checked then Include(FOptionsRx, rdgCaseInsensitiveSort) else Exclude(FOptionsRx, rdgCaseInsensitiveSort); FSortEngine.SortList(s, DataSource.DataSet, o); end; FreeAndNil(rxSortByForm); Invalidate; end; end; Procedure TRxDBGrid.OnChooseVisibleFields(Sender: TObject); begin if rdgAllowColumnsForm in OptionsRx then ShowColumnsDialog; end; Procedure TRxDBGrid.GetOnCreateLookup; begin if Assigned(F_CreateLookup) then F_CreateLookup(FRxDbGridLookupComboEditor); end; Procedure TRxDBGrid.GetOnDisplayLookup; begin if Assigned(F_DisplayLookup) then F_DisplayLookup(FRxDbGridLookupComboEditor); end; //!!! constructor TRxDBGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); {$IFDEF RXDBGRID_OPTIONS_WO_CANCEL_ON_EXIT} Options:=Options - [dgCancelOnExit]; {$ENDIF} FMarkerUp := LoadLazResBitmapImage('rx_markerup'); FMarkerDown := LoadLazResBitmapImage('rx_markerdown'); Options:=Options - [dgTabs]; OptionsRx:=OptionsRx + [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter]; FAutoSort:=True; // FTitleButtons:=True; F_Clicked := False; // F_MenuBMP := TBitmap.Create; F_MenuBMP := LoadLazResBitmapImage('menu_grid'); DoCreateJMenu; F_LastFilter := TStringList.Create; F_SortListField := TStringList.Create; FPropertyStorageLink:=TPropertyStorageLink.Create; FPropertyStorageLink.OnSave:=@OnIniSave; FPropertyStorageLink.OnLoad:=@OnIniLoad; // FTitleLines := TITLE_DEFAULT; FAllowedOperations:=[aoInsert, aoUpdate, aoDelete, aoAppend]; // FFooterColor:=clWindow; FFooterColor:=clYellow; FFooterRowCount:=0; FFilterListEditor := TFilterListCellEditor.Create(nil); with FFilterListEditor do begin Name := 'FilterListEditor'; Visible := False; Items.Append(''); ReadOnly := true; AutoComplete := true; OnChange := @FFilterListEditorOnChange; OnCloseUp := @FFilterListEditorOnCloseUp; end; FColumnResizing := false; FRxDbGridLookupComboEditor:=TRxDBGridLookupComboEditor.Create(nil); FRxDbGridLookupComboEditor.Name:='RxDBGridLookupComboEditor'; FRxDbGridLookupComboEditor.Visible:=false; FRxDbGridDateEditor:=TRxDBGridDateEditor.Create(nil); FRxDbGridDateEditor.Name:='RxDbGridDateEditor'; FRxDbGridDateEditor.Visible:=false; end; destructor TRxDBGrid.Destroy; begin FreeAndNil(FRxDbGridLookupComboEditor); FreeAndNil(FRxDbGridDateEditor); FreeAndNil(FMarkerDown); FreeAndNil(FMarkerUp); FreeAndNil(FPropertyStorageLink); FreeAndNil(FFilterListEditor); FreeAndNil(F_PopupMenu); FreeAndNil(F_MenuBMP); FreeAndNil(F_LastFilter); FreeAndNil(F_SortListField); inherited Destroy; end; procedure TRxDBGrid.LayoutChanged; begin inherited LayoutChanged; // CalcTitle; end; procedure TRxDBGrid.ShowFindDialog; begin ShowRxDBGridFindForm(Self); end; procedure TRxDBGrid.ShowColumnsDialog; begin ShowRxDBGridColumsForm(Self); end; function TRxDBGrid.ColumnByFieldName(AFieldName: string): TRxColumn; var i:integer; begin Result:=nil; AFieldName:=UpperCase(AFieldName); for i:=0 to Columns.Count - 1 do begin if UpperCase(Columns[i].FieldName)=AFieldName then begin Result:=Columns[i] as TRxColumn; exit; end; end; end; function TRxDBGrid.ColumnByCaption(ACaption: string): TRxColumn; var i:integer; begin Result:=nil; ACaption:=UpperCase(ACaption); for i:=0 to Columns.Count - 1 do if ACaption = UpperCase(Columns[i].Title.Caption) then begin Result:=TRxColumn(Columns[i]); exit; end; end; { TRxDbGridColumns } function TRxDbGridColumns.Add: TRxColumn; begin result := TRxColumn( inherited Add); end; { TRxColumn } function TRxColumn.GetKeyList: TStrings; begin if FKeyList=nil then FKeyList := TStringList.Create; Result := FKeyList; end; procedure TRxColumn.SetFilter(const AValue: TRxColumnFilter); begin FFilter.Assign(AValue); end; function TRxColumn.GetFooter: TRxColumnFooter; begin Result:=FFooter; end; procedure TRxColumn.SetFooter(const AValue: TRxColumnFooter); begin FFooter.Assign(AValue); end; procedure TRxColumn.SetImageList(const AValue: TImageList); begin if FImageList=AValue then exit; FImageList:=AValue; if Grid <> nil then Grid.Invalidate; end; procedure TRxColumn.SetKeyList(const AValue: TStrings); begin if AValue=nil then begin if FKeyList<>nil then FKeyList.Clear end else KeyList.Assign(AValue); end; procedure TRxColumn.SetNotInKeyListIndex(const AValue: Integer); begin if FNotInKeyListIndex=AValue then exit; FNotInKeyListIndex:=AValue; if Grid <> nil then Grid.Invalidate; end; function TRxColumn.CreateTitle: TGridColumnTitle; begin Result:=TRxColumnTitle.Create(Self); end; constructor TRxColumn.Create(ACollection: TCollection); begin inherited Create(ACollection); FNotInKeyListIndex:=-1; FFooter:=TRxColumnFooter.Create(Self); FFilter := TRxColumnFilter.Create(Self); end; destructor TRxColumn.destroy; begin if FKeyList<>nil then begin FKeyList.Free; FKeyList:=nil; end; FreeAndNil(FFooter); FreeAndNil(FFilter); inherited destroy; end; procedure TRxColumn.OptimizeWidth; begin if Grid <> nil then TRxDBGrid(Grid).OptimizeColumnsWidth(FieldName); end; { TRxColumnTitle } procedure TRxColumnTitle.SetOrientation(const AValue: TTextOrientation); begin if FOrientation=AValue then exit; FOrientation:=AValue; TRxDBGrid(TRxColumn(Column).Grid).CalcTitle; TRxColumn(Column).ColumnChanged; end; function TRxColumnTitle.GetCaptionLinesCount: integer; begin if Assigned(FCaptionLines) then Result:=FCaptionLines.Count else Result:=0; end; function TRxColumnTitle.CaptionLine(ALine:integer):TMLCaptionItem; begin if Assigned(FCaptionLines) and (FCaptionLines.Count>0) and (ALine>=0) and (FCaptionLines.Count>ALine) then Result:=TMLCaptionItem(FCaptionLines[ALine]) else Result:=nil; end; procedure TRxColumnTitle.ClearCaptionML; var i:integer; R:TMLCaptionItem; begin for i:=0 to FCaptionLines.Count - 1 do begin R:=TMLCaptionItem(FCaptionLines[i]); R.Free; end; FCaptionLines.Clear; end; procedure TRxColumnTitle.SetCaption(const AValue: TCaption); var c:integer; s:string; procedure AddMLStr(AStr:string); var R:TMLCaptionItem; begin R:=TMLCaptionItem.Create; R.Caption:=AStr; R.Col:=Column; FCaptionLines.Add(R); end; begin inherited SetCaption(AValue); ClearCaptionML; c:=Pos('|', AValue); if C>0 then begin S:=AValue; while C>0 do begin AddMLStr(Copy(S, 1, C-1)); System.Delete(S, 1, C); c:=Pos('|', S); end; if S<>'' then AddMLStr(S); end; if not (csLoading in Column.Grid.ComponentState) and Column.Grid.HandleAllocated then TRxDBGrid(Column.Grid).CalcTitle; end; constructor TRxColumnTitle.Create(TheColumn: TGridColumn); begin inherited Create(TheColumn); {$IFDEF NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID} Alignment:=taCenter; {$ENDIF} FCaptionLines:=TFPList.Create; end; destructor TRxColumnTitle.Destroy; begin ClearCaptionML; FreeAndNil(FCaptionLines); inherited Destroy; end; { TRxColumnFooter } procedure TRxColumnFooter.SetValue(const AValue: String); begin if FValue=AValue then exit; FValue:=AValue; FOwner.ColumnChanged; end; procedure TRxColumnFooter.SetDisplayFormat(const AValue: String); begin if FDisplayFormat=AValue then exit; FDisplayFormat:=AValue; FOwner.ColumnChanged; end; procedure TRxColumnFooter.SetAlignment(const AValue: TAlignment); begin if FAlignment=AValue then exit; FAlignment:=AValue; FOwner.ColumnChanged; end; procedure TRxColumnFooter.SetFieldName(const AValue: String); begin if FFieldName=AValue then exit; FFieldName:=AValue; FOwner.ColumnChanged; end; procedure TRxColumnFooter.SetLayout(const AValue: TTextLayout); begin if FLayout=AValue then exit; FLayout:=AValue; FOwner.ColumnChanged; end; procedure TRxColumnFooter.SetValueType(const AValue: TFooterValueType); begin if FValueType=AValue then exit; FValueType:=AValue; if FValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then TRxDBGrid(FOwner.Grid).CalcStatTotals; FOwner.ColumnChanged; end; function TRxColumnFooter.DisplayText: string; begin case FValueType of fvtSum, fvtAvg, fvtMax, fvtMin:Result:=GetStatTotal; fvtCount:Result:=GetRecordsCount; fvtFieldValue:Result:=GetFieldValue; fvtStaticText:Result:=FValue; fvtRecNo:Result:=GetRecNo; else Result:=''; end; end; function TRxColumnFooter.GetFieldValue: string; begin if (FFieldName<>'') and TRxDBGrid(FOwner.Grid).DatalinkActive then Result:=TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName).AsString else Result:=''; end; function TRxColumnFooter.GetRecordsCount: string; begin if TRxDBGrid(FOwner.Grid).DatalinkActive then begin if DisplayFormat <> '' then Result:=Format(DisplayFormat, [TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecordCount]) else Result:=IntToStr(TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecordCount); end else Result:=''; end; function TRxColumnFooter.GetRecNo: string; begin if TRxDBGrid(FOwner.Grid).DatalinkActive then begin if DisplayFormat <> '' then Result:=Format(DisplayFormat, [TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecNo]) else Result:=IntToStr(TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecNo); end else Result:=''; end; function TRxColumnFooter.GetStatTotal: string; var F:TField; begin if (FFieldName<>'') and TRxDBGrid(FOwner.Grid).DatalinkActive and (TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecordCount<>0) then begin F:=TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName); if Assigned(F) then begin if F.DataType in [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftDate, ftTime, ftDateTime, ftTimeStamp] then begin if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then begin if FValueType in [fvtSum, fvtAvg] then Result:='' else if FTestValue=0 then Result:='' else if FDisplayFormat = '' then Result:=DateToStr(FTestValue) else Result:=FormatDateTime(FDisplayFormat, FTestValue); end else if F.DataType in [ftSmallint, ftInteger, ftWord] then begin if FDisplayFormat = '' then Result:=IntToStr(Round(FTestValue)) else Result:=Format(FDisplayFormat, [Round(FTestValue)]); end else begin if FDisplayFormat <> '' then Result:=FormatFloat(FDisplayFormat, FTestValue) else if F.DataType = ftCurrency then Result:=FloatToStrF(FTestValue, ffCurrency, 12, 2) else Result:=FloatToStr(FTestValue); end end else Result:=''; end else Result:=''; end else Result:=''; end; procedure TRxColumnFooter.ResetTestValue; var F:TField; begin FTestValue:=0; if (ValueType=fvtMin) and (TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecordCount<>0) then begin F:=TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName); if (Assigned(F)) and not (F.IsNull) then if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then FTestValue:=F.AsDateTime else FTestValue:=F.AsFloat; end; end; procedure TRxColumnFooter.UpdateTestValue; var F:TField; begin if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then begin F:=TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName); if Assigned(F) then begin if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then begin case FValueType of fvtMax:FTestValue:=Max(FTestValue, F.AsDateTime); fvtMin:FTestValue:=Min(FTestValue, F.AsDateTime); end; end else begin case FValueType of fvtSum:FTestValue:=FTestValue+F.AsFloat; // fvtAvg: fvtMax:FTestValue:=Max(FTestValue, F.AsFloat); fvtMin:FTestValue:=Min(FTestValue, F.AsFloat); end; end; end; end; end; function TRxColumnFooter.DeleteTestValue: boolean; var F:TField; begin Result:=true; if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then begin F:=TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName); if (Assigned(F)) and not (F.IsNull) then if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then Result:=not ((FValueType in [fvtMax, fvtMin]) and (FTestValue=F.AsDateTime)) else if FValueType in [fvtMax, fvtMin] then Result:=(FTestValue<>F.AsFloat) else FTestValue:=FTestValue-F.AsFloat; end; end; function TRxColumnFooter.PostTestValue: boolean; var F:TField; begin Result:=true; if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then begin F:=TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName); if Assigned(F) then if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then begin if FValueType in [fvtMax, fvtMin] then if F.DataSet.State=dsinsert then begin if not (F.IsNull) then case FValueType of fvtMax:FTestValue:=Max(FTestValue, F.AsDateTime); fvtMin:FTestValue:=Min(FTestValue, F.AsDateTime); end end else if (F.OldValue<>null) and (FTestValue=TDateTime(F.OldValue)) then Result:=false else if not F.IsNull then case FValueType of fvtMax:FTestValue:=Max(FTestValue, F.AsDateTime); fvtMin:FTestValue:=Min(FTestValue, F.AsDateTime); end; end else if F.DataSet.State=dsinsert then begin if not F.IsNull then case FValueType of fvtSum:FTestValue:=FTestValue+F.AsFloat; fvtMax:FTestValue:=Max(FTestValue, F.AsFloat); fvtMin:FTestValue:=Min(FTestValue, F.AsFloat); end; end else if (FValueType in [fvtMax, fvtMin]) and (F.OldValue<>null) and (FTestValue=Float(F.OldValue)) then Result:=false else case FValueType of fvtSum: begin if F.OldValue<>null then FTestValue:=FTestValue-Float(F.OldValue); if not F.IsNull then FTestValue:=FTestValue+F.AsFloat; end; fvtMax:if not F.IsNull then FTestValue:=Max(FTestValue, F.AsFloat); fvtMin:if not F.IsNull then FTestValue:=Min(FTestValue, F.AsFloat); end; end; end; function TRxColumnFooter.ErrorTestValue: boolean; var F:TField; begin Result:=true; if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then begin F:=TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName); if Assigned(F) then if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then begin if FValueType in [fvtMax, fvtMin] then if not (F.IsNull) and (FTestValue=F.AsDateTime) then Result:=false else if (F.DataSet.RecordCount<>0) and (F.OldValue<>null) then case FValueType of fvtMax:FTestValue:=Max(FTestValue, TDateTime(F.OldValue)); fvtMin:FTestValue:=Min(FTestValue, TDateTime(F.OldValue)); end; end else if (FValueType in [fvtMax, fvtMin]) and not (F.IsNull) and (FTestValue=F.AsFloat) then Result:=false else case FValueType of fvtSum: if F.DataSet.RecordCount=0 then begin if not F.IsNull then FTestValue:=FTestValue-F.AsFloat end else begin if F.OldValue<>null then FTestValue:=FTestValue+Float(F.OldValue); if not F.IsNull then FTestValue:=FTestValue-F.AsFloat; end; fvtMax: if (F.DataSet.RecordCount<>0) and (F.OldValue<>null) then FTestValue:=Max(FTestValue, Float(F.OldValue)); fvtMin: if (F.DataSet.RecordCount<>0) and (F.OldValue<>null) then FTestValue:=Min(FTestValue, Float(F.OldValue)); end; end; end; ///! constructor TRxColumnFooter.Create(Owner: TRxColumn); begin inherited Create; FOwner:=Owner; FTestValue:=0; FLayout:=tlCenter; end; { TFilterListCellEditor } procedure TFilterListCellEditor.WndProc(var TheMessage: TLMessage); begin if TheMessage.msg=LM_KILLFOCUS then begin Change; Hide; if HWND(TheMessage.WParam) = HWND(Handle) then begin // lost the focus but it returns to ourselves // eat the message. TheMessage.Result := 0; exit; end; end; inherited WndProc(TheMessage); end; procedure TFilterListCellEditor.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key,Shift); case Key of VK_RETURN: begin DroppedDown := False; Change; Hide; end; end; end; procedure TFilterListCellEditor.Show(Grid: TCustomGrid; Col: Integer); begin FGrid := Grid; FCol := Col; Visible := true; // Text:=TRxColumn(TRxDBGrid(Grid).SelectedColumn).Filter.Value; SetFocus; // DroppedDown := true; end; { TRxColumnFilter } function TRxColumnFilter.GetItemIndex: integer; begin Result:=FValueList.IndexOf(FValue); end; procedure TRxColumnFilter.SetColor(const AValue: TColor); begin if FColor = AValue then exit; FColor:=AValue; FOwner.ColumnChanged; end; procedure TRxColumnFilter.SetFont(const AValue: TFont); begin FFont.Assign(AValue); FOwner.ColumnChanged; end; procedure TRxColumnFilter.SetItemIndex(const AValue: integer); begin if (AValue>=-1) and (AValue0) do begin RxDBGridSortEngineList.Objects[0].Free; RxDBGridSortEngineList.Delete(0); end; RxDBGridSortEngineList.Free; end.