rm_cross.pas

这是一个功能强大

        v := 0;
        if lField.Value <> Null then
          v := 1;
      end
      else
        v := lField.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 TRMCrossArray.GetIsTotalRow(Index: Integer): Boolean;
begin
  Result := Pos('+;+', Rows[Index]) <> 0;
end;

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

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

constructor TRMQuickIntArray.Create(Length: Integer);
begin
  inherited Create;

  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)
  else
    Result := s;
end;

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

destructor TRMCrossList.Destroy;
begin
  FreeAndNil(FList);
  inherited Destroy;
end;

procedure TRMCrossList.Add(v: TRMCrossView);
begin
  FList.Add(v);
  v.FSavedOnBeforePrint := v.ParentReport.OnBeforePrint;
  v.ParentReport.OnBeforePrint := v.OnReportBeforePrintEvent;
  v.FSavedOnPrintColumn := v.ParentReport.OnPrintColumn;
  v.ParentReport.OnPrintColumn := v.OnReportPrintColumnEvent;
end;

procedure TRMCrossList.Delete(v: TRMCrossView);
var
  i: Integer;
  v1: TRMCrossView;
begin
  v.ParentReport.OnBeforePrint := v.FSavedOnBeforePrint;
  v.ParentReport.OnPrintColumn := v.FSavedOnPrintColumn;

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

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

  for i := 1 to FList.Count - 1 do
  begin
    v := TRMCrossView(FList[i]);
    v1 := TRMCrossView(FList[i - 1]);
    v.FSavedOnBeforePrint := v1.OnReportBeforePrintEvent;
    v.FSavedOnPrintColumn := v1.OnReportPrintColumnEvent;
  end;
end;

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

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

function TRMCrossView.IsCrossView: Boolean;
begin
  Result := True;
end;

constructor TRMCrossView.Create;
begin
  inherited Create;
  FCrossArray := nil;
  BaseName := 'Cross';

  DontUndo := True;
  OnePerPage := True;
  Restrictions := [rmrtDontSize, rmrtDontEditMemo];
  spWidth := 348;
  spHeight := 94;
  Visible := False;
  LeftFrame.Visible := True;
  TopFrame.Visible := True;
  RightFrame.Visible := True;
  BottomFrame.Visible := True;

  ParentReport := RMCurReport;
  RMCrossList.Add(Self);

  ShowRowTotal := True;
  ShowColumnTotal := True;
  ShowIndicator := True;
  SortColHeader := True;
  SortRowHeader := True;
  FInternalFrame := True;
  FDataWidth := 0; FDataHeight := 0;
  FHeaderWidth := '0';
  FHeaderHeight := '0';
  FDefDY := 18;

  FDictionary := TStringList.Create;
  FAddColumnsHeader := TStringList.Create;
end;

destructor TRMCrossView.Destroy;
var
  i: Integer;
  lPage: TRMReportPage;

  procedure _Del(s: string);
  var
    t: TRMView;
  begin
    if lPage <> nil then
    begin
      t := lPage.FindObject(s);
      if t <> nil then
        lPage.Delete(lPage.Objects.IndexOf(t));
    end;
  end;

begin
  lPage := nil;
  for i := 0 to ParentReport.Pages.Count - 1 do
  begin
    if ParentReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      lPage := TRMReportPage(ParentReport.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('CrossHeaderMemo' + Name);

  RMCrossList.Delete(Self);

  FreeAndNil(FDictionary);
  FreeAndNil(FAddColumnsHeader);

  inherited Destroy;
end;

type
  THackReport = class(TRMReport)
  end;

  THackReportPage = class(TRMReportPage)
  end;

  THackReportView = class(TRMReportView)
  end;

  THackMemoView = class(TRMMemoView)
  end;

  THackUserDataset = class(TRMUserDataset)
  end;

function TRMCrossView.OneObject(aPage: TRMReportPage; Name1, Name2: string): TRMMemoView;
begin
  Result := TRMMemoView(RMCreateObject(rmgtMemo, ''));
  Result.ParentPage := aPage;
  Result.Name := Name1 + Name;
  Result.Memo.Add(Name2);
  Result.Font.Style := [fsBold];
  Result.spWidth := 80;
  Result.spHeight := FDefDY;
  Result.HAlign := rmHCenter;
  Result.VAlign := rmVCenter;
  Result.LeftFrame.Visible := True;
  Result.RightFrame.Visible := True;
  Result.TopFrame.Visible := True;
  Result.BottomFrame.Visible := True;
  Result.Restrictions := [rmrtDontSize, rmrtDontMove, rmrtDontDelete];
  THackMemoView(Result).IsChildView := True;
  Result.Visible := False;
end;

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

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

  OneObject(p, 'ColumnHeaderMemo', RMLoadStr(rmRes + 755)); //'Header'

  v := OneObject(p, 'ColumnTotalMemo', RMLoadStr(rmRes + 756)); //'Total'
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandColumnTotalMemo', RMLoadStr(rmRes + 757)); //'Grand total'
  v.FillColor := clSilver;

  OneObject(p, 'RowHeaderMemo', RMLoadStr(rmRes + 755)); //'Header'

  v := OneObject(p, 'CellMemo', RMLoadStr(rmRes + 758)); //'Cell'
  v.Font.Style := [];

  v := OneObject(p, 'RowTotalMemo', RMLoadStr(rmRes + 756)); //'Total'
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandRowTotalMemo', RMLoadStr(rmRes + 757)); //'Grand total'
  v.FillColor := clSilver;

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

procedure TRMCrossView.ShowEditor;
var
  tmp: TRMCrossForm;
begin
  tmp := TRMCrossForm.Create(Application);
  try
    tmp.Cross := Self;
    tmp.ShowModal;
  finally
    tmp.Free;
  end;
end;

procedure TRMCrossView.Draw(aCanvas: TCanvas);
var
  v: TRMView;
  bmp, lBmp2: TBitmap;
  p: TRMReportPage;

  procedure _Draw(t: TRMView);
  begin
    t.Draw(aCanvas);
    if TRMMemoView(t).Highlight.Condition <> '' then
      aCanvas.Draw(t.spLeft_Designer + 1, t.spTop_Designer + 1, lBmp2);
  end;

begin
  if ParentReport.FindObject('ColumnHeaderMemo' + Name) = nil then
    CreateObjects;

  BeginDraw(aCanvas);
  CalcGaps;
  ShowBackground;
  ShowFrame;
  bmp := TBitmap.Create;
  lBmp2 := TBitmap.Create;
  try
    lBmp2.LoadFromResourceName(hInstance, 'RM_HIGHLIGHT');

    v := ParentReport.FindObject('ColumnHeaderMemo' + Name);
    v.SetspBounds(spLeft + 92, spTop + 8, v.spWidth, v.spHeight);
    _Draw(v);

    v := ParentReport.FindObject('ColumnTotalMemo' + Name);
    v.SetspBounds(spLeft + 176, spTop + 8, v.spWidth, v.spHeight);
    _Draw(v);

    v := ParentReport.FindObject('GrandColumnTotalMemo' + Name);
    v.SetspBounds(spLeft + 260, spTOp + 8, v.spWidth, v.spHeight);
    _Draw(v);

    v := ParentReport.FindObject('RowHeaderMemo' + Name);
    v.SetspBounds(spLeft + 8, spTop + 28, v.spWidth, v.spHeight);
    _Draw(v);

    v := ParentReport.FindObject('CellMemo' + Name);
    v.SetspBounds(spLeft + 92, spTop + 28, v.spWidth, v.spHeight);
    _Draw(v);

    v := ParentReport.FindObject('RowTotalMemo' + Name);
    v.SetspBounds(spLeft + 8, spTop + 48, v.spWidth, v.spHeight);
    _Draw(v);

    v := ParentReport.FindObject('GrandRowTotalMemo' + Name);
    v.SetspBounds(spLeft + 8, spTop + 68, v.spWidth, v.spHeight);
    _Draw(v);

    v := ParentReport.FindObject('CrossHeaderMemo' + Name);
    if v = nil then
    begin
      p := ParentPage;
      v := OneObject(p, 'CrossHeaderMemo', '');
    end;
    v.SetspBounds(spLeft + 8, spTop + 8, v.spWidth, v.spHeight);
    _Draw(v);

    bmp.Handle := LoadBitmap(hInstance, 'RM_CrossObject');
    aCanvas.Draw(spLeft + spWidth - 20, spTop + spHeight - 20, bmp);
  finally
    bmp.Free;
    lBmp2.Free;
    RestoreCoord;
  end;
end;

procedure TRMCrossView.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FInternalFrame := RMReadBoolean(aStream);
  FRepeatCaptions := RMReadBoolean(aStream);
  FShowHeader := RMReadBoolean(aStream);
  FDataWidth := RMReadInt32(aStream);
  FDataHeight := RMReadInt32(aStream);
  FHeaderWidth := RMReadString(aStream);
  FHeaderHeight := RMReadString(aStream);
  FDictionary.Text := RMReadString(aStream);
  FRowNoHeader := RMReadString(aStream);
  RMReadMemo(aStream, FAddColumnsHeader);
  OnePerPage := True;
end;

procedure TRMCrossView.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteBoolean(aStream, FInternalFrame);
  RMWriteBoolean(aStream, FRepeatCaptions);
  RMWriteBoolean(aStream, FShowHeader);
  RMWriteInt32(aStream, FDataWidth);
  RMWriteInt32(aStream, FDataHeight);
  RMWriteString(aStream, FHeaderWidth);
  RMWriteString(aStream, FHeaderHeight);
  RMWriteString(aStream, FDictionary.Text);
  RMWriteString(aStream, FRowNoHeader);
  RMWriteMemo(aStream, FAddColumnsHeader);
end;

procedure TRMCrossView.CalcWidths;
var
  i, w, maxw, h, maxh, k: Integer;
  v: TRMView;
  b: TBitmap;
  m: TWideStringList;
begin
  ParentReport.CurrentPage := ParentPage;

  FFlag := True;
  if FDataWidth <= 0 then
    FColumnWidths := TRMQuickIntArray.Create(FCrossArray.Columns.Count + 1)
  else if (FHeaderWidth = '') or (FHeaderWidth = '0') then
    FColumnWidths := TRMQuickIntArray.Create(FCrossArray.TopLeftSize.cx + 1);

  FColumnHeights := TRMQuickIntArray.Create(FCrossArray.TopLeftSize.cy + 2);
  FLastTotalCol := TRMQuickIntArray.Create(FCrossArray.TopLeftSize.cy + 1);

  if FDataHeight > 0 then