rm_cross.pas

report machine 2.3 功能强大

              (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 + rmftLeft;
            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;

    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; // width of header
    FTopLeftSize.cx := cn;

    for i := 0 to cn - 1 do
      Cell[Rows[0], Chr(i), 0] := '';

    Cell[Rows[Rows.Count - 1], #0, 0] := FRowGrandTotalString;
    Cell[Rows[Rows.Count - 1], #0, -1] := RMftTop + RMftBottom + RMftLeft;

    for i := 1 to cn - 1 do
      Cell[Rows[Rows.Count - 1], Chr(i), -1] := RMftTop + RMftBottom;

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

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

        for j := 1 to n - 1 do
          Cell[s, Chr(j - 1), -1] := RMftLeft;

        for j := n to cn do
        begin
          if j = n then
          begin
            Cell[s, Chr(j - 1), 0] := FRowTotalString;
            Cell[s, Chr(j - 1), -1] := RMftLeft + RMftTop;
          end
          else
            Cell[s, Chr(j - 1), -1] := RMftTop + RMftBottom;
        end;
      end
      else
      begin
        Flag := False;
        for j := 0 to cn - 1 do
        begin
          if (not Flag) and CompareSl(j) then
            Cell[s, Chr(j), -1] := RMftLeft
          else
          begin
            if TVarData(FRowTypes[j]).VType = varDate then
            begin
              d := StrToFloat(Trim(sl[j]));
              TVarData(FRowTypes[j]).VDate := d;
              v := FRowTypes[j];
            end
            else if (TVarData(FRowTypes[j]).VType = varString) or
              (TVarData(FRowTypes[j]).VType = varOleStr) or
              (TVarData(FRowTypes[j]).VType = varEmpty) or
              (TVarData(FRowTypes[j]).VType = varNull) then
              v := Trim(sl[j])
            else
            begin
              d := StrToFloat(Trim(sl[j]));
              v := FloatToStr(d);
            end;
            Cell[s, Chr(j), 0] := v;
            Cell[s, Chr(j), -1] := rmftTop + rmftLeft;
            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 do
      CellOr(Rows[Rows.Count - 2], Columns[i], RMftBottom);
  end;

begin
  FDataSet.Open;
  FDataSet.First;
  while not FDataSet.EOF do
  begin
    for i := 0 to FCellFields.Count - 1 do
    begin
      f := TField(FDataSet.FindField(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;
  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;

  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;


{TRMCrossView}

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


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

constructor TRMCrossList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TRMCrossList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

procedure TRMCrossList.Add(v: TRMCrossView);
begin
  FList.Add(v);
  v.FSavedOnBeginDoc := v.FReport.OnCrossBeginDoc;
  v.FReport.OnCrossBeginDoc := v.ReportBeginDoc;
  v.FSavedOnBeforePrint := v.FReport.OnBeforePrint;
  v.FReport.OnBeforePrint := v.ReportBeforePrint;
  v.FSavedOnPrintColumn := v.FReport.OnPrintColumn;
  v.FReport.OnPrintColumn := v.ReportPrintColumn;
  v.FSavedOnEndDoc := v.FReport.OnEndDoc;
  v.FReport.OnEndDoc := v.ReportEndDoc;
end;

procedure TRMCrossList.Delete(v: TRMCrossView);
var
  i: Integer;
  v1: TRMCrossView;
begin
  v.FReport.OnCrossBeginDoc := v.FSavedOnBeginDoc;
  v.FReport.OnBeforePrint := v.FSavedOnBeforePrint;
  v.FReport.OnPrintColumn := v.FSavedOnPrintColumn;
  v.FReport.OnEndDoc := v.FSavedOnEndDoc;

  i := FList.IndexOf(v);
  FList.Delete(i);

  if (i = 0) and (FList.Count > 0) then
  begin
    v := TRMCrossView(FList[0]);
    v.FSavedOnBeginDoc := v.FReport.OnCrossBeginDoc;
    v.FSavedOnEndDoc := v.FReport.OnEndDoc;
    v.FSavedOnBeforePrint := v.FReport.OnBeforePrint;
    v.FSavedOnPrintColumn := v.FReport.OnPrintColumn;
  end;

  for i := 1 to FList.Count - 1 do
  begin
    v := TRMCrossView(FList[i]);
    v1 := TRMCrossView(FList[i - 1]);
    v.FSavedOnBeginDoc := v1.ReportBeginDoc;
    v.FSavedOnEndDoc := v1.ReportEndDoc;
    v.FSavedOnBeforePrint := v1.ReportBeforePrint;
    v.FSavedOnPrintColumn := v1.ReportPrintColumn;
  end;

  if FList.Count > 0 then
  begin
    v := TRMCrossView(FList[FList.Count - 1]);
    v.FReport.OnCrossBeginDoc := v.ReportBeginDoc;
  end;
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMCrossView}

class function TRMCrossView.CanPlaceOnGridView: Boolean;
begin
  Result := False;
end;

constructor TRMCrossView.Create;
begin
  inherited Create;
  FCross := nil;
  Typ := gtAddIn;
  BaseName := 'Cross';
  Flags := Flags + flDontUndo + flOnePerPage;
  Prop['FrameTyp'] := 15;
  Restrictions := RMrfDontEditMemo + RMrfDontSize;
  dx := 348;
  dy := 94;
  Visible := False;
  FReport := CurReport;
  RMCrossList.Add(Self);

  PShowRowTotal := True; PShowColTotal := True;
  PShowIndicator := False;
  FInternalFrame := True;
  FColWidth := 0; FColHeight := 0;
  FRowWidth := 0; FRowHeight := 0;
end;

destructor TRMCrossView.Destroy;
var
  i: Integer;
  p: TRMPage;

  procedure Del(s: string);
  var
    v: TRMView;
  begin
    if p <> nil then
    begin
      v := p.FindObject(s);
      if v <> nil then
        p.Delete(p.Objects.IndexOf(v));
    end;
  end;

begin
  p := nil;
  for i := 0 to FReport.Pages.Count - 1 do
  begin
    if FReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      p := FReport.Pages[i];
      Break;
    end;
  end;

  Del('ColumnHeaderMemo' + Name);
  Del('ColumnTotalMemo' + Name);
  Del('GrandColumnTotalMemo' + Name);
  Del('RowHeaderMemo' + Name);
  Del('CellMemo' + Name);
  Del('RowTotalMemo' + Name);
  Del('GrandRowTotalMemo' + Name);
  Del('ColHeaderMemo' + Name);
  Del('IndicatorMemo' + Name);
  RMCrossList.Delete(Self);
  inherited Destroy;
end;

type
  THackMemoView = class(TRMMemoView)
  end;

function TRMCrossView.OneObject(p: TRMPage; Name1, Name2: string): TRMMemoView;
begin
  Result := TRMMemoView(RMCreateObject(gtMemo, ''));
  Result.Name := Name1 + Name;
  Result.Memo.Add(Name2);
  Result.Font.Style := [fsBold];
  Result.dx := 80;
  Result.dy := 18;
  Result.Visible := False;
  Result.Alignment := RMtaCenter + RMtaMiddle;
  Result.Prop['FrameTyp'] := 15;
  Result.Restrictions := RMrfDontSize + RMrfDontMove + RMrfDontDelete;
  Result.PChildView := True;
  p.Objects.Add(Result);
end;

function TRMCrossView.ParentPage: TRMPage;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to FReport.Pages.Count - 1 do
  begin
    if FReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      Result := FReport.Pages[i];
      Break;
    end;
  end;
end;

procedure TRMCrossView.CreateObjects;
var
  v: TRMMemoView;
  p: TRMPage;
begin
  p := ParentPage;

  OneObject(p, 'ColumnHeaderMemo', 'Header');

  v := OneObject(p, 'ColumnTotalMemo', 'Total');
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandColumnTotalMemo', 'Grand total');
  v.FillColor := clSilver;

  OneObject(p, 'RowHeaderMemo', 'Header');

  v := OneObject(p, 'CellMemo', 'Cell');
  v.Alignment := RMtaRight;
  v.Font.Style := [];

  v := OneObject(p, 'RowTotalMemo', 'Total');
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandRowTotalMemo', 'Grand total');
  v.FillColor := clSilver;

  OneObject(p, 'IndicatorMemo', '');
end;

procedure TRMCrossView.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('InternalFrame', [RMdtBoolean], nil);
  AddProperty('RepeatCaptions', [RMdtBoolean], nil);
  AddProperty('ShowRowTotal', [rmdtBoolean], nil);
  AddProperty('ShowColTotal', [rmdtBoolean], nil);
  AddProperty('ShowIndicator', [rmdtBoolean], nil);
  AddProperty('ColumnWidth', [rmdtInteger], nil);
  AddProperty('ColumnHeight', [rmdtInteger], nil);
  AddProperty('RowWidth', [rmdtInteger], nil);
  AddProperty('RowHeight', [rmdtInteger], nil);

  RemoveProperty('Name');
  RemoveProperty('BandAlign');
  RemoveProperty('PrintFrame');
  RemoveProperty('PrintVisible');
  RemoveProperty('FillColor');
  RemoveProperty('FrameColor');
  RemoveProperty('FrameStyle');
  RemoveProperty('FrameTyp');
  RemoveProperty('FrameWidth');
end;

procedure TRMCrossView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'INTERNALFRAME' then
    FInternalFrame := Value
  else if Index = 'REPEATCAPTIONS' then
    FRepeatCaptions := Value
  else if Index = 'SHOWHEADER' then
    FShowHeader := Value
  else if Index = 'SHOWROWTOTAL' then
    PShowRowTotal := Value
  else if Index = 'SHOWCOLTOTAL' then
    PShowColTotal := Value
  else if Index = 'SHOWINDICATOR' then
    PShowIndicator := Value
  else if Index = 'COLUMNWIDTH' then
  	FColWidth := Value
  else if Index = 'COLUMNHEIGHT' then
  	FColHeight := Value
  else if Index = 'ROWWIDTH' then
  	FRowWidth := Value
  else if Index = 'ROWHEIGHT' then
  	FRowHeight := Value;
end;

function TRMCrossView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'INTERNALFRAME' then
    Result := FInternalFrame
  else if Index = 'REPEATCAPTIONS' then
    Result := FRepeatCaptions
  else if Index = 'SHOWHEADER' then
    Result := FShowHeader
  else if Index = 'SHOWROWTOTAL' then
    Result := PShowRowTotal
  else if Index = 'SHOWCOLTOTAL' then
    Result := PShowColTotal
  else if Index = 'SHOWINDICATOR' then
    Result := PShowIndicator
  else if Index = 'COLUMNWIDTH' then
  	Result := FColWidth
  else if Index = 'COLUMNHEIGHT' then
  	Result := FColHeight
  else if Index = 'ROWWIDTH' then
  	Result := FRowWidth
  else if Index = 'ROWHEIGHT' then
  	Result := FRowHeight;
end;

procedure TRMCrossView.ShowEditor;
var