rm_cross.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,297 行 · 第 1/5 页

    begin
      THackUserDataset(FColumnDS).FRecordNo := FCross.TopLeftSize.cx;
      while not FColumnDS.EOF do
      begin
        maxw := 0;

        FRowDS.First;
        FRowDS.Next;
        while not FRowDS.EOF do
        begin
          ReportBeforePrint(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;
          FRowDS.Next;
        end;
        if FColumnWidths.Cell[FColumnDS.RecordNo] < maxw then
          FColumnWidths.Cell[FColumnDS.RecordNo] := maxw;
        FColumnDS.Next;
      end;
      FColumnWidths.Cell[FCross.Columns.Count] := 0;
    end;

    FRowDS.First;
    for i := 0 to FCross.TopLeftSize.cy do
    begin
      maxh := 0;

      FColumnDS.First;
      while not FColumnDS.EOF do
      begin
        w := v.spWidth;
        v.spWidth := 1000;
        h := RMToScreenPixels(THackMemoView(v).CalcHeight, rmutMMThousandths);
        v.spWidth := w;
        if h > maxh then
          maxh := h;
        FColumnDS.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;
      FRowDS.Next;
    end;

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

    if ShowRowTotal or ShowColumnTotal then
    begin
      THackUserDataset(FRowDS).FRecordNo := FRowDS.RangeEndCount - 1;
      FColumnDS.First;
      while not FColumnDS.EOF do
      begin
        w := v.spWidth;
        v.spWidth := 1000;
        h := RMToScreenPixels(THackMemoView(v).CalcHeight, rmutMMThousandths);
        v.spWidth := w;
        if h > FMaxGTHeight then
          FMaxGTHeight := h;
        FColumnDS.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.MakeBands;
var
  i, d, d1, dx, dh: Integer;
  lBandMasterHeader: TRMBandHeader;
  lBandMasterData: TRMBandMasterData;
  lBandCrossHeader: TRMBandCrossHeader;
  lBandCrossData: TRMBandCrossData;
  v, v1: TRMMemoView;
  lPage: TRMReportPage;
begin
  lPage := ParentPage;

  lBandMasterHeader := TRMBandHeader.Create; // master header
  lBandMasterHeader.ParentPage := lPage;
  lBandMasterHeader.Name := 'CrossHeader1' + Name;
  lBandMasterHeader.CrossDataSetName := 'ColumnDS' + Name;
  lBandMasterHeader.SetspBounds(0, 400, 0, FDefDY);
  lBandMasterHeader.ReprintOnNewPage := FRepeatCaptions;

  lBandMasterData := TRMBandMasterData.Create; // master data
  lBandMasterData.ParentPage := lPage;
  lBandMasterData.Name := 'CrossData1' + Name;
  lBandMasterData.SetspBounds(0, 500, 0, FDefDY);
  lBandMasterData.DataSetName := 'RowDS' + Name;
  lBandMasterData.CrossDataSetName := 'ColumnDS' + Name;
  lBandMasterData.Stretched := True;

  lBandCrossHeader := TRMBandCrossHeader.Create; // cross header
  lBandCrossHeader.ParentPage := lPage;
  lBandCrossHeader.Name := 'CrossHeader2' + Name;
  lBandCrossHeader.SetspBounds(lPage.spMarginLeft, 0, 60, FDefDY);
  lBandCrossHeader.ReprintOnNewPage := True;

  lBandCrossData := TRMBandCrossData.Create; // cross data
  lBandCrossData.ParentPage := lPage;
  lBandCrossData.Name := 'CrossData2' + Name;
  lBandCrossData.SetspBounds(500, 0, 60, FDefDY);

  d := lBandMasterData.spTop;
  dh := lBandMasterData.spHeight;
  for i := 0 to FCross.CellItemsCount - 1 do
  begin
    v := TRMMemoView.Create;
    v.ParentPage := lPage;
    v.Name := 'CrossMemo@' + IntToStr(i) + Name;
    v.SetspBounds(lBandCrossData.spLeft, d, lBandCrossData.spWidth, dh);
    inc(d, dh);
    lBandMasterData.spHeight := lBandMasterData.spHeight + dh;
  end;

  ParentReport.CurrentPage := nil;
  CalcWidths;

  lBandMasterHeader.spHeight := 0;
  d := lBandMasterHeader.spTop;
  for i := 0 to FCross.TopLeftSize.cy - 1 + ord(FShowHeader) do // 交叉表数据栏 + 主项标头栏
  begin
    v := TRMMemoView.Create;
    v.ParentPage := lPage;
    dh := FColumnHeights.Cell[i + Ord(not FShowHeader)];
    v.SetspBounds(lBandCrossData.spLeft, d, lBandCrossData.spWidth, dh);
    v.Name := 'CrossMemo_' + IntToStr(i) + Name;
    lBandMasterHeader.spHeight := lBandMasterHeader.spHeight + dh;
    Inc(d, dh);
  end;

  lBandMasterData.spTop := lBandMasterHeader.spTop + lBandMasterHeader.spHeight + 30;
  lBandMasterData.spHeight := FMaxCellHeight * FCross.CellItemsCount;
  dh := FMaxCellHeight;
  d := lBandMasterData.spTop;
  for i := 0 to FCross.CellItemsCount - 1 do // 交叉表数据栏 + 主项数据栏
  begin
    v := TRMMemoView(ParentReport.FindObject('CrossMemo@' + IntToStr(i) + Name));
    v.ParentPage := lPage;
    v.spTop := d;
    v.spHeight := dh;
    inc(d, dh);
  end;

  lBandCrossHeader.spWidth := 0;
  d := lBandCrossHeader.spLeft;
  for i := 0 to FCross.TopLeftSize.cx - 1 do // 交叉表标头栏 + 主项数据栏
  begin
    v := TRMMemoView.Create;
    v.ParentPage := lPage;
    if (FHeaderWidth = '') or (FHeaderWidth = '0') then
      dx := FColumnWidths.Cell[i]
    else
      dx := GetHeaderWidthByIndex(i);
    v.SetspBounds(d, lBandMasterData.spTop, dx, lBandMasterData.spHeight);
    v.Name := 'CrossMemo' + IntToStr(i) + Name;
    lBandCrossHeader.spWidth := lBandCrossHeader.spWidth + dx;
    Inc(d, dx);
  end;

  if ShowIndicator or FShowHeader then
  begin
    v1 := TRMMemoView(lPage.FindObject('CrossHeaderMemo' + Name));
    if v1 <> nil then
    begin
      d := 0;
      for i := 0 to FCross.TopLeftSize.cy - 1 do
      begin
        d := d + FColumnHeights.Cell[i + Ord(not FShowHeader)];
      end;

      v := TRMMemoView.Create;
      v.ParentPage := lPage;
      v.Name := 'IndicatorMemo0' + Name;
      v.SetspBounds(lBandCrossHeader.spLeft, lBandMasterHeader.spTop, 0, lBandMasterHeader.spHeight);
      v.LeftFrame.Visible := True;
      v.RightFrame.Visible := True;
      v.TopFrame.Visible := True;
      v.BottomFrame.Visible := True;

      v.spHeight := d;
      v.spWidth := 0;
      for i := 0 to FCross.TopLeftSize.cx - 1 do
      begin
        if (FHeaderWidth = '') or (FHeaderWidth = '0') then
          v.spWidth := v.spWidth + FColumnWidths[i]
        else
          v.spWidth := v.spWidth + GetHeaderWidthByIndex(i);
      end;

      THackMemoView(v).FFlags := THackMemoView(v1).FFlags;
      THackMemoView(v).IsChildView := False;
      v.RotationType := TRMMemoView(v1).RotationType;
      v.LeftFrame.Assign(v1.LeftFrame);
      v.RightFrame.Assign(v1.RightFrame);
      v.TopFrame.Assign(v1.TopFrame);
      v.BottomFrame.Assign(v1.BottomFrame);
      v.FillColor := v1.FillColor;
      THackMemoView(v).FDisplayFormat := THackMemoView(v1).FDisplayFormat;
      THackMemoView(v).FormatFlag := THackMemoView(v1).FormatFlag;
      v.spGapLeft := TRMMemoView(v1).spGapLeft;
      v.spGapTop := TRMMemoView(v1).spGapTop;
      v.Highlight.Assign(TRMMemoView(v1).Highlight);
      v.LineSpacing := TRMMemoView(v1).LineSpacing;
      v.CharacterSpacing := TRMMemoView(v1).CharacterSpacing;
      v.Font.Assign(TRMMemoView(v1).Font);
      v.Memo.Assign(v1.Memo);
      v.HAlign := TRMMemoView(v1).HAlign;
      v.VAlign := TRMMemoView(v1).VAlign;
    end;
  end;

  if FShowHeader then
  begin
    d := lBandMasterHeader.spTop;
    for i := 0 to FCross.TopLeftSize.cy - 1 do
      d := d + FColumnHeights.Cell[i];

    d1 := lBandCrossHeader.spLeft;
    dh := FColumnHeights.Cell[FCross.TopLeftSize.cy];
    for i := 0 to FCross.TopLeftSize.cx - 1 do
    begin
      v := TRMMemoView.Create;
      v.ParentPage := lPage;
      if (FHeaderWidth = '') or (FHeaderWidth = '0') then
        dx := FColumnWidths.Cell[i]
      else
        dx := GetHeaderWidthByIndex(i);
      v.SetspBounds(d1, d, dx, dh);
      v.Name := 'CrossMemo~' + IntToStr(FCross.TopLeftSize.cy) + '~' + IntToStr(i) + Name;
      Inc(d1, dx);
    end;
  end;
end;

procedure TRMCrossView.ReportPrintColumn(ColNo: Integer; var Width: 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
      Width := FColumnWidths.Cell[ColNo - 1 + FCross.TopLeftSize.cx]
    else
      Width := FDataWidth;

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

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

  if Assigned(FSavedOnPrintColumn) then
    FSavedOnPrintColumn(ColNo, Width);
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.ReportBeforePrint(aMemo: TStrings; aView: TRMReportView);
var
  v: Variant;
  s, s1: string;
  i, j, row, col, ColCount: Integer;
  hd: Boolean;
  lHAlign: TRMHAlign;
  lVAlign: TRMVAlign;
  v1: 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;
    row := FRowDS.RecordNo;
    col := FColumnDS.RecordNo;
    if not FFlag then
    begin
      while FRowDS.RecordNo <= FCross.TopLeftSize.cy do
        FRowDS.Next;
      while FColumnDS.RecordNo < FCross.TopLeftSize.cx do
        FColumnDS.Next;
      row := FRowDS.RecordNo;
      col := FColumnDS.RecordNo;
      if aView.Name <> 'CrossMemo@0' + Name then
      begin
        s := Copy(aView.Name, 1, Pos(Name, aView.Name) - 1);
        if s[10] in ['_', '@', '~'] then
        begin
          if s[10] = '@' then
            i := StrToInt(Copy(s, 11, 255))
          else if s[10] = '~' then
          begin
            Delete(s, 1, 10);
            row := StrToInt(Copy(s, 1, Pos('~', s) - 1));
            Delete(s, 1, Pos('~', s));
            col := StrToInt(s);
          end
          else
          begin
            row := StrToInt(Copy(s, 11, 255));
            if not FShowHeader then
              Inc(row);
          end;
        end
        else
          col := StrToInt(Copy(s, 10, 255));
      end;
    end
    else if aView.Name <> 'CrossMemo' + Name then
    begin
      s := Copy(aView.Name, 1, Pos(Name, aView.Name) - 1);
      if s[10] = '@' then
        i := StrToInt(Copy(s, 11, 255));
    end;

    if not FShowHeader and (Row = 0) then
      Inc(Row);
    if not FFlag then
    begin
      if row <= FCross.TopLeftSize.cy then
        aView.spHeight := FColumnHeights.Cell[Row];
      aView.Visible := True;
      if Col < FCross.TopLeftSize.cx then
      begin
        if (FHeaderWidth = '') or (FHeaderWidth = '0') then
          aView.spWidth := FColumnWidths.Cell[Col]
        else
          aView.spWidth := GetHeaderWidthByIndex(Col);
      end
      else if FDataWidth <= 0 then
        aView.spWidth := FColumnWidths.Cell[Col]
      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 (row = FCross.TopLeftSize.cy + 1) and (col >= FCross.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;

    v := FCross.CellByIndex[row, col, -1];
    if v <> Null then
    begin
      aView.LeftFrame.Visible := (v and rmftLeft) = rmftLeft;
      aView.RightFrame.Visible := (v and rmftRight) = rmftRight;
      aView.TopFrame.Visible := (v and rm