rm_cross.pas

report machine 2.3 功能强大

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

procedure TRMCrossView.Draw(Canvas: TCanvas);
var
  v: TRMView;
  bmp: TBitmap;
  p: TRMPage;
begin
  if FReport.FindObject('ColumnHeaderMemo' + Name) = nil then
    CreateObjects;
  BeginDraw(Canvas);
  CalcGaps;
  ShowBackground;
  ShowFrame;

  v := FReport.FindObject('ColumnHeaderMemo' + Name);
  v.SetBounds(x + 92, y + 8, v.dx, v.dy);
  v.Draw(Canvas);

  v := FReport.FindObject('ColumnTotalMemo' + Name);
  v.SetBounds(x + 176, y + 8, v.dx, v.dy);
  v.Draw(Canvas);

  v := FReport.FindObject('GrandColumnTotalMemo' + Name);
  v.SetBounds(x + 260, y + 8, v.dx, v.dy);
  v.Draw(Canvas);

  v := FReport.FindObject('RowHeaderMemo' + Name);
  v.SetBounds(x + 8, y + 28, v.dx, v.dy);
  v.Draw(Canvas);

  v := FReport.FindObject('CellMemo' + Name);
  v.SetBounds(x + 92, y + 28, v.dx, v.dy);
  v.Draw(Canvas);

  v := FReport.FindObject('RowTotalMemo' + Name);
  v.SetBounds(x + 8, y + 48, v.dx, v.dy);
  v.Draw(Canvas);

  v := FReport.FindObject('GrandRowTotalMemo' + Name);
  v.SetBounds(x + 8, y + 68, v.dx, v.dy);
  v.Draw(Canvas);

  v := FReport.FindObject('IndicatorMemo' + Name);
  if v = nil then
  begin
    p := ParentPage;
    v := OneObject(p, 'IndicatorMemo', '');
  end;
  v.SetBounds(x + 8, y + 8, v.dx, v.dy);
  v.Draw(Canvas);

  bmp := TBitmap.Create;
  try
    bmp.Handle := LoadBitmap(hInstance, 'RM_CrossObject');
    Canvas.Draw(x + dx - 20, y + dy - 20, bmp);
  finally
    bmp.Free;
  end;
  RestoreCoord;
end;

procedure TRMCrossView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FInternalFrame := RMReadBoolean(Stream);
  FRepeatCaptions := RMReadBoolean(Stream);
  FShowHeader := RMReadBoolean(Stream);

	if RMVersion * 100 + HVersion * 10 + LVersion > 38 * 100 + 0 * 10 + 0 then
  begin
		FColWidth := RMReadInteger(Stream);
  	FColHeight := RMReadInteger(Stream);
	  FRowWidth := RMReadInteger(Stream);
  	FRowHeight := RMReadInteger(Stream);
  end;
end;

procedure TRMCrossView.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteBoolean(Stream, FInternalFrame);
  RMWriteBoolean(Stream, FRepeatCaptions);
  RMWriteBoolean(Stream, FShowHeader);
  RMWriteInteger(Stream, FColWidth);
  RMWriteInteger(Stream, FColHeight);
  RMWriteInteger(Stream, FRowWidth);
  RMWriteInteger(Stream, FRowHeight);
end;

procedure TRMCrossView.DefinePopupMenu(Popup: TPopupMenu);
var
  m: TMenuItem;
begin
  m := TMenuItem.Create(Popup);
  m.Caption := 'Repeat captions'; //LoadStr(SRepeatHeader);
  m.OnClick := P1Click;
  m.Checked := FRepeatCaptions;
  Popup.Items.Add(m);

  m := TMenuItem.Create(Popup);
  m.Caption := 'Internal frame'; //LoadStr(SRepeatHeader);
  m.OnClick := P2Click;
  m.Checked := FInternalFrame;
  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.CalcWidths;
var
  i, w, maxw, h, maxh: Integer;
  v: TRMView;
  b: TBitmap;
  m: TStringList;
begin
  FFlag := True;
  FColumnWidths := VarArrayCreate([0, FCross.Columns.Count + 10], varInteger);
  FColumnHeights := VarArrayCreate([0, FCross.TopLeftSize.cy], varInteger);
  v := FReport.FindObject('CrossMemo' + Name);
  m := TStringList.Create;
  b := TBitmap.Create;
  THackMemoView(v).Canvas := b.Canvas;

  FColumnDS.First;
  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 (FRowWidth > 0) and (FColumnDs.RecNo < FCross.TopLeftSize.cx) then // WHF Modify
	    FColumnWidths[FColumnDS.RecNo] := FRowWidth
		else
  	  FColumnWidths[FColumnDS.RecNo] := maxw;
    FColumnDS.Next;
  end;
  FColumnWidths[FCross.Columns.Count] := 0;

  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 FColHeight > 0 then // WHF Modify
    	FColumnHeights[i] := FColHeight
    else
    begin
	    if maxh > v.dy then
  	    FColumnHeights[i] := maxh
    	else
      	FColumnHeights[i] := v.dy;
    end;    
    FRowDS.Next;
  end;

  THackMemoView(v).DrawMode := drAll;
  m.Free;
  b.Free;
  FFlag := False;
end;

procedure TRMCrossView.MakeBands;
var
  i, d: Integer;
  ch1, ch2, cd1, cd2: TRMBandView;
  v: TRMMemoView;
  v1: TRMView;
  p: TRMPage;
begin
  p := ParentPage;

  ch1 := TRMBandView.Create; // master header
  ch1.BandType := btMasterHeader;
  ch1.Name := 'CrossHeader1' + Name;
  ch1.SetBounds(0, 400, 0, 18);
  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, 18);
  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, 18);
  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, 18);
  p.Objects.Add(cd2);

  v := TRMMemoView.Create;
  v.Name := 'CrossMemo' + Name;
  v.SetBounds(cd2.x, cd1.y, cd2.dx, cd1.dy);
  p.Objects.Add(v);

	RM_Class.CurPage := nil;
  CalcWidths;

  ch1.dy := 0;
  d := ch1.y;
  for i := 0 to FCross.TopLeftSize.cy - 1 do
  begin
    v := TRMMemoView.Create;
    v.SetBounds(cd2.x, d, cd2.dx, FColumnHeights[i]);
    v.Name := 'CrossMemo_' + IntToStr(i) + Name;
    p.Objects.Add(v);
    ch1.dy := ch1.dy + FColumnHeights[i];
    d := d + FColumnHeights[i];
  end;

// WHF Add
  cd1.y := ch1.y + + ch1.dy + 30;
  if FRowHeight > 0 then
  	cd1.dy := FRowHeight;
  p.FindObject('CrossMemo' + Name).SetBounds(cd2.x, cd1.y, cd2.dx, cd1.dy);

  ch2.dx := 0;
  d := ch2.x;
  for i := 0 to FCross.TopLeftSize.cx - 1 do
  begin
    v := TRMMemoView.Create;
    v.SetBounds(d, cd1.y, FColumnWidths[i], cd1.dy);
    v.Name := 'CrossMemo' + IntToStr(i) + Name;
    p.Objects.Add(v);
    ch2.dx := ch2.dx + FColumnWidths[i];
    d := d + FColumnWidths[i];
  end;

// WHF Add
  if PShowIndicator then
  begin
    v1 := p.FindObject('IndicatorMemo' + Name);
    if v1 <> nil then
    begin
      v := TRMMemoView.Create;
      v.Name := 'IndicatorMemo0' + Name;
      v.SetBounds(ch2.x, ch1.y, FColumnWidths[0], ch1.dy);
      v.Prop['FrameTyp'] := 15;
      p.Objects.Add(v);

      v.dy := ch1.dy;
    	v.dx := 0;
		  for i := 0 to FCross.TopLeftSize.cx - 1 do
      begin
      	v.dx := v.dx + FColumnWidths[i];
      end;

      v.Flags := v1.Flags;
      v.Prop['FrameWidth'] := v1.Prop['FrameWidth'];
      v.Prop['FrameColor'] := v1.Prop['FrameColor'];
      v.Prop['FrameStyle'] := v1.Prop['FrameStyle'];
      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;
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 FColWidth > 0 then // WHF Modify
    	Width := FColWidth
    else
	    Width := FColumnWidths[ColNo - 1 + FCross.TopLeftSize.cx];
    FReport.FindObject('CrossMemo' + Name).dx := Width;
    for i := 0 to FCross.TopLeftSize.cy - 1 do
    begin
      FReport.FindObject('CrossMemo_' + IntToStr(i) + Name).dx := Width;
    end;
  end;
  if Assigned(FSavedOnPrintColumn) then
    FSavedOnPrintColumn(ColNo, Width);
end;

procedure TRMCrossView.ReportBeforePrint(Memo: TStringList; View: TRMView);
var
  v: Variant;
  s, s1: string;
  i, row, col: Integer;
  b, hd: Boolean;
  al: Integer;
  v1: TRMMemoView;

  procedure Assign(m1, m2: TRMMemoView);
  begin
    m1.Flags := m2.Flags;
    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;
    if FCross.CellItemsCount = 1 then
      m1.HighlightStr := RMParser.Str2OPZ(m2.HighlightStr)
    else
      m1.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
    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 := FRowDS.RecNo;
      col := FColumnDS.RecNo;
      if View.Name <> 'CrossMemo' + Name then
      begin
        s := Copy(View.Name, 1, Pos(Name, View.Name) - 1);
        if s[10] = '_' then
        begin
          row := StrToInt(Copy(s, 11, 255));
          if not FShowHeader then
            Inc(row);
        end
        else
          col := StrToInt(Copy(s, 10, 255));
      end;
    end;

		if col >= FCross.Columns.Count then  // whf add
    begin
		  if Assigned(FSavedOnBeforePrint) then FSavedOnBeforePrint(Memo, View);
      Exit;
    end;

    if not FShowHeader and (row = 0) then
      Inc(row);

    Assign(TRMMemoView(View), TRMMemoView(FReport.FindObject('CellMemo' + Name)));
    al := TRMMemoView(View).Alignment;

    if FInternalFrame then
      View.Prop['FrameTyp'] := 15
    else
    begin
    	View.LeftFrame.Visible := True;
      View.RightFrame.Visible := True;
      View.TopFrame.Visible := False;
      View.BottomFrame.Visible := False;
    end;

    if (row = FCross.TopLeftSize.cy + 1) and (col >= FCross.TopLeftSize.cx) then
    begin
			if View.LeftFrame.Visible and View.RightFrame.Visible then
      	View.TopFrame.Visible := True;
    end;

    if (FCross.TopLeftSize.cy = 1) and (row = 0)  then // WHF Modify
      View.Prop['FrameTyp'] := 15
    else
    begin
      v := FCross.CellByIndex[row, col, -1];
      if v <> Null then
        View.Prop['FrameTyp'] := v;
      if row = FCross.Rows.Count - 2 then
        View.Prop['FrameTyp'] := View.Prop['FrameTyp'] or RMftBottom;
      if not PShowColTotal and (col = FCross.Columns.Count - 2) then
        View.Prop['FrameTyp'] := View.Prop['FrameTyp'] or RMftRight;

      if Pos('CrossMemo_', View.Name) = 1 then
      begin
      	if RM_class.Flag_NewPage then
					View.Prop['FrameTyp'] := View.Prop['FrameTyp'] or rmftLeft
				else if View.x + View.dx + CurPage.FindObject('CrossData2' + Name).dx > CurPage.RightMargin then
        	View.Prop['FrameTyp'] := View.Prop['FrameTyp'] or rmftRight;
      end
      else if (Pos('CrossMemo', View.Name) = 1) and (CurPage <> nil) then
      begin
      	if CurPage.CurY + CurPage.FindObject('CrossData1' + Name).dy * 2 > CurPage.CurBottomY then
        	View.Prop['FrameTyp'] := View.Prop['FrameTyp'] or rmftBottom;
      end;
    end;

    hd := False;
    if (row <= FCross.TopLeftSize.cy) and (col >= FCross.TopLeftSize.cx) then // column header
    begin
      Assign(TRMMemoView(View), TRMMemoView(FReport.FindObject('ColumnHeaderMemo' + Name)));
      hd := True;
    end
    else if (col < FCross.TopLeftSize.cx) and (row > FCross.TopLeftSize.cy) then // row header
    begin
      Assign(TRMMemoView(View), TRMMemoView(FReport.FindObject('RowHeaderMemo' + Name)));
      hd := True;
    end;

    if (col = FCross.Columns.Count - 1) and (row > 0) then // grand total column