frxdesgnworkspace.pas

这个是功能强大的报表软件

    if c.IsAncestor then
      frxResources.MainButtonImages.Draw(FCanvas,
        Round((c.AbsLeft + 2) * FScale), Round((c.AbsTop + 1) * FScale), 99);
  end;

  // debug
  procedure DrawShiftTree(c: TfrxReportComponent);
  var
    i: Integer;
    c1: TfrxReportComponent;
  begin
    for i := 0 to c.FShiftChildren.Count - 1 do
    begin
      c1 := c.FShiftChildren[i];
      with FCanvas do
      begin
        Pen.Style := psSolid;
        Pen.Color := clRed;
        Pen.Mode := pmCopy;
        Pen.Width := 1;
        if c is TfrxBand then
          MoveTo(Round(c.AbsLeft + c.Width / 2), Round(c.AbsTop))
        else
          MoveTo(Round(c.AbsLeft + c.Width / 2), Round(c.AbsTop + c.Height));
        LineTo(Round(c1.AbsLeft + c1.Width / 2), Round(c1.AbsTop));
      end;
      DrawShiftTree(c1);
    end;
  end;


begin
  { update aligned objects }
  if Page is TfrxReportPage then
    Page.AlignChildren;

  { draw objects }
  for i := 0 to FObjects.Count - 1 do
  begin
    c := FObjects[i];
    if c is TfrxReportComponent then
      DrawObject(TfrxReportComponent(c));
  end;

  // debug
{  for i := 0 to FObjects.Count - 1 do
  begin
    c := FObjects[i];
    if c is TfrxBand then
    begin
      PrepareShiftTree(TfrxBand(c));
      DrawShiftTree(TfrxReportComponent(c));
    end;
  end;}


  { draw selection }
  for i := 0 to SelectedCount - 1 do
    if not FMouseDown then
      DrawSqares(FSelectedObjects[i]);
end;

procedure TfrxDesignerWorkspace.DrawBackground;

  procedure Line(x, y, x1, y1: Integer);
  begin
    FCanvas.MoveTo(x, y);
    FCanvas.LineTo(x1, y1);
  end;

  procedure DrawPoints;
  var
    GridBmp: TBitmap;
    i: Extended;
    c: TColor;
    dx, dy: Extended;
  begin
    if FGridType = gtDialog then
      c := clBlack else
      c := clGray;
    dx := FGridX * FScale;
    dy := FGridY * FScale;
    if (dx > 2) and (dy > 2) then
    begin
      GridBmp := TBitmap.Create;
      GridBmp.Width:= Width;
      GridBmp.Height := 1;

      GridBmp.Canvas.Pen.Color := FColor;
      GridBmp.Canvas.MoveTo(0, 0);
      GridBmp.Canvas.LineTo(Width, 0);

      i := 0;
      while i < Width do
      begin
        GridBmp.Canvas.Pixels[Round(i), 0] := c;
        i := i + dx;
      end;

      i := 0;
      while i < Height do
      begin
        FCanvas.Draw(0, Round(i), GridBmp);
        i := i + dy;
      end;

      GridBmp.Free;
    end;
  end;

  procedure DrawMM;
  var
    i, dx, maxi: Extended;
    i1: Integer;
    Color5, Color10: TColor;
  begin
    if FGridLCD then
    begin
      Color5 := $F2F2F2;
      Color10 := $E2E2E2;
    end
    else
    begin
      Color5 := $F8F8F8;
      Color10 := $E8E8E8;
    end;

    with FCanvas do
    begin
      Pen.Width := 1;
      Pen.Mode := pmCopy;
      Pen.Style := psSolid;

      if FGridType = gt1cm then
        dx := fr01cm * FScale else
        dx := fr01in * FScale;

      if Width > Height then
        maxi := Width else
        maxi := Height;

      i := 0;
      i1 := 0;
      while i < maxi do
      begin
        if i1 mod 10 = 0 then
          Pen.Color := Color10
        else if i1 mod 5 = 0 then
          Pen.Color := Color5
        else if FGridType = gt1in then
          Pen.Color := Color5
        else
          Pen.Color := clWhite;
        if Pen.Color <> clWhite then
        begin
          Line(Round(i), 0, Round(i), Height);
          Line(0, Round(i), Width, Round(i));
        end;
        i := i + dx;
        Inc(i1);
      end;
    end;
  end;

begin
  FCanvas.Brush.Color := FColor;
  FCanvas.Brush.Style := bsSolid;
  FCanvas.FillRect(Rect(0, 0, Width, Height));

  if FShowGrid then
    case FGridType of
      gt1pt, gtDialog, gtChar:
        DrawPoints;
      gt1cm, gt1in:
        DrawMM;
    end;
end;

procedure TfrxDesignerWorkspace.DrawSelectionRect;
begin
  with Canvas do
  begin
    Pen.Mode := pmXor;
    Pen.Color := clSilver;
    Pen.Width := 1;
    Pen.Style := psDot;
    Brush.Style := bsClear;
    with FSelectionRect do
      Rectangle(Round(Left), Round(Top), Round(Right), Round(Bottom));
    Pen.Mode := pmCopy;
    Brush.Style := bsSolid;
  end;
end;

procedure TfrxDesignerWorkspace.DrawInsertionRect;
var
  R: TfrxRect;
begin
  with Canvas do
  begin
    Pen.Mode := pmCopy;
    Pen.Color := clBlack;
    Pen.Width := 1;
    Pen.Style := psDot;
    Brush.Style := bsClear;
    with FInsertion do
      R := frxRect(Left, Top, Left + Width, Top + Height);
    NormalizeRect(R);
    Rectangle(Round(R.Left * FScale), Round(R.Top * FScale),
      Round(R.Right * FScale) + 1, Round(R.Bottom * FScale) + 1);
    Brush.Style := bsSolid;
  end;
end;

procedure TfrxDesignerWorkspace.DrawCross(Down: Boolean);
var
  x, y: Extended;
begin
  with FInsertion do
    if Down then
    begin
      if Flags <> 0 then
      begin
        x := (Left + Width) * FScale;
        y := (Top + Height) * FScale;
      end
      else if Abs(Width) > Abs(Height) then
      begin
        x := (Left + Width) * FScale;
        y := Top * FScale;
      end
      else
      begin
        x := Left * FScale;
        y := (Top + Height) * FScale;
      end;
    end
    else
    begin
      x := Left * FScale;
      y := Top * FScale;
    end;

  with Canvas do
  begin
    Pen.Mode := pmXor;
    Pen.Color := clSilver;
    Pen.Width := 1;
    Pen.Style := psSolid;
    MoveTo(Round(x - 4), Round(y));
    LineTo(Round(x + 5), Round(y));
    MoveTo(Round(x), Round(y - 4));
    LineTo(Round(x), Round(y + 5));
    if Down then
    begin
      MoveTo(Round(FInsertion.Left * FScale), Round(FInsertion.Top * FScale));
      LineTo(Round(x), Round(y));
    end;

    Pen.Mode := pmCopy;
  end;
end;

procedure TfrxDesignerWorkspace.FindNearest(dx, dy: Integer);
var
  i: Integer;
  c, sel, found: TfrxComponent;
  min, dist, dist_dx, dist_dy: Extended;
  r1, r2, r3: TfrxRect;

  function RectsIntersect(r1, r2: TfrxRect): Boolean;
  begin
    Result := not ((r2.Left > r1.Right) or (r2.Right < r1.Left) or
      (r2.Top > r1.Bottom) or (r2.Bottom < r1.Top));
  end;

begin
  if SelectedCount <> 1 then Exit;

  found := nil;
  sel := FSelectedObjects[0];
  min := 1e10;
  for i := 0 to FObjects.Count - 1 do
  begin
    c := FObjects[i];
    if not (c is TfrxReportComponent) or (c is TfrxBand) or (c = sel) then continue;

    r1 := frxRect(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
    dist := 0;
    dist_dx := 0;
    dist_dy := 0;
    with sel do
      if dx = 1 then
      begin
        r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
        r3 := frxRect(AbsLeft, 0, 1e10, 1e10);
        dist := r1.Left - r2.Left;
        dist_dx := r1.Left - (AbsLeft + Width);
        if r1.Top > r2.Top then
          dist_dy := r1.Top - r2.Bottom else
          dist_dy := r2.Top - r1.Bottom;
      end
      else if dx = -1 then
      begin
        r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
        r3 := frxRect(0, 0, AbsLeft + Width, 1e10);
        dist := r2.Right - r1.Right;
        dist_dx := AbsLeft - r1.Right;
        if r1.Top > r2.Top then
          dist_dy := r1.Top - r2.Bottom else
          dist_dy := r2.Top - r1.Bottom;
      end
      else if dy = 1 then
      begin
        r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
        r3 := frxRect(0, AbsTop, 1e10, 1e10);
        dist := r1.Top - r2.Top;
        dist_dy := r1.Top - (AbsTop + Height);
        if r1.Left > r2.Left then
          dist_dx := r1.Left - r2.Right else
          dist_dx := r2.Left - r1.Right;
      end
      else if dy = -1 then
      begin
        r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
        r3 := frxRect(0, 0, 1e10, AbsTop + Height);
        dist := r2.Bottom - r1.Bottom;
        dist_dy := AbsTop - r1.Bottom;
        if r1.Left > r2.Left then
          dist_dx := r1.Left - r2.Right else
          dist_dx := r2.Left - r1.Right;
      end;

    if not RectsIntersect(r1, r2) then
    begin
      if (not RectsIntersect(r1, r3)) or
         ((dx <> 0) and (dist_dx < dist_dy)) or
         ((dy <> 0) and (dist_dy < dist_dx)) or
         ((dist_dx = 0) and (dist_dy = 0)) then continue;
      dist := sqrt(dist_dx * dist_dx + dist_dy * dist_dy) * (Width + Height);
    end;

    if dist < min then
    begin
      found := c;
      min := dist;
    end;
  end;

  if found <> nil then
  begin
    FSelectedObjects.Clear;
    FSelectedObjects.Add(found);
    if Assigned(FOnNotifyPosition) then
      FOnNotifyPosition(GetSelectionBounds);
    SelectionChanged;
  end;
end;

procedure TfrxDesignerWorkspace.NormalizeCoord(c: TfrxComponent);
begin
  if c.Width < 0 then
  begin
    c.Width := -c.Width;
    c.Left := c.Left - c.Width;
  end;
  if c.Height < 0 then
  begin
    c.Height := -c.Height;
    c.Top := c.Top - c.Height;
  end;
end;

procedure TfrxDesignerWorkspace.NormalizeRect(var R: TfrxRect);
var
  i: Extended;
begin
  with R do
  begin
    if Left > Right then
    begin
      i := Left;
      Left := Right;
      Right := i
    end;
    if Top > Bottom then
    begin
      i := Top;
      Top := Bottom;
      Bottom := i
    end;
  end;
end;

procedure TfrxDesignerWorkspace.AdjustBands(AttachObjects: Boolean = True);
var
  i, j: Integer;
  sl: TStringList;
  b: TfrxBand;
  c, c0: TfrxComponent;
  add, add1: Extended;
  l: TList;
  ch: TfrxChild;

  procedure DoBand(Bnd: TfrxBand);
  var
    y: Extended;
  begin
    if Bnd.Vertical then Exit;

    if Bnd is TfrxPageHeader then
      y := 0
    else if Bnd is TfrxReportTitle then
      y := 0.01
    else if Bnd is TfrxColumnHeader then
      y := 0.02
    else if Bnd is TfrxColumnFooter then
      y := 99999
    else if Bnd is TfrxReportSummary then
      y := 100000
    else if Bnd is TfrxPageFooter then
      y := 100001
    else
      y := Abs(Bnd.Top);

    if TfrxReportPage(FPage).TitleBeforeHeader then
    begin
      if Bnd is TfrxReportTitle then
        y := 0
      else if Bnd is TfrxPageHeader then
        y := 0.01
    end;

    sl.AddObject(Format('%9.2f', [y]), Bnd);
  end;

  procedure TossObjects(Bnd: TfrxBand);
  var
    i: Integer;
    c: TfrxComponent;
    SaveRestrictions: TfrxRestrictions;
  begin
    if Bnd.Vertical then Exit;

    while Bnd.Objects.Count > 0 do
    begin
      c := Bnd.Objects[0];
      SaveRestrictions := c.Restrictions;
      c.Restrictions := [];
      c.Top := c.AbsTop;
      c.Restrictions := SaveRestrictions;
      c.Parent := Bnd.Parent;
    end;

    if AttachObjects then
      for i := 0 to FObjects.Count - 1 do
      begin
        c := FObjects[i];
        if (c is TfrxView) and (c.AbsTop >= Bnd.Top - 1e-4) and (c.AbsTop < Bnd.Top + Bnd.Height + 1e-4) then
        begin
          SaveRestrictions := c.Restrictions;
          c.Restrictions := [];
          c.Top := c.AbsTop - Bnd.Top;
          c.Restrictions := SaveRestrictions;
          c.Parent := Bnd;
        end;
      end;
  end;

  function Round8(e: Extended): Extended;
  begin
    Result := Round(e * 100000000) / 100000000;
  end;

  procedure AdjustParent(Ctrl: TfrxComponent; Index: Integer);
  var
    i: Integer;
    c: TfrxComponent;
    found: Boolean;
  begin
    found := False;
    for i := Index - 1 downto 0 do
    begin
      c := FObjects[i];
      if (c <> Ctrl) and (c is TfrxDialogControl) and
        (csAcceptsControls in TfrxDialogControl(c).Control.ControlStyle) then
        if (Ctrl.AbsLeft >= c.AbsLeft) and
           (Ctrl.AbsTop >= c.AbsTop) and (Ctrl.AbsLeft < c.AbsLeft + c.Width) and
           (Ctrl.AbsTop < c.AbsTop + c.Height) then
        begin
          Ctrl.Top := Ctrl.AbsTop - c.AbsTop;
          Ctrl.Left := Ctrl.AbsLeft - c.AbsLeft;