sctctrl.pas

suite component ace report

        if IsMemo Then
        begin
          UpdateMemo;
          if (AceMemo.MemoLines > 0) And ((PrintRow - Row) >= 0) And
              ((PrintRow - Row) < AceMemo.MemoLines) then
          begin
            AceMemo.ParseString(AceMemo.MemoStrings[PrintRow - Row]);
            for subpos := 0 to AceMemo.Parts.Count - 1 do
            begin
              tsp := TAceTabStringPos(AceMemo.Parts.items[subpos]);

              case AlignHorizontal of
                laLeft:
                begin
                  spot := FBorderMargin + xPos + tsp.Pos;
                end;
                laRight:
                begin
                  if subpos = (AceMemo.Parts.Count - 1) then spot := xPos - FBorderMargin
                  else spot := xPos-FBorderMargin-Width + tsp.pos + tsp.width;
                end;
                laCenter:
                begin
                  if AceMemo.Parts.count = 1 then spot := Left + (width div 2)
                  else
                  begin
                    spot := Left + BorderMargin+tsp.pos + (tsp.width div 2);
                  end;
                end;
              else
                spot := 0;
              end;

              spot := round(spot / PixelsPerINch * 1440);
              rtf.DefineTab(spot, GetAlign(self));
            end;
          end;
        end else if PrintRow = Row then
        begin
          spot := round(getspot(self) / TSctPage(oPage).PixelsPerInch * 1440);
          rtf.DefineTab(spot, getalign(self));
        end;
      end;
{    end;}
  end;
end;

procedure TSctTVLabel.PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
var
  subpos: Integer;
  tsp: TAceTabStringPos;
  TempFont: TFont;
  TempStyle: TFontStyles;
Begin
  if RtfPrint And PrintOk then
  begin
    BeforePrint;
{    if Variable <> nil then
    begin}
      if IsMemo Then
      begin
        UpdateMemo;
        if AceMemo.MemoLines = 0 then EndPrint := True;
        if (AceMemo.MemoLines > 0) And ((PrintRow - Row) >= 0) And
              ((PrintRow - Row) < AceMemo.MemoLines) then
        begin
          BeforePrint;

          TempFont := TFont.Create;
          TempFont.Assign(Font);
          TempStyle := TempFont.Style;
          Exclude(TempStyle, fsUnderline);
          TempFont.Style := TempStyle;
          rtf.Font := TempFont;

          AceMemo.ParseString(AceMemo.MemoStrings[PrintRow - Row]);
          for subpos := 0 to AceMemo.Parts.Count - 1 do
          begin
            tsp := TAceTabStringPos(AceMemo.Parts.items[subpos]);
            rtf.Tab;
            rtf.Font := Font;
            rtf.TextOut(tsp.Text);
          end;

          TempFont.Free;

          AfterPrint;
          if (PrintRow - Row) >= (AceMemo.MemoLines-1) then EndPrint := True;
        end;
      end
      else if Row = PrintRow 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);

        TempFont.Free;
        AfterPrint;
        EndPrint := True;
      end;
    end;
{  end;}
end;


function TSctTVLabel.PrintMemo( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer): Integer;
var
  lines, ht, mySpace: Integer;
begin

  AceCanvas.SetFontAngle(0);
  UpdateMemo;
{
  if FSuppressWhiteSpace And Not FirstTime then
  begin
    while FDataRow < AceMemo.MemoLines do
    begin
      if AceMemo.MemoStrings[DataRow] = '' then Inc(FDataRow)
      end else break;
    end;
  end;
 }

  if Stretch then
  begin
    mySpace := Space;
    Lines := (mySpace - (FBorderMargin * 2)) div AceMemo.LineHeight;
    if FirstTime And (lines = 0) then lines := 1;
    if Lines > (AceMemo.MemoLines - DataRow) then lines := AceMemo.MemoLines - DataRow;
    ht := (Lines * AceMemo.LineHeight) + (FBorderMargin * 2);
    if FirstTime And (ht < Height) then ht := height;
    if AceMemo.MemoLines <= 0 then EndPrint := True;
    if (DataRow + Lines) >= AceMemo.MemoLines Then EndPrint := True;

    Result := ht;

    if (lines = 0) And (AceMemo.MemoLines > 0) then result := Space;
    if FirstTime And (Result < Height) Then Result := Height;
  end else
  begin
    result := height;
    lines := (height - (FBorderMargin * 2)) div AceMemo.LineHeight;
    { always print at least one line unless there are none }
    if lines = 0 then lines := 1;
    if (lines > AceMemo.MemoLines) Then lines := AceMemo.MemoLines;
    EndPrint := True;
  end;


  InitPrint(AceCanvas, Bounds(Rect.left, Rect.Top, width, Result - 1));

  if lines > 0 then
  begin
    AceMemo.RangeBegin := DataRow;
    AceMemo.RangeEnd := DataRow + lines - 1;
    AceMemo.Print(AceCanvas, Rect.left + FBorderMargin, Rect.Top + FBorderMargin);
  end;

  if Painting then PrintBorder(AceCanvas, Rect)
  else PrintBorder(AceCanvas, Bounds(Rect.Left, Rect.Top, width, Result));

  DataRow := DataRow + lines;
end;

procedure TSctTVLabel.Paint;
var
  AceCanvas: TAceCanvas;
  R: TRect;
begin
  FPainting := True;
  AceCanvas := TAceCanvas.Create;
  try
    DataRow := 0;
    FirstTime := True;
    AceCanvas.Handle := Canvas.Handle;
    R := Bounds(0, 0, width - 1, height - 1);
    PrintLabel(AceCanvas, R, Height);
  finally
    AceCanvas.free;
  end;
  FPainting := False;
end;

procedure TSctTVLabel.PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer);
var
  xSpot, ySpot: Integer;
  ok: Boolean;
  Str: String;
begin
  xSpot := GetXSpot(Rect.Left);
  ySpot := GetYSpot(Rect.Top);

  Str := '';
  ok := False;

  if Variable <> nil then
  begin
    if FPainting And Not Variable.Initialized then Variable.Initialize;
    ok := Variable.Active;
  end;
  if IsMemo then PrintMemo(AceCanvas, Rect, Space)
  else
  begin
    if ok then
    begin
      if FSuppressRepeats then
          ok := Variable.DataNow.AsString <> Variable.DataLast.AsString;
      if ok then Str := DataNow;
    end else
    begin
      Str := DataNow;
      ok := True;
    end;

    if ok then
    begin
      InitPrint(AceCanvas, Rect);

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

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

      PrintBorder( AceCanvas, Rect );
    end;
  end;
end;

procedure TSctTVLabel.StartPrint;
var
  FontSize: Integer;
begin
  EndPrint := False;
  if PrintOk then
  begin
    if Not RtfPrint And (TSctPage(Page).Outputtype = otRichText) then EndPrint := True;
    if Not EndPrint then
    begin
      DataRow := 0;
      FirstTime := True;

      Canvas.Font := font;
      FontSize := canvas.font.size;
      canvas.font.pixelsperinch := PixelsPerInch;
      canvas.font.size := Fontsize;
      UpdateMemo;
    end;
  end else EndPrint := True;
end;

function TSctTVLabel.PrintHeight( oPage: Tcomponent; Space, taking: Integer): Integer;
var
  pg: TSctPage;
  R: TRect;
begin
  if PrintOk then
  begin
    if IsMemo then
    begin
      if FirstTime then BeforePrint;
      pg := TSctPage(oPage);
      if FirstTime then
      begin
        { Ajust space to start from printing point }
        Space := Space - top;
        R := Bounds(pg.xPos + left, pg.yPos + top, width, height)
      end else R := Bounds(pg.xPos + left, pg.yPos + 1, width, height);

      result := PrintMemo( pg.PrintTo.AceCanvas, R, Space);

      { Adjust space taken to add in starting point of label }
      if FirstTime then result := result + top;

      if EndPrint then AfterPrint;
    end else
    begin
      Print(oPage, space);
      EndPrint := True;
      result := top + height;
    end;
    FirstTime := False;
  end else
  begin
    EndPrint := True;
    result := 0;
  end;
end;

function TSctTVLabel.spendheight(oPage: TComponent; Space: Integer): Integer;
begin
  if PrintOk Then
  begin
    if IsMemo then result := spendMemo(oPage, Space)
    else result := top + height;
  end else result := 0;
end;

function TSctTVLabel.spendMemo( oPage: TComponent; Space: Integer): Integer;
var
  mySpace: Integer;
  lines: Integer;
begin

  UpdateMemo;

  if FSuppressWhiteSpace And Not FirstTime then
  begin
    while DataRow < AceMemo.MemoLines do
    begin
      if AceMemo.MemoStrings[DataRow] = '' then Inc(FDataRow)
      else break;
    end;
  end;

  if Stretch then
  begin
    if FirstTime then
    begin
      mySpace := Space - top; { don't include area between top of label and top of band }
      { first time through, you need at least the label height; }
      if mySpace < height Then
      begin
        result := top + height;
      end else
      begin
        lines := (mySpace - (FBorderMargin * 2)) div AceMemo.LineHeight;
        if lines < 0 then lines := 0;
        if lines > (AceMemo.MemoLines - DataRow) then lines := AceMemo.MemoLines - DataRow;
        result := top + (lines * AceMemo.LineHeight) + (FBorderMargin * 2);
        if ((top + height) > result) And ((top + height) <= Space) Then result := top + height;
      end;
    end else
    begin
      mySpace := Space;
      lines := (mySpace - (FBorderMargin * 2)) div AceMemo.LineHeight;
      if lines < 0 then lines := 0;
      if lines > (AceMemo.MemoLines - DataRow) then lines := AceMemo.MemoLines - DataRow;
      result := 1 + (lines * AceMemo.LineHeight) + (FBorderMargin * 2);
    end;
  end else
  begin
    result := top + height;
  end;
end;

procedure TSctTVLabel.SetVariable(Variable: TSctvar);
begin
  FVariable := Variable;
  Invalidate;
end;

function TSctTVLabel.GetDisplayText: string;
begin
  if Self is TSctTextLabel then
  begin
    if Caption = '' then
    begin
      if Painting then Result := 'Fill in caption.'
      else Result := ''
    end else Result := Caption; { I think this line is redundent }
  end else
  begin
    if Variable = nil then
    begin
      if Painting then Result := 'Fill in variable.'
      else Result := '';
    end else Result := Variable.Name;
  end;
end;

procedure TSctTVLabel.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;

{ TSctTextLabel }
procedure TSctTextLabel.WriteState(Writer: TWriter);
var
  ml: TSctModifyLabel;
begin
  inherited WriteState(Writer);
  ml.lb := Self;
  PostMessage(Parent.Handle, Sct_ModifyTextLabel, 0,LongInt(Self));
end;



{ TSctCheckLabel }
constructor TSctCheckLabel.Create(AOwner: Tcomponent);
begin
  inherited Create(AOwner);
  FCheckStyle := csCross;
  Width := 12;
  Height := 12;
end;

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

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

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

procedure TSctCheckLabel.PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer);
var
  Value: Boolean;
  cs: TAceCheckStyle;
begin
  if FPainting Or (Variable = nil) then
  begin
    if (Variable = nil) then Value :=  True
    else
    begin
      if Not Variable.Initialized then Variable.Initialize;

      if Variable.Active then value := Variable.AsBoolean
      else Value := True;
    end;
  end else Value := Variable.AsBoolean;

  InitPrint(AceCanvas, Rect);

  if Value then
  begin
    if FCheckStyle = csCross then cs := acsCross
    else cs := acsCheck;
    AceCanvas.DrawCheckBox(Rect,cs , Pen.Color, Pen.Width);
  end;

  PrintBorder( AceCanvas, Rect );
end;

procedure TSctCheckLabel.SetCheckStyle(style: TSctCheckStyle);
begin
  if FCheckStyle <> style then
  begin
    FCheckStyle := style;
    Invalidate;
  end;
end;

procedure TSctChecklabel.setvariable(variable: TSctvar);
begin
  FVariable := variable;
  Invalidate;
end;