frxdesgnworkspace.pas

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

          Ctrl.Parent := c;
          found := True;
          break;
        end;
    end;

    if not found and (Ctrl.Parent <> Page) then
    begin
      Ctrl.Top := Ctrl.AbsTop;
      Ctrl.Left := Ctrl.AbsLeft;
      Ctrl.Parent := Page;
      BringToFront;
    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]);

  { arrange child bands }
  sl.Sorted := False;
  i := 0;
  while i < sl.Count do
  begin
    sl[i] := '';
    b := TfrxBand(sl.Objects[i]);
    if b.Child <> nil then
    begin
      j := sl.IndexOfObject(b.Child);
      if j <> -1 then
      begin
        c := TfrxComponent(sl.Objects[j]);
        sl.Delete(j);
        if j < i then
          Dec(i);
        sl.InsertObject(i + 1, '', c);
      end;
    end;
    Inc(i);
  end;

  { set top/middle/bottom indexes }
  i := 0;
  while i < sl.Count do
  begin
    b := TfrxBand(sl.Objects[i]);
    if sl[i] = '' then
      if (b is TfrxPageHeader) or (b is TfrxReportTitle) or (b is TfrxColumnHeader) then
        sl[i] := 'top'
      else if (b is TfrxPageFooter) or (b is TfrxReportSummary) or (b is TfrxColumnFooter) then
        sl[i] := 'bottom'
      else
        sl[i] := 'middle';
    ch := b.Child;
    while ch <> nil do
    begin
      j := sl.IndexOfObject(ch);
      if j <> -1 then
        sl[j] := sl[i];
      ch := ch.Child;
    end;
    Inc(i);
  end;

  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 ((sl[i - 1] = 'top') and (sl[i] <> 'top')) or
           ((sl[i] = 'bottom') and (sl[i - 1] <> 'bottom')) 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
  begin
    c := FObjects[i];
    if c is TfrxBand then
      TossObjects(TfrxBand(c))
    else if c is TfrxDialogControl then
      AdjustParent(c, i);
  end;

  { 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.PrepareShiftTree(Band: TfrxBand);
var
  i, j, k: Integer;
  c0, c1, c2, top: TfrxReportComponent;
  allObjects: TStringList;
  Found: Boolean;
  area0, area1, area2, area01: TfrxRectArea;
begin
  allObjects := TStringList.Create;
  allObjects.Duplicates := dupAccept;

  { temporary top object }
  top := TfrxMemoView.Create(nil);
  top.SetBounds(0, Band.Top-2, Band.Width, 1);

  { sort objects }
  for i := 0 to Band.Objects.Count - 1 do
  begin
    c0 := Band.Objects[i];
    allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
    c0.FShiftChildren.Clear;
  end;
  allObjects.Sort;
  allObjects.InsertObject(0, Format('%10.2f', [top.Top]), top);

  for i := 0 to allObjects.Count - 1 do
  begin
    c0 := TfrxReportComponent(allObjects.Objects[i]);
    area0 := TfrxRectArea.Create(c0);

    { find an object under c0 }
    for j := i + 1 to allObjects.Count - 1 do
    begin
      c1 := TfrxReportComponent(allObjects.Objects[j]);
      area1 := TfrxRectArea.Create(c1);

      if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
        area0.InterceptsX(area1) then
      begin
        area01 := area0.InterceptX(area1);
        Found := False;

        { check if there is no other objects between c1 and c0 }
        for k := j - 1 downto i + 1 do
        begin
          c2 := TfrxReportComponent(allObjects.Objects[k]);
          area2 := TfrxRectArea.Create(c2);

          if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
            area01.InterceptsX(area2) then
            Found := True;

          area2.Free;
          if Found then
            break;
        end;

        if not Found then
          c0.FShiftChildren.Add(c1);

        area01.Free;
      end;

      area1.Free;
    end;

    area0.Free;
  end;

  { copy children from the top object to the band }
  Band.FShiftChildren.Clear;
  for i := 0 to top.FShiftChildren.Count - 1 do
    Band.FShiftChildren.Add(top.FShiftChildren[i]);

  allObjects.Free;
  top.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
      max := c.Top + c.Height;
    if c.Top < min then
      min := c.Top;
  end;

  max := max - min;
  if Bnd.Height < max then
    Bnd.Height := max;
  if min < 0 then
    for i := 0 to Bnd.Objects.Count - 1 do
      with TfrxComponent(Bnd.Objects[i]) do
        Top := Top - min;
end;

function TfrxDesignerWorkspace.ListsEqual(List1, List2: TList): Boolean;
var
  i: Integer;
begin
  Result := List1.Count = List2.Count;
  if Result then
    for i := 0 to List1.Count - 1 do
      if List1.List[i] <> List2.List[i] then
        Result := False;
end;

procedure TfrxDesignerWorkspace.DeleteObjects;
var
  c, c1: TfrxComponent;
  i: Integer;
begin
  if SelectedCount = 0 then exit;

  i := 0;
  while FSelectedObjects.Count > i do
  begin
    c := FSelectedObjects[i];

    if not (rfDontDelete in c.Restrictions) then
    begin
      if c.IsAncestor then
        raise Exception.Create('Could not delete ' + c.Name + ', it was introduced in the ancestor report');
      FSelectedObjects.Remove(c);
      FObjects.Remove(c);

      while c.Objects.Count > 0 do
      begin
        c1 := c.Objects[0];
        FSelectedObjects.Remove(c1);
        FObjects.Remove(c1);
        c1.Free;
      end;

      c.Free;
    end
    else
      Inc(i);
  end;

  if FSelectedObjects.Count = 0 then
    FSelectedObjects.Add(FPage);

  AdjustBands;
  FModifyFlag := True;
  DoModify;
  SelectionChanged;
end;

procedure TfrxDesignerWorkspace.EditObject;
begin
  if FSelectedObjects.Count = 1 then
    if Assigned(FOnEdit) then
      FOnEdit(Self);
end;

procedure TfrxDesignerWorkspace.DoNudge(dx, dy: Extended; Smooth: Boolean);
var
  i: Integer;
  c: TfrxComponent;
begin
  if SelectedCount = 0 then exit;
  if not Smooth or (GridType = gtChar) then
  begin
    dx := dx * FGridX;
    dy := dy * FGridY;
  end;

  for i := 0 to SelectedCount - 1 do
  begin
    c := FSelectedObjects[i];
    c.Left := c.Left + dx;
    c.Top := c.Top + dy;
  end;

  FModifyFlag := True;
  if Assigned(FOnNotifyPosition) then
    FOnNotifyPosition(GetSelectionBounds);
  Repaint;
end;

procedure TfrxDesignerWorkspace.DoSize(dx, dy: Extended);
var
  i: Integer;
  c: TfrxComponent;
begin
  if SelectedCount = 0 then exit;
  dx := dx * FGridX;
  dy := dy * FGridY;

  for i := 0 to SelectedCount - 1 do
  begin
    c := FSelectedObjects[i];
    c.Width := c.Width + dx;
    if c.Width < 0 then
      c.Width := c.Width - dx;
    c.Height := c.Height + dy;
    if c.Height < 0 then
      c.Height := c.Height - dy;
  end;

  FModifyFlag := True;
  if Assigned(FOnNotifyPosition) then
    FOnNotifyPosition(GetSelectionBounds);
  Repaint;
end;

procedure TfrxDesignerWorkspace.DoStick(dx, dy: Integer);
var
  i: Integer;
  c, sel, found: TfrxComponent;
  min, dist: Extended;
  r1, r2: TfrxRect;
  gapLeft, gapRight, gapTop, gapBottom: Extended;

  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;
    with sel do
      if dx = 1 then
      begin
        r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
        dist := r1.Left - r2.Left;
      end
      else if dx = -1 then
      begin
        r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
        dist := r2.Right - r1.Right;
      end
      else if dy = 1 then
      begin
        r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
        dist := r1.Top - r2.Top;
      end
      else if dy = -1 then
      begin
        r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
        dist := r2.Bottom - r1.Bottom;
      end;

    if RectsIntersect(r1, r2) then
      if dist < min then
      begin
        found := c;
        min := dist;
      end;
  end;

  if found <> nil then
  begin
    gapLeft := 0;
    gapRight := 0;
    gapTop := 0;
    gapBottom := 0;
    if (sel is TfrxDMPMemoView) and (found is TfrxDMPMemoView) then
    begin
      if (ftLeft in TfrxDMPMemoView(sel).Frame.Typ) or
         (ftRight in TfrxDMPMemoView(found).Frame.Typ) then
        gapLeft := fr1CharX;
      if (ftRight in TfrxDMPMemoView(sel).Frame.Typ) or
         (ftLeft in TfrxDMPMemoView(found).Frame.Typ) then
        gapRight := fr1CharX;
      if (ftTop in TfrxDMPMemoView(sel).Frame.Typ) or
         (ftBottom in TfrxDMPMemoView(found).Frame.Typ) then
        gapTop := fr1CharY;
      if (ftBottom in TfrxDMPMemoView(sel).Frame.Typ) or
         (ftTop in TfrxDMPMemoView(found).Frame.Typ) then
        gapBottom := fr1CharY;
    end;
    if dx = 1 then
      sel.Left := found.Left - sel.Width - gapRight
    else if dx = -1 then
      sel.Left := found.Left + found.Width + gapLeft
    else if dy = 1 then
      sel.Top := found.Top - sel.Height - gapBottom
    else if dy = -1 then
      sel.Top := found.Top + found.Height + gapTop;

    FModifyFlag := True;
    if Assigned(FOnNotifyPosition) then
      FOnNotifyPosition(GetSelectionBounds);
    Repaint;
  end;
end;

procedure TfrxDesignerWorkspace.DoTab;
var
  c: TfrxComponent;
  i: Integer;
begin
  if SelectedCount <> 1 then Exit;

  c := SelectedObjects[0];
  if (c is TfrxBand) and (c.Objects.Count > 0) then
    SelectedObjects[0] := c.Objects[0]
  else if c is TfrxView then
  begin
    i := c.Parent.Objects.IndexOf(c);
    if i = c.Parent.Objects.Count - 1 then
      i := 0
    else
      Inc(i);
    SelectedObjects[0] := c.Parent.Objects[i];
  end;

  if Assigned(FOnNotifyPosition) then
    FOnNotifyPosition(GetSelectionBounds);
  SelectionChanged;
end;

procedure TfrxDesignerWorkspace.KeyDown(var Key: Word; Shift: TShiftState);
var
  p: TPoint;
  dx, dy: Integer;
begin
  if FDisableUpdate then exit;

  if ssAlt in Shift then
  begin
    GetCursorPos(p);
    p := ScreenToClient(p);
    MouseMove(Shift, p.X, p.Y);
  end;

  dx := 0; dy := 0;

  case Key of
    vk_Delete:
      DeleteObjects;

    vk_Return:
      EditObject;

    vk_Left:
      dx := -1;

    vk_Right:
      dx := 1;

    vk_Up:
      dy := -1;