frxdesgnworkspace.pas

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

  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;
  end;

  function CheckMove: Boolean;
  var
    al: Boolean;
  begin
    al := FGridAlign;
    if ssAlt in Shift then
      al := not al;

    Result := False;

    if al and not GridCheck then
      Result := True;

    CheckGuides(kx, ky, Result);
  end;

  procedure CheckNegative(c: TfrxComponent);
  const
    ar1: array[ct1..ct8] of TfrxCursorType = (ct3, ct4, ct1, ct2, ct6, ct5, ct0, ct0);
    ar2: array[ct1..ct8] of TfrxCursorType = (ct4, ct3, ct2, ct1, ct0, ct0, ct8, ct7);
    ar3: array[ct1..ct8] of TfrxCursorType = (ct2, ct1, ct4, ct3, ct0, ct0, ct0, ct0);
  begin
    if (c is TfrxLineView) and (TfrxLineView(c).Diagonal = True) then exit;
    if (c.Width < 0) and (c.Height < 0) then
      FCT := ar3[FCT]
    else if c.Width < 0 then
      FCT := ar1[FCT]
    else if c.Height < 0 then
      FCT := ar2[FCT];
    NormalizeCoord(c);
  end;

  procedure CTtoCursor;
  const
    ar: array[ct0..ct10] of TCursor =
      (crDefault, crSizeNWSE, crSizeNWSE, crSizeNESW,
       crSizeNESW, crSizeWE, crSizeWE, crSizeNS, crSizeNS, crCross, crCross);
  begin
    Cursor := ar[FCT];
  end;

begin
  inherited;
  if FDisableUpdate then Exit;

  if SelectedCount = 0 then
    NotifyRect := frxRect(X / FScale, Y / FScale, 0, 0) else
    NotifyRect := GetSelectionBounds;

// cursor shapes
  if not FMouseDown and (FMode = dmSelect) then
    if SelectedCount = 1 then
    begin
      FMode1 := dmSize;
      c := FSelectedObjects[0];
      FCT := ct0;
      if Contain(c.AbsLeft, c.AbsTop) then
        FCT := ct1
      else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
        FCT := ct2
      else if Contain(c.AbsLeft + c.Width, c.AbsTop) then
        FCT := ct3
      else if Contain(c.AbsLeft, c.AbsTop + c.Height) then
        FCT := ct4
      else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height / 2) then
        FCT := ct5
      else if Contain(c.AbsLeft, c.AbsTop + c.Height / 2) then
        FCT := ct6
      else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop) then
        FCT := ct7
      else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop + c.Height) then
        FCT := ct8;

      if c is TfrxCustomLineView then
        if not TfrxCustomLineView(c).Diagonal then
        begin
          if c.Width = 0 then
            if FCT in [ct1, ct3] then
              FCT := ct7
            else if FCT in [ct4, ct2] then
              FCT := ct8
            else
              FCT := ct0;
          if c.Height = 0 then
            if FCT in [ct1, ct4] then
              FCT := ct6
            else if FCT in [ct3, ct2] then
              FCT := ct5
            else
              FCT := ct0;
        end
        else
          if FCT = ct1 then
            FCT := ct9
          else if FCT = ct2 then
            FCT := ct10
          else
            FCT := ct0;


      if FCT = ct0 then
        FMode1 := dmNone;
      CTtoCursor;
    end
    else if SelectedCount > 1 then
    begin
      FMode1 := dmScale;
      c := GetRightBottomObject;
      if (c <> nil) and Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
        Cursor := crSizeNWSE
      else
      begin
        Cursor := crDefault;
        FMode1 := dmNone;
      end;
    end
    else
      Cursor := crDefault;

// resizing a band - setup
  if not FMouseDown and (FMode = dmSelect) and not (FMode1 in [dmSize, dmScale]) then
  begin
    Cursor := crDefault;
    FMode1 := dmNone;
    for i := 0 to FObjects.Count - 1 do
    begin
      c := FObjects[i];
      if c is TfrxBand then
        if TfrxBand(c).Vertical then
        begin
          if Contain3(c.Left + c.Width) then
          begin
            Cursor := crHSplit;
            FMode1 := dmSizeBand;
            FSizedBand := TfrxBand(c);
            break;
          end;
        end
        else
        begin
          if Contain0(c.Top + c.Height) then
          begin
            Cursor := crVSplit;
            FMode1 := dmSizeBand;
            FSizedBand := TfrxBand(c);
            break;
          end;
        end;
    end;
  end;

// resizing a band
  if FMouseDown and (FMode1 = dmSizeBand) then
  begin
    kx := X / FScale - FLastMousePointX;
    ky := Y / FScale - FLastMousePointY;
    if CheckMove then Exit;

    FModifyFlag := True;
    if FSizedBand.Vertical then
      FSizedBand.Width := FSizedBand.Width + kx
    else
      FSizedBand.Height := FSizedBand.Height + ky;
    AdjustBandHeight(FSizedBand);
    AdjustBands;

    FLastMousePointX := FLastMousePointX + kx;
    FLastMousePointY := FLastMousePointY + ky;
    Repaint;
    with FSizedBand do
      NotifyRect := frxRect(Left, Top, Width, Height);
  end;

// inplace editing - setup
  if not FMouseDown and (ssAlt in Shift) then
  begin
    Cursor := crDefault;
    FMode1 := dmNone;
    for i := 0 to FObjects.Count - 1 do
    begin
      c := FObjects[i];
      if (c is TfrxCustomMemoView) and Contain2(c) then
      begin
        FInplaceObject := TfrxCustomMemoView(c);
        Cursor := crIBeam;
        FMode1 := dmInplaceEdit;
        break;
      end;
    end;
  end;

// inserting
  if not FMouseDown and (FMode1 = dmInsertObject) then
  begin
    kx := X / FScale - FInsertion.Left;
    ky := Y / FScale - FInsertion.Top;
    if CheckMove then Exit;

    DrawInsertionRect;
    FInsertion.Left := FInsertion.Left + kx;
    FInsertion.Top := FInsertion.Top + ky;
    DrawInsertionRect;
    with FInsertion do
      NotifyRect := frxRect(Left, Top, Width, Height);
  end;

// inserting + resizing
  if FMouseDown and (FMode1 = dmInsertObject) then
  begin
    kx := X / FScale - FInsertion.Left;
    ky := Y / FScale - FInsertion.Top;
    if CheckMove then Exit;

    DrawInsertionRect;
    FInsertion.Width := kx;
    FInsertion.Height := ky;
    DrawInsertionRect;
    with FInsertion do
      NotifyRect := frxRect(Left, Top, Width, Height);
  end;

// moving
  if FMouseDown and (FMode1 = dmMove) then
  begin
    kx := X / FScale - FLastMousePointX;
    ky := Y / FScale - FLastMousePointY;
    if CheckMove then Exit;

    if not FModifyFlag and (SelectedCount = 1) and
      (TObject(FSelectedObjects[0]) is TfrxBand) and
      (TfrxBand(FSelectedObjects[0]).Vertical) then
    begin
      for i := 0 to FObjects.Count - 1 do
      begin
        c := FObjects[i];
        if (c is TfrxView) and
          (c.Left >= TfrxBand(FSelectedObjects[0]).Left - 1e-4) and
          (c.Left + c.Width <= TfrxBand(FSelectedObjects[0]).Left +
          TfrxBand(FSelectedObjects[0]).Width + 1e-4) then
          FSelectedObjects.Add(c);
      end;
    end;

    if (TObject(FSelectedObjects[0]) is TfrxBand) and
      (TfrxBand(FSelectedObjects[0]).Vertical) then
      ky := 0;

    FModifyFlag := True;
    for i := 0 to SelectedCount - 1 do
    begin
      c := FSelectedObjects[i];
      c.Left := c.Left + kx;
      if FSelectedObjects.IndexOf(c.Parent) = -1 then
        c.Top := c.Top + ky;
    end;

    FLastMousePointX := FLastMousePointX + kx;
    FLastMousePointY := FLastMousePointY + ky;
    Repaint;
    NotifyRect := GetSelectionBounds;
  end;

// resizing one object
  if FMouseDown and (FMode1 = dmSize) then
  begin
    kx := X / FScale - FLastMousePointX;
    ky := Y / FScale - FLastMousePointY;
    if CheckMove then Exit;

    FModifyFlag := True;
    c := FSelectedObjects[0];
    case FCT of
      ct1, ct9:
        begin
          c.Left := c.Left + kx;
          c.Width := c.Width - kx;
          c.Top := c.Top + ky;
          c.Height := c.Height - ky;
        end;

      ct2, ct10:
        begin
          c.Width := c.Width + kx;
          c.Height := c.Height + ky;
        end;

      ct3:
        begin
          c.Top := c.Top + ky;
          c.Width := c.Width + kx;
          c.Height := c.Height - ky;
        end;

      ct4:
        begin
          c.Left := c.Left + kx;
          c.Width := c.Width - kx;
          c.Height := c.Height + ky;
        end;

      ct5:
        begin
          c.Width := c.Width + kx;
        end;

      ct6:
        begin
          c.Left := c.Left + kx;
          c.Width := c.Width - kx;
        end;

      ct7:
        begin
          c.Top := c.Top + ky;
          c.Height := c.Height - ky;
        end;

      ct8:
        begin
          c.Height := c.Height + ky;
        end;
    end;
    CheckNegative(c);
    CTtoCursor;

    if c.Left < 0 then
      c.Left := 0;

    if c is TfrxBand then
    begin
      if FCT in [ct1, ct3, ct7] then
        for i := 0 to c.Objects.Count - 1 do
          with TfrxComponent(c.Objects[i]) do
            Top := Top - ky;
      AdjustBandHeight(TfrxBand(c));
      AdjustBands;
    end;

    FLastMousePointX := FLastMousePointX + kx;
    FLastMousePointY := FLastMousePointY + ky;
    Repaint;
    NotifyRect := frxRect(c.Left, c.Top, c.Width, c.Height);
  end;

// scaling
  if FMouseDown and (FMode1 = dmScale) then
  begin
    kx := X / FScale - FLastMousePointX;
    ky := Y / FScale - FLastMousePointY;
    if CheckMove then Exit;

    FModifyFlag := True;
    with FScaleRect do
      if not ((Right + kx < Left) or (Bottom + ky < Top)) then
        FScaleRect := frxRect(Left, Top, Right + kx, Bottom + ky);
    nx := (FScaleRect.Right - FScaleRect.Left) / (FScaleRect1.Right - FScaleRect1.Left);
    ny := (FScaleRect.Bottom - FScaleRect.Top) / (FScaleRect1.Bottom - FScaleRect1.Top);
    for i := 0 to SelectedCount - 1 do
    begin
      c := FSelectedObjects[i];
      c.Left := FScaleRect1.Left + (THackComponent(c).FOriginalRect.Left - FScaleRect1.Left) * nx;
      c.Top := FScaleRect1.Top + (THackComponent(c).FOriginalRect.Top - FScaleRect1.Top) * ny;
      if c.Parent is TfrxBand then
        c.Top := c.Top - c.Parent.Top;
      c.Width := THackComponent(c).FOriginalRect.Right * nx;
      c.Height := THackComponent(c).FOriginalRect.Bottom * ny;
    end;

    FLastMousePointX := FLastMousePointX + kx;
    FLastMousePointY := FLastMousePointY + ky;
    Repaint;
    with FScaleRect do
      NotifyRect := frxRect(Right - Left, Bottom - Top, nx, ny);
  end;

// drawing selection rectangle
  if FMouseDown and (FMode1 = dmSelectionRect) then
  begin
    DrawSelectionRect;
    FSelectionRect := frxRect(FSelectionRect.Left, FSelectionRect.Top, X, Y);
    DrawSelectionRect;
  end;

// inserting a line
  if not FMouseDown and (FMode1 = dmInsertLine) then
  begin
    kx := X / FScale - FInsertion.Left;
    ky := Y / FScale - FInsertion.Top;
    if CheckMove then Exit;

    DrawCross(False);
    FInsertion.Left := FInsertion.Left + kx;
    FInsertion.Top := FInsertion.Top + ky;
    DrawCross(False);
    with FInsertion do
      NotifyRect := frxRect(Left, Top, 0, 0);
  end;

// inserting a line + resizing
  if FMouseDown and (FMode1 = dmInsertLine) then
  begin
    kx := X / FScale - (FInsertion.Left + FInsertion.Width);
    ky := Y / FScale - (FInsertion.Top + FInsertion.Height);
    if CheckMove then Exit;

    DrawCross(True);
    FInsertion.Width := FInsertion.Width + kx;
    FInsertion.Height := FInsertion.Height + ky;
    DrawCross(True);
    with FInsertion do
      NotifyRect := frxRect(Left, Top, Width, Height);
  end;

  if FMouseDown and (Cursor <> crHand) then
    if Parent is TScrollingWinControl then
      with TScrollingWinControl(Parent) do
      begin
        x := x + Round(FMargins.Left * FScale);
        y := y + Round(