rm_grid.pas

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

    Result := Result + Max(HorzStroke, VertStroke);
  end;

  function CalcMinHorzCell: Integer;
  var
    i: Integer;
  begin
    Result := Cells[LeftCol, TopRow].StartCol;
    for i := 1 to MaxVertCell do
      Result := Min(Result, Cells[LeftCol, i].StartCol);
  end;

  function CalcMinVertCell: Integer;
  var
    i: Integer;
  begin
    Result := Cells[LeftCol, TopRow].StartRow;
    for i := 1 to MaxHorzCell do
      Result := Min(Result, Cells[i, TopRow].StartRow);
  end;

begin
  UpdateRect := Canvas.ClipRect;
  CalcDrawInfo(DrawInfo);
  with DrawInfo do
  begin
    if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then
    begin
      MaxHorzExtent := Min(Width, Horz.GridBoundary);
      MaxVertExtent := Min(Height, Vert.GridBoundary);
      MaxHorzCell := Min(Horz.GridCellCount - 1, Horz.LastFullVisibleCell + 1);
      MaxVertCell := Min(Vert.GridCellCount - 1, Vert.LastFullVisibleCell + 1);
      MinHorzCell := CalcMinHorzCell;
      MinVertCell := CalcMinVertCell;
      MaxStroke := CalcMaxStroke;
      PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
      StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
      FillDWord(StrokeList^, MaxStroke, 2);

      DrawLines(rmgoFixedHorzLine in Options, rmgoFixedVertLine in Options, // 固定区交叉区
        1, 1, Horz.FixedCellCount, Vert.FixedCellCount,
        [0, 0, Horz.FixedBoundary, Vert.FixedBoundary], FFixedLineColor, Color);
      DrawLines(rmgoFixedHorzLine in Options, rmgoFixedVertLine in Options, // 顶部固定区
        LeftCol, 1, MaxHorzCell, Vert.FixedCellCount,
        [Horz.FixedBoundary, 0, MaxHorzExtent,
        Vert.FixedBoundary], FFixedLineColor, Color);
      DrawLines(rmgoFixedHorzLine in Options, rmgoFixedVertLine in Options, // 左部固定区
        1, TopRow, Horz.FixedCellCount, MaxVertCell,
        [0, Vert.FixedBoundary, Horz.FixedBoundary,
        MaxVertExtent], FFixedLineColor, Color);
      DrawLines(rmgoHorzLine in Options, rmgoVertLine in Options, // 活动区域
        LeftCol, TopRow, MaxHorzCell, MaxVertCell,
        [Horz.FixedBoundary, Vert.FixedBoundary, MaxHorzExtent,
        MaxVertExtent], FClientLineColor, Color);

      StackFree(StrokeList);
      StackFree(PointsList);
    end;

    Sel := Selection;
    FrameFlags1 := 0; FrameFlags2 := 0;
    if rmgoFixedVertLine in Options then
    begin
      FrameFlags1 := BF_RIGHT; FrameFlags2 := BF_LEFT;
    end;
    if rmgoFixedHorzLine in Options then
    begin
      FrameFlags1 := FrameFlags1 or BF_BOTTOM;
      FrameFlags2 := FrameFlags2 or BF_TOP;
    end;
    DrawCells(6, 0, 0, FFixedCols, FFixedRows, FixedColor, [rmgdFixed]); // 固定区交叉区
    DrawCells(7, MinHorzCell, 0, MaxHorzCell, FFixedRows, FixedColor, [rmgdFixed]); // 顶部固定区
    DrawCells(8, 0, MinVertCell, FFixedCols, MaxVertCell, FixedColor, [rmgdFixed]);
    DrawCells(9, MinHorzCell, MinVertCell, MaxHorzCell, MaxVertCell, Color, []);

    if Horz.GridBoundary < Horz.GridExtent then
    begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(Rect(Horz.GridBoundary, 0, Horz.GridExtent, Vert.GridBoundary));
    end;
    if Vert.GridBoundary < Vert.GridExtent then
    begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(Rect(0, Vert.GridBoundary, Horz.GridExtent, Vert.GridExtent));
    end;
  end;
end;

function TRMGridEx.CalcCoordFromPoint(X, Y: Integer;
  const DrawInfo: TRMGridDrawInfo): TPoint;

  function DoCalc(const AxisInfo: TRMGridAxisDrawInfo; N: Integer): Integer;
  var
    I, Start, Stop: Longint;
    Line: Integer;
  begin
    with AxisInfo do
    begin
      if N < FixedBoundary then
      begin
        Start := 0;
        Stop := FixedCellCount - 1;
        Line := 0;
      end
      else
      begin
        Start := FirstGridCell;
        Stop := GridCellCount - 1;
        Line := FixedBoundary;
      end;
      Result := -1;
      for I := Start to Stop do
      begin
        Inc(Line, GetExtent(I) + EffectiveLineWidth);
        if N < Line then
        begin
          Result := I;
          Exit;
        end;
      end;
    end;
  end;

  function DoCalcRightToLeft(const AxisInfo: TRMGridAxisDrawInfo; N: Integer): Integer;
  var
    I, Start, Stop: Longint;
    Line: Integer;
  begin
    N := ClientWidth - N;
    with AxisInfo do
    begin
      if N < FixedBoundary then
      begin
        Start := 0;
        Stop := FixedCellCount - 1;
        Line := ClientWidth;
      end
      else
      begin
        Start := FirstGridCell;
        Stop := GridCellCount - 1;
        Line := FixedBoundary;
      end;
      Result := -1;
      for I := Start to Stop do
      begin
        Inc(Line, GetExtent(I) + EffectiveLineWidth);
        if N < Line then
        begin
          Result := I;
          Exit;
        end;
      end;
    end;
  end;

begin
  Result.X := DoCalc(DrawInfo.Horz, X);
  Result.Y := DoCalc(DrawInfo.Vert, Y);
end;

procedure TRMGridEx.CalcDrawInfo(var DrawInfo: TRMGridDrawInfo);
begin
  CalcDrawInfoXY(DrawInfo, ClientWidth, ClientHeight);
end;

procedure TRMGridEx.CalcDrawInfoXY(var DrawInfo: TRMGridDrawInfo;
  UseWidth, UseHeight: Integer);

  procedure CalcAxis(var AxisInfo: TRMGridAxisDrawInfo; UseExtent: Integer);
  var
    I: Integer;
  begin
    with AxisInfo do
    begin
      GridExtent := UseExtent;
      GridBoundary := FixedBoundary;
      FullVisBoundary := FixedBoundary;
      LastFullVisibleCell := FirstGridCell;
      for I := FirstGridCell to GridCellCount - 1 do
      begin
        Inc(GridBoundary, GetExtent(I) + EffectiveLineWidth);
        if GridBoundary > GridExtent + EffectiveLineWidth then
        begin
          GridBoundary := GridExtent;
          Break;
        end;
        LastFullVisibleCell := I;
        FullVisBoundary := GridBoundary;
      end;
    end;
  end;

begin
  CalcFixedInfo(DrawInfo);
  CalcAxis(DrawInfo.Horz, UseWidth);
  CalcAxis(DrawInfo.Vert, UseHeight);
end;

procedure TRMGridEx.CalcFixedInfo(var DrawInfo: TRMGridDrawInfo);

  procedure CalcFixedAxis(var Axis: TRMGridAxisDrawInfo; LineOptions: TRMGridOptions;
    FixedCount, FirstCell, CellCount: Integer; GetExtentFunc: TRMGetExtentsFunc);
  var
    I: Integer;
  begin
    with Axis do
    begin
      if LineOptions * Options = [] then
        EffectiveLineWidth := 0
      else
        EffectiveLineWidth := 1;

      FixedBoundary := 0;
      for I := 0 to FixedCount - 1 do
        Inc(FixedBoundary, GetExtentFunc(I) + EffectiveLineWidth);

      FixedCellCount := FixedCount;
      FirstGridCell := FirstCell;
      GridCellCount := CellCount;
      GetExtent := GetExtentFunc;
    end;
  end;

begin
  CalcFixedAxis(DrawInfo.Horz, [rmgoFixedVertLine, rmgoVertLine], FFixedCols,
    LeftCol, ColCount, GetColWidths);
  CalcFixedAxis(DrawInfo.Vert, [rmgoFixedHorzLine, rmgoHorzLine], FFixedRows,
    TopRow, RowCount, GetRowHeights);
end;

{ Calculates the TopLeft that will put the given Coord in view }

function TRMGridEx.CalcMaxTopLeft(const Coord: TPoint;
  const DrawInfo: TRMGridDrawInfo): TPoint;

  function CalcMaxCell(const Axis: TRMGridAxisDrawInfo; Start: Integer): Integer;
  var
    Line: Integer;
    I, Extent: Longint;
  begin
    Result := Start;
    with Axis do
    begin
      Line := GridExtent + EffectiveLineWidth;
      for I := Start downto FixedCellCount do
      begin
        Extent := GetExtent(I);
        if Extent > 0 then
        begin
          Dec(Line, Extent);
          Dec(Line, EffectiveLineWidth);
          if Line < FixedBoundary then
          begin
            if (Result = Start) and (GetExtent(Start) <= 0) then
              Result := I;
            Break;
          end;
          Result := I;
        end;
      end;
    end;
  end;

begin
  Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
  Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
end;

procedure TRMGridEx.CalcSizingState(X, Y: Integer; var State: TRMGridState;
  var Index: Longint; var SizingPos, SizingOfs: Integer;
  var FixedInfo: TRMGridDrawInfo);

  procedure CalcAxisState(const AxisInfo: TRMGridAxisDrawInfo; Pos: Integer;
    NewState: TRMGridState);
  var
    I, Line, Back, Range: Integer;
  begin
    with AxisInfo do
    begin
      Line := FixedBoundary;
      Range := EffectiveLineWidth;
      Back := 0;
      if Range < 7 then
      begin
        Range := 7;
        Back := (Range - EffectiveLineWidth) shr 1;
      end;
      for I := FirstGridCell to GridCellCount - 1 do
      begin
        Inc(Line, GetExtent(I));
        if Line > GridBoundary then
          Break;
        if (Pos >= Line - Back) and (Pos <= Line - Back + Range) then
        begin
          State := NewState;
          SizingPos := Line;
          SizingOfs := Line - Pos;
          Index := I;
          Exit;
        end;
        Inc(Line, EffectiveLineWidth);
      end;
      if (GridBoundary = GridExtent) and (Pos >= GridExtent - Back)
        and (Pos <= GridExtent) then
      begin
        State := NewState;
        SizingPos := GridExtent;
        SizingOfs := GridExtent - Pos;
        Index := LastFullVisibleCell + 1;
      end;
    end;
  end;

  function XOutsideHorzFixedBoundary: Boolean;
  begin
    with FixedInfo do
      Result := X > Horz.FixedBoundary
  end;

  function XOutsideOrEqualHorzFixedBoundary: Boolean;
  begin
    with FixedInfo do
      Result := X >= Horz.FixedBoundary
  end;


var
  EffectiveOptions: TRMGridOptions;
begin
  State := rmgsNormal;
  Index := -1;
  EffectiveOptions := FOptions;
  if [rmgoColSizing, rmgoRowSizing] * EffectiveOptions <> [] then
    with FixedInfo do
    begin
      Vert.GridExtent := ClientHeight;
      Horz.GridExtent := ClientWidth;
      if (XOutsideHorzFixedBoundary) and (rmgoColSizing in EffectiveOptions) then
      begin
        if Y >= Vert.FixedBoundary then
          Exit;
        CalcAxisState(Horz, X, rmgsColSizing);
      end
      else if (Y > Vert.FixedBoundary) and (rmgoRowSizing in EffectiveOptions) then
      begin
        if XOutsideOrEqualHorzFixedBoundary then
          Exit;
        CalcAxisState(Vert, Y, rmgsRowSizing);
      end;
    end;
end;

procedure TRMGridEx.ChangeSize(NewColCount, NewRowCount: Longint);
var
  OldColCount, OldRowCount: Longint;
  OldDrawInfo: TRMGridDrawInfo;

  procedure MinRedraw(const OldInfo, NewInfo: TRMGridAxisDrawInfo; Axis: Integer);
  var
    R: TRect;
    First: Integer;
  begin
    if not FAutoDraw then
      Exit;
    First := Min(OldInfo.LastFullVisibleCell, NewInfo.LastFullVisibleCell);
    R := CellRect(First and not Axis, First and Axis);
    R.Bottom := Height;
    R.Right := Width;
    Windows.InvalidateRect(Handle, @R, False);
  end;

  procedure DoChange;
  var
    Coord: TPoint;
    NewDrawInfo: TRMGridDrawInfo;
  begin
    if FColWidths <> nil then
      UpdateExtents(FColWidths, ColCount, FDefaultColWidth);
    if FRowHeights <> nil then
      UpdateExtents(FRowHeights, RowCount, FDefaultRowHeight);
    Coord := FCurrent;
    if Row >= RowCount then
      Coord.Y := RowCount - 1;
    if Col >= ColCount then
      Coord.X := ColCount - 1;
    if (FCurrent.X <> Coord.X) or (FCurrent.Y <> Coord.Y) then
      MoveCurrent(Coord.X, Coord.Y, True, True);
    if (FAnchor.X <> Coord.X) or (FAnchor.Y <> Coord.Y) then
      MoveAnchor(Coord);
    if VirtualView or (LeftCol <> OldDrawInfo.Horz.FirstGridCell) or
      (TopRow <> OldDrawInfo.Vert.FirstGridCell) then
    begin
      if FAutoDraw then
        InvalidateGrid;
    end
    else if HandleAllocated then
    begin
      CalcDrawInfo(NewDrawInfo);
      MinRedraw(OldDrawInfo.Horz, NewDrawInfo.Horz, 0);
      MinRedraw(OldDrawInfo.Vert, NewDrawInfo.Vert, -1);
    end;
    UpdateScrollRange;
    SizeChanged(OldColCount, OldRowCount);
  end;

begin
  if HandleAllocated then
    CalcDrawInfo(OldDrawInfo);
  OldColCount := FColCount;
  OldRowCount := FRowCount;
  FColCount := NewColCount;
  FRowCount := NewRowCount;
  if FFixedCols > NewColCount then FFixedCols := NewColCount - 1;
  if FFixedRows > NewRowCount then FFixedRows := NewRowCount - 1;
  try
    DoChange;
  except
    { Could not change size so try to clean up by setting the size back }
    FColCount := OldColCount;
    FRowCount :=