rxdbctrl.pas

修改后的RxLib控件源码

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;

{$ENDIF RX_D4}

procedure TRxDBGrid.EditChanged(Sender: TObject);
begin
  if Assigned(FOnEditChange) then FOnEditChange(Self);
end;

procedure TRxDBGrid.TopLeftChanged;
begin
  if (dgRowSelect in Options) and DefaultDrawing then
    GridInvalidateRow(Self, Self.Row);
  inherited TopLeftChanged;
  if FTracking then StopTracking;
  if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
end;

procedure TRxDBGrid.StopTracking;
begin
  if FTracking then begin
    TrackButton(-1, -1);
    FTracking := False;
    MouseCapture := False;
  end;
end;

procedure TRxDBGrid.TrackButton(X, Y: Integer);
var
  Cell: TGridCoord;
  NewPressed: Boolean;
  I, Offset: Integer;
begin
  Cell := MouseCoord(X, Y);
  Offset := TitleOffset;
  NewPressed := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y)) and
    (FPressedCol = {$IFDEF WIN32} GetMasterColumn(Cell.X, Cell.Y) {$ELSE}
    Cell.X {$ENDIF}) 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.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Cell: TGridCoord;
  MouseDownEvent: TMouseEvent;
  EnableClick: Boolean;
begin
  if not AcquireFocus then Exit;
  if (ssDouble in Shift) and (Button = mbLeft) then begin
    DblClick;
    Exit;
  end;
  if Sizing(X, Y) then
    inherited MouseDown(Button, Shift, X, Y)
  else begin
    Cell := MouseCoord(X, Y);
{$IFDEF RX_D4}
    if (DragKind = dkDock) and (Cell.X < IndicatorOffset) and
      (Cell.Y < TitleOffset) and (not (csDesigning in ComponentState)) then
    begin
      BeginDrag(False);
      Exit;
    end;
{$ENDIF}
    if FTitleButtons and (Datalink <> nil) and Datalink.Active and
      (Cell.Y < TitleOffset) and (Cell.X >= IndicatorOffset) and
      not (csDesigning in ComponentState) then
    begin
      if (dgColumnResize in Options) and (Button = mbRight) then begin
        Button := mbLeft;
        FSwapButtons := True;
        MouseCapture := True;
      end
      else if Button = mbLeft then begin
        EnableClick := True;
        CheckTitleButton(Cell.X - IndicatorOffset, Cell.Y, EnableClick);
        if EnableClick then begin
          MouseCapture := True;
          FTracking := True;
{$IFDEF WIN32}
          FPressedCol := GetMasterColumn(Cell.X, Cell.Y);
{$ELSE}
          FPressedCol := Cell.X;
{$ENDIF}
          TrackButton(X, Y);
        end else Beep;
        Exit;
      end;
    end;
    if (Cell.X < FixedCols + IndicatorOffset) and Datalink.Active then begin
      if (dgIndicator in Options) then
        inherited MouseDown(Button, Shift, 1, Y)
      else if Cell.Y >= TitleOffset then
        if Cell.Y - Row <> 0 then Datalink.Dataset.MoveBy(Cell.Y - Row);
    end
    else inherited MouseDown(Button, Shift, X, Y);
    MouseDownEvent := OnMouseDown;
    if Assigned(MouseDownEvent) then MouseDownEvent(Self, Button, Shift, X, Y);
    if not (((csDesigning in ComponentState) or (dgColumnResize in Options)) and
      (Cell.Y < TitleOffset)) and (Button = mbLeft) then
    begin
      if MultiSelect and Datalink.Active then
        with SelectedRows do begin
          FSelecting := False;
          if ssCtrl in Shift then
            CurrentRowSelected := not CurrentRowSelected
          else begin
            Clear;
            if FClearSelection then CurrentRowSelected := True;
          end;
        end;
    end;
  end;
end;

procedure TRxDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FTracking then TrackButton(X, Y);
  inherited MouseMove(Shift, X, Y);
end;

procedure TRxDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Cell: TGridCoord;
  ACol: Longint;
  DoClick: Boolean;
begin
  if FTracking and {$IFDEF WIN32} (FPressedCol <> nil) {$ELSE}
    (FPressedCol >= 0) {$ENDIF} then
  begin
    Cell := MouseCoord(X, Y);
    DoClick := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y))
      and (Cell.Y < TitleOffset) and
{$IFDEF WIN32}
      (FPressedCol = GetMasterColumn(Cell.X, Cell.Y));
{$ELSE}
      (Cell.X = FPressedCol);
{$ENDIF}
    StopTracking;
    if DoClick then begin
      ACol := Cell.X;
      if (dgIndicator in Options) then Dec(ACol);
      if (DataLink <> nil) and DataLink.Active and (ACol >= 0) and
        (ACol < {$IFDEF WIN32} Columns.Count {$ELSE} FieldCount {$ENDIF}) then
      begin
{$IFDEF WIN32}
        DoTitleClick(FPressedCol.Index, FPressedCol.Field);
{$ELSE}
        DoTitleClick(ACol, Fields[ACol]);
{$ENDIF}
      end;
    end;
  end
  else if FSwapButtons then begin
    FSwapButtons := False;
    MouseCapture := False;
    if Button = mbRight then Button := mbLeft;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

{$IFDEF WIN32}
procedure TRxDBGrid.WMRButtonUp(var Message: TWMMouse);
begin
  if not (FGridState in [gsColMoving, gsRowMoving]) then
    inherited
  else if not (csNoStdEvents in ControlStyle) then
    with Message do MouseUp(mbRight, KeysToShiftState(Keys), XPos, YPos);
end;
{$ENDIF}

procedure TRxDBGrid.WMCancelMode(var Message: TMessage);
begin
  StopTracking;
  inherited;
end;

type
  THack = class(TWinControl);

procedure TRxDBGrid.WMChar(var Msg: TWMChar);

  function DoKeyPress(var Msg: TWMChar): Boolean;
  var
    Form: TCustomForm;
    Ch: Char;
  begin
    Result := True;
    Form := GetParentForm(Self);
    if (Form <> nil) and TForm(Form).KeyPreview and
      THack(Form).DoKeyPress(Msg) then Exit;
    with Msg do begin
      if Assigned(FOnKeyPress) then begin
        Ch := Char(CharCode);
        FOnKeyPress(Self, Ch);
        CharCode := Word(Ch);
      end;
      if Char(CharCode) = #0 then Exit;
    end;
    Result := False;
  end;

begin
  if EditorMode or not DoKeyPress(Msg) then inherited;
end;

procedure TRxDBGrid.KeyPress(var Key: Char);
begin
  if EditorMode then inherited OnKeyPress := FOnKeyPress;
  try
    inherited KeyPress(Key);
  finally
    inherited OnKeyPress := nil;
  end;
end;

procedure TRxDBGrid.DefaultDataCellDraw(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  DefaultDrawDataCell(Rect, Field, State);
end;

{$IFDEF WIN32}
function TRxDBGrid.GetMasterColumn(ACol, ARow: Longint): TColumn;
begin
  if (dgIndicator in Options) then Dec(ACol, IndicatorOffset);
  if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
    (ACol < Columns.Count) then
  begin
    Result := Columns[ACol];
{$IFDEF RX_D4}
    Result := ColumnAtDepth(Result, ARow);
{$ENDIF}
  end
  else Result := nil;
end;
{$ENDIF}

procedure TRxDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);

{$IFDEF RX_D4}
  function CalcTitleRect(Col: TColumn; ARow: Integer; var MasterCol: TColumn): TRect;
    { copied from Inprise's DbGrids.pas }
  var
    I,J: Integer;
    InBiDiMode: Boolean;
    DrawInfo: TGridDrawInfo;
  begin
    MasterCol := ColumnAtDepth(Col, ARow);
    if MasterCol = nil then Exit;
    I := DataToRawColumn(MasterCol.Index);
    if I >= LeftCol then J := MasterCol.Depth
    else begin
      if (FixedCols > 0) and (MasterCol.Index < FixedCols) then begin
        J := MasterCol.Depth;
      end
      else begin
        I := LeftCol;
        if Col.Depth > ARow then J := ARow
        else J := Col.Depth;
      end;
    end;
    Result := CellRect(I, J);
    InBiDiMode := UseRightToLeftAlignment and (Canvas.CanvasOrientation = coLeftToRight);
    for I := Col.Index to Columns.Count - 1 do begin
      if ColumnAtDepth(Columns[I], ARow) <> MasterCol then Break;
      if not InBiDiMode then begin
        J := CellRect(DataToRawColumn(I), ARow).Right;
        if J = 0 then Break;
        Result.Right := Max(Result.Right, J);
      end
      else begin
        J := CellRect(DataToRawColumn(I), ARow).Left;
        if J >= ClientWidth then Break;
        Result.Left := J;
      end;
    end;
    J := Col.Depth;
    if (J <= ARow) and (J < FixedRows - 1) then begin
      CalcFixedInfo(DrawInfo);
      Result.Bottom := DrawInfo.Vert.FixedBoundary -
        DrawInfo.Vert.EffectiveLineWidth;
    end;
  end;

  procedure DrawExpandBtn(var TitleRect, TextRect: TRect; InBiDiMode: Boolean;
    Expanded: Boolean); { copied from Inprise's DbGrids.pas }
  const
    ScrollArrows: array [Boolean, Boolean] of Integer =
      ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
  var
    ButtonRect: TRect;
    I: Integer;
  begin
    I := GetSystemMetrics(SM_CXHSCROLL);
    if ((TextRect.Right - TextRect.Left) > I) then begin
      Dec(TextRect.Right, I);
      ButtonRect := TitleRect;
      ButtonRect.Left := TextRect.Right;
      I := SaveDC(Canvas.Handle);
      try
        Canvas.FillRect(ButtonRect);
        InflateRect(ButtonRect, -1, -1);
        with ButtonRect do
          IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
        InflateRect(ButtonRect, 1, 1);
        { DrawFrameControl doesn't draw properly when orienatation has changed.
          It draws as ExtTextOut does. }
        if InBiDiMode then { stretch the arrows box }
          Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
        DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
          ScrollArrows[InBiDiMode, Expanded] or DFCS_FLAT);
      finally
        RestoreDC(Canvas.Handle, I);
      end;
      TitleRect.Right := ButtonRect.Left;
    end;
  end;
{$ENDIF RX_D4}

var
  FrameOffs: Byte;
  BackColor: TColor;
  SortMarker: TSortMarker;
  Indicator, ALeft: Integer;
  Down: Boolean;
  Bmp: TBitmap;
  SavePen: TColor;
  OldActive: Longint;
  MultiSelected: Boolean;
  FixRect: TRect;
  TitleRect, TextRect: TRect;
  AField: TField;
{$IFDEF RX_D4}
  MasterCol: TColumn;
  InBiDiMode: Boolean;
{$ENDIF}
{$IFDEF WIN32}
  DrawColumn: TColumn;

  MyRow, MyCol: Integer;
  MyRect: TRect;
  Value: String;

const
  EdgeFlag: array[Boolean] of UINT = (BDR_RAISEDINNER, BDR_SUNKENINNER);
{$ENDIF}

  procedure DrawExtendedTitle;
  var
    TitleStr: String;
    LineCount, I: Integer;
    CurLine: array [0..1024] of Char;
    LeftLine, RightLine, TopLine, BottomLine: Boolean;
    CharAlign: TAlignment;
    CurTop, CurBottom: Integer;
    Flags: Integer;
    R: TRect;
    EndPoint: Integer;

    procedure GetLineCount;
    var
      P: PChar;
    begin
      LineCount := 1;
      P := PChar(TitleStr);
      while StrPos(P, CLineFeed) <> nil do
        begin
        Inc(LineCount);
        P := PChar(LongInt(StrPos(P, CLineFeed)) + 2);
        end;
    end;

    procedure GetLine(Index: Integer);
    var
      P: PChar;
      II: Integer;
      LineLen: Integer;
    begin
      if Index >= LineCount then CurLine := '';
      P := PChar(TitleStr)