rm_cross.pas

这是一个功能强大

    FMaxCellHeight := FDataHeight
  else
    FMaxCellHeight := 0;

  FMaxGTHeight := 0;
  if not ShowRowTotal then
    FRowDataSet.RangeEndCount := FRowDataSet.RangeEndCount - 1;
  if not ShowColumnTotal then
    FColumnDataSet.RangeEndCount := FColumnDataSet.RangeEndCount - 1;

  for k := 0 to FCrossArray.CellItemsCount - 1 do
  begin
    v := ParentReport.FindObject('CrossMemo@' + IntToStr(k) + Name);
    m := TWideStringList.Create;
    b := TBitmap.Create;
    THackMemoView(v).Canvas := b.Canvas;

    if (FHeaderWidth = '') or (FHeaderWidth = '0') then
    begin
      FColumnDataSet.First;
      while FColumnDataSet.RecordNo < FCrossArray.TopLeftSize.cx do
      begin
        maxw := 0;

        FRowDataSet.First;
        FRowDataSet.Next;
        while not FRowDataSet.EOF do
        begin
          OnReportBeforePrintEvent(nil, TRMReportView(v));
          m.Assign(v.Memo);
          if m.Count = 0 then
            m.Add(' ');
          w := THackMemoView(v).CalcWidth(m) + 5;
          if w > maxw then
            maxw := w;
          FRowDataSet.Next;
        end;
        if FColumnWidths.Cell[FColumnDataSet.RecordNo] < maxw then
          FColumnWidths.Cell[FColumnDataSet.RecordNo] := maxw;
        FColumnDataSet.Next;
      end;
    end;

    if FDataWidth <= 0 then
    begin
      THackUserDataset(FColumnDataSet).FRecordNo := FCrossArray.TopLeftSize.cx;
      while not FColumnDataSet.EOF do
      begin
        maxw := 0;

        FRowDataSet.First;
        FRowDataSet.Next;
        while not FRowDataSet.EOF do
        begin
          OnReportBeforePrintEvent(nil, TRMReportView(v));
          m.Assign(v.Memo);
          if m.Count = 0 then
            m.Add(' ');
          w := THackMemoView(v).CalcWidth(m) + 5;
          if w > maxw then
            maxw := w;
          FRowDataSet.Next;
        end;
        if FColumnWidths.Cell[FColumnDataSet.RecordNo] < maxw then
          FColumnWidths.Cell[FColumnDataSet.RecordNo] := maxw;
        FColumnDataSet.Next;
      end;
      FColumnWidths.Cell[FCrossArray.Columns.Count] := 0;
    end;

    FRowDataSet.First;
    for i := 0 to FCrossArray.TopLeftSize.cy do
    begin
      maxh := 0;

      FColumnDataSet.First;
      while not FColumnDataSet.EOF do
      begin
        w := v.spWidth;
        v.spWidth := 1000;
        h := RMToScreenPixels(THackMemoView(v).CalcHeight, rmutMMThousandths);
        v.spWidth := w;
        if h > maxh then
          maxh := h;
        FColumnDataSet.Next;
      end;

      if (FHeaderHeight <> '') and (FHeaderHeight <> '0') then // WHF Modify
      begin
        FColumnHeights.Cell[i] := GetHeaderHeightByIndex(i);
      end
      else
      begin
        if maxh > v.spHeight then
          FColumnHeights.Cell[i] := maxh
        else
          FColumnHeights.Cell[i] := v.spHeight;
      end;
      FRowDataSet.Next;
    end;

    FColumnDataSet.First;
    while not FColumnDataSet.EOF do
    begin
      w := v.spWidth;
      v.spWidth := 1000;
      h := RMToScreenPixels(THackMemoView(v).CalcHeight, rmutMMThousandths);
      v.spWidth := w;
      if h > FMaxCellHeight then
        FMaxCellHeight := h;
      FColumnDataSet.Next;
    end;

    if ShowRowTotal or ShowColumnTotal then
    begin
      THackUserDataset(FRowDataSet).FRecordNo := FRowDataSet.RangeEndCount - 1;
      FColumnDataSet.First;
      while not FColumnDataSet.EOF do
      begin
        w := v.spWidth;
        v.spWidth := 1000;
        h := RMToScreenPixels(THackMemoView(v).CalcHeight, rmutMMThousandths);
        v.spWidth := w;
        if h > FMaxGTHeight then
          FMaxGTHeight := h;
        FColumnDataSet.Next;
      end;
    end;

    THackMemoView(v).DrawMode := rmdmAll;
    FreeAndNil(m);
    FreeAndNil(b);
  end;

  if FMaxCellHeight < FDefDy then
    FMaxCellHeight := FDefDY;
  if FMaxGTHeight < FDefDy then
    FMaxGTHeight := FDefDY;
  FFlag := False;
  FLastX := 0;
end;

procedure TRMCrossView.OnReportPrintColumnEvent(aColNo: Integer; var aWidth: Integer);
var
  i: Integer;
  lCurView: TRMView;
begin
  lCurView := ParentReport.CurrentView;
  if (not FSkip) and (Pos(Name, lCurView.Name) > 0) then
  begin
    if FDataWidth <= 0 then
      aWidth := FColumnWidths.Cell[aColNo - 1 + FCrossArray.TopLeftSize.cx]
    else
      aWidth := FDataWidth;

    for i := 0 to FCrossArray.CellItemsCount - 1 do
      ParentReport.FindObject('CrossMemo@' + IntToStr(i) + Name).spWidth := aWidth;

    if FRowDataSet.RecordNo < FCrossArray.TopLeftSize.cy then
    begin
      for i := 0 to FCrossArray.TopLeftSize.cy - 1 do
        ParentReport.FindObject('CrossMemo_' + IntToStr(i) + Name).spWidth := aWidth;
    end;
  end;

  if Assigned(FSavedOnPrintColumn) then
    FSavedOnPrintColumn(aColNo, aWidth);
end;

function _GetString(S: string; N: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(S) do
  begin
    if S[i] = ';' then
      Dec(N)
    else if N = 1 then
      Result := Result + s[i]
    else if N = 0 then
      break;
  end;
end;

function _GetPureString(S: string; N: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(S) do
  begin
    if S[i] = ';' then
      Dec(N)
    else if N = 1 then
      Result := Result + s[i]
    else if N = 0 then
      break;
  end;
  Result := PureName1(Result);
end;

procedure TRMCrossView.OnReportBeforePrintEvent(aMemo: TWideStringList; aView: TRMReportView);
var
  lValue: Variant;
  lStr: WideString;
  lStr1: WideString;
  i, j, lRow, lCol, lColCount: Integer;
  lRowHeaderFlag: Boolean;
  lHAlign: TRMHAlign;
  lVAlign: TRMVAlign;
  t: TRMMemoView;
  ft: Word;
  lCurPage: THackReportPage;
  lCurBand: TRMBand;

  procedure _Assign(m1, m2: TRMMemoView);
  begin
    m1.RotationType := m2.RotationType;
    m1.FillColor := m2.FillColor;
    THackMemoView(m1).FDisplayFormat := THackMemoView(m2).FDisplayFormat;
    THackMemoView(m1).FormatFlag := THackMemoView(m2).FormatFlag;
    m1.spGapLeft := m2.spGapLeft;
    m1.spGapTop := m2.spGapTop;
    m1.Highlight.Assign(m2.Highlight);
    m1.LineSpacing := m2.LineSpacing;
    m1.CharacterSpacing := m2.CharacterSpacing;
    m1.Font := m2.Font;
    m1.HAlign := TRMMemoView(m2).HAlign;
    m1.VAlign := TRMMemoView(m2).VAlign;
  end;

begin
  lCurPage := THackReportPage(ParentReport.CurrentPage);
  lCurBand := ParentReport.CurrentBand;

  if (not FSkip) and (Pos('CrossMemo', aView.Name) = 1) and (Pos(Name, aView.Name) > 0) then
  begin
    i := 0;
    lRow := FRowDataSet.RecordNo;
    lCol := FColumnDataSet.RecordNo;
    if not FFlag then
    begin
      while FRowDataSet.RecordNo <= FCrossArray.TopLeftSize.cy do
        FRowDataSet.Next;
      while FColumnDataSet.RecordNo < FCrossArray.TopLeftSize.cx do
        FColumnDataSet.Next;
      lRow := FRowDataSet.RecordNo;
      lCol := FColumnDataSet.RecordNo;
      if aView.Name <> 'CrossMemo@0' + Name then
      begin
        lStr := Copy(aView.Name, 1, Pos(Name, aView.Name) - 1);
        if (lStr[10] = '_') or (lStr[10] = '@') or (lStr[10] = '~') then
        begin
          if lStr[10] = '@' then
            i := StrToInt(Copy(lStr, 11, 255))
          else if lStr[10] = '~' then
          begin
            Delete(lStr, 1, 10);
            lRow := StrToInt(Copy(lStr, 1, Pos('~', lStr) - 1));
            Delete(lStr, 1, Pos('~', lStr));
            lCol := StrToInt(lStr);
          end
          else
          begin
            lRow := StrToInt(Copy(lStr, 11, 255));
            if not FShowHeader then
              Inc(lRow);
          end;
        end
        else
          lCol := StrToInt(Copy(lStr, 10, 255));
      end;
    end
    else if aView.Name <> 'CrossMemo' + Name then
    begin
      lStr := Copy(aView.Name, 1, Pos(Name, aView.Name) - 1);
      if lStr[10] = '@' then
        i := StrToInt(Copy(lStr, 11, 255));
    end;

    if not FShowHeader and (lRow = 0) then
      Inc(lRow);
    if not FFlag then
    begin
      if lRow <= FCrossArray.TopLeftSize.cy then
        aView.spHeight := FColumnHeights.Cell[lRow];
      aView.Visible := True;
      if lCol < FCrossArray.TopLeftSize.cx then
      begin
        if (FHeaderWidth = '') or (FHeaderWidth = '0') then
          aView.spWidth := FColumnWidths.Cell[lCol]
        else
          aView.spWidth := GetHeaderWidthByIndex(lCol);
      end
      else if FDataWidth <= 0 then
        aView.spWidth := FColumnWidths.Cell[lCol]
      else
        aView.spWidth := FDataWidth;
    end;

    _Assign(TRMMemoView(aView), TRMMemoView(ParentReport.FindObject('CellMemo' + Name)));
    lHAlign := TRMMemoView(aView).HAlign;
    lVAlign := TRMMemoView(aView).VAlign;
    if FInternalFrame then
    begin
      aView.LeftFrame.Visible := True;
      aView.TopFrame.Visible := True;
      aView.RightFrame.Visible := True;
      aView.BottomFrame.Visible := True;
    end
    else
    begin
      aView.LeftFrame.Visible := True;
      aView.RightFrame.Visible := True;
      aView.TopFrame.Visible := False;
      aView.BottomFrame.Visible := False;
    end;

    if (lRow = FCrossArray.TopLeftSize.cy + 1) and (lCol >= FCrossArray.TopLeftSize.cx) then
    begin
      if (not aView.TopFrame.Visible) and (not aView.BottomFrame.Visible) and
        (aView.LeftFrame.Visible or aView.RightFrame.Visible) then
        aView.TopFrame.Visible := True;
    end;

    lValue := FCrossArray.CellByIndex[lRow, lCol, -1];
    if lValue <> Null then
    begin
      aView.LeftFrame.Visible := (lValue and rmftLeft) = rmftLeft;
      aView.RightFrame.Visible := (lValue and rmftRight) = rmftRight;
      aView.TopFrame.Visible := (lValue and rmftTop) = rmftTop;
      aView.BottomFrame.Visible := (lValue and rmftBottom) = rmftBottom;
    end;

    if lRow = FCrossArray.Rows.Count - 2 then
      aView.BottomFrame.Visible := True;

    if not ShowColumnTotal and (FAddColumnsHeader.Count > 0) and (lCol >= FCrossArray.Columns.Count - 1 - FAddColumnsHeader.Count) then
      lValue := FCrossArray.CellByIndex[lRow, lCol + 1, 0]
    else
      lValue := FCrossArray.CellByIndex[lRow, lCol, 0];
    if lValue = Null then
      lStr := ''
    else
      lStr := lValue;

    lRowHeaderFlag := False;
    if lRow <= FCrossArray.TopLeftSize.cy then // header
    begin
      _Assign(TRMMemoView(aView), TRMMemoView(ParentReport.FindObject('ColumnHeaderMemo' + Name)));
      if lCurPage.Flag_ColumnNewPage and (Pos('CrossMemo_', aView.Name) = 1) then
        aView.LeftFrame.Visible := True;
      lRowHeaderFlag := True;
      if not FFlag then
      begin
        if lCol >= FCrossArray.TopLeftSize.cx then
        begin
          if lRow > 0 then
          begin
            aView.Visible := (lValue <> Null) or (lCol - FLastTotalCol.Cell[lRow - 1] = 1);
            if (aView.Visible and (lCol < FCrossArray.Columns.Count - 1)) and
              (FCrossArray.CellByIndex[lRow, lCol + 1, 0] = Null) then
            begin
              for i := lCol + 1 to FCrossArray.Columns.Count - 1 do
              begin
                ft := FCrossArray.CellByIndex[lRow, i, -1];
                if FDataWidth <= 0 then
                  j := aView.spWidth + FColumnWidths.Cell[i]
                else
                  j := aView.spWidth + FDataWidth;

                if not ((ft <> rmftTop) and (ft and rmftLeft <> 0)) then
                begin
                  if aView.spLeft + j <= lCurPage.PrinterInfo.ScreenPageWidth - lCurPage.spMarginRight then
                    aView.spWidth := j
                  else
                  begin
                    FLastTotalCol.Cell[lRow - 1] := i - 1;
                    Break;
                  end;
                end
                else
                  Break;
              end;
            end;
          end
          else
          begin
            aView.Visible := (lValue <> Null) or (lCol - FLastX = 1);
            aView.TopFrame.Visible := True;
            aView.BottomFrame.Visible := True;
            aView.RightFrame.Visible := True;

            if TRMMemoView(aView).HAlign = rmHCenter then
              TRMMemoView(aView).HAlign := rmHLeft;
            if aView.Visible and (lCol < FCrossArray.Columns.Count - 1) then
            begin
              lColCount := FCrossArray.Columns.Count - 1;
              if not ShowColumnTotal then
                Dec(lColCount);
              for i := lCol + 1 to lColCount do
              begin
                if FDataWidth <= 0 then
                  j := aView.spWidth + FColumnWidths.Cell[i]
                else
                  j := aView.spWidth + FDataWidth;
                if aView.spLeft + j <= lCurPage.PrinterInfo.ScreenPageWidth - lCurPage.spMarginRight then
                  aView.spWidth := j
                else
                begin
                  FLastX := i - 1;
                  Break;
                end;
              end;
            end;
          end;
        end
        else
        begin // lRow Header
          if lRow = FCrossArray.TopLeftSize.cy then
          begin
            aView.LeftFrame.Visible := True;
            aView.TopFrame.Visible := True;
            aView.RightFrame.Visible := True;
            aView.BottomFrame.Visible := True;
          end
          else
          begin
            lValue := '';
            if lCol = FCrossArray.TopLeftSize.cx - 1 then
            begin
              aView.LeftFrame.Visible := False;
              aView.TopFrame.Visible := False;
              aView.RightFrame.Visible := True;
              aView.BottomFrame.Visible := False;
            end
            else
            begin
              aView.LeftFrame.Visible := False;
              aView.TopFrame.Visible := False;
              aView.RightFrame.Visible := False;
              aView.BottomFrame.Visible := False;
            end;
            if (lCol = 0) then
              aView.LeftFrame.Visible := True;
            if lRow = 0 then
            begin
              aView.TopFrame.Visible := True;
              if not FCrossArray.DoDataCol then
                aView.BottomFrame.Visible := True;
              if (lCol = 0) then
              beg