rm_grid.pas

进销存·完整的·有数据库的·非常完整·只得参考

procedure TRMCellInfo.SetText(const Value: string);
begin
  if View is TRMMemoView then
    TRMMemoView(View).Memo.Text := Value;
end;

function TRMCellInfo.GetFillColor: TColor;
begin
  Result := FView.FillColor;
end;

procedure TRMCellInfo.SetFillColor(Value: TColor);
begin
  FView.FillColor := Value;
end;

function TRMCellInfo.GetFont: TFont;
begin
  if View is TRMMemoView then
    Result := TRMMemoView(View).Font
  else
    Result := FFont;
end;

procedure TRMCellInfo.SetFont(Value: TFont);
begin
  if View is TRMMemoView then
    TRMMemoView(View).Font.Assign(Value);
  FFont.Assign(Value);
end;

function TRMCellInfo.GetAutoWordBreak: Boolean;
begin
  if View is TRMMemoView then
    Result := TRMMemoView(View).PWordwrap
  else
    Result := FAutowordBreak;
end;

procedure TRMCellInfo.SetAutowordBreak(Value: Boolean);
begin
  FAutowordBreak := Value;
  if View is TRMMemoView then
    TRMMemoView(View).PWordwrap := Value;
end;

function TRMCellInfo.GetHorizAlign: TRMAlignment;
begin
  if View is TRMMemoView then
    Result := TRMMemoView(View).PAlignment
  else
    Result := FHorizAlign;
end;

procedure TRMCellInfo.SetHorizAlign(Value: TRMAlignment);
begin
  FHorizAlign := Value;
  if View is TRMMemoView then
    TRMMemoView(View).PAlignment := Value;
end;

function TRMCellInfo.GetVertAlign: TRMLayout;
begin
  if View is TRMMemoView then
    Result := TRMMemoView(View).PLayout
  else
    Result := FVertAlign;
end;

procedure TRMCellInfo.SetVertAlign(Value: TRMLayout);
begin
  FVertAlign := Value;
  if View is TRMMemoView then
    TRMMemoView(View).PLayout := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

constructor TRMRowCell.Create(ARow, AColCount: Integer; AGrid: TRMGridEx);
var
  i: Integer;
  liCellInfo: TRMCellInfo;
begin
  inherited Create;
  FList := TList.Create;
  for i := 0 to AColCount - 1 do
  begin
    liCellInfo := TRMCellInfo.Create;
    AGrid.InitCell(AGrid, liCellInfo, i, ARow);
    FList.Add(liCellInfo);
  end;
end;

destructor TRMRowCell.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

procedure TRMRowCell.Clear;
begin
  while FList.Count > 0 do
  begin
    TRMCellInfo(FList[0]).Free;
    FList.Delete(0);
  end;
end;

procedure TRMRowCell.Add(ARow, ACol: Integer; AGrid: TRMGridEx);
var
  liCellInfo: TRMCellInfo;
begin
  liCellInfo := TRMCellInfo.Create;
  AGrid.InitCell(AGrid, liCellInfo, ACol, ARow);
  FList.Add(liCellInfo);
end;

procedure TRMRowCell.Delete(Index: Integer);
begin
  TRMCellInfo(FList[Index]).Free;
  FList.Delete(Index);
end;

function TRMRowCell.GetItem(Index: Integer): TRMCellInfo;
begin
  Result := TRMCellInfo(FList[Index]);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

constructor TRMCells.Create(AColCount, ARowCount: Integer; AGrid: TRMGridEx);
var
  i: Integer;
  liRowCell: TRMRowCell;
begin
  inherited Create;
  FList := TList.Create;
  FGrid := AGrid;
  for i := 0 to ARowCount - 1 do
  begin
    liRowCell := TRMRowCell.Create(i, AColCount, AGrid);
    FList.Add(liRowCell);
  end;
end;

destructor TRMCells.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

procedure TRMCells.Clear;
begin
  while FList.Count > 0 do
  begin
    TRMRowCell(FList[0]).Free;
    FList.Delete(0);
  end;
end;

function TRMCells.GetItem(Index: Integer): TRMRowCell;
begin
  Result := TRMRowCell(FList[Index]);
end;

procedure TRMCells.Insert(AIndex: Integer);
var
  liRowCell: TRMRowCell;
begin
  liRowCell := TRMRowCell.Create(AIndex, FGrid.ColCount, FGrid);
  FList.Insert(AIndex, liRowCell);
end;

procedure TRMCells.Add(AIndex: Integer);
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
  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;

procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
var
  Intersect, Union: TRect;

  function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
  begin
    with Rect do
      Result := (X >= Left) and (X <= Right) and (Y >= Top) and
        (Y <= Bottom);
  end;

  function Includes(const P1: TPoint; var P2: TPoint): Boolean;
  begin
    with P1 do
    begin
      Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
      if Result then
        P2 := P1;
    end;
  end;

  function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
  begin
    Build := True;
    with R do
      if Includes(P1, TopLeft) then
      begin
        if not Includes(P3, BottomRight) then
          BottomRight := P2;
      end
      else if Includes(P2, TopLeft) then
        BottomRight := P3
      else
        Build := False;
  end;

begin
  FillChar(XorRects, SizeOf(XorRects), 0);
  if not Bool(IntersectRect(Intersect, R1, R2)) then
  begin
    { Don't intersect so its simple }
    XorRects[0] := R1;
    XorRects[1] := R2;
  end
  else
  begin
    UnionRect(Union, R1, R2);
    if Build(XorRects[0],
      Point(Union.Left, Union.Top),
      Point(Union.Left, Intersect.Top),
      Point(Union.Left, Intersect.Bottom)) then
      XorRects[0].Right := Intersect.Left;
    if Build(XorRects[1],
      Point(Intersect.Left, Union.Top),
      Point(Intersect.Right, Union.Top),
      Point(Union.Right, Union.Top)) then
      XorRects[1].Bottom := Intersect.Top;
    if Build(XorRects[2],
      Point(Union.Right, Intersect.Top),
      Point(Union.Right, Intersect.Bottom),
      Point(Union.Right, Union.Bottom)) then
      XorRects[2].Left := Intersect.Right;
    if Build(XorRects[3],
      Point(Union.Left, Union.Bottom),
      Point(Intersect.Left, Union.Bottom),
      Point(Intersect.Right, Union.Bottom)) then
      XorRects[3].Top := Intersect.Bottom;
  end;
end;

procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
  Default: Integer);
var
  LongSize, OldSize: LongInt;
  NewSize: Integer;
  I: Integer;
begin
  if Amount <> 0 then
  begin
    if not Assigned(Extents) then
      OldSize := 0
    else
      OldSize := PIntArray(Extents)^[0];
    if (Index < 0) or (OldSize < Index) then
      InvalidOp(SIndexOutOfRange);
    LongSize := OldSize + Amount;
    if LongSize < 0 then
      InvalidOp(STooManyDeleted)
    else if LongSize >= MaxListSize - 1 then
      InvalidOp(SGridTooLarge);
    NewSize := Cardinal(LongSize);
    if NewSize > 0 then
      Inc(NewSize);
    ReallocMem(Extents, NewSize * SizeOf(Integer));
    if Assigned(Extents) then
    begin
      I := Index + 1;
      while I < NewSize do
      begin
        PIntArray(Extents)^[I] := Default;
        Inc(I);
      end;
      PIntArray(Extents)^[0] := NewSize - 1;
    end;
  end;
end;

procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
  Default: Integer);
var
  OldSize: Integer;
begin
  OldSize := 0;
  if Assigned(Extents) then
    OldSize := PIntArray(Extents)^[0];
  ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
end;

procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
var
  Extent: Integer;
begin
  if Assigned(Extents) then
  begin
    Extent := PIntArray(Extents)^[FromIndex];
    if FromIndex < ToIndex then
      Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
        (ToIndex - FromIndex) * SizeOf(Integer))
    else if FromIndex > ToIndex then
      Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
        (FromIndex - ToIndex) * SizeOf(Integer));
    PIntArray(Extents)^[ToIndex] := Extent;
  end;
end;

{ Private. LongMulDiv multiplys the first two arguments and then
  divides by the third.  This is used so that real number
  (floating point) arithmetic is not necessary.  This routine saves
  the possible 64-bit value in a temp before doing the divide.  Does
  not do error checking like divide by zero.  Also assumes that the
  result is in the 32-bit range (Actually 31-bit, since this algorithm
  is for unsigned). }

function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
  external 'kernel32.dll' name 'MulDiv';

type
  TSelection = record