rm_cross.pas

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

            i1 := j;
            while i1 < ColumnsSl.Count do
            begin
              if Pos('+;+', ColumnsSl[i1]) = 0 then
                break;
              Inc(i1);
            end;
            if i1 < ColumnsSl.Count then
              cg.Reset(ColumnsSl[i1], j);
            break;
          end
          else if Pos('+;+', ColumnsSl[j]) = 0 then
          begin
            if RowsSl = Rows then
              cg.AddValue(CellArray[i, j])
            else
              cg.AddValue(CellArray[j, i]);
          end;
        end;
      end;
    end;

    for i := 0 to FieldsSl.Count do
      TRMCrossGroupItem(l[i]).Free;
    l.Free;
  end;

  procedure CheckAvg;
  var
    i, j: Integer;
    v: Variant;
    n: TRMQuickIntArray;
    Check: Boolean;

    procedure CalcAvg(i1, j1: Integer);
    var
      i, j, k: Integer;
      v1: Variant;
    begin
      for i := 0 to FCellFields.Count - 1 do
      begin
        v[i] := 0;
        n[i] := 0;
      end;

      for i := CellByIndex[i1, 0, -1] to i1 - 1 do
      begin
        for j := CellByIndex[0, j1, -1] to j1 - 1 do
        begin
          if (not IsTotalRow[i]) and (not IsTotalColumn[j]) then
          begin
            for k := 0 to FCellFields.Count - 1 do
            begin
              if FuncName(FCellFields[k]) = 'avg' then
              begin
                v1 := CellByIndex[i, j, k];
                if v1 <> Null then
                begin
                  n[k] := n[k] + 1;
                  v[k] := v[k] + v1;
                end;
              end;
            end;
          end;
        end;
      end;

      for i := 0 to FCellFields.Count - 1 do
      begin
        if FuncName(FCellFields[i]) = 'avg' then
        begin
          if n[i] <> 0 then
            Cell[Rows[i1], Columns[j1], i] := v[i] / n[i]
          else
            Cell[Rows[i1], Columns[j1], i] := Null;
        end;
      end;
    end;

  begin
    v := VarArrayCreate([0, FCellFields.Count - 1], varVariant);
    n := TRMQuickIntArray.Create(FCellFields.Count);

    Check := False;
    for i := 0 to FCellFields.Count - 1 do
    begin
      if FuncName(FCellFields[i]) = 'avg' then
      begin
        Check := True;
        break;
      end;
    end;

    if Check then
    begin
      for i := 0 to Rows.Count - 1 do
      begin
        if IsTotalRow[i] or (i = Rows.Count - 1) then
        begin
          for j := 0 to Columns.Count - 1 do
          begin
            if IsTotalColumn[j] or (j = Columns.Count - 1) then
              CalcAvg(i, j);
          end;
        end;
      end;
    end;

    for i := 0 to Rows.Count - 1 do
      Cell[Rows[i], Columns[0], -1] := Null;
    for i := 0 to Columns.Count - 1 do
      Cell[Rows[0], Columns[i], -1] := Null;

    VarClear(v);
    n.Free;
  end;

  procedure MakeColumnHeader;
  var
    i, j, n, cn: Integer;
    s: string;
    sl, sl1: TStringList;
    Flag: Boolean;
    d: Double;
    v: Variant;

    function CompareSl(Index: Integer): Boolean;
    begin
      Result := (sl.Count > Index) and (sl1.Count > Index) and (sl[Index] = sl1[Index]);
    end;

  begin
    sl := TStringList.Create;
    sl1 := TStringList.Create;
    cn := CharCount(';', Columns[0]) + 1; // height of header
    FTopLeftSize.cy := cn;

    FFlag_Insert := True;
    for i := 0 to cn do
    begin
      FInsertPos := i;
      Cell[Chr(i), Columns[0], 0] := '';
    end;
    FFlag_Insert := False;

    for i := 0 to Columns.Count - 1 do
      Cell[#0, Columns[i], -1] := rmftTop or rmftBottom;

    Cell[#0, Columns[0], 0] := FHeaderString;
    Cell[#0, Columns[0], -1] := rmftLeft or rmftTop or rmftBottom;
    Cell[#0, Columns[Columns.Count - 1], -1] := rmftTop or rmftRight;
    for i := 1 to FAddColumnsHeader.Count do
      Cell[#0, Columns[Columns.Count - 1 - i], -1] := rmftTop or rmftRight;

    for i := 1 to cn do
    begin
      Cell[Chr(i), Columns[Columns.Count - 1], -1] := rmftLeft or rmftRight;
      for j := 1 to FAddColumnsHeader.Count do
        Cell[Chr(i), Columns[Columns.Count - 1 - j], -1] := rmftLeft or rmftRight;
    end;

    Cell[#1, Columns[Columns.Count - 1 - FAddColumnsHeader.Count], 0] := FColumnGrandTotalString;
    Cell[#1, Columns[Columns.Count - 1 - FAddColumnsHeader.Count], -1] := rmftLeft or rmftTop or rmftRight;
    for i := 0 to FAddColumnsHeader.Count - 1 do
    begin
      Cell[#1, Columns[Columns.Count - 1 - i], 0] := FAddColumnsHeader[FAddColumnsHeader.Count - 1 - i];
      Cell[#1, Columns[Columns.Count - 1 - i], -1] := rmftLeft or rmftTop or rmftRight;
    end;

    for i := 0 to Columns.Count - 2 - FAddColumnsHeader.Count do
    begin
      s := Columns[i];
      RMSetCommaText(s, sl);
      if Pos('+;+', s) <> 0 then
      begin
        n := CharCount(';', s);
        for j := 1 to n - 1 do
          Cell[Chr(j), s, -1] := rmftTop;

        for j := n to cn do
        begin
          if j = n then
          begin
            Cell[Chr(j), s, 0] := FColumnTotalString;
            Cell[Chr(j), s, -1] := rmftRight or rmftLeft or rmftTop;
          end
          else
            Cell[Chr(j), s, -1] := rmftRight or rmftLeft;
        end;
      end
      else
      begin
        Flag := False;
        for j := 0 to cn - 1 do
        begin
          if (not Flag) and CompareSl(j) then
            Cell[Chr(j + 1), s, -1] := rmftTop
          else
          begin
            if TVarData(FColTypes[j]).VType = varDate then
            begin
              d := StrToFloat(Trim(sl[j]));
              TVarData(FColTypes[j]).VDate := d;
              v := FColTypes[j];
            end
            else if (TVarData(FColTypes[j]).VType = varString) or
              (TVarData(FColTypes[j]).VType = varOleStr) or
              (TVarData(FColTypes[j]).VType = varEmpty) or
              (TVarData(FColTypes[j]).VType = varNull) then
              v := Trim(sl[j])
            else
            begin
              d := StrToFloat(Trim(sl[j]));
              v := FloatToStr(d);
            end;
            Cell[Chr(j + 1), s, 0] := v;
            Cell[Chr(j + 1), s, -1] := rmftTop or rmftLeft or rmftRight;
            Flag := True;
          end;
        end;
      end;
      sl1.Assign(sl);
    end;

    sl.Free;
    sl1.Free;
  end;

  procedure MakeRowHeader;
  var
    i, j, n, cn: Integer;
    s: string;
    sl, sl1: TStringList;
    Flag: Boolean;
    d: Double;
    v: Variant;
    lNowRowNo: Integer;

    function CompareSl(Index: Integer): Boolean;
    begin
      Result := (sl.Count > Index) and (sl1.Count > Index) and (sl[Index] = sl1[Index]);
    end;

    procedure CellOr(Index1, Index2: string; Value: Integer);
    var
      v: Variant;
    begin
      v := Cell[Index1, Index2, -1];
      if v = Null then
        v := 0;
      v := v or Value;
      Cell[Index1, Index2, -1] := v;
    end;

  begin
    sl := TStringList.Create;
    sl1 := TStringList.Create;
    cn := CharCount(';', Rows[FTopLeftSize.cy + 1]) + 1 + Ord(DoDataCol) + Ord(ShowRowNo); // width of header
    FTopLeftSize.cx := cn;

    FFlag_Insert := True;
    for i := 0 to cn - 1 do
    begin
      FInsertPos := i;
      Cell[Rows[0], Chr(i), 0] := '';
    end;
    FFlag_Insert := False;

    Cell[Rows[Rows.Count - 1], #0, 0] := FRowGrandTotalString;
    Cell[Rows[Rows.Count - 1], #0, -1] := rmftTop or rmftBottom or rmftLeft;

    for i := 1 to cn - 1 do
      Cell[Rows[Rows.Count - 1], Chr(i), -1] := rmftTop or rmftBottom;

    if DoDataCol then
    begin
      for i := FTopLeftSize.cy + 1 to Rows.Count - 1 do
      begin
        Cell[Rows[i], Chr(cn - 1), 0] := DataStr;
        Cell[Rows[i], Chr(cn - 1), -1] := 15;
      end;
    end;

    for i := 0 to FTopLeftSize.cy do
    begin
      for j := 0 to cn - 1 do
        Cell[Chr(i), Chr(j), -1] := 0;
    end;

    lNowRowNo := 1;
    for i := FTopLeftSize.cy + 1 to Rows.Count - 2 do
    begin
      s := Rows[i];
      RMSetCommaText(s, sl);
      if Pos('+;+', s) <> 0 then
      begin
        n := CharCount(';', s);
//        if ShowRowNo then
//        	Cell[s, Chr(0), 0] := '';
        for j := 1 to n - 1 + Ord(ShowRowNo) do
          Cell[s, Chr(j - 1), -1] := rmftLeft;

        for j := n + Ord(ShowRowNo) to cn - Ord(DoDataCol) do
        begin
          if (j = n + Ord(ShowRowNo)) then
          begin
            Cell[s, Chr(j - 1), 0] := FRowTotalString;
            Cell[s, Chr(j - 1), -1] := rmftLeft or rmftTop;
          end
          else
          begin
            Cell[s, Chr(j - 1), -1] := rmftTop or rmftBottom;
          end;
        end;
      end
      else
      begin
        Flag := False;
//        if ShowRowNo then
//        	Cell[s, Chr(0), 0] := '';
        for j := Ord(ShowRowNo) to cn - 1 - Ord(DoDataCol) do
        begin
          if (not Flag) and CompareSl(j - Ord(ShowRowNo)) then
          begin
            Cell[s, Chr(j), -1] := rmftLeft;
            if ShowRowNo and (j = 1) then
              Cell[s, Chr(0), -1] := rmftLeft;
          end
          else
          begin
            if TVarData(FRowTypes[j - Ord(ShowRowNo)]).VType = varDate then
            begin
              d := StrToFloat(Trim(sl[j - Ord(ShowRowNo)]));
              TVarData(FRowTypes[j]).VDate := d;
              v := FRowTypes[j];
            end
            else if (TVarData(FRowTypes[j - Ord(ShowRowNo)]).VType = varString) or
              (TVarData(FRowTypes[j - Ord(ShowRowNo)]).VType = varOleStr) or
              (TVarData(FRowTypes[j - Ord(ShowRowNo)]).VType = varEmpty) or
              (TVarData(FRowTypes[j - Ord(ShowRowNo)]).VType = varNull) then
              v := Trim(sl[j - Ord(ShowRowNo)])
            else
            begin
              d := StrToFloat(Trim(sl[j - Ord(ShowRowNo)]));
              v := FloatToStr(d);
            end;
            Cell[s, Chr(j), 0] := v;
            Cell[s, Chr(j), -1] := rmftTop or rmftLeft;
            if ShowRowNo and (j = 1) then
            begin
              Cell[s, Chr(0), 0] := lNowRowNo;
              Cell[s, Chr(0), -1] := rmftTop or rmftLeft;
              Inc(lNowRowNo);
            end;
            Flag := True;
          end;
        end;
      end;
      sl1.Assign(sl);
    end;

    sl.Free;
    sl1.Free;

    for i := cn to Columns.Count - 1 do
      CellOr(Rows[Rows.Count - 1], Columns[i], 15);
    for i := cn to Columns.Count - 1 do
      CellOr(Rows[FTopLeftSize.cy], Columns[i], rmftBottom);
    for i := 0 to cn - 1 - ord(DoDataCol) do
      CellOr(Rows[Rows.Count - 2], Columns[i], rmftBottom);
  end;

begin
  FDataSet.Open;
  FDataSet.First;
  while not FDataSet.EOF do
  begin
    Application.ProcessMessages;
    for i := 0 to FCellFields.Count - 1 do
    begin
      f := FDataSet.FindField(CurReport.Dictionary.RealFieldName[PureName(FCellFields[i])]);
      if FuncName(FCellFields[i]) = 'count' then
      begin
        v := 0;
        if f.Value <> Null then
          v := 1;
      end
      else
        v := f.Value;

      s1 := GetFieldValues(FRowFields);
      s2 := GetFieldValues(FColFields);
      if Cell[s1, s2, i] = Null then
        Cell[s1, s2, i] := v
      else
        Cell[s1, s2, i] := Cell[s1, s2, i] + v;
    end;
    FDataSet.Next;
  end;

  if Columns.Count = 0 then
    Exit;

  if (not SortColHeader) and (CharCount(';', Columns[0]) > 0) then
  	_Sort(FColumns);
  if (not SortRowHeader) and (CharCount(';', Rows[0]) > 0) then
  	_Sort(FRows);

  MakeTotals(Columns, True);
  Cell[Rows[0], Columns[Columns.Count - 1] + '+', 0] := 0;
  MakeTotals(Rows, False);
  Cell[Rows[Rows.Count - 1] + '+', Columns[0], 0] := 0;

  CalcTotals(FColFields, Rows, Columns);
  CalcTotals(FRowFields, Columns, Rows);
  CheckAvg;

  for i := 0 to FAddColumnsHeader.Count - 1 do
  begin
    Cell[Rows[0], Columns[Columns.Count - 1] + '+', 0] := 0;
  end;

  MakeColumnHeader;
  MakeRowHeader;
end;

function TRMCross.GetIsTotalRow(Index: Integer): Boolean;
begin
  Result := Pos('+;+', Rows[Index]) <> 0;
end;

function TRMCross.GetIsTotalColumn(Index: Integer): Boolean;
begin
  Result := Pos('+;+', Columns[Index]) <> 0;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMQuickArray }

constructor TRMQuickIntArray.Create(Length: Integer);
begin
  Len := Length;
  GetMem(arr, Len * SizeOf(TIntArrayCell));
  for Length := 0 to Len - 1 do
    arr[Length] := 0;
end;

destructor TRMQuickIntArray.Destroy;
begin
  FreeMem(arr, Len * SizeOf(TIntArrayCell));
  inherited;
end;

function TRMQuickIntArray.GetCell(Index: Integer): Integer;
begin
  Result := arr[Index];
end;

procedure TRMQuickIntArray.SetCell(Index: Integer; const Value: Integer);
begin
  arr[Index] := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMCrossList }

function PureName1(s: string): string;
begin
  if Pos('+', s) <> 0 then
    Result := Copy(s, 1, Pos('+', s) - 1)