sctrep.pas

suite component ace report

  except
    AllowDelete := False;
  end;
end;

procedure TSctBand.Paint;
var
  setup: TSctPageSetup;
  spot: LongInt;
  value: Double;
  AC: TAceCanvas;
begin
  inherited Paint;
  { set current printer type }
  Setup := TSctPage(Parent).PageSetup;
  { draw right margin for current printer }

  with Canvas do
  begin
    if FShade <> spNone then
    begin
      { Brush style has to be solid, otherwise on nt4 shading will come out
        as a big black block instead of shading.  Don't know why, probably a
        bug. }
      Brush.Color := clWhite;
      Brush.Style := bsSolid;
      AceShadeRect(Handle,Bounds(0,0,Width,Height),FShade);
      Brush.Style := bsClear;
    end;

    Pen.color := clBlack;
    Pen.Width := 1;
    Pen.Style := psDot;
    value := setup.um.toIn(setup.PrintWidth, setup.units);
    spot := round(value * PixelsPerInch);
    MoveTo(spot,0);
    LineTo(spot,ClientHeight);
    Pen.Style := psSolid;


  end;

  AC := TAceCanvas.Create;
  AC.Handle := Canvas.Handle;
  SctDrawBorder(AC, Bounds(0,0,Width,Height), BorderType, True);
  AC.Free;

end;

procedure TSctBand.WMSize(var Message: TWMSize);
var
  spot: Integer;
  lb: TsctLabel;
begin
  inherited;
  if Parent <> nil Then
  begin
    TSctPage(Parent).ArrangeBands;
    if FLabels <> nil then
    begin
      for spot := 0 to Flabels.count - 1 do
      begin
        lb := FLabels.items[spot];
        if lb is TSctVerticalDivider then lb.height := height;
      end;
    end;
    TSctReport( TSctPage(Parent).Parent ).PositionButtons;
  end;
end;

procedure TSctBand.WMMove(var Message: TWMMove);
begin
  inherited;
  if (Parent <> nil) And (csDesigning in ComponentState) then
  begin
    TSctReport( TSctPage(Parent).Parent ).PositionButtons;
  end;
end;

procedure TSctBand.ModifyLabel( var Message: TSctModifyLabel );
var
  Strings: TStringList;
  Spot: Integer;
begin
  Strings := TStringList.Create;
  ClipBoardToStrings(Strings);
  for Spot := 0 to Strings.Count - 1 do
  begin
    if Pos(': TSctTextLabel', Strings[Spot]) > 0 then
    begin
      if Pos('object', Strings[Spot]) > 0 then
      begin
        if Pos(Message.LB.Name + ':', Strings[Spot]) > 0 then
        begin
          Strings[Spot] := 'object ' + Message.LB.Name + ': TSctvarlabel';
        end;
      end;
    end;
  end;
  ClipBoard.SetTextBuf(Strings.GetText);
  Strings.Free;

end;




function TSctBand.DoOnPrintWhen: Boolean;
begin
{$ifdef SCT_OLDEVENT}
  Result := FOnPrintWhen(self);
{$else}
  Result := False;
  FOnPrintWhen(self, Result);
{$endif}
end;

function TSctBand.GetPrintOk: Boolean;
begin
  if Visible And (Not Continued Or NewPageRepeat) Then
  begin
    result := True;
    try
      if Assigned(FOnPrintWhen) then result := DoOnPrintWhen;
    except
      result := False;
    end;
  end else result := False;
end;

function TSctBand.GetPrintHeight: Integer;
begin
  if PrintOk Then result := Height
  else result := 0;
end;

procedure TSctBand.Print(oPage: TSctPage);
var
  Pos: Integer;
  item: TSctLabel;
  R: TRect;
begin

  if PrintOk Then
  begin
    BeforePrint;
    Include(FBandState, bsPrinting);

    if Page.PrintOk then
    begin
      R := Bounds(oPage.xPos,oPage.yPos,oPage.PageWidth - 1 -
             (oPage.xPos - round(oPage.PageSetup.LeftMargin * oPage.PixelsPerInch)), height);

      if FShade <> spNone then
      begin
        { Brush style has to be solid, otherwise on nt4 shading will come out
          as a big black block instead of shading.  Don't know why, probably a
          bug. }
        oPage.Canvas.Brush.Color := clWhite;
        oPage.Canvas.Brush.Style := bsSolid;
        oPage.Canvas.ShadeRect(Rect(R.Left+1,R.Top+1,R.Right-1,R.Bottom-1), FShade);
        oPage.Canvas.Brush.Style := bsClear;
      end;

      Pen.width := 1;
      Pen.color := clBlack;
      oPage.Canvas.Pen := Pen;
      Brush.Color := Color;
      oPage.Canvas.Brush := Brush;
      if Brush.Color <> clWhite Then oPage.FillRect(Bounds(0, 1, oPage.PageWidth - 1, height));
      SctDrawBorder(oPage.FCanvas,R, BorderType, False);

      { send a print message to every object in the list }
      if FLabels <> nil then
      begin
        for Pos := 0 to (FLabels.Count - 1) Do
        begin
          item := FLabels.Items[Pos];
          item.Print(oPage, height);
        end;
      end;
    end;

    Exclude(FBandState, bsPrinting);
    AfterPrint;
  end;
end;

procedure TSctBand.StartPrint;
var
  Pos: Integer;
begin
  if PrintOk Then
  begin
    BeforePrint;
    Include(FBandState, bsPrinting);
    if FLabels <> nil then
    begin
      for Pos := 0 to (FLabels.Count - 1) Do
      begin
        if TSctLabel(FLabels.Items[Pos]).Parent = self Then
          TSctLabel( FLabels.Items[Pos]).StartPrint;
      end;
    end;
    EndPrint := False;
    FirstPass := True;
  end else EndPrint := True;
end;

procedure TSctBand.FinishedPrint;
begin
  Exclude(FBandState, bsPrinting);
end;

function TSctBand.SpendHeight(oPage: TSctPage; Space: Integer): Integer;
var
  spent, pos, took: Integer;
  tobig: Boolean;
  item: TSctLabel;
begin
  spent := 0;
  if PrintOk Then
  begin
    tobig := False;
    if TSctGroupPage(oPage).LastPagePos = oPage.yPos then tobig := True;
    if Stretch then
    begin
      if (Space >= height) or (Space = -1) Or tobig Then
      begin
        if FLabels <> nil then
        begin
          for Pos := 0 to (FLabels.Count - 1) Do
          begin
            item := FLabels.Items[Pos];
            if (item.Parent = self) And (Not item.EndPrint) Then
            begin
              took := item.spendHeight(oPage, Space);
              if took > spent Then spent := took;
            end;
          end;
        end;
      end;
    end else if Space >= height then spent := height;
  end;
  result := spent;
end;

procedure TSctBand.PrintRtf(oPage: TSctPage; rtf: TSctRtfFile);
var
  Pos, row: Integer;
  item: TSctLabel;
  lablist: TList;
  sortlist, memolist: TList;

  spot: Integer;
  value: Integer;
  Done: Boolean;

  function getspot(l: TSctLabel): Integer;
  begin
    case l.AlignHorizontal of
      laLeft: result := l.left;
      laRight: result := l.left + l.width;
      laCenter: result := l.left + (l.width div 2);
    else
      result := 0;
    end;
  end;
  function getAlign(l: TSctLabel): TSctTabAlignment;
  begin
    case l.AlignHorizontal of
      laLeft: result := taLeft;
      laRight: result := taRight;
      laCenter: result := taCenter;
    else result := taLeft;
    end;
  end;
begin

  if PrintOk Then
  begin
    lablist := TList.Create;
    sortlist := TList.Create;
    memolist := TList.Create;

    if FLabels <> nil then
    begin
      for pos := 0 to FLabels.count - 1 do
      begin
        item := FLabels.Items[Pos];
        item.StartPrint;
        sortlist.Add(item);
      end;
    end;

    while sortlist.Count > 0 do
    begin
      value := getspot(sortlist.items[0]);
      spot := 0;
      for pos := 0 to sortlist.Count - 1 do
      begin
        item := sortlist.Items[Pos];
        if getspot(item) < value then
        begin
          value := getspot(item);
          spot := pos;
        end;
      end;
      lablist.Add( sortlist.items[spot]);
      sortlist.delete(spot);
    end;


    BeforePrint;
    Include(FBandState, bsPrinting);

    if BorderType = btUnderLine then rtf.BorderType := rbtBottom
    else rtf.BorderType := rbtBox;

    if Bordertype <> btNone then  rtf.StartBorder;

    row := 0;
    repeat
      { make a tab spot for each label }
      rtf.PageBreak := FNewPage And Not oPage.FirstNewPage;
      rtf.ParagraphDefault;
      for pos := 0 to lablist.Count - 1 do
      begin
        item := lablist.Items[Pos];
        item.PrintTab(oPage,rtf, row);
      end;


      for Pos := 0 to (lablist.Count - 1) Do
      begin
        item := lablist.Items[Pos];
        item.PrintRtf(oPage, rtf, row);
      end;
      rtf.NewParagraph;


      { check to see if done printing all of the rows }
      Done := True;
      for pos := 0 to lablist.Count - 1 do
      begin
        item := lablist.items[pos];
        if Not item.EndPrint then Done := False;
      end;
      Inc(Row);
    until Done;

    if Bordertype <> btNone then  rtf.EndBorder;


    Exclude(FBandState, bsPrinting);
    AfterPrint;

    lablist.Free;
    sortlist.Free;
    memolist.Free;
  end;
  EndPrint := True;
end;

function TSctBand.PrintHeight(oPage: TSctPage; Space: Integer): Integer;
var
  spent,pos,took: Integer;
  Done: Boolean;
  item: TSctLabel;
  R: TRect;
  tobig: Boolean;
begin
  spent := 0;
  if PrintOk Then
  begin
    tobig := False;
    if TSctGroupPage(oPage).LastPagePos = oPage.yPos then tobig := True;
    if (Space >= Height) Or tobig Then
    begin
      { need to find out how much a band will take so that we
        can color the band before anything else is printed }
      if FLabels <> nil then
      begin
        for Pos := 0 to (FLabels.Count - 1) Do
        begin
          item := FLabels.Items[Pos];
          if Not item.EndPrint Then
          begin
            took := item.spendHeight(oPage, Space);
            if took > spent Then spent := took;
          end;
        end;
      end;
      if (Spent > 0) And Page.PrintOk then
      begin
        if (height > spent) And FirstPass Then spent := height;

        if FShade <> spNone then
        begin
          { Brush style has to be solid, otherwise on nt4 shading will come out
            as a big black block instead of shading.  Don't know why, probably a
            bug. }
          oPage.Canvas.Brush.Color := clWhite;
          oPage.Canvas.Brush.Style := bsSolid;
          oPage.Canvas.ShadeRect(Bounds(oPage.xPos+1,oPage.yPos+1,oPage.PageWidth-2,Spent-2), FShade);
          oPage.Canvas.Brush.Style := bsClear;
        end;

        Pen.width := 1;
        Pen.color := clBlack;
        oPage.Canvas.Pen := Pen;
        Brush.Color := Color;
        oPage.Canvas.Brush := Brush;
        if Color <> clWhite then
        begin
          R := Bounds(0, 1, oPage.PageWidth - 1 -
             (oPage.xPos - round(oPage.PageSetup.LeftMargin * oPage.PixelsPerInch)), spent);
          oPage.FillRect(R);
        end;
        SctDrawBorder(oPage.FCanvas, Bounds(oPage.xPos,oPage.yPos,oPage.PageWidth - 1, spent), BorderType, False);
      end;

      PushDest;
      if (FLabels <> nil) then
      begin
        for Pos := 0 to (FLabels.Count - 1) Do
        begin
          item := FLabels.Items[Pos];
          took := item.PrintHeight(oPage, Space, spent);
          if took > spent Then spent := took;
        end;
      end;
      PopDest;

      Done := True;
      if FLabels <> nil then
      begin
        for