frxdesgnworkspace.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

      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:= pmXor;
    Pen.Color:= clSilver;
    Pen.Width:= 1;
    Pen.Style:= psSolid;
    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);
    Pen.Mode:= pmCopy;
    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;
var
  i:Integer;
  sl:TStringList;
  c, c0:TfrxComponent;
  add, add1:Extended;
  l:TList;

  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 TfrxReportSummary then
      y:= 99999
    else if Bnd is TfrxColumnFooter 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;

    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 IsTopBand(b:TfrxComponent):Boolean;
  begin
    Result:= (b is TfrxPageHeader) or (b is TfrxReportTitle) or (b is TfrxColumnHeader);
  end;

  function IsBottomBand(b:TfrxComponent):Boolean;
  begin
    Result:= (b is TfrxPageFooter) or (b is TfrxReportSummary) or (b is TfrxColumnFooter);
  end;

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

  procedure AdjustParent(Ctrl:TfrxComponent; Index:Integer);
  var
    i:Integer;
    c:TfrxComponent;
  begin
    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;
          Ctrl.Parent:= c;
          break;
        end;
    end;
  end;

begin
  sl:= TStringList.Create;
  sl.Sorted:= True;
  sl.Duplicates:= dupAccept;

  { sort bands }
  for i:= 0 to FObjects.Count-1 do
    if TObject(FObjects[i]) is TfrxBand then
      DoBand(FObjects[i]);

  add1:= 0;
  case FGridType of
    gt1pt:add1:= 40;
    gt1cm:add1:= fr1cm;
    gt1in:add1:= fr1in * 0.4;
    gtChar:add1:= fr1CharY;
  end;

  { rearrange all bands }
  if not FFreeBandsPlacement then
    for i:= 0 to sl.Count-1 do
    begin
      c:= TfrxComponent(sl.Objects[i]);
      if i = 0 then
        c.Top:= Round8(FBandHeader)
      else
      begin
        c0:= TfrxComponent(sl.Objects[i-1]);
        if (isTopBand(c0) and not IsTopBand(c)) or
           (isBottomBand(c) and not IsBottomBand(c0)) then
          add:= add1 else
          add:= 0;

        c.Top:= Round8(Round((c0.Top+c0.Height+FBandHeader+FGapBetweenBands)
          / FGridY) * FGridY+add);
      end;
    end;

  sl.Free;

  { toss objects }
  for i:= 0 to FObjects.Count-1 do
    if TObject(FObjects[i]) is TfrxBand then
      TossObjects(FObjects[i])
    else if TObject(FObjects[i]) is TfrxDialogControl then
      AdjustParent(FObjects[i], i);

  { move all bands to the begin of objects list }
  l:= TList.Create;
  for i:= 0 to FObjects.Count-1 do
    if TObject(FObjects[i]) is TfrxBand then
      l.Add(FObjects[i]);
  for i:= 0 to FObjects.Count-1 do
    if not (TObject(FObjects[i]) is TfrxBand) then
      l.Add(FObjects[i]);

  FObjects.Clear;
  for i:= 0 to l.Count-1 do
    FObjects.Add(l[i]);
  l.Free;
end;

procedure TfrxDesignerWorkspace.AdjustBandHeight(Bnd:TfrxBand);
var
  i:Integer;
  max, min:Extended;
  c:TfrxComponent;
begin
  max:= 0;
  min:= 0;
  for i:= 0 to Bnd.Objects.Count-1 do
  begin
    c:= Bnd.Objects[i];
    if (c is TfrxView) and (TfrxView(c).Align in [baClient, baBottom]) then
      continue;
    if c.Top+c.Height > max then