rm_cross.pas

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

  m.Caption := RMLoadStr(rmRes + 763); //'Show header';
  m.OnClick := P3Click;
  m.Checked := FShowHeader;
  Popup.Items.Add(m);
end;

procedure TRMCrossView.P1Click(Sender: TObject);
begin
  RMDesigner.BeforeChange;
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    if (Restrictions and RMrfDontModify) = 0 then
      FRepeatCaptions := Checked;
  end;
  RMDesigner.AfterChange;
end;

procedure TRMCrossView.P2Click(Sender: TObject);
begin
  RMDesigner.BeforeChange;
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    if (Restrictions and RMrfDontModify) = 0 then
      FInternalFrame := Checked;
  end;
  RMDesigner.AfterChange;
end;

procedure TRMCrossView.P3Click(Sender: TObject);
begin
  RMDesigner.BeforeChange;
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    if (Restrictions and rmrfDontModify) = 0 then
      FShowHeader := Checked;
  end;
  RMDesigner.AfterChange;
end;

procedure TRMCrossView.CalcWidths;
var
  i, w, maxw, h, maxh, k: Integer;
  v: TRMView;
  b: TBitmap;
  m: TStringList;
begin
  FFlag := True;
  if FDataWidth <= 0 then
    FColumnWidths := TRMQuickIntArray.Create(FCross.Columns.Count + 1)
  else if (FHeaderWidth = '') or (FHeaderWidth = '0') then
    FColumnWidths := TRMQuickIntArray.Create(FCross.TopLeftSize.cx + 1);

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

  if FDataHeight > 0 then
    FMaxCellHeight := FDataHeight
  else
    FMaxCellHeight := 0;
  FMaxGTHeight := 0;

  if not PShowRowTotal then
    FRowDS.RangeEndCount := FRowDS.RangeEndCount - 1;
  if not PShowColTotal then
    FColumnDS.RangeEndCount := FColumnDS.RangeEndCount - 1;

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

    if (FHeaderWidth = '') or (FHeaderWidth = '0') then
    begin
      FColumnDS.First;
      while FColumnDS.RecNo < FCross.TopLeftSize.cx do
      begin
        maxw := 0;

        FRowDS.First;
        FRowDS.Next;
        while not FRowDS.EOF do
        begin
          ReportBeforePrint(nil, 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.RecNo] < maxw then
          FColumnWidths.Cell[FColumnDS.RecNo] := maxw;
        FColumnDS.Next;
      end;
    end;

    if FDataWidth <= 0 then
    begin
      THackUserDataset(FColumnDS).FRecNo := FCross.TopLeftSize.cx;
      while not FColumnDS.EOF do
      begin
        maxw := 0;

        FRowDS.First;
        FRowDS.Next;
        while not FRowDS.EOF do
        begin
          ReportBeforePrint(nil, 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.RecNo] < maxw then
          FColumnWidths.Cell[FColumnDS.RecNo] := 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.dx;
        v.dx := 1000;
        h := THackMemoView(v).CalcHeight;
        v.dx := w;
        if h > maxh then
          maxh := h;
        FColumnDS.Next;
      end;

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

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

    if PShowRowTotal or PShowColTotal then
    begin
      THackUserDataset(FRowDS).FRecNo := FRowDS.RangeEndCount - 1;
      FColumnDS.First;
      while not FColumnDS.EOF do
      begin
        w := v.dx;
        v.dx := 1000;
        h := THackMemoView(v).CalcHeight;
        v.dx := w;
        if h > FMaxGTHeight then
          FMaxGTHeight := h;
        FColumnDS.Next;
      end;
    end;

    THackMemoView(v).DrawMode := drAll;
    m.Free;
    b.Free;
  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;
  ch1, ch2, cd1, cd2: TRMBandView;
  v: TRMMemoView;
  p: TRMPage;
  v1: TRMView;
begin
  p := ParentPage;

  ch1 := TRMBandView.Create; // master header
  ch1.BandType := btMasterHeader;
  ch1.Name := 'CrossHeader1' + Name;
  ch1.SetBounds(0, 400, 0, FDefDY);
  if FRepeatCaptions then
    ch1.Prop['RepeatHeader'] := True;
  p.Objects.Add(ch1);

  cd1 := TRMBandView.Create; // master data
  cd1.BandType := btMasterData;
  cd1.Name := 'CrossData1' + Name;
  cd1.SetBounds(0, 500, 0, FDefDY);
  cd1.DataSet := 'RowDS' + Name;
  cd1.Prop['Stretched'] := True;
  p.Objects.Add(cd1);

  ch2 := TRMBandView.Create; // cross header
  ch2.BandType := btCrossHeader;
  ch2.Name := 'CrossHeader2' + Name;
  ch2.SetBounds(p.LeftMargin, 0, 60, FDefDY);
  if FRepeatCaptions then
    ch2.Prop['RepeatHeader'] := True;
  p.Objects.Add(ch2);

  cd2 := TRMBandView.Create; // cross data
  cd2.BandType := btCrossData;
  cd2.Name := 'CrossData2' + Name;
  cd2.DataSet := 'CrossHeader1' + Name + '=ColumnDS' + Name + ';CrossData1' + Name + '=ColumnDS' + Name + ';';
  cd2.SetBounds(500, 0, 60, FDefDY);
  p.Objects.Add(cd2);

  d := cd1.y;
  dh := cd1.dy;
  for i := 0 to FCross.CellItemsCount - 1 do
  begin
    v := TRMMemoView.Create;
    v.Name := 'CrossMemo@' + IntToStr(i) + Name;
    v.SetBounds(cd2.x, d, cd2.dx, dh);
    p.Objects.Add(v);
    inc(d, dh);
    inc(cd1.dy, dh);
  end;

  RM_Class.CurPage := nil;
  CalcWidths;

  ch1.dy := 0;
  d := ch1.y;
  for i := 0 to FCross.TopLeftSize.cy - 1 + ord(FShowHeader) do // 交叉表数据栏 + 主项标头栏
  begin
    v := TRMMemoView.Create;
    dh := FColumnHeights.Cell[i + Ord(not FShowHeader)];
    v.SetBounds(cd2.x, d, cd2.dx, dh);
    v.Name := 'CrossMemo_' + IntToStr(i) + Name;
    p.Objects.Add(v);
    Inc(ch1.dy, dh);
    Inc(d, dh);
  end;

  cd1.y := ch1.y + +ch1.dy + 30;
  cd1.dy := FMaxCellHeight * FCross.CellItemsCount;
  dh := FMaxCellHeight;
  d := cd1.y;
  for i := 0 to FCross.CellItemsCount - 1 do // 交叉表数据栏 + 主项数据栏
  begin
    v := TRMMemoView(FReport.FindObject('CrossMemo@' + IntToStr(i) + Name));
    v.y := d;
    v.dy := dh;
    inc(d, dh);
  end;

  ch2.dx := 0;
  d := ch2.x;
  for i := 0 to FCross.TopLeftSize.cx - 1 do // 交叉表标头栏 + 主项数据栏
  begin
    v := TRMMemoView.Create;
    if (FHeaderWidth = '') or (FHeaderWidth = '0') then
      dx := FColumnWidths.Cell[i]
    else
      dx := GetHeaderWidth(i);
    v.SetBounds(d, cd1.y, dx, cd1.dy);
    v.Name := 'CrossMemo' + IntToStr(i) + Name;
    p.Objects.Add(v);
    Inc(ch2.dx, dx);
    Inc(d, dx);
  end;

  if PShowIndicator or FShowHeader then
  begin
    v1 := p.FindObject('IndicatorMemo' + 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.Name := 'IndicatorMemo0' + Name;
      v.SetBounds(ch2.x, ch1.y, 0, ch1.dy);
      v.Prop['FrameTyp'] := 15;
      p.Objects.Add(v);

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

      v.Flags := v1.Flags and not flChildView;
      v.Flags1 := v1.Flags;
      v.RotationType := TRMMemoView(v1).RotationType;
      v.Prop['FrameWidth'] := v1.Prop['FrameWidth'];
      v.Prop['FrameColor'] := v1.Prop['FrameColor'];
      v.Prop['FrameStyle'] := v1.Prop['FrameStyle'];
      v.LeftRightFrame := v1.LeftRightFrame;
      v.FillColor := v1.FillColor;
      v.Format := v1.Format;
      v.FormatStr := v1.FormatStr;
      v.gapx := v1.gapx;
      v.gapy := v1.gapy;
      v.Alignment := TRMMemoView(v1).Alignment;
      v.Highlight := TRMMemoView(v1).Highlight;
      v.LineSpacing := TRMMemoView(v1).LineSpacing;
      v.CharacterSpacing := TRMMemoView(v1).CharacterSpacing;
      v.Font := TRMMemoView(v1).Font;
      v.Memo.Assign(v1.Memo);
    end;
  end;

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

    d1 := ch2.x;
    dh := FColumnHeights.Cell[FCross.TopLeftSize.cy];
    for i := 0 to FCross.TopLeftSize.cx - 1 do
    begin
      v := TRMMemoView.Create;
      if (FHeaderWidth = '') or (FHeaderWidth = '0') then
        dx := FColumnWidths.Cell[i]
      else
        dx := GetHeaderWidth(i);
      v.SetBounds(d1, d, dx, dh);
      v.Name := 'CrossMemo~' + IntToStr(FCross.TopLeftSize.cy) + '~' + IntToStr(i) + Name;
      p.Objects.Add(v);
      Inc(d1, dx);
    end;
  end;
end;

procedure TRMCrossView.ReportPrintColumn(ColNo: Integer; var Width: Integer);
var
  i: Integer;
begin
  if not FSkip and (Pos(Name, CurView.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
      FReport.FindObject('CrossMemo@' + IntToStr(i) + Name).dx := Width;

    if FRowDS.RecNo < FCross.TopLeftSize.cy then
    begin
      for i := 0 to FCross.TopLeftSize.cy - 1 do
        FReport.FindObject('CrossMemo_' + IntToStr(i) + Name).dx := 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(Memo: TStringList; View: TRMView);
var
  v: Variant;
  s, s1: string;
  i, j, row, col, ColCount: Integer;
  hd: Boolean;
  al: Integer;
  v1: TRMMemoView;
  ft: Word;

  procedure Assign(m1, m2: TRMMemoView);
  begin
    m1.Flags := m2.Flags and not flChildView;
    m1.Flags1 := m2.Flags1;
    m1.RotationType := m2.RotationType;
    m1.Prop['FrameWidth'] := m2.Prop['FrameWidth'];
    m1.Prop['FrameColor'] := m2.Prop['FrameColor'];
    m1.Prop['FrameStyle'] := m2.Prop['FrameStyle'];
    m1.FillColor := m2.FillColor;
    m1.Format := m2.Format;
    m1.FormatStr := m2.FormatStr;
    m1.gapx := m2.gapx;
    m1.gapy := m2.gapy;
    m1.Alignment := m2.Alignment;
    m1.Highlight := m2.Highlight;
    m1.HighlightStr := RMParser.Str2OPZ(m2.HighlightStr);
    m1.LineSpacing := m2.LineSpacing;
    m1.CharacterSpacing := m2.CharacterSpacing;
    m1.Font := m2.Font;
  end;

begin
  if (not FSkip) and (Pos('CrossMemo', View.Name) = 1) and (Pos(Name, View.Name) <> 0) then
  begin
    i := 0;
    row := FRowDS.RecNo;
    col := FColumnDS.RecNo;
    if not FFlag then
    begin
      while FRowDS.RecNo <= FCross.TopLeftSize.cy do
        FRowDS.Next;
      while FColumnDS.RecNo < FCross.TopLeftSize.cx do
        FColumnDS.Next;
      row :=