fr_cross.pas

FASTREPORT报表工具,可以迅速制作报表.

  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);

  Canvas.Draw(x + dx - 20, y + dy - 20, frCrossForm.Image1.Picture.Bitmap);
  RestoreCoord;
end;

procedure TfrCrossView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FInternalFrame := frReadBoolean(Stream);
  FRepeatCaptions := frReadBoolean(Stream);
  FShowHeader := frReadBoolean(Stream);
end;

procedure TfrCrossView.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  frWriteBoolean(Stream, FInternalFrame);
  frWriteBoolean(Stream, FRepeatCaptions);
  frWriteBoolean(Stream, FShowHeader);
end;

procedure TfrCrossView.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 TfrCrossView.P1Click(Sender: TObject);
begin
  frDesigner.BeforeChange;
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    if (Restrictions and frrfDontModify) = 0 then
      FRepeatCaptions := Checked;
  end;
  frDesigner.AfterChange;
end;

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


//------------------------------------
type
  THackMemoView = class(TfrMemoView)
  end;

procedure TfrCrossView.CalcWidths;
var
  i, w, maxw, h, maxh: Integer;
  v: TfrView;
  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;

    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 maxh > v.dy then
      FColumnHeights[i] := maxh else
      FColumnHeights[i] := v.dy;
    FRowDS.Next;
  end;

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

procedure TfrCrossView.MakeBands;
var
  i, d: Integer;
  ch1, ch2, cd1, cd2: TfrBandView;
  v: TfrMemoView;
  p: TfrPage;
begin
  p := nil;
  for i := 0 to FReport.Pages.Count - 1 do
    if FReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      p := FReport.Pages[i];
      break;
    end;

  ch1 := TfrBandView.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 := TfrBandView.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 := TfrBandView.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 := TfrBandView.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 := TfrMemoView.Create;
  v.Name := 'CrossMemo' + Name;
  v.SetBounds(cd2.x, cd1.y, cd2.dx, cd1.dy);
  p.Objects.Add(v);

  CalcWidths;

  ch2.dx := 0;
  d := ch2.x;
  for i := 0 to FCross.TopLeftSize.cx - 1 do
  begin
    v := TfrMemoView.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;

  ch1.dy := 0;
  d := ch1.y;
  for i := 0 to FCross.TopLeftSize.cy - 1 do
  begin
    v := TfrMemoView.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;
end;

procedure TfrCrossView.ReportPrintColumn(ColNo: Integer; var Width: Integer);
var
  i: Integer;
begin
  if not FSkip and (Pos(Name, CurView.Name) <> 0) then
  begin
    Width := FColumnWidths[ColNo - 1 + FCross.TopLeftSize.cx];
    FReport.FindObject('CrossMemo' + Name).dx := Width;
    for i := 0 to FCross.TopLeftSize.cy - 1 do
      FReport.FindObject('CrossMemo_' + IntToStr(i) + Name).dx := Width;
  end;
  if Assigned(FSavedOnPrintColumn) then
    FSavedOnPrintColumn(ColNo, Width);
end;

procedure TfrCrossView.ReportBeforePrint(Memo: TStringList; View: TfrView);
var
  v: Variant;
  s, s1: String;
  i, row, col: Integer;
  b, hd: Boolean;
  al: Integer;
  v1: TfrMemoView;

  procedure Assign(m1, m2: TfrMemoView);
  begin
    m1.Flags := m2.Flags;
    m1.FrameWidth := m2.FrameWidth;
    m1.FrameColor := m2.FrameColor;
    m1.FrameStyle := m2.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 := frParser.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 not FShowHeader and (row = 0) then
      Inc(row);

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

    if FInternalFrame then
      View.FrameTyp := 15 else
      View.FrameTyp := frftLeft + frftRight;

    if (row = FCross.TopLeftSize.cy + 1) and (col >= FCross.TopLeftSize.cx) then
      if View.FrameTyp = frftLeft + frftRight then
         Inc(View.FrameTyp, frftTop);

    v := FCross.CellByIndex[row, col, -1];
    if v <> Null then
      View.FrameTyp := v;
    if row = FCross.Rows.Count - 2 then
      View.FrameTyp := View.FrameTyp or frftBottom;

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

    if (col = FCross.Columns.Count - 1) and (row > 0) then // grand total column
      Assign(TfrMemoView(View), TfrMemoView(FReport.FindObject('GrandColumnTotalMemo' + Name)))
    else if row = FCross.Rows.Count - 1 then // grand total row
      Assign(TfrMemoView(View), TfrMemoView(FReport.FindObject('GrandRowTotalMemo' + Name)))
    else if FCross.IsTotalColumn[col] and (row > 0) then // "total" column
    begin
      if (View.FrameTyp and frftLeft) <> 0 then
        Assign(TfrMemoView(View), TfrMemoView(FReport.FindObject('ColumnTotalMemo' + Name)));
    end
    else if FCross.IsTotalRow[row] then // "total" row
    begin
      if (col >= FCross.TopLeftSize.cx) or ((View.FrameTyp and frftTop) <> 0) then
        Assign(TfrMemoView(View), TfrMemoView(FReport.FindObject('RowTotalMemo' + Name)));
    end;

    if not hd then
    begin
      TfrMemoView(View).Alignment := al;
      v1 := TfrMemoView(FReport.FindObject('CellMemo' + Name));
      TfrMemoView(View).Format := v1.Format;
      TfrMemoView(View).FormatStr := v1.FormatStr;
    end;

    if (row <= FCross.TopLeftSize.cy) and (col < FCross.TopLeftSize.cx) then
      View.FillColor := clNone;

    if (col >= FCross.TopLeftSize.cx) and (row > FCross.TopLeftSize.cy) then // cross body
    begin
      s := '';
      for i := 0 to FCross.CellItemsCount - 1 do
      begin
        v := FCross.CellByIndex[row, col, i];
        frVariables['CrossVariable'] := v;
        CurView := View;
        FReport.InternalOnGetValue('CrossVariable', s1);
        s := s + s1 + #13#10;
      end;
    end
    else
    begin
      v := FCross.CellByIndex[row, col, 0];
      if v = Null then
        s := ''
      else
      begin
        frVariables['CrossVariable'] := v;
        CurView := View;
        FReport.InternalOnGetValue('CrossVariable', s);
      end;
    end;

    b := (row = 0) and (col = FCross.TopLeftSize.cx);
    View.Prop['AutoWidth'] := b;
    View.Prop['WordWrap'] := not b;

    View.Memo.Text := s;
  end;
  if Assigned(FSavedOnBeforePrint) then
    FSavedOnBeforePrint(Memo, View);
end;

procedure TfrCrossView.ReportBeginDoc;
var
  v: TfrView;
begin
  Visible := False;
  FSkip := False;
  if (Memo.Count < 4) or (Trim(Memo[0]) = '') or (Trim(Memo[1]) = '') or
     (Trim(Memo[2]) = '') or (Trim(Memo[3]) = '') then
  begin
    FSkip := True;
    if Assigned(FSavedOnBeginDoc) then
      FSavedOnBeginDoc;
    Exit;
  end;

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

  FCross := TfrCross.Create(TfrTDataSet(
    frFindComponent(FReport.Owner, FReport.Dictionary.RealDatasetName[Memo[0]])),
    Memo[1], Memo[2], Memo[3]);

  v := FReport.FindObject('ColumnTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.ColumnTotalString := v.Memo[0];

  v := FReport.FindObject('GrandColumnTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.ColumnGrandTotalString := v.Memo[0];

  v := FReport.FindObject('RowTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.RowTotalString := v.Memo[0];

  v := FReport.FindObject('GrandRowTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.RowGrandTotalString := v.Memo[0];

  FCross.Build;
  if FCross.Columns.Count = 0 then
  begin
    FCross.Free;
    FSkip := True;
    if Assigned(FSavedOnBeginDoc) then
      FSavedOnBeginDoc;
    Exit;
  end;

  FRowDS := TfrUserDataset.Create(FReport.Owner);
  FRowDS.Name := 'RowDS' + Name;
  FRowDS.RangeEnd := reCount;
  FRowDS.RangeEndCount := FCross.Rows.Count;

  FColumnDS := TfrUserDataset.Create(FReport.Owner);
  FColumnDS.Name := 'ColumnDS' + Name;
  FColumnDS.RangeEnd := reCount;
  FColumnDS.RangeEndCount := FCross.Columns.Count;

  MakeBands;
  if Assigned(FSavedOnBeginDoc) then
    FSavedOnBeginDoc;
end;

procedure TfrCrossView.ReportEndDoc;
begin
  if not FSkip then
  begin
    FCross.Free;
    FRowDS.Free;
    FColumnDS.Free;
    VarClear(FColumnWidths);
    VarClear(FColumnHeights);
  end;
  if Assigned(FSavedOnEndDoc) then
    FSavedOnEndDoc;
end;

//------------------------------------------------------------------------------

procedure TfrCrossForm.Localize;
begin
  GroupBox1.Caption := frLoadStr(frRes + 750);
  GroupBox2.Caption := frLoadStr(frRes + 751);
  CheckBox1.Caption := frLoadStr(frRes + 752);
  Label1.Caption := frLoadStr(frRes + 753);
  Caption := frLoadStr(frRes + 754);
  Button1.Caption := frLoadStr(SOK);
  Button2.Caption := frLoadStr(SCancel);
end;

procedure TfrCrossForm.FillDatasetsLB;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  DatasetsLB.Items.BeginUpdate;
  CurReport.Dictionary.GetDatasetList(DatasetsLB.Items);