cxlookupgrid.pas

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

    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);