rxdbctrl.pas

修改后的RxLib控件源码

  //牟孝金
  for I := 0 to FixedCols - 1 do
    TabStops[I] := False;
  K := 0;
  for I := 0 to Columns.Count-1 do
    begin
    Canvas.Font := Columns[I].Title.Font;
    J := Canvas.TextHeight('Wg') + 4;
    if J > K then K := J;
    end;
  if K = 0 then
    begin
    Canvas.Font := TitleFont;
    K := Canvas.TextHeight('Wg') + 4;
    end;
  if dgTitles in Options then
    begin
    if FTitleExtended then
      N := (FTitleLines) * (K - 1) - 1
    else
      N := K;
    if RowHeights[0] <> N then
      begin
      RowHeights[0] := N;
      LayOutChanged;
      end;
    end;
end;

procedure TRxDBGrid.SetFixedCols(Value: Integer);
var
  FixCount, I: Integer;
begin
  FixCount := Max(Value, 0) + IndicatorOffset;
  if DataLink.Active and not (csLoading in ComponentState) and
    (ColCount > IndicatorOffset + 1) then
  begin
    FixCount := Min(FixCount, ColCount - 1);
    inherited FixedCols := FixCount;
    for I := 1 to Min(FixedCols, ColCount - 1) do
      TabStops[I] := False;
  end;
  FFixedCols := FixCount - IndicatorOffset;
end;

function TRxDBGrid.GetFixedCols: Integer;
begin
  if DataLink.Active then Result := inherited FixedCols - IndicatorOffset
  else Result := FFixedCols;
end;

{$IFDEF RX_D4}
function TRxDBGrid.CalcLeftColumn: Integer;
begin
  Result := FixedCols + IndicatorOffset;
  while (Result < ColCount) and (ColWidths[Result] <= 0) do
    Inc(Result);
end;
{$ENDIF}

procedure TRxDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
  KeyDownEvent: TKeyEvent;

  procedure ClearSelections;
  begin
    if FMultiSelect then begin
      if FClearSelection then SelectedRows.Clear;
      FSelecting := False;
    end;
  end;

  procedure DoSelection(Select: Boolean; Direction: Integer);
  var
    AddAfter: Boolean;
{$IFNDEF WIN32}
    CurRow: TBookmark;
{$ENDIF}
  begin
    AddAfter := False;
{$IFDEF WIN32}
    BeginUpdate;
    try
{$ENDIF}
      if MultiSelect and DataLink.Active then
        if Select and (ssShift in Shift) then begin
          if not FSelecting then begin
{$IFNDEF WIN32}
            if FSelectionAnchor <> nil then StrDispose(FSelectionAnchor);
{$ENDIF}
            FSelectionAnchor := TBookmarks(SelectedRows).CurrentRow;
            SelectedRows.CurrentRowSelected := True;
            FSelecting := True;
            AddAfter := True;
          end
          else with TBookmarks(SelectedRows) do begin
{$IFDEF WIN32}
            AddAfter := Compare(CurrentRow, FSelectionAnchor) <> -Direction;
{$ELSE}
            CurRow := CurrentRow;
            try
              AddAfter := Compare(CurRow, FSelectionAnchor) <> -Direction;
            finally
              StrDispose(CurRow);
            end;
{$ENDIF}
            if not AddAfter then CurrentRowSelected := False;
          end
        end
        else ClearSelections;
      if Direction <> 0 then Datalink.DataSet.MoveBy(Direction);
      if AddAfter then SelectedRows.CurrentRowSelected := True;
{$IFDEF WIN32}
    finally
      EndUpdate;
    end;
{$ENDIF}
  end;

  procedure NextRow(Select: Boolean);
  begin
    with Datalink.Dataset do begin
      DoSelection(Select, 1);
      if EOF and CanModify and (not ReadOnly) and (dgEditing in Options) then
        Append;
    end;
  end;

  procedure PriorRow(Select: Boolean);
  begin
    DoSelection(Select, -1);
  end;

  procedure CheckTab(GoForward: Boolean);
  var
    ACol, Original: Integer;
  begin
    ACol := Col;
    Original := ACol;
    if MultiSelect and DataLink.Active then
      while True do begin
        if GoForward then Inc(ACol) else Dec(ACol);
        if ACol >= ColCount then begin
          ClearSelections;
          ACol := IndicatorOffset;
        end
        else if ACol < IndicatorOffset then begin
          ClearSelections;
          ACol := ColCount;
        end;
        if ACol = Original then Exit;
        if TabStops[ACol] then Exit;
      end;
  end;

  function DeletePrompt: Boolean;
  var
    S: string;
  begin
    if (SelectedRows.Count > 1) then
{$IFDEF WIN32}
      S := ResStr(SDeleteMultipleRecordsQuestion)
{$ELSE}
      S := LoadStr(SDeleteMultipleRecords)
{$ENDIF}
    else S := ResStr(SDeleteRecordQuestion);
    Result := not (dgConfirmDelete in Options) or
      (MessageDlg(S, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  end;

begin
  KeyDownEvent := OnKeyDown;
  if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  if not Datalink.Active or not CanGridAcceptKey(Key, Shift) then Exit;
  with Datalink.DataSet do
    if ssCtrl in Shift then begin
      if (Key in [VK_UP, VK_PRIOR, VK_DOWN, VK_NEXT, VK_HOME, VK_END]) then
        ClearSelections;
      case Key of
        VK_LEFT:
          if FixedCols > 0 then begin
{$IFDEF RX_D4}
            SelectedIndex := CalcLeftColumn - IndicatorOffset;
{$ELSE}
            SelectedIndex := FixedCols;
{$ENDIF}
            Exit;
          end;
        VK_DELETE:
          if not ReadOnly and CanModify and not
            IsDataSetEmpty(Datalink.DataSet) then
          begin
            if DeletePrompt then begin
              if SelectedRows.Count > 0 then SelectedRows.Delete
              else Delete;
            end;
            Exit;
          end;
      end
    end
    else begin
      case Key of
        VK_LEFT:
          if (FixedCols > 0) and not (dgRowSelect in Options) then begin
{$IFDEF RX_D4}
            if SelectedIndex <= CalcLeftColumn - IndicatorOffset then
              Exit;
{$ELSE}
            if SelectedIndex <= FFixedCols then Exit;
{$ENDIF}
          end;
        VK_HOME:
          if (FixedCols > 0) and (ColCount <> IndicatorOffset + 1) and
            not (dgRowSelect in Options) then
          begin
{$IFDEF RX_D4}
            SelectedIndex := CalcLeftColumn - IndicatorOffset;
{$ELSE}
            SelectedIndex := FixedCols;
{$ENDIF}
            Exit;
          end;
      end;
      if (Datalink.DataSet.State = dsBrowse) then begin
        case Key of
          VK_UP:
            begin
              PriorRow(True); Exit;
            end;
          VK_DOWN:
            begin
              NextRow(True); Exit;
            end;
        end;
      end;
      if ((Key in [VK_LEFT, VK_RIGHT]) and (dgRowSelect in Options)) or
        ((Key in [VK_HOME, VK_END]) and ((ColCount = IndicatorOffset + 1)
          or (dgRowSelect in Options))) or (Key in [VK_ESCAPE, VK_NEXT,
          VK_PRIOR]) or ((Key = VK_INSERT) and (CanModify and
          (not ReadOnly) and (dgEditing in Options))) then
        ClearSelections
      else if ((Key = VK_TAB) and not (ssAlt in Shift)) then
        CheckTab(not (ssShift in Shift));
    end;
  OnKeyDown := nil;
  try
    inherited KeyDown(Key, Shift);
  finally
    OnKeyDown := KeyDownEvent;
  end;
end;

procedure TRxDBGrid.SetShowGlyphs(Value: Boolean);
begin
  if FShowGlyphs <> Value then begin
    FShowGlyphs := Value;
    Invalidate;
  end;
end;

procedure TRxDBGrid.SetRowsHeight(Value: Integer);
begin
  if not (csDesigning in ComponentState) and (DefaultRowHeight <> Value) then
  begin
    DefaultRowHeight := Value;
    if dgTitles in Options then RowHeights[0] := Value + 2;
    if HandleAllocated then
      Perform(WM_SIZE, SIZE_RESTORED, MakeLong(ClientWidth, ClientHeight));
  end;
end;

function TRxDBGrid.GetRowsHeight: Integer;
begin
  Result := DefaultRowHeight;
end;

{$IFDEF WIN32}

function TRxDBGrid.GetOptions: TDBGridOptions;
begin
  Result := inherited Options;
  if FMultiSelect then Result := Result + [dgMultiSelect]
  else Result := Result - [dgMultiSelect];
end;

procedure TRxDBGrid.SetOptions(Value: TDBGridOptions);
var
  NewOptions: TGridOptions;
begin
  inherited Options := Value - [dgMultiSelect];
  NewOptions := TDrawGrid(Self).Options;
  if FTitleButtons then begin
    TDrawGrid(Self).Options := NewOptions + [goFixedHorzLine, goFixedVertLine];
  end
  else begin
    //if not (dgColLines in Value) then
      NewOptions := NewOptions - [goFixedVertLine];
    //if not (dgRowLines in Value) then
      NewOptions := NewOptions - [goFixedHorzLine];
    TDrawGrid(Self).Options := NewOptions;
  end;
  SetMultiSelect(dgMultiSelect in Value);
end;

{$ELSE}

procedure TRxDBGrid.LinkActive(Value: Boolean);
begin
  SelectedRows.LinkActive(Value);
  inherited LinkActive(Value);
end;

function TRxDBGrid.GetFixedColor: TColor;
begin
  Result := inherited TitleColor;
end;

procedure TRxDBGrid.SetFixedColor(Value: TColor);
begin
  if FixedColor <> Value then begin
    inherited TitleColor := Value;
    inherited FixedColor := Value;
    Invalidate;
  end;
end;

procedure TRxDBGrid.ColumnMoved(FromIndex, ToIndex: Longint);
begin
  inherited ColumnMoved(FromIndex, ToIndex);
  if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
end;

{$ENDIF WIN32}

procedure TRxDBGrid.Paint;
begin
  inherited Paint;
  if not (csDesigning in ComponentState) and
    (dgRowSelect in Options) and DefaultDrawing and Focused then
  begin
    Canvas.Font.Color := clWindowText;
    with Selection do
      DrawFocusRect(Canvas.Handle, BoxRect(Left, Top, Right, Bottom));
  end;
end;

procedure TRxDBGrid.SetTitleButtons(Value: Boolean);
begin
  if FTitleButtons <> Value then begin
    FTitleButtons := Value;
    Invalidate;
{$IFDEF WIN32}
    SetOptions(Options);
{$ENDIF}
  end;
end;

procedure TRxDBGrid.SetMultiSelect(Value: Boolean);
begin
  if FMultiSelect <> Value then begin
    FMultiSelect := Value;
    if not Value then SelectedRows.Clear;
  end;
end;

function TRxDBGrid.GetStorage: TFormPlacement;
begin
  Result := FIniLink.Storage;
end;

procedure TRxDBGrid.SetStorage(Value: TFormPlacement);
begin
  FIniLink.Storage := Value;
end;

function TRxDBGrid.AcquireFocus: Boolean;
begin
  Result := True;
  if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
  begin
    SetFocus;
    Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
  end;
end;

function TRxDBGrid.CanEditShow: Boolean;
var
  F: TField;
begin
  Result := inherited CanEditShow;
  F := nil;
  if Result and (Datalink <> nil) and Datalink.Active and (FieldCount > 0) and
    (SelectedIndex < FieldCount) and (SelectedIndex >= 0) and
    (FieldCount <= DataSource.DataSet.FieldCount) then
  begin
    F := Fields[SelectedIndex];
    if F <> nil then Result := GetImageIndex(F) < 0;
  end;
  if Result and Assigned(FOnShowEditor) then
    FOnShowEditor(Self, F, Result);
end;

procedure TRxDBGrid.GetCellProps(Field: TField; AFont: TFont;
  var Background: TColor; Highlight: Boolean);
var
  AColor, ABack: TColor;
begin
  if Assigned(FOnGetCellParams) then
    FOnGetCellParams(Self, Field, AFont, Background, Highlight)
  else if Assigned(FOnGetCellProps) then begin
    if Highlight then begin
      AColor := AFont.Color;
      FOnGetCellProps(Self, Field, AFont, ABack);
      AFont.Color := AColor;
    end
    else FOnGetCellProps(Self, Field, AFont, Background);
  end;
end;

procedure TRxDBGrid.DoTitleClick(ACol: Longint; AField: TField);
begin
  if Assigned(FOnTitleBtnClick) then FOnTitleBtnClick(Self, ACol, AField);
end;

procedure TRxDBGrid.CheckTitleButton(ACol, ARow: Longint; var Enabled: Boolean);
var
  Field: TField;
begin
  if (ACol >= 0) and (ACol < {$IFDEF WIN32} Columns.Count {$ELSE}
    FieldCount {$ENDIF}) then
  begin
    if Assigned(FOnCheckButton) then begin
{$IFDEF WIN32}
      Field := Columns[ACol].Field;
  {$IFDEF RX_D4}
      if ColumnAtDepth(Columns[ACol], ARow) <> nil then
        Field := ColumnAtDepth(Columns[ACol], ARow).Field;
  {$ENDIF}
{$ELSE}
      Field := Fields[ACol];
{$ENDIF}
      FOnCheckButton(Self, ACol, Field, Enabled);
    end;
  end
  else Enabled := False;
end;

procedure TRxDBGrid.DisableScroll;
begin
  Inc(FDisableCount);
end;