frxdesgnworkspace.pas

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

    vk_Down:
      dy := 1;

    vk_Tab:
      DoTab;
  end;

  if (dx <> 0) or (dy <> 0) then
    if ssCtrl in Shift then
      DoNudge(dx, dy, not (ssShift in Shift))
    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, j: Integer;
  c, c1: 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 csContainer in c.frComponentStyle then
        begin
          if c.ContainerMouseDown(Self, X, Y) then
            FMode1 := dmContainer
          else
            for j := c.ContainerObjects.Count - 1 downto 0 do
            begin
              c1 := c.ContainerObjects[j];
              if c1.Visible and Contain(c1) then
              begin
                c := c1;
                break;
              end;
            end;
        end;

        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);
      if FMode1 <> dmContainer then
        FMode1 := dmMove;
    end;

    NeedRepaint := True;
  end;

//band detach band objects
  if (FMode1 = dmMove) and (FSelectedObjects.Count = 1) and
    (TObject(FSelectedObjects[0]) is TfrxBand) and (ssAlt in Shift) then
    AdjustBands(False);

// 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, SaveBounds: 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;

    FInsertion.Left :=