frxdesgnworkspace.pas

报表控件。FastReport 是非常强大的报表控件

        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
      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
      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);
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.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.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;

    vk_Down:
      dy := 1;
  end;

  if (dx <> 0) or (dy <> 0) then
    if ssCtrl in Shift then
      DoNudge(dx, dy)
    else if ssShift in Shift then
      DoSize(dx, dy)
    else if ssAlt in Shift then
      DoStick(dx, dy)
    else
      FindNearest(dx, dy);
end;

procedure TfrxDesignerWorkspace.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if FDisableUpdate then exit;
  DoModify;
end;

procedure TfrxDesignerWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  i: Integer;
  c: TfrxComponent;
  EmptySpace: Boolean;
  l: TList;
  NeedRepaint: Boolean;
  p: TPoint;

  function Contain(c: TfrxComponent): Boolean;
  var
    w0, w1, w2, w3: Extended;
    Left, Top, Right, Bottom, e, k, mx, my: Extended;
  begin
    Result := False;
    w0 := 0;
    w1 := 0;
    w2 := 0;
    if c.Width = 0 then
    begin
      w0 := 4;
      w1 := 4
    end
    else if c.Height = 0 then
      w2 := 4;
    w3 := w2;
    if c is TfrxBand then
      if TfrxBand(c).Vertical then
        w0 := FBandHeader
      else
        w2 := FBandHeader;

    Left := c.AbsLeft;
    Right := c.AbsLeft + c.Width;
    Top := c.AbsTop;
    Bottom := c.AbsTop + c.Height;
    mx := X / FScale;
    my := Y / FScale;

    if Right < Left then
    begin
      e := Right;
      Right := Left;
      Left := e;
    end;
    if Bottom < Top then
    begin
      e := Bottom;
      Bottom := Top;
      Top := e;
    end;

    if (c is TfrxLineView) and TfrxLineView(c).Diagonal and
      (c.Width <> 0) and (c.Height <> 0) then
    begin
      k := c.Height / c.Width;
      if Abs((k * (mx - c.AbsLeft) - (my - c.AbsTop)) * cos(arctan(k))) < 5 then
        Result := True;
      if (mx < Left - 5) or (mx > Right + 5) or (my < Top - 5) or (my > Bottom + 5) then
        Result := False;
    end
    else if (mx >= Left - w0) and (mx <= Right + w1) and
      (my >= Top - w2) and (my <= Bottom + w3) then
      Result := True;
  end;

begin
  inherited;
  if FDisableUpdate then exit;
  if FDblClicked then
  begin
    FDblClicked := False;
    exit;
  end;

  if TInplaceMemo(FInplaceMemo).Visible then
    TInplaceMemo(FInplaceMemo).EditDone;

  l := TList.Create;
  for i := 0 to FSelectedObjects.Count - 1 do
    l.Add(FSelectedObjects[i]);

  if FPage is TfrxReportPage then
    ValidParentForm(Self).ActiveControl := Parent else
    ValidParentForm(Self).ActiveControl := nil;

  FMouseDown := True;
  FLastMousePointX := X / FScale;
  FLastMousePointY := Y / FScale;
  NeedRepaint := False;

// Ctrl was pressed
  if (FMode1 = dmNone) and (ssCtrl in Shift) then
  begin
    FSelectedObjects.Clear;
    FSelectedObjects.Add(FPage);
    FMode1 := dmSelectionRect;
    FSelectionRect := frxRect(X, Y, X, Y);
    NeedRepaint := True;
  end;

// clicked on object or on empty space
  if FMode1 = dmNone then
  begin
    EmptySpace := True;

    for i := FObjects.Count - 1 downto 0 do
    begin
      c := FObjects[i];
      if (c is TfrxReportComponent) and Contain(c) then
      begin
        EmptySpace := False;
        if ssShift in Shift then
          if FSelectedObjects.IndexOf(c) <> -1 then
            FSelectedObjects.Remove(c) else
            FSelectedObjects.Add(c)
        else if FSelectedObjects.IndexOf(c) = -1 then
        begin
          FSelectedObjects.Clear;
          FSelectedObjects.Add(c);
        end;
        break;
      end;
    end;

    if EmptySpace then
    begin
      FSelectedObjects.Clear;
      FSelectedObjects.Add(FPage);
      FMode1 := dmSelectionRect;
      FSelectionRect := frxRect(X, Y, X, Y);
    end
    else if FSelectedObjects.Count = 0 then
    begin
      FSelectedObjects.Add(FPage);
      FMode1 := dmNone;
    end
    else
    begin
      FSelectedObjects.Remove(FPage);
      FMode1 := dmMove;
    end;

    NeedRepaint := True;
  end;

// scaling
  if FMode1 = dmScale then
  begin
    FScaleRect := GetSelectionBounds;
    FScaleRect.Right := FScaleRect.Right + FScaleRect.Left;
    FScaleRect.Bottom := FScaleRect.Bottom + FScaleRect.Top;
    FScaleRect1 := FScaleRect;
    for i := 0 to SelectedCount - 1 do
    begin
      c := FSelectedObjects[i];
      THackComponent(c).FOriginalRect := frxRect(c.AbsLeft, c.AbsTop, c.Width, c.Height);
    end;
  end;

// inserting a line
  if FMode1 = dmInsertLine then
  begin
    FInsertion.Width := 0;
    FInsertion.Height := 0;
  end;

  if NeedRepaint then
    if not ListsEqual(l, FSelectedObjects) then
      SelectionChanged else
      Repaint;