rm_grid.pas

这是一个功能强大

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';

{ TRMGridEx }

constructor TRMGridEx.Create(AOwner: TComponent);
const
  GridStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
begin
  inherited Create(AOwner);
  if NewStyleControls then
    ControlStyle := GridStyle
  else
    ControlStyle := GridStyle + [csFramed];

  FCurrentCol := -1;
  FCurrentRow := -1;
  FDrawPicture := False;
  FEditorMode := False;
  FInplaceEdit := nil;
  FAutoCreateName := True;
  FSaveLastNameIndex := 1;
  FInLoadSaveMode := False;
  FCanEditModify := True;
  FColCount := 10;
  FRowCount := 6;
  FFixedCols := 1;
  FFixedRows := 1;
  FGridLineWidth := 1;
  FmmDefaultColWidth := RMToMMThousandths(64, rmutScreenPixels);
  FmmDefaultRowHeight := RMToMMThousandths(24, rmutScreenPixels);
  FOptions := [rmgoFixedVertLine, rmgoFixedHorzLine, rmgoVertLine, rmgoHorzLine,
    rmgoRangeSelect, rmgoRowSizing, rmgoColSizing, rmgoDrawFocusSelected,
    rmgoEditing];
  FScrollBars := ssBoth;
  FBorderStyle := bsSingle;
  FSaveCellExtents := True;
  ParentColor := False;
  TabStop := True;
  FDefaultDrawing := True;
  FAutoDraw := True;

  Color := clWindow;
  FFixedColor := clBtnFace;
  FTitleColor := clBtnFace;
  FHighLightColor := clBlack;
  FHighLightTextColor := clWhite;
  FFocusedTitleColor := clBlack;
  FFixedLineColor := clBlack;
  FClientLineColor := clSilver;
  FFocusedFillColor := $00E7D7CE; //clSkyBlue;

  FAutoUpdate := True;
  FGridCanCopyMove := False;
  FGridCanFill := False;

  if RMIsChineseGB then
    Font.Name := '宋体'
  else
    Font.Name := 'Arial';
  Font.Charset := StrToInt(RMLoadStr(SCharset));
  Font.Size := 10;

  FCells := TRMCells.Create(FColCount, FRowCount, Self);
  SetBounds(Left, Top, FColCount * DefaultColWidth, FRowCount * DefaultRowHeight);
  Initialize;
end;

destructor TRMGridEx.Destroy;
begin
  FreeAndNil(FInplaceEdit);
  FAutoDraw := False;
  FCells.Free;
  inherited Destroy;
  FreeMem(FColWidths);
  FreeMem(FRowHeights);
end;

procedure TRMGridEx.FreeEditor;
begin
  FEditorMode := False;
  FreeAndNil(FInplaceEdit);
end;

procedure TRMGridEx.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_TABSTOP;
    if FScrollBars in [ssVertical, ssBoth] then
      Style := Style or WS_VSCROLL;
    if FScrollBars in [ssHorizontal, ssBoth] then
      Style := Style or WS_HSCROLL;
    WindowClass.style := CS_DBLCLKS;
    if FBorderStyle = bsSingle then
    begin
      if NewStyleControls and Ctl3D then
      begin
        Style := Style and not WS_BORDER;
        ExStyle := ExStyle or WS_EX_CLIENTEDGE;
      end
      else
        Style := Style or WS_BORDER;
    end;
  end;
end;

procedure TRMGridEx.ClearGrid;
begin
  FInLoadSaveMode := True;
  try
    Initialize;
    FCells.Free;
    FreeMem(FColWidths);
    FreeMem(FRowHeights);
    FColWidths := nil;
    FRowHeights := nil;

    FColCount := 2;
    FRowCount := 2;
    FCells := TRMCells.Create(FColCount, FRowCount, Self);
    SetBounds(Left, Top, FColCount * DefaultColWidth, FRowCount * DefaultRowHeight);
    ColWidths[0] := 100;
    Initialize;
  finally
    FInLoadSaveMode := False;
  end;
end;

procedure TRMGridEx.Assign(Source: TPersistent);
var
  i, liCol, liRow: Integer;
begin
  if not (Source is TRMGridEx) then Exit;

  ColCount := TRMGridEx(Source).ColCount;
  RowCount := TRMGridEx(Source).RowCount;
  FixedColor := TRMGridEx(Source).FixedColor;
  Font.Assign(TRMGridEx(Source).Font);
  DefaultRowHeight := TRMGridEx(Source).DefaultRowHeight;
  DefaultColWidth := TRMGridEx(Source).DefaultColWidth;
  for i := 1 to TRMGridEx(Source).ColCount - 1 do
    ColWidths[i] := TRMGridEx(Source).ColWidths[i];

  for i := 1 to TRMGridEx(Source).RowCount - 1 do
    RowHeights[i] := TRMGridEx(Source).RowHeights[i];

  for liCol := 1 to TRMGridEx(Source).ColCount - 1 do
  begin
    for liRow := 1 to TRMGridEx(Source).RowCount - 1 do
    begin
      Cells[liCol, liRow].Assign(TRMGridEx(Source).Cells[liCol, liRow]);
    end;
  end;
end;

procedure TRMGridEx.CreateViewsName;
var
  i, j: Integer;
  sl: TStringList;
  lPage: TRMCustomPage;
  lCell: TRMCellInfo;
  str, str1: string;
  lPageObjects: TList;

  procedure _GetObjects;
  var
    i, j: Integer;
  begin
    if sl <> nil then Exit;

    sl := TStringList.Create;
    sl.BeginUpdate;
    for i := 0 to ParentReport.Pages.Count - 1 do
    begin
      lPage := ParentReport.Pages[i];
      lPageObjects := lPage.PageObjects;
      for j := 0 to lPageObjects.Count - 1 do
      begin
        if TRMView(lPageObjects[j]).Name <> '' then
          sl.Add(UpperCase(TRMView(lPageObjects[j]).Name));
        THackPage(lPage).AddChildView(sl, True);
      end;
    end;

    sl.Sort;
    sl.Sorted := True;
    sl.EndUpdate;
  end;

  procedure _CreateName;
  var
    lIndex: Integer;
  begin
    _GetObjects;
    str1 := THackView(lCell.View).BaseName;
    while True do
    begin
      str := str1 + IntToStr(FSaveLastNameIndex);
      if not sl.Find(UpperCase(str), lIndex) then
      begin
        lCell.View.Name := str;

        Inc(FSaveLastNameIndex);
        sl.Add(UpperCase(str));
        Break;
      end;
      Inc(FSaveLastNameIndex);
    end;
  end;

begin
  if not AutoCreateName then Exit;

  sl := nil;
  try
    for i := 1 to RowCount - 1 do
    begin
      j := 1;
      while j < ColCount do
      begin
        lCell := Cells[j, i];
        if (lCell.StartRow = i) and (lCell.View.Name = '') then
        begin
          _CreateName;
        end;
        j := lCell.EndCol + 1;
      end;
    end;
  finally
    sl.Free;
  end;
end;

function TRMGridEx.GetCellInfo(ACol, Arow: Integer): TRMCellinfo;
var
  liCell: TRMCellInfo;
begin
  liCell := Cells[ACol, ARow];
  Result := Cells[liCell.StartCol, liCell.StartRow];
end;

function TRMGridEx.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
var
  GridRect: TRect;
begin
  GridRect.Left := ALeft;
  GridRect.Right := ARight;
  GridRect.Top := ATop;
  GridRect.Bottom := ABottom;
  GridRectToScreenRect(GridRect, Result, False);
end;

function TRMGridEx.CellRect(ACol, ARow: Longint): TRect;
begin
  Result := BoxRect(ACol, ARow, ACol, ARow);
end;

function TRMGridEx.IsActiveControl: Boolean;
var
  H: Hwnd;
  ParentForm: TCustomForm;
begin
  Result := False;
  ParentForm := GetParentForm(Self);
  if Assigned(ParentForm) then
  begin
    if (ParentForm.ActiveControl = Self) then
      Result := True
  end
  else
  begin
    H := GetFocus;
    while IsWindow(H) and (Result = False) do
    begin