cxlookupgrid.pas

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

procedure TcxLookupGridColumns.EndUpdate;
begin
  inherited;
  if (Grid <> nil) and not (csDestroying in Grid.ComponentState) then
    Grid.EndUpdate;
end;

procedure TcxLookupGridColumns.RestoreDefaults;
var
  I: Integer;
begin
  BeginUpdate;
  try
    for I := 0 to Count-1 do
      Items[I].RestoreDefaults;
  finally
    EndUpdate;
  end;
end;

function TcxLookupGridColumns.GetOwner: TPersistent;
begin
  Result := FGrid;
end;

procedure TcxLookupGridColumns.Update(Item: TCollectionItem);
begin
  if (FGrid = nil) or (csLoading in FGrid.ComponentState) then Exit;
  Grid.Change([lgcLayout]);
end;

function TcxLookupGridColumns.GetColumn(Index: Integer): TcxLookupGridColumn;
begin
  Result := TcxLookupGridColumn(inherited Items[Index]);
end;

procedure TcxLookupGridColumns.SetColumn(Index: Integer; Value: TcxLookupGridColumn);
begin
  Items[Index].Assign(Value);
end;

{ TcxLookupGridDataController }

function TcxLookupGridDataController.GetItem(Index: Integer): TObject;
begin
  Result := Grid.Columns[Index];
end;

function TcxLookupGridDataController.GetGrid: TcxCustomLookupGrid;
begin
  Result := GetOwner as TcxCustomLookupGrid;
end;

{ TcxLookupGridOptions }

constructor TcxLookupGridOptions.Create(AGrid: TcxCustomLookupGrid);
begin
  inherited Create;
  FGrid := AGrid;
  FColumnSorting := True;
  FFocusRowOnMouseMove := True;
  FGridLines := glBoth;
  FRowSelect := True;
  FShowHeader := True;
end;

procedure TcxLookupGridOptions.Assign(Source: TPersistent);
begin
  if Source is TcxLookupGridOptions then
  begin
    if Assigned(Grid) then
      Grid.BeginUpdate;
    try
      AnsiSort := TcxLookupGridOptions(Source).AnsiSort;
      CaseInsensitive := TcxLookupGridOptions(Source).CaseInsensitive;
      ColumnSorting := TcxLookupGridOptions(Source).ColumnSorting;
      FocusRowOnMouseMove := TcxLookupGridOptions(Source).FocusRowOnMouseMove;
      GridLines := TcxLookupGridOptions(Source).GridLines;
      RowSelect := TcxLookupGridOptions(Source).RowSelect;
      ShowHeader := TcxLookupGridOptions(Source).ShowHeader;
    finally
      if Assigned(Grid) then
        Grid.EndUpdate;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TcxLookupGridOptions.Changed;
begin
  if Assigned(Grid) then
    Grid.Change([lgcLayout]);
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

function TcxLookupGridOptions.GetAnsiSort: Boolean;
begin
  if Assigned(Grid) then
    Result := dcoAnsiSort in Grid.DataController.Options
  else
    Result := False;
end;

function TcxLookupGridOptions.GetCaseInsensitive: Boolean;
begin
  if Assigned(Grid) then
    Result := dcoCaseInsensitive in Grid.DataController.Options
  else
    Result := False;
end;

procedure TcxLookupGridOptions.SetAnsiSort(Value: Boolean);
begin
  if Assigned(Grid) then
  begin
    if Value then
      Grid.DataController.Options := Grid.DataController.Options + [dcoAnsiSort]
    else
      Grid.DataController.Options := Grid.DataController.Options - [dcoAnsiSort];
  end;    
end;

procedure TcxLookupGridOptions.SetCaseInsensitive(Value: Boolean);
begin
  if Assigned(Grid) then
  begin
    if Value then
      Grid.DataController.Options := Grid.DataController.Options + [dcoCaseInsensitive]
    else
      Grid.DataController.Options := Grid.DataController.Options - [dcoCaseInsensitive];
  end;
end;

procedure TcxLookupGridOptions.SetGridLines(Value: TcxGridLines);
begin
  if FGridLines <> Value then
  begin
    FGridLines := Value;
    Changed;
  end;
end;

procedure TcxLookupGridOptions.SetRowSelect(Value: Boolean);
begin
  if FRowSelect <> Value then
  begin
    FRowSelect := Value;
    if Value and Assigned(Grid) then
      Grid.FocusedColumn := nil;
  end;
end;

procedure TcxLookupGridOptions.SetShowHeader(Value: Boolean);
begin
  if FShowHeader <> Value then
  begin
    FShowHeader := Value;
    Changed;
  end;
end;

{ TcxCustomLookupGrid }

constructor TcxCustomLookupGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColumns := GetColumnsClass.Create(Self, GetColumnClass);
  FOptions := GetOptionsClass.Create(Self);
  CreateHandlers;
  CreateSubClasses;
  Color := clWindow;
  ParentColor := False;
  Width := 250;
  Height := 200;
  Keys := [kArrows];
end;

destructor TcxCustomLookupGrid.Destroy;
begin
  SetScrollMode(smNone);
  DestroySubClasses;
  DestroyHandlers;
  FOptions.Free;
  FColumns.Free;
  inherited Destroy;
end;

procedure TcxCustomLookupGrid.BeginUpdate;
begin
  Inc(FLockCount);
  FDataController.BeginUpdate;
end;

procedure TcxCustomLookupGrid.CancelUpdate;
begin
  Dec(FLockCount);
end;

procedure TcxCustomLookupGrid.EndUpdate;
begin
  FDataController.EndUpdate;
  Dec(FLockCount);
  CheckChanges;
end;

function TcxCustomLookupGrid.GetHitInfo(P: TPoint): TcxLookupGridHitInfo;

  function CalcColumnIndex(out AColumnIndex: Integer): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to ViewInfo.Columns.Count - 1 do
      if PtInRect(ViewInfo.Columns[I].Bounds, P) then
      begin
        AColumnIndex := I;
        Result := True;
        Break;
      end;
  end;

  function CalcCellIndex(out ARowIndex, AColumnIndex: Integer): Boolean;
  var
    I, J: Integer;
  begin
    Result := False;
    for I := 0 to ViewInfo.Rows.Count - 1 do
      if PtInRect(ViewInfo.Rows[I].Bounds, P) then
      begin
        ARowIndex := ViewInfo.Rows[I].RowIndex;
        for J := 0 to ViewInfo.Rows[I].Count - 1 do
          if PtInWidth(ViewInfo.Rows[I][J].Bounds, P) then
          begin
            AColumnIndex := ViewInfo.Rows[I][J].Index;
            Result := True;
            Break;
          end;
        Break;
      end;
  end;

begin
  Result.HitTest := htNone;
  Result.RowIndex := -1;
  Result.ColumnIndex := -1;
  if not PtInRect(ViewInfo.ClientBounds, P) then Exit;
  if PtInRect(ViewInfo.HeadersRect, P) then
  begin
    if CalcColumnIndex(Result.ColumnIndex) then
      Result.HitTest := htHeader;
  end
  else
    if PtInRect(ViewInfo.RowsRect, P) then
    begin
      if CalcCellIndex(Result.RowIndex, Result.ColumnIndex) then
        Result.HitTest := htCell;
    end;
end;

function TcxCustomLookupGrid.GetNearestPopupHeight(AHeight: Integer): Integer;
var
  AHeaderHeight, ARowHeight, ARowCount: Integer;
begin
  AHeaderHeight := ViewInfo.HeadersRect.Bottom - ViewInfo.HeadersRect.Top;
  ARowHeight := ViewInfo.RowHeight;
  ARowCount := (AHeight - AHeaderHeight) div ARowHeight;
  if ARowCount <= 0 then
    ARowCount := 1
  else
    if ARowCount > GetRowCount then
      ARowCount := GetRowCount;
  if ARowCount < 1 then ARowCount := 1;
  Result := AHeaderHeight + ARowHeight * ARowCount;
end;

function TcxCustomLookupGrid.GetPopupHeight(ADropDownRowCount: Integer): Integer;
begin
  Result := ViewInfo.HeadersRect.Bottom - ViewInfo.HeadersRect.Top +
    ViewInfo.RowHeight * ADropDownRowCount;
end;

function TcxCustomLookupGrid.IsMouseOverList(const P: TPoint): Boolean;
begin
  Result := GetHitInfo(P).RowIndex <> -1;
end;

function TcxCustomLookupGrid.IsRowVisible(ARowIndex: Integer): Boolean;
begin
  with ViewInfo do
    Result := (VisibleRowCount > 0) and (Rows[0].RowIndex <= ARowIndex) and
      (ARowIndex <= Rows[VisibleRowCount - 1].RowIndex);
end;

procedure TcxCustomLookupGrid.LockPopupMouseMove;
begin
  FPrevMousePos := InternalGetCursorPos;
end;

procedure TcxCustomLookupGrid.MakeFocusedRowVisible;
begin
  if FocusedRowIndex <> -1 then
    MakeRowVisible(FocusedRowIndex);
end;

procedure TcxCustomLookupGrid.MakeRowVisible(ARowIndex: Integer);

  procedure SetBottomRowIndex(ARowIndex: Integer);
  begin
    TopRowIndex := ARowIndex - ViewInfo.VisibleRowCount + 1; // TODO: AutoHeight
  end;

begin
  if ViewInfo.VisibleRowCount > 0 then
  begin
    if ARowIndex < ViewInfo.Rows[0].RowIndex then
      TopRowIndex := ARowIndex
    else
      if ARowIndex > ViewInfo.Rows[ViewInfo.VisibleRowCount - 1].RowIndex then
        SetBottomRowIndex(ARowIndex);
  end;
end;

procedure TcxCustomLookupGrid.SyncSelected(ASelected: Boolean);
begin
  DataController.SyncSelected(ASelected);
end;

procedure TcxCustomLookupGrid.ColorChanged;
begin
  LayoutChanged;
  inherited ColorChanged;
end;

procedure TcxCustomLookupGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_LEFT:
      FocusColumn(FocusedColumnIndex - 1);
    VK_RIGHT:
      FocusColumn(FocusedColumnIndex + 1);
    VK_UP:
      FocusNextRow(False); // Grid mode
    VK_DOWN:
      FocusNextRow(True); // Grid mode
    VK_HOME:
      if (ssCtrl in Shift) or Options.RowSelect then
        DataController.GotoFirst
      else
        FocusColumn(0);
    VK_END:
      if (ssCtrl in Shift) or Options.RowSelect then
        DataController.GotoLast
      else
        FocusColumn(Columns.Count - 1);
    VK_PRIOR:
      FocusPriorPage;
    VK_NEXT:
      FocusNextPage;
    VK_RETURN:
      DoCloseUp(FocusedRowIndex <> -1);
  end;
end;

procedure TcxCustomLookupGrid.Loaded;
begin
  inherited Loaded;
  Change([lgcLayout]);
end;

procedure TcxCustomLookupGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  AHitInfo: TcxLookupGridHitInfo;
begin
  inherited MouseDown(Button, Shift, X, Y);
  AHitInfo := GetHitInfo(Point(X, Y));
  if AHitInfo.HitTest = htHeader then
    DoHeaderClick(AHitInfo.ColumnIndex, Shift)
  else
    if AHitInfo.HitTest = htCell then
    begin
      DoCellClick(AHitInfo.RowIndex, AHitInfo.ColumnIndex, Shift);
      FRowPressed := True;
    end;
end;

procedure TcxCustomLookupGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  ScrollModeA: array[Boolean] of TcxLookupGridScrollMode = (smTop, smBottom); 
var
  AHitInfo: TcxLookupGridHitInfo;
  P: TPoint;
begin
  inherited MouseMove(Shift, X, Y);
  P := InternalGetCursorPos;
  if (P.X = FPrevMousePos.X) and (P.Y = FPrevMousePos.Y) then
    Exit;
  FPrevMousePos := P;
  if MouseCapture or IsHotTrack then
  begin
    AHitInfo := GetHitInfo(Point(X, Y));
    if FRowPressed and MouseCapture and ((Y < ViewInfo.VisibleRowsRect.Top) or
      (Y > ViewInfo.VisibleRowsRect.Bottom)) then
      SetScrollMode(ScrollModeA[Y > ViewInfo.VisibleRowsRect.Bottom])
    else
    begin
      SetScrollMode(smNone);
      if AHitInfo.HitTest = htCell then
      begin