sctctrl.pas

suite component ace report

    R := Bounds(0, 0, width - 1, height - 1);
    PrintLabel(AceCanvas, R, Height);
  finally
    AceCanvas.free;
  end;
  FPainting := False;
end;

function TSctLabel.GetxSpot(x: Integer): Integer;
begin
  case AlignHorizontal of
    laLeft: result := x + FBorderMargin;
    laRight: result := x + width - FBorderMargin;
    laCenter: result := x + (width div 2);
  else
    result := 0;
  end;
end;
function TSctLabel.GetySpot(y: Integer): Integer;
begin
  case AlignVertical of
    laTop: result := y + FBorderMargin;
    laBottom: result := y + height - FBorderMargin;
    laMiddle: result := y + (height div 2);
    laCenterVert: result := y + ((height - ((4 * abs(font.height))div 3))div 2);
  else
    result := 0;
  end;
end;

procedure TSctLabel.InitPrint(AceCanvas: TAceCanvas; rect: TRect);
begin
  FBrushSet.Assign(FBrush);
  if Transparent then
  begin
    FBrushSet.Color := clWhite;
    FBrushSet.Style := bsClear;
    AceCanvas.Brush := FBrushSet;
  end else
  begin
    if FShade = spNone then
    begin
      FBrushSet.Color := Color;
      FBrushSet.Style := bsSolid;
      AceCanvas.Brush := FBrushSet;
      AceCanvas.FillRect(rect);
      AceCanvas.Brush.Style := bsClear;
    end else
    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. }
      FBrushSet.Color := clWhite;
      FBrushSet.Style := bsSolid;
      AceCanvas.Brush := FBrushSet;
      AceCanvas.ShadeRect(rect, FShade);
      AceCanvas.Brush.Style := bsClear;
    end;
  end;

end;

procedure TSctLabel.PrintBorder(AceCanvas: TAceCanvas; Rect: TRect);
begin
  SctDrawBorder(AceCanvas, Rect, FBorderType, Painting);
end;

procedure TSctLabel.PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer);
var
  xSpot, ySpot: Integer;
begin

  xSpot := GetXSpot(Rect.Left);
  ySpot := GetYSpot(Rect.Top);

  InitPrint(AceCanvas, Rect);

  AceCanvas.Font := Font;
  AceCanvas.SetTextAlign( AlignFlags );
  AceCanvas.SetFontAngle(FRotateFont);

  if ClipRect Then AceCanvas.TextRect(Rect , xSpot, ySpot, DataNow)
  else AceCanvas.TextOut(xSpot, ySpot, DataNow);

  PrintBorder( AceCanvas, Rect );
end;


procedure TSctLabel.Print(oPage: TComponent; space: Integer);
var
  pg: TSctPage;
  R: TRect;
Begin
  EndPrint := False;
  if PrintOk then
  begin
    pg := TSctPage(oPage);
    BeforePrint;
    R := Bounds(pg.xPos + left, pg.yPos + top, width, height);
    PrintLabel(pg.PrintTo.AceCanvas, R, Space);
    AfterPrint;
  end;
  EndPrint := True;
End;

procedure TSctLabel.PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
var
  TempFont: TFont;
  TempStyle: TFontStyles;
Begin
  if PrintOk then
  begin
    if Not RtfPrint then EndPrint := True
    else if (PrintRow = row) And RtfPrint then
    begin
      BeforePrint;
      TempFont := TFont.Create;
      TempFont.Assign(Font);
      TempStyle := TempFont.Style;
      Exclude(TempStyle, fsUnderline);
      TempFont.Style := TempStyle;
      rtf.Font := TempFont;
      rtf.Tab;
      rtf.Font := font;
      rtf.TextOut(DataNow);
      AfterPrint;
      EndPrint := True;
      TempFont.Free;
    end;
  end;
end;

procedure TSctLabel.PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
var
  spot: Integer;
begin
  if PrintOk then
  begin
    if (PrintRow = row) And RtfPrint then
    begin
      spot := round(getspot(self) / TSctPage(oPage).PixelsPerInch * 1440);
      rtf.DefineTab(spot, getalign(self));
    end;
  end;
end;

procedure TSctLabel.StartPrint;
begin
  EndPrint := False;  { endprint is referenced in PrintOk }
  EndPrint := Not PrintOk;
end;

function TSctLabel.PrintHeight( oPage: Tcomponent; Space, taking: Integer): Integer;
Begin
  if PrintOk then
  begin
    Print(oPage, Space);
    result := top + height;
  end else result := 0;
  EndPrint := True;
End;

function TSctLabel.spendheight(oPage: TComponent; Space: Integer): Integer;
begin
  if PrintOk then result := top + height
  else result := 0;
end;

function TSctLabel.getdatanow: String;
begin
  result := DisplayText;
end;

procedure TSctLabel.SetParent(AParent: TWinControl);
begin
  if AParent <> Parent then
  begin
    { do this check so don't put my component on where is does not belong }
    if (AParent = nil) Or (AParent is TSctBand) Then
    begin
    end else Abort;

    if AParent <> nil Then
    begin
      if AParent is TSctPage Then
      begin
        TSctPage(AParent).InsertLabel(self);
        inherited SetParent(AParent);
      end else if AParent is TSctBand Then
      begin
        TSctBand(AParent).InsertLabel(self);
        inherited SetParent(AParent);
      end else Abort;
    end else
    begin
      if Parent <> nil Then
      begin
        if Parent is TSctPage Then TSctPage(Parent).RemoveLabel(self)
        else if Parent is TSctBand Then TSctBand(Parent).RemoveLabel(self);
      end;
      inherited SetParent(AParent);
    end;
  end;
end;

function TSctLabel.getpage: TWinControl;
begin
  result := nil;
  if Parent is TSctPage Then result := Parent
  else if Parent is TSctBand Then result := TSctBand(Parent).Parent;
end;

function TSctLabel.getAlignFlags: word;
begin
  result := 0;
  case AlignVertical of
    laTop: Inc(result, TA_TOP);
    laBottom: Inc(result, TA_BOTTOM);
    laMiddle: Inc(result, TA_BASELINE);
    laCenterVert: Inc(result, TA_TOP);
  end;
  case AlignHorizontal of
    laLeft: Inc(result, TA_LEFT);
    laRight: Inc(result, TA_RIGHT);
    laCenter: Inc(result, TA_CENTER);
  end;
end;

function TSctLabel.getxpos: Integer;
begin
  result := 0;
  case AlignHorizontal of
    laLeft: result := left + 1;
    laRight: result := left + width - 1;
    laCenter: result := left + (width div 2);
  end;
end;


function TSctLabel.getypos: Integer;
begin
  result := 0;
  case AlignVertical of
    laTop: Inc(result, top + 1);
    laBottom: Inc(result, top + height - 1);
    laMiddle: result := top + (height div 2);
    laCenterVert: result := top + (height div 2);    
  end;
end;

procedure TSctLabel.ReadAutoSize(Reader: TReader);
begin
  Reader.ReadBoolean;
end;
procedure TSctLabel.WriteAutoSize( Writer: TWriter);
begin
end;


{ TSctTVLabel }
constructor TSctTVLabel.Create(AOwner: Tcomponent);
begin
  inherited Create(AOwner);
  FDataFormat := TSctFormat.Create;
  FDataFormat.SctLabel := self;
  FWrapHeightPercent := 100;
  FAceMemo := TAceMemo.Create;
  FJustifyMemo := False;
  FSuppressRepeats := False;
  FLines := TStringList.Create;
  FSuppressBlankLines := False;
  FSuppressWhiteSpace := False;
end;

destructor TSctTVLabel.Destroy;
begin
  if FAceMemo <> nil then FAceMemo.Free;
  if FDataFormat <> nil then FDataFormat.Free;
  if FLines <> nil then FLines.Free;
  inherited Destroy;
end;

procedure TSctTVLabel.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('AutoSize', ReadAutoSize, WriteAutoSize, False);
end;
procedure TSctTVLabel.SetLines(Value: TStrings);
begin
  FLines.Assign(Value);
  Invalidate;
end;
procedure TSctTVLabel.SetWrapHeightPercent(whp: TSctWrapHeightPercent);
begin
  if FWrapHeightPercent <> whp then
  begin
    FWrapHeightPercent := whp;
    Invalidate;
  end;
end;

procedure TSctTVLabel.SetJustifyMemo(Value: Boolean);
begin
  if FJustifyMemo <> Value then
  begin
    FJustifyMemo := Value;
    Invalidate;
  end;
end;

procedure TSctTVLabel.UpdateMemo;
var
  pg: TSctGroupPage;
  S: String;
  Updated: Boolean;
begin
  pg := TSctGroupPage(Page);

  TMemoryStream(AceMemo.MemoStream).Clear;
  AceMemo.TextDriverCompatibility := pg.PageSetup.TextDriverCompatibility;
  AceMemo.PixelsPerInch := PixelsPerInch;
  AceMemo.Font := Font;
  AceMemo.Width := Width - (FBorderMargin * 2);
  AceMemo.WrapText := WrapText;
  AceMemo.WrapHeightPercent := FWrapHeightPercent;
  AceMemo.SuppressBlankLines := FSuppressBlankLines;
  AceMemo.SuppressWhiteSpace := FSuppressWhiteSpace;

  case AlignHorizontal of
    laLeft: AceMemo.MemoAlignment := maLeft;
    laRight: AceMemo.MemoAlignment := maRight;
    laCenter: AceMemo.MemoAlignment := maCenter;
  end;
  if FJustifyMemo then AceMemo.MemoAlignment := maJustify;

  Updated := False;
  S := '';
  if Variable <> nil then
  begin
    if Variable.Active then
    begin
      if (Variable.Datatype = dtypeMemo) Or (Variable.Datatype = dtypeBlob) then
         AceMemo.MemoStream := Variable.AsStream
      else
         AceMemo.MemoStream := FDataFormat.FormatAsStream(Variable.DataNow);

      Updated := True;
    end;
  end;

  if Not Updated And (Caption <> '') then S := Caption;

  if (S = '') And Not Updated then
  begin
    if Lines.Count > 0 then
    begin
      Lines.SaveToStream(AceMemo.MemoStream);
      Updated := True;
    end;
  end;

  if Not Updated then
  begin
    if S = '' then S := DisplayText;
    if Length(S) > 0 then
    begin
      {$ifdef WIN32}
      AceMemo.MemoStream.WriteBuffer(Pointer(S)^, Length(S));
      {$else}
      AceMemo.MemoStream.WriteBuffer(S[1], Length(S));
      {$endif}
    end;
  end;

  AceMemo.UpdateMemo;
end;

function TSctTVLabel.getdatanow: String;
var
  Updated: Boolean;
begin
  Updated := False;
  if Variable <> nil then
  begin
    if (csDesigning in ComponentState) Or (Not Variable.Initialized) Then
    begin
      if Not (Variable.Initialized) then Variable.Initialize;
      if Variable.Active Then
      begin
        case Variable.DataType of
          dtypeBlob, dtypeMemo, dtypeGraphic: result := DisplayText;
        else
          begin
            Result := FDataFormat.FormatAsString(Variable.DataNow);
            Updated := True;
          end;
        end;
      end;
    end else
    begin
      Result := FDataFormat.FormatAsString(Variable.Data);
      Updated := True;
    end;
  end;
  if Not Updated And (Caption <> '') then
  begin
    Result := Caption;
    Updated := True;
  end;

  if Not Updated then
  begin
    if FLines.Count > 0 then
    begin
      Result := Lines[0];
    end else Result := DisplayText;
  end;
end;

function TSctTVLabel.IsMemo: Boolean;
begin
  Result := False;
  if Self is TSctVarLabel then
  begin
    if Variable <> nil then
    begin
      if (Variable.DataType = dtypeMemo)
         Or (Variable.DataType = dtypeBlob)
         Or WrapText Then result := True;
    end else Result := WrapText;
  end else
  begin
    Result := WrapText;
  end;
end;

procedure TSctTVLabel.Print(oPage: TComponent; space: Integer);
var
  pg: TSctPage;
  R: TRect;
Begin
  EndPrint := False;

  if PrintOk then
  begin
    BeforePrint;
    pg := TSctPage(oPage);
    R := Bounds(pg.xPos + left, pg.yPos + top, width, height);
    DataRow := 0;
    FirstTime := True;

    if IsMemo then Space := Space - top;

    PrintLabel(pg.PrintTo.AceCanvas, R, Space);
    AfterPrint;
  end;
  EndPrint := True;
End;

procedure TSctTVLabel.PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
var
  spot: Integer;
  subpos: Integer;
  tsp: TAceTabStringPos;
begin
  if RtfPrint And PrintOk then
  begin
{    if Variable <> nil then
    begin}
      if (PrintRow >= Row) then
      begin