fr_cross.pas

不错的报表工具

    FDataCaption := Value
end;

function TfrCrossView.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'INTERNALFRAME' then
    Result := FInternalFrame
  else if Index = 'REPEATCAPTIONS' then
    Result := FRepeatCaptions
  else if Index = 'SHOWHEADER' then
    Result := FShowHeader
  else if Index = 'SHOWGRANDTOTAL' then
    Result := FShowGrandTotal
  else if Index = 'DATAWIDTH' then
    Result := FDataWidth
  else if Index = 'HEADERWIDTH' then
    Result := FHeaderWidth
  else if Index = 'MAXNAMELEN' then
    Result := FMaxNameLen
  else if Index = 'DATACAPTION' then
    Result := FDataCaption
end;

procedure TfrCrossView.ShowEditor;
begin
  frCrossForm.Cross := Self;
  frCrossForm.ShowModal;
end;

procedure TfrCrossView.Draw(Canvas: TCanvas);
var
  v: TfrView;
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);

  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);
  if LVersion > 0 then 
  begin
    FShowGrandTotal := frReadBoolean(Stream);
    FDataWidth      := frReadInteger(Stream);
    FHeaderWidth    := frReadInteger(Stream);
  end else begin
    FShowGrandTotal := True;
    FDataWidth      := -1;
    FHeaderWidth    := -1;
  end;
  if LVersion > 1 then 
  begin
    FDictionary.Text := frReadString(Stream);
    FMaxNameLen  := frReadInteger(Stream);
  end else begin
    FDictionary.Text := '';
    FMaxNameLen  := 100;
  end;
  if LVersion > 2 then
  begin
    FDataCaption := frReadString(Stream);
  end else
  begin
    FDataCaption := 'Data';
  end;
end;

procedure TfrCrossView.SaveToStream(Stream: TStream);
begin
  LVersion := 3;
  inherited SaveToStream(Stream);
  frWriteBoolean(Stream, FInternalFrame);
  frWriteBoolean(Stream, FRepeatCaptions);
  frWriteBoolean(Stream, FShowHeader);
  frWriteBoolean(Stream, FShowGrandTotal);
  frWriteInteger(Stream, FDataWidth);
  frWriteInteger(Stream, FHeaderWidth);
  frWriteString (Stream, FDictionary.Text);
  frWriteInteger(Stream, FMaxNameLen);
  frWriteString(Stream, FDataCaption);
end;

procedure TfrCrossView.DefinePopupMenu(Popup: TPopupMenu);
var
  m: TMenuItem;
begin
  m := TMenuItem.Create(Popup);
  m.Caption := frLoadStr(frRes + 2605);
  m.OnClick := P1Click;
  m.Checked := FRepeatCaptions;
  Popup.Items.Add(m);

  m := TMenuItem.Create(Popup);
  m.Caption := frLoadStr(frRes + 2606);
  m.OnClick := P2Click;
  m.Checked := FInternalFrame;
  Popup.Items.Add(m);

  m := TMenuItem.Create(Popup); 
  m.Caption := frLoadStr(frRes + 2607);
  m.OnClick := P3Click;
  m.Checked := FShowHeader;
  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, k: Integer;
  v: TfrView;
  b: TBitmap;
  m: TStringList;
begin
  FFlag := True;
  if FDataWidth = -1 then 
    FColumnWidths  := TQuickIntArray.Create(FCross.Columns.Count+1) else
  if FHeaderWidth = -1 then
    FColumnWidths  := TQuickIntArray.Create(FCross.TopLeftSize.cx+1);

  FColumnHeights := TQuickIntArray.Create(FCross.TopLeftSize.cy + 2);
  LastTotalCol   := TQuickIntArray.Create(FCross.TopLeftSize.cy + 1);

  MaxCellHeight := 0; MaxGTHeight := 0;

  If not FShowGrandTotal then 
  begin
    FRowDS.RangeEndCount    := FRowDS.RangeEndCount - 1;
    FColumnDS.RangeEndCount := FColumnDS.RangeEndCount - 1;
  end;

  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 = -1 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 = -1 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 maxh > v.dy then
        FColumnHeights.Cell[i] := maxh else
        FColumnHeights.Cell[i] := v.dy;
      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 > MaxCellHeight then
        MaxCellHeight := h;
      FColumnDS.Next;
    end;

    If FShowGrandTotal 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 > MaxGTHeight then
          MaxGTHeight := h;
        FColumnDS.Next;
      end;
    end;

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

  if MaxCellHeight < DefDy then 
     MaxCellHeight := DefDY;
  if MaxGTHeight < DefDy then   
     MaxGTHeight := DefDY;
  FFlag  := False;
  LastX := 0;                  
end;

procedure TfrCrossView.MakeBands;
var
  i, j, d, d1, dx, dh: Integer;
  ch1, ch2, cd1, cd2, cf1: 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, DefDY);
  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, DefDY);
  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, DefDY);
  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, DefDY);
  p.Objects.Add(cd2);

  d  := cd1.y;   
  dh := cd1.dy;
  for i := 0 to FCross.CellItemsCount - 1 do
  begin
    v := TfrMemoView.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;

  CalcWidths; 

  cd1.dy := MaxCellHeight*FCross.CellItemsCount; 
  dh := MaxCellHeight;
  d  := cd1.y;
  for i := 0 to FCross.CellItemsCount - 1 do
  begin
    v := FReport.FindObject('CrossMemo@'+ IntToStr(i) + Name) as TfrMemoView;
    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 := TfrMemoView.Create;
    if FHeaderWidth = -1 then
      dx := FColumnWidths.Cell[i] else
      dx := FHeaderWidth;
    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;

  ch1.dy := 0;
  d := ch1.y;
  for i := 0 to FCross.TopLeftSize.cy - 1 + ord(FShowHeader) do //!! 湾 玎猁忄屐 镳