rxdbctrl.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

    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;

type
  THackLink = class(TGridDataLink);

procedure TRxDBGrid.EnableScroll;
begin
  if FDisableCount <> 0 then begin
    Dec(FDisableCount);
    if FDisableCount = 0 then
      THackLink(DataLink).DataSetScrolled(0);
  end;
end;

function TRxDBGrid.ScrollDisabled: Boolean;
begin
  Result := FDisableCount <> 0;
end;

procedure TRxDBGrid.Scroll(Distance: Integer);
{$IFNDEF RX_D3}
var
  IndicatorRect: TRect;
{$ENDIF}
begin
  if FDisableCount = 0 then begin
    inherited Scroll(Distance);
{$IFNDEF RX_D3}
    if (dgIndicator in Options) and HandleAllocated and MultiSelect then
    begin
      IndicatorRect := BoxRect(0, 0, 0, RowCount - 1);
      InvalidateRect(Handle, @IndicatorRect, False);
    end;
{$ENDIF}
  end;
end;

{$IFDEF RX_D4}

function TRxDBGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := False;
  if Assigned(OnMouseWheelDown) then
    OnMouseWheelDown(Self, Shift, MousePos, Result);
  if not Result then begin
    if not AcquireFocus then Exit;
    if Datalink.Active then begin
      Result := Datalink.DataSet.MoveBy(1) <> 0;
    end;
  end;
end;

function TRxDBGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := False;
  if Assigned(OnMouseWheelUp) then
    OnMouseWheelUp(Self, Shift, MousePos, Result);
  if not Result then begin
    if not AcquireFocus then Exit;
    if Datalink.Active then begin
      Result := Datalink.DataSet.MoveBy(-1) <> 0;
    end;
  end;
end;