frxdesgnworkspace.pas

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

      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
      FMode1:= dmMove;

    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;

  if (Button = mbRight) and (PopupMenu<>nil) then
  begin
    FMode1:= dmNone;
    FMouseDown:= False;
    Repaint;
    p:= ClientToScreen(Point(X, Y));
    PopupMenu.Popup(p.X, p.Y);
  end;

  l.Free;
end;

procedure TfrxDesignerWorkspace.MouseMove(Shift:TShiftState; X, Y:Integer);
var
  c:TfrxComponent;
  kx, ky, nx, ny:Extended;
  i:Integer;
  NotifyRect:TfrxRect;

  function Contain(px, py:Extended):Boolean;
  begin
    Result:= (X / FScale >= px-2) and (X / FScale <= px+3) and
      (Y / FScale >= py-2) and (Y / FScale <= py+3);
  end;

  function Contain0(py:Extended):Boolean;
  begin
    Result:= (Y / FScale >= py-2) and (Y / FScale <= py+2);
  end;

  function Contain1(px, py:Extended):Boolean;
  begin
    Result:= (FLastMousePointX >= px-2) and (FLastMousePointX <= px+3) and
      (FLastMousePointY >= py-2) and (FLastMousePointY <= py+3);
  end;

  function Contain2(c:TfrxComponent):Boolean;
  var
    w1, w2:Integer;
  begin
    w1:= 0;
    w2:= 0;
    if c.Width = 0 then
      w1:= 4 else
      w2:= 4;
    if (X / FScale >= c.AbsLeft-w1) and (X / FScale <= c.AbsLeft+c.Width+w1) and
       (Y / FScale >= c.AbsTop-w2) and (Y / FScale <= c.AbsTop+c.Height+w2) then
      Result:= True else
      Result:= False;
  end;

  function Contain3(px:Extended):Boolean;
  begin
    Result:= (X / FScale >= px-2) and (X / FScale <= px+2);
  end;

  function GridCheck:Boolean;
  begin
    Result:= (kx >= FGridX) or (kx <=-FGridX) or
              (ky >= FGridY) or (ky <=-FGridY);
    if Result then
    begin
      kx:= Trunc(kx / FGridX) * FGridX;
      ky:= Trunc(ky / FGridY) * FGridY;
    end;