sctrep.pas

suite component ace report

procedure TSctGroup.DeleteBands;
begin
  if FHeader <> nil Then
  begin
    with FHeader do
    begin
      updatelevel.parent := nil;
      updatelevel.Free;
    end;

    FHeader.Parent := nil;
    FHeader.SafeDelete;
    FHeader := nil;
  end;
  if FFooter <> nil Then
  begin
    with FFooter do
    begin
      updatelevel.parent := nil;
      updatelevel.Free;
    end;

    FFooter.Parent := nil;
    FFooter.SafeDelete;
    FFooter := nil;
  end;
end;


function TSctGroup.CheckBroken: Boolean;
begin
  FBroken := False;
  if Variable <> nil Then
    FBroken := (TSctvar(Variable).DataNow.AsString
             <> TSctvar(Variable).DataLast.AsString );

  try
    if Assigned(FOnCheckBroken) then FOnCheckBroken(Self);
  except
    Application.HandleException(Self);
  end;
  Result := FBroken;
end;

procedure TSctGroup.PrintHead(oPage: TSctPage);
begin
  if FShowHead Then FHeader.Print(oPage);
  FBroken := False;
end;

procedure TSctGroup.PrintFoot(oPage: TSctPage);
begin
  if FShowFoot Then FFooter.Print(oPage);
end;

procedure TSctGroup.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Level', readlevel, writelevel, True);
end;

procedure TSctGroup.ReadLevel(Reader: TReader);
begin
  FLevel := Reader.ReadInteger;
end;
procedure TSctGroup.WriteLevel( Writer: TWriter);
begin
  Writer.WriteInteger(FLevel);
end;

{ TSctReserveSpace }
constructor TSctReserveSpace.Create;
begin
  inherited Create;
  FSpace := 0;
  FBand := nil;
  FBandCount := 1;
end;

destructor TSctReserveSpace.Destroy;
begin
  inherited Destroy;
end;

function TSctReserveSpace.GetReserve: Integer;
begin
  if band <> nil then result := Space + (band.height * bandcount)
  else result := Space;
end;

{TSctBand}
constructor TSctBand.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLabels := nil;
  FBorderType := btNone;
  FVisible := True;
  FStretch := False;
  bandname := '';
  Caption := '';
{  Color := clWhite;}
  ParentColor := True;
  FAllowDelete := False;
  FNewPage := False;
  FNewPageRepeat := False;
  FBrush := TBrush.Create;
  FPen := TPen.Create;
  FReserveSpace := TSctReserveSpace.Create;
  FBand := nil;
  FShade := spNone;

  if csDesigning in ComponentState then
  begin
    DragMode := dmAutomatic;
    OnDragOver := BandDragOver;
    OnDragDrop := BandDragDrop;
  end;
end;

destructor TSctBand.destroy;
begin
  if Not OkDelete Then raise Exception.Create(LoadStr(SCT_EDeleteBand));

  if FBrush <> nil Then FBrush.Free;
  if FPen <> nil then FPen.Free;
  if FReserveSpace <> nil then FReserveSpace.Free;


  inherited Destroy;
end;

procedure TSctBand.MouseMovement(var Message: TCMDesignHitTest);
var
  report: TSctReport;
begin
  inherited;
  if Page <> nil then
  begin
    Report := TSctReport(Page.Parent);
    Report.TopRuler.UpdateHair(Message.xPos);
    Report.LeftRuler.UpdateHair(top + Message.yPos);

  end;
end;
{$ifdef WIN32}
  {$ifdef AceDesignTime}
  type
    MyDragControlObject = class(TDragControlObject)
    private
      property Control;
    end;
  {$endif}
{$endif}
procedure TSctBand.WndProc(var Message: TMessage);
var
  {$ifdef AceDesignTime}
    S: Pointer;
    Accepts: Boolean;
    {$ifdef WIN32} dragControl: TDragControlObject; {$endif}
  {$endif}

  noinherited: Boolean;
begin
  noinherited := False;
{$ifdef AceDesignTime}
  if csDesigning in ComponentState then
  begin
{$ifdef WIN32}

    if Message.msg = CM_DRAG then
    begin
      with TCMDrag(Message), DragRec^ do
      begin
        S := Source;
        if TDragObject(S) is TDragControlObject then
        begin
          DragControl := TDragControlObject(S);
          S := MyDragControlObject(DragControl).Control;
        end;
        with ScreenToClient(Pos) do
        begin
          case DragMessage of
            dmDragEnter, dmDragLeave, dmDragMove:
             begin
               noinherited := True;
               BandDragOver(self, S, X, Y, TDragState(DragMessage), Accepts);
               Result := Ord(Accepts);
             end;
            dmDragDrop:
            begin
              BandDragDrop(self, S, X, Y);
              noinherited := true;
            end;
          end;
        end;
      end;

    end;
{$endif}
  end;
{$endif}
  if Not noinherited then inherited WndProc(Message);
end;

procedure TSctBand.BandDragOver(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean);
 {$ifdef AceDesignTime}
var
   Message: TCMDesignHitTest;
 {$endif}
begin
  Accept := False;
  {$ifdef AceDesignTime}
  if csDesigning in ComponentState then
  begin
    if TSctReport(Page.Parent).FDropForm <> nil then
    begin
      if TAceDropLabels(TSctReport(Page.Parent).FDropForm).SList = Source then
      begin
        Accept := True;
        Message.msg := WM_MOUSEMOVE;
        Message.keys := 0;
        Message.xPos := x;
        Message.yPos := y;
        MouseMovement(Message);
      end;
    end;
  end;
  {$endif}
end;
procedure TSctBand.BandDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  {$ifdef AceDesignTime}
  if csDesigning in ComponentState then
  begin
    if TSctReport(Page.Parent).FDropForm <> nil then
    begin
      if TAceDropLabels(TSctReport(Page.Parent).FDropForm).SList = Source then
      begin
        TAceDropLabels(TSctReport(Page.Parent).FDropForm).DropLabels(self,x,y);
      end;
    end;
  end;
  {$endif}
end;


procedure TSctBand.BeforePrint;
begin
  try
    if Assigned(FOnBeforePrint) then FOnBeforePrint(Self)
  except
    Application.HandleException(Self);
  end;
end;

procedure TSctBand.AfterPrint;
begin
  try
    if Assigned(FOnAfterPrint) then FOnAfterPrint(Self)
  except
    Application.HandleException(Self);
  end;
end;


procedure TSctBand.Loaded;
var
  h: Integer;
begin
  inherited Loaded;
  if Not (csDesigning in ComponentState) then
  begin
    if PixelsPerInch <> Font.PixelsPerInch then
    begin
      if Not ParentFont then
      begin
        h := Font.Height;
        { Set correct PixelsPerInch }
        Font.PixelsPerInch := PixelsPerInch;
        { This will create a new font resource }
        Font.Height := h;
        { This will reset all the child fonts }
        Perform(CM_FONTCHANGED, 0, 0);
      end;
    end;
  end;
end;

procedure TSctBand.SetBorderType(bt: TSctBorderType);
begin
  if FBorderType <> bt then
  begin
    FBorderType := bt;
    Invalidate;
  end;
end;

function TSctBand.GetMainBand: TSctBand;
begin
  result := self;
end;


procedure TSctBand.SetVisible(value: Boolean);
var
  pos: Integer;
  bh: TSctBandHead;
begin
  if FVisible <> value then
  begin
    FVisible := value;
    if (csDesigning in ComponentState) And Not (csLoading in ComponentState)
        And Not (csReading in ComponentState) then
    begin
      pos := Page.Bands.IndexOf(self);
      if pos <> -1 then
      begin
        bh := TSctBandHead(Page.BandHeads[pos]);
        if bh.VisibleCheck.Checked <> value Then bh.VisibleCheck.Checked := value;
      end;
    end;
  end;
end;
procedure TSctBand.SetStretch(value: Boolean);
var
  pos: Integer;
  bh: TSctBandHead;
begin
  if FStretch <> value then
  begin
    FStretch := value;
    if (csDesigning in ComponentState) And Not (csLoading in ComponentState)
        And Not (csReading in ComponentState) then
    begin
      pos := Page.Bands.IndexOf(self);
      if pos <> -1 then
      begin
        bh := TSctBandHead(Page.BandHeads[pos]);
        if bh.StretchCheck.Checked <> value Then bh.StretchCheck.Checked := value;
      end;
    end;
  end;
end;
procedure TSctBand.SetNewPage(value: Boolean);
var
  pos: Integer;
  bh: TSctBandHead;
begin
  if FNewPage <> value then
  begin
    FNewPage := value;
    if (csDesigning in ComponentState) And Not (csLoading in ComponentState)
        And Not (csReading in ComponentState) then
    begin
      pos := Page.Bands.IndexOf(self);
      if pos <> -1 then
      begin
        bh := TSctBandHead(Page.BandHeads[pos]);
        if bh.NewPageCheck.Checked <> value Then bh.NewPageCheck.Checked := value;
      end;
    end;
  end;
end;

procedure TSctBand.SetNewPageRepeat(value: Boolean);
var
  pos: Integer;
  bh: TSctBandHead;
begin
  if FNewPageRepeat <> value then
  begin
    if (csDesigning in ComponentState) And (Self is TSctSubDataBand) then
    Begin
      FNewPageRepeat := False;
      ShowMessage('Look in the help on how to set repeat on a subdata band.');
    end else FNewPageRepeat := value;
    if (csDesigning in ComponentState) And Not (csLoading in ComponentState)
        And Not (csReading in ComponentState) then
    begin
      pos := Page.Bands.IndexOf(self);
      if pos <> -1 then
      begin
        bh := TSctBandHead(Page.BandHeads[pos]);
        if bh.NewPageRepeatCheck.Checked <> value Then bh.NewPageRepeatCheck.Checked := value;
      end;
    end;
  end;
end;

function TSctBand.getppi: Integer;
begin
  if parent <> nil Then result := TSctPage(Parent).PixelsPerInch
  else result := screen.PixelsPerInch;
end;

procedure TSctBand.SetParent(AParent: TWinControl);
begin
  if AParent <> Parent then
  begin
    if AParent <> nil Then
    begin
      if AParent is TSctPage Then
      begin
        page := TSctPage(AParent);
        page.InsertBand(self);
        inherited SetParent(AParent);
      end else sysutils.Abort;
    end else
    begin
      if Parent <> nil Then TSctPage(Parent).RemoveBand(self);
      inherited SetParent(AParent);
      page := nil;
    end;
  end;
end;

function TSctBand.GetAllowDelete: Boolean;
begin
  Result := True;
{$ifdef AceDesignTime}
  if (csDesigning in ComponentState) Then
    if (Not AllowDelete) Then
      if Not (csDestroying in ComponentState)Then
        if Parent <> nil Then
        begin
          Result := False;
          {$ifdef WIN32}
          if (csAncestor in ComponentState) then Result := True;
          {$endif}
        end;
{$endif}
end;


procedure TSctBand.SafeDelete;
begin
  try
    AllowDelete := True;
    Free;