sctutil.pas

suite component ace report

  else result := 0;
  end;
end;

function TSctUnitMaster.CMTo(Value: Double; uto: TSctUnits): Double;
begin
  case uto of
    unitInches: result := Value / 2.54;
    unitMiliMeters: result := Value * 10;
    unitCentimeters: result := Value;
  else result := 0;
  end;
end;


{ TSctRuler }
constructor TSctRuler.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FVertical := False;
  bevelInner := bvLowered;
  bevelOuter := bvRaised;
  bevelWidth := 1;
  FPixelsPerInch := screen.PixelsPerInch;
  FUnits := unitInches;
  FUM := TSctUnitMaster.Create;
  FStartPixels := 0;
  FShowCrossHair := True;
  FCrossHairPosition := 0;
end;

destructor TSctRuler.destroy;
begin
  if FUM <> nil Then FUM.Free;
  inherited destroy;
end;

procedure TSctRuler.ChangeScale(M, D: Integer);
begin
end;

procedure TSctRuler.Paint;
var
  pos,pos2: Integer;
  count: Integer;

  divisions,dlen: Integer;
  space: Double;
  value: Double;
begin
  inherited Paint;

  value := PixelsPerInch / um.InTo(1, units);
  case units of
    unitInches: divisions := 8;
    unitCentiMeters: divisions := 6;
    unitMiliMeters:
    begin
      divisions := 6;
      Value := Value * 10;
    end;
  else divisions := 5;
  end;

  with Canvas Do
  begin
    Pen.width := 1;
    Pen.Color := clBlack;
    Pen.style := psSolid;
    Font.Name := 'Arial';
    Font.Size := 7;

    if Vertical Then
    begin
      count := round( (height + FStartPixels) / Value);
      For Pos := 0 to count Do
      begin
        if units = unitMiliMeters Then
          TextOut(4, round(Pos * Value + 3 + FStartPixels), IntToStr(Pos * 10) )
        else TextOut(4, round(Pos * Value + 3 + FStartPixels), IntToStr(Pos) );

        for pos2 := 0 to divisions do
        begin
          space := pos * value + FStartPixels + (pos2 * value / divisions);
          MoveTo(width, round(space));
          if pos2 = 0 then dlen := 0
          else if pos2 = (divisions div 2) then dlen := width div 2
          else dlen := width - (width div 4);

          LineTo(dlen, round(space));
        end;
      end;
    end else
    begin
      { count is how many units that need to be printed }
      count := round( (width + abs(FStartPixels)) / Value );

      For Pos := 0 to count Do
      begin
        if units = unitMiliMeters Then
          TextOut(round(Pos * Value + 3 + FStartPixels) ,2, IntToStr(Pos * 10) )
        else TextOut(round(Pos * Value + 3 + FStartPixels),2, IntToStr(Pos) );

        for pos2 := 0 to divisions do
        begin
          space := pos * value + FStartPixels + (pos2 * value / divisions);
          MoveTo(round(space), height);
          if pos2 = 0 then dlen := 0
          else if pos2 = (divisions div 2) then dlen := height div 2
          else dlen := height - (height div 4);

          LineTo(round(space),dlen);
        end;
      end;
    end;
  end;

end;

procedure TSctRuler.UpdateHair(Position: Integer);
var
  rold, rnew: TRect;
begin
  if Vertical then
  begin
    rold := bounds(0, FCrossHairPosition, Width, 1);
    rnew := bounds(0, Position, Width, 1);
  end else
  begin
    rold := bounds(FCrossHairPosition+FStartPixels, 0, 1, Height);
    rnew := bounds(Position+FStartPixels, 0, 1, Height);
  end;

  { replace last position to avoid flickering }
  if FCrossHairPosition <> Position then
  begin
    InvalidateRect(Handle, @rold, False);
    FCrossHairPosition := Position;
  end;

  { draw new cross hair }
  if FShowCrossHair then
  begin
    with Canvas do
    begin
      Brush.Color := clWhite;
      Brush.Style := bsSolid;
      FillRect(rnew);
    end;
  end;

end;




{ TSctRulerContainer }
constructor TSctRulerContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRulers := TList.Create;
  bevelInner := bvLowered;
  bevelOuter := bvRaised;
  bevelWidth := 1;

  FShowCrossHair := True;
  FCrossHairPosition := 0;
end;

destructor TSctRulerContainer.destroy;
begin
  { rulers will get free because they are owned by the container }
  if FRulers <> nil then FRulers.free;
  inherited destroy;
end;

procedure TSctRulerContainer.ChangeScale(M, D: Integer);
begin
end;

procedure TSctRulerContainer.UpdateRulers;
var
  pg: TSctGroupPage;
  spot, count, rcount: Integer;
  ruler: TSctRuler;
  band: TSctBand;
  addtop: Integer;
begin
  if Page <> nil then
  begin
    pg := TSctGroupPage(Page);
    if pg.Bands <> nil then
    begin
      height := pg.Height;
      top := pg.top;
      left := pg.left - width;
      if pg.BorderStyle = bsNone then addtop := 0
      else addtop := 2;

      count := pg.Bands.Count;
      rCount := FRulers.Count;
      if rCount <> count then
      begin
        while rCount <> count do
        begin
          if rCount < count then
          begin
            ruler := TSctRuler.Create(Self);
            ruler.Parent := self;
            FRulers.Add(ruler);

            rCount := rCount + 1;
          end else
          begin
            ruler := TSctRuler(FRulers.items[rCount - 1]);
            if ruler <> nil then
            begin
              ruler.Parent := nil;
              ruler.Free;
            end;
            FRulers.Delete(rCount - 1);
            rCount := rCount - 1;
          end;
        end;
      end;
      for spot := 0 to rCount - 1 do
      begin
        band := TSctBand(pg.bands.items[spot]);
        ruler := TSctRuler(FRulers.items[spot]);
        ruler.Vertical := True;
        ruler.top := band.top + addtop;
        ruler.height := band.height;
        ruler.width := width;

        if (ruler.top < height) then
        begin
          if((ruler.top + ruler.height) > height) then
          begin
            ruler.height := height - ruler.top - 1;
          end;
          ruler.visible := True;
        end else ruler.visible := False;

        ruler.Invalidate;
      end;
    end;
  end;
end;

function TSctRulerContainer.GetPage: TComponent;
begin
  Result := nil;
  if Parent is TSctReport then
  begin
    if TSctReport(Parent).Pages.Count > 0 then
      Result := TSctReport(Parent).Pages.items[0];
  end;
end;

procedure TSctRulerContainer.SetPixelsPerInch(ppi: Integer);
var
  spot: Integer;
begin
  if FRulers <> nil then
  begin
    for spot := 0 to FRulers.Count - 1 do
      TSctRuler(FRulers.items[spot]).PixelsPerInch := ppi;
  end;
end;

procedure TSctRulerContainer.SetUnits( u: TSctUnits);
var
  spot: Integer;
begin
  if FRulers <> nil then
  begin
    for spot := 0 to FRulers.Count - 1 do
      TSctRuler(FRulers.items[spot]).units := u;
  end;
end;

procedure TSctRulerContainer.UpdateHair(Position: Integer);
var
  oldruler, newruler: TSctRuler;

  function getruler(pos: Integer): TSctRuler;
  var
    ruler: TSctRuler;
    spot: Integer;
  begin
    result := nil;
    for spot := 0 to FRulers.Count - 1 do
    begin
      ruler := TSctRuler(FRulers.items[spot]);
      if (ruler.top <= pos) and ((ruler.top+ruler.height) >= pos) then
        result := ruler;
    end;
  end;
begin
  oldruler := getruler(FCrossHairPosition);
  newruler := getruler(Position);

  if (oldruler <> nil) And (oldruler <> newruler) then
  begin
    oldruler.ShowCrossHair := False;
    oldruler.UpdateHair(-1);
  end;
  if newruler <> nil then
  begin
    newruler.ShowCrossHair := True;
    newruler.UpdateHair( Position - newruler.top );
  end;

  FCrossHairPosition := Position;

end;


end.