sctctrl.pas

suite component ace report

procedure TSctCheckLabel.Notification(AComponent: TComponent;
      Operation: TOperation);
begin
  Inherited Notification(AComponent, Operation);
  if (AComponent is TSctvar) Then
  begin
    if (Operation = opRemove) And (TSctvar(AComponent) = Variable) Then
      Variable := nil;
  end;

end;



{ TSctTotalvarLabel }
constructor TSctTotalvarLabel.Create(AOwner: Tcomponent);
begin
  inherited Create(AOwner);
  AlignHorizontal := laRight;
  FDataFormat := TSctFloatFormat.Create;
  FDataFormat.SctLabel := self;
  FAutoLevel := True;
  FLevel := nil;
  FTotalVariable := nil;
  FTotalType := ttSum;
end;

destructor TSctTotalVarLabel.Destroy;
begin
  if FDataFormat <> nil then FDataFormat.free;
  inherited destroy;
end;

procedure TSctTotalVarLabel.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('AutoSize', ReadAutoSize, WriteAutoSize, False);
end;

procedure TSctTotalvarLabel.Notification(AComponent: TComponent;
      Operation: TOperation);
begin
  Inherited Notification(AComponent, Operation);
  if (AComponent is TSctvar) Then
  begin
    if (Operation = opRemove) And (TSctvar(AComponent) = TotalVariable) Then
      TotalVariable := nil;
  end;

end;

function TSctTotalvarLabel.getdisplayText: string;
begin
  if TotalVariable <> nil Then  result := TotalVariable.Name
  else result := 'Fill in variable.';
end;

function TSctTotalvarLabel.getdatanow: String;
var
  Pagelevel: TSctLevel;
  data: TSctFloat;
begin
  if AutoLevel Or (Level = nil) Then
  begin
    if Parent is TSctBand Then Pagelevel := TSctBand(Parent).Updatelevel
    else PageLevel := Level;
  end else PageLevel := Level;
  if TotalVariable = nil then result := DisplayText
  else
  begin
    if (csDesigning in ComponentState) Or (Not TotalVariable.Initialized) Then
    begin
      if Not TotalVariable.Initialized then TotalVariable.Initialize;
      if TotalVariable.Active Then
      begin
        data := TotalVariable.getlevel(PageLevel, TotalType);
        result := FDataFormat.FormatAsString(data);
      end else result := DisplayText;
    end else
    begin
      data := TotalVariable.getlevel(PageLevel, TotalType);
      result := FDataFormat.FormatAsString(data);
    end;
  end;
end;

procedure TSctTotalvarlabel.setvariable(variable: TSctTotalvar);
begin
  FTotalVariable := variable;
  Invalidate;
end;

{ TSctLine }
constructor TSctLine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLineType := ltHorizontal;
end;

destructor TSctLine.Destroy;
begin
  inherited Destroy;
end;

procedure TSctLine.SetLineType(lt: TSctLineType);
begin
  if lt <> FLineType Then
  begin
    FLineType := lt;
    Invalidate;
  end;
end;

procedure TSctLine.PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer);
var
  x,y,x1,y1: Integer;
begin
  x := 0;
  y := 0;
  x1 := 0;
  y1 := 0;

  InitPrint(AceCanvas, Rect);
  AceCanvas.Pen := Pen;
  AceCanvas.Brush := Brush;


  case linetype of
    ltHorizontal:
    begin
      x := Rect.Left;
      x1 := Rect.Right;
      case AlignVertical of
        laTop:    y := Rect.top;
        laBottom: y := Rect.bottom - Pen.width;
        laMiddle: y := Rect.top + (height div 2);
        laCenterVert: y := Rect.top + (height div 2);
      end;
      y1 := y;
    end;
    ltVertical:
    begin
      y := Rect.Top;
      y1 := Rect.Bottom;
      case AlignHorizontal of
        laLeft:   x := Rect.left;
        laCenter: x := Rect.left + (width div 2);
        laRight:  x := Rect.right - Pen.width;
      end;
      x1 := x;
    end;
    ltDiagonalLeft:
    begin
      x := Rect.left;
      x1 := Rect.Right;
      y := Rect.top;
      y1 := Rect.Bottom;
    end;
    ltDiagonalRight:
    begin
      x1 := Rect.left;
      x := Rect.Right;
      y := Rect.top;
      y1 := Rect.Bottom;
    end;
  end;

  if (linetype = ltVertical) And (Pen.Width > 0) then
  begin
    Brush.Color := Pen.Color;
    Brush.Style := bsSolid;
    AceCanvas.Brush := Brush;
    AceCanvas.FillRect(Bounds(x,y,x1-x+Pen.Width, y1 - y + 1));
  end else if (LineType = ltVertical) or (LineType = ltHorizontal) then
  begin
    Brush.Color := Pen.Color;
    Brush.Style := bsSolid;
    AceCanvas.Brush := Brush;
    if LineType = ltHorizontal then
      AceCanvas.FillRect(Bounds(x,y,x1-x+1,y1-y+Pen.Width))
    else AceCanvas.FillRect(Bounds(x,y,x1-x+Pen.Width, y1 - y + 1));
  end else
  begin
    AceCanvas.MoveTo(x, y);
    AceCanvas.LineTo(x1, y1);
  end;


  PrintBorder( AceCanvas, Rect );
end;

procedure TSctLine.PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
begin
end;

procedure TSctLine.PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
begin
  EndPrint := True;
end;

{ TSctShape }
constructor TSctShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShapeType := sstRectangle;
end;

destructor TSctShape.Destroy;
begin
  inherited Destroy;
end;

procedure TSctShape.SetShapeType(ST: TSctShapeType);
begin
  if FShapeType <> ST Then
  begin
    FShapeType := ST;
    Invalidate;
  end;
end;

procedure TSctShape.PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer);
var
  X, Y, W, H, S: Integer;
  R: TRect;
begin
  AceCanvas.Brush := FBrush;
  AceCanvas.Pen := FPen;

  X := FPen.Width div 2;
  Y := X;
  W := Width - FPen.Width + 1;
  H := Height - FPen.Width + 1;
  if W < H then S := W else S := H;
  if ShapeType in [sstSquare, sstRoundSquare, sstCircle] then
  begin
    Inc(X, (W - S) div 2);
    Inc(Y, (H - S) div 2);
    W := S;
    H := S;
  end;
  case ShapeType of
    sstRectangle, sstSquare:
    begin
      if ShapeType = sstRectangle then R := Rect
      else R := Bounds(Rect.Left + x, Rect.Top + y, w, h);
      with AceCanvas do
      begin
        if FPainting then
        begin
          R.Right := R.Right - 1;
          R.Bottom := R.Bottom - 1;
        end;
        AceCanvas.Rectangle(R.left, R.top, R.Right, R.Bottom);
      end;

    end;
    sstRoundRect, sstRoundSquare:
      AceCanvas.RoundRect(Rect.Left + X, Rect.Top + Y, Rect.Left + X + W, Rect.Top + Y + H, S div 4, S div 4);
    sstCircle, sstEllipse:
      AceCanvas.Ellipse(Rect.Left + X, Rect.Top + Y, Rect.Left + X + W, Rect.Top + Y + H);
  end;

end;

procedure TSctShape.PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
begin
end;

procedure TSctShape.PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
begin
  EndPrint := True;
end;


{ TSctImageLabel }
constructor TSctImageLabel.Create(AOwner: Tcomponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  Center := False;
  FImageStream := TMemoryStream.Create;
  FData := nil;
  FAceBitmap := nil;
end;

destructor TSctImageLabel.Destroy;
begin
  if FData <> nil then FData.Free;
  if FPicture <> nil then FPicture.Free;
  if FImageStream <> nil then FImageStream.Free;
  if FAceBitmap <> nil then FAceBitmap.Free;
  inherited Destroy;
end;

procedure TSctImageLabel.SetCenter( C: Boolean);
begin
  if FCenter <> C Then
  begin
    FCenter := C;
    Invalidate;
  end;
end;

procedure TSctImageLabel.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
  Invalidate;
end;

procedure TSctImageLabel.StartPrint;
begin
  EndPrint := False;
  EndPrint := Not PrintOk;
  if Not EndPrint then UpdateImage;
end;

function TSctImageLabel.PrintHeight( oPage: Tcomponent; Space, taking: Integer): Integer;
Begin
  if PrintOk then
  begin
    Print(oPage, Space);
    if Stretch then Result := Top + Height
    else if FAceBitmap <> nil then Result := Top + FAceBitmap.Height
    else if (FData <> nil) then Result := Top + FData.Graphic.Height
    else Result := Top + Height;
  end else Result := 0;
  EndPrint := True;
End;

function TSctImageLabel.Spendheight(oPage: TComponent; Space: Integer): Integer;
begin
  UpdateImage;
  if PrintOk then
  begin
    if Stretch then Result := Top + Height
    else if FAceBitmap <> nil then Result := Top + FAceBitmap.Height
    else if (FData <> nil) then Result := Top + FData.Graphic.Height
    else Result := Top + Height;
  end else Result := 0;
end;

procedure TSctImageLabel.UpdateImage;
var
  stream: TStream;
  Size: LongInt;
  ok: Boolean;
  Graphic: TGraphic;
begin
  { clear out old stuff }
  FImageStream.Clear;
  if FAceBitmap <> nil then FAceBitmap.Free;
  FAceBitmap := nil;
  if FData <> nil then FData.Free;
  FData := nil;

  ok := True;
  if FPainting And (Variable <> nil) And Not Variable.Initialized Then
  begin
    Variable.Initialize;
    ok := Variable.Active;
  end;
  if ok then
  begin
    if (Variable <> nil) And
       ((Variable.DataType = dtypeGraphic)
         Or (Variable.DataType = dtypeBlob)) Then
    begin
      Stream := Variable.Data.AsStream;
      Stream.Position := 0;
      Size := Stream.Size;
      AceIsBlob(Stream);
      FImageStream.CopyFrom(Stream, Size - Stream.Position);
    end else
       if (Picture.Graphic <> nil) And Not (Picture.Graphic.Empty) then
             Picture.Graphic.SaveToStream(FImageStream);

    FImageStream.Position := 0;
    if FImageStream.Size > 0 then
    begin
      if AceIsBitmap(FImageStream) then
      begin
        FAceBitmap := TAceBitmap.Create;
        FAceBitmap.LoadFromStream(FImageStream);
      end else
      begin
        FData := TPicture.Create;
        Graphic := AceGetGraphic(FImageStream);
        FData.Graphic := Graphic;
        Graphic.Free;
        if FData.Graphic = nil then
        begin
          FData.Free;
          FData := nil;
        end else if FData.Graphic.Empty then
        begin
          FData.Free;
          FData := nil;
        end;
      end;
    end;

  end;

end;

procedure TSctImageLabel.PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer);
var
  R: TRect;
begin
  R := Rect;
  UpdateImage;
  InitPrint(AceCanvas, Rect);
  if (FData <> nil) or (FAceBitmap <> nil) then
  begin
    FImageStream.Position := 0;
    if Stretch Then
    begin
      if FAceBitmap <> nil then AceCanvas.StretchDrawBitmap(Rect, FImageStream)
      else AceCanvas.StretchDraw(Rect, FData.Graphic);
    end else
    begin
      if Center then
      begin
        if FAceBitmap  <> nil then
          OffsetRect(R, (Width - FAceBitmap.Width) div 2, (Height - FAceBitmap.Height) div 2)
        else
          OffsetRect(R, (Width - FData.Width) div 2, (Height - FData.Height) div 2);
      end;
      if FAceBitmap <> nil then AceCanvas.DrawBitmap(r.left, r.top , FImageStream)
      else AceCanvas.Draw(r.left, r.top, FData.Graphic);
      { add these here so border gets printed correctly }
      if Not Painting then
      begin
        if FAceBitmap <> nil then
        begin
          R.Right := R.Left + FAceBitmap.Width + 1;
          R.Bottom := R.Top + FAceBitmap.Height + 1;
        end else
        begin
          R.Right := R.Left + FData.Graphic.Width + 1;
          R.Bottom := R.Top + FData.Graphic.Height + 1;
        end;
      end;
    end;
    if FPainting then PrintBorder( AceCanvas, Rect )
    else PrintBorder( AceCanvas, R );
  end else PrintBorder(AceCanvas, Rect);
end;

procedure TSctImageLabel.PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
begin
end;

procedure TSctImageLabel.PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
begin
  EndPrint := True;
end;

procedure TSctImageLabel.Setvariable(Variable: TSctvar);
begin
  FVariable := Variable;
  Invalidate;
end;

function TSctImageLabel.getdisplayText: string;
begin
  if Variable <> nil Then