rm_grid.pas

这是一个功能强大

var
  liRowCell: TRMRowCell;
begin
  liRowCell := TRMRowCell.Create(AIndex, FGrid.ColCount, FGrid);
  FList.Add(liRowCell);
end;

procedure TRMCells.Delete(AIndex: Integer);
begin
  TRMRowCell(FList[AIndex]).Free;
  FList.Delete(AIndex);
end;

type
  TSelection = record
    StartPos, EndPos: Integer;
  end;

  {------------------------------------------------------------------------------}
  {------------------------------------------------------------------------------}
  { TRMInplaceEdit }

constructor TRMInplaceEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ParentCtl3D := False;
  Ctl3D := False;
  TabStop := False;
  BorderStyle := bsNone;
  DoubleBuffered := False;
end;

destructor TRMInplaceEdit.Destroy;
begin
  inherited Destroy;
end;

procedure TRMInplaceEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not ES_AUTOHSCROLL or ES_MULTILINE;
end;

procedure TRMInplaceEdit.CMShowingChanged(var Message: TMessage);
begin
end;

procedure TRMInplaceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  if rmgoTabs in Grid.Options then
    Message.Result := Message.Result or DLGC_WANTTAB;
end;

procedure TRMInplaceEdit.WMClear(var Message);
begin
  if not EditCanModify then Exit;
  inherited;
end;

procedure TRMInplaceEdit.WMCut(var Message);
begin
  if not EditCanModify then Exit;
  inherited;
end;

procedure TRMInplaceEdit.DblClick;
begin
  Grid.DblClick;
end;

function TRMInplaceEdit.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
end;

function TRMInplaceEdit.EditCanModify: Boolean;
begin
  Result := Grid.CanEditModify;
end;

procedure TRMInplaceEdit.ValidateError;
begin
end;

procedure TRMInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);

  procedure SendToParent;
  begin
    Grid.KeyDown(Key, Shift);
    Key := 0;
  end;

  procedure ParentEvent;
  var
    GridKeyDown: TKeyEvent;
  begin
    GridKeyDown := Grid.OnKeyDown;
    if Assigned(GridKeyDown) then GridKeyDown(Grid, Key, Shift);
  end;

  function Ctrl: Boolean;
  begin
    Result := ssCtrl in Shift;
  end;

  function Selection: TSelection;
  begin
    SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
  end;

  function RightSide: Boolean;
  begin
    with Selection do
      Result := ((StartPos = 0) or (EndPos = StartPos)) and
        (EndPos = GetTextLen);
  end;

  function LeftSide: Boolean;
  begin
    with Selection do
      Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = GetTextLen));
  end;

begin
  case Key of
    VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
      SendToParent;
    VK_ESCAPE:
      begin
        Text := FTempText;
        SendToParent;
      end;
    VK_INSERT:
      if Shift = [] then SendToParent
      else if (Shift = [ssShift]) and not Grid.CanEditModify then Key := 0;
    VK_LEFT: if not Ctrl and LeftSide then SendToParent;
    VK_RIGHT: if not Ctrl and RightSide then SendToParent;
    VK_HOME: if not Ctrl and LeftSide then
      begin
        Key := VK_LEFT;
        SendToParent;
      end;
    VK_END: if not Ctrl and RightSide then
      begin
        Key := VK_RIGHT;
        SendToParent;
      end;
    VK_F2:
      begin
        ParentEvent;
        if Key = VK_F2 then
        begin
          Deselect;
          Exit;
        end;
      end;
    VK_TAB: if not (ssAlt in Shift) then SendToParent;
  end;
  if (Key = VK_DELETE) and not Grid.CanEditModify then Key := 0;
  if Key <> 0 then
  begin
    ParentEvent;
    inherited KeyDown(Key, Shift);
  end;
end;

procedure TRMInplaceEdit.KeyPress(var Key: Char);
var
  Selection: TSelection;
begin
  Grid.KeyPress(Key);
  if (Key in [#32..#255]) and not Grid.CanEditAcceptKey(Key) then
  begin
    Key := #0;
    MessageBeep(0);
  end;

  case Key of
    #9, #27: Key := #0;
    #13:
      begin
        SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
        if (Selection.StartPos = 0) and (Selection.EndPos = GetTextLen) then
          Deselect else
          SelectAll;
        Key := #0;
      end;
    ^H, ^V, ^X, #32..#255:
      if not Grid.CanEditModify then Key := #0;
  end;

  if not FCell.CanEdit then
  begin
    inherited;
    Exit;
  end;
end;

procedure TRMInplaceEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  Grid.KeyUp(Key, Shift);
end;

procedure TRMInplaceEdit.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_SETFOCUS:
      begin
        if (GetParentForm(Self) = nil) or GetParentForm(Self).SetFocusedControl(Grid) then
          Dispatch(Message);

        Exit;
      end;
    WM_LBUTTONDOWN:
      begin
        if UINT(GetMessageTime - FClickTime) < GetDoubleClickTime then
          Message.Msg := WM_LBUTTONDBLCLK;
        FClickTime := 0;
      end;
  end;

  inherited WndProc(Message);
end;

procedure TRMInplaceEdit.WMPaste(var Message);
begin
  if not EditCanModify then Exit;

  if not FCell.CanEdit then
  begin
    inherited;
    Exit;
  end;

  inherited;
end;

procedure TRMInplaceEdit.Deselect;
begin
  SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
end;

procedure TRMInplaceEdit.Invalidate;
var
  Cur: TRect;
begin
  ValidateRect(Handle, nil);
  InvalidateRect(Handle, nil, True);
  Windows.GetClientRect(Handle, Cur);
  MapWindowPoints(Handle, Grid.Handle, Cur, 2);
  ValidateRect(Grid.Handle, @Cur);
  InvalidateRect(Grid.Handle, @Cur, False);
end;

procedure TRMInplaceEdit.Hide;
begin
  if HandleAllocated and IsWindowVisible(Handle) then
  begin
    Invalidate;
    SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW or SWP_NOZORDER or
      SWP_NOREDRAW);
    if Focused then Windows.SetFocus(Grid.Handle);
  end;
end;

function TRMInplaceEdit.PosEqual(const Rect: TRect): Boolean;
var
  Cur: TRect;
begin
  GetWindowRect(Handle, Cur);
  MapWindowPoints(HWND_DESKTOP, Grid.Handle, Cur, 2);
  Result := EqualRect(Rect, Cur);
end;

procedure TRMInplaceEdit.InternalMove(const Loc: TRect; Redraw: Boolean);
begin
  if IsRectEmpty(Loc) then Hide
  else
  begin
    CreateHandle;
    Redraw := Redraw or not IsWindowVisible(Handle);
    Invalidate;
    with Loc do
      SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top,
        SWP_SHOWWINDOW or SWP_NOREDRAW);
    BoundsChanged;
    if Redraw then Invalidate;
    if Grid.Focused then
      Windows.SetFocus(Handle);
  end;
end;

procedure TRMInplaceEdit.BoundsChanged;
var
  R: TRect;
begin
  R := Rect(2, 2, Width - 2, Height);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
end;

procedure TRMInplaceEdit.UpdateLoc(const Loc: TRect);
begin
  InternalMove(Loc, False);
end;

function TRMInplaceEdit.Visible: Boolean;
begin
  Result := IsWindowVisible(Handle);
end;

procedure TRMInplaceEdit.Move(const Loc: TRect);
begin
  InternalMove(Loc, True);
end;

procedure TRMInplaceEdit.SetFocus;
begin
  if IsWindowVisible(Handle) then
    Windows.SetFocus(Handle);
end;

procedure TRMInplaceEdit.UpdateContents;
begin
  Text := '';
  FCell := Grid.Cells[Grid.FInplaceCol, Grid.FInplaceRow];
  //  EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
  Text := FCell.Text;
  MaxLength := 0;

  FTempText := Text;
  //Color := FCell.FillColor;
  Font.Assign(FCell.Font);
end;

type
  PIntArray = ^TIntArray;
  TIntArray = array[0..MaxCustomExtents] of Integer;

function ColTitle(Index: Integer): string;
var
  Hi, Lo: Integer;
begin
  Result := '';
  if (Index < 0) or (Index > 255) then
    Exit;
  Hi := Index div 26;
  Lo := Index mod 26;
  if Index <= 25 then
    Result := Chr(Ord('A') + Lo)
  else
    Result := Chr(Ord('A') + Hi - 1) + Chr(Ord('A') + Lo);
end;

procedure InvalidOp(const id: string);
begin
  raise ERMInvalidGridOperation.Create(id);
end;

function GridRect(Coord1, Coord2: TPoint): TRect;
begin
  with Result do
  begin
    Left := Coord2.X;
    if Coord1.X < Coord2.X then
      Left := Coord1.X;
    Right := Coord1.X;
    if Coord1.X < Coord2.X then
      Right := Coord2.X;
    Top := Coord2.Y;
    if Coord1.Y < Coord2.Y then
      Top := Coord1.Y;
    Bottom := Coord1.Y;
    if Coord1.Y < Coord2.Y then
      Bottom := Coord2.Y;
  end;
end;

procedure Restrict(var Coord: TPoint; MinX, MinY, MaxX, MaxY: Longint);
begin
  with Coord do
  begin
    if X > MaxX then
      X := MaxX
    else if X < MinX then
      X := MinX;
    if Y > MaxY then
      Y := MaxY
    else if Y < MinY then
      Y := MinY;
  end;
end;

function PointInGridRect(Col, Row: Longint; const Rect: TRect): Boolean;
begin
  Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
    and (Row <= Rect.Bottom);
end;

function GridRectInterSects(GridRect1, GridRect2: TRect): Boolean; // GridRect2 in GridRect1
var
  i, j: Integer;
begin
  Result := True;
  for i := GridRect1.Left to GridRect1.Right do
  begin
    for j := GridRect1.Top to GridRect1.Bottom do
    begin
      if PointInGridRect(i, j, GridRect2) then
        Exit;
    end;
  end;
  Result := False;
end;

type
  TXorRects = array[0..3] of TRect;