frxdesgnworkspace1.pas

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

  inherited;

  if FTool = dtHand then
  begin
    Cursor := crHand;

    if FMouseDown then
    begin
      kx := X - FLastMousePointX;
      ky := Y - FLastMousePointY;

      if Parent is TScrollingWinControl then
        with TScrollingWinControl(Parent) do
        begin
          px := HorzScrollBar.Position;
          py := VertScrollBar.Position;
          HorzScrollBar.Position := px - Round(kx);
          VertScrollBar.Position := py - Round(ky);
          if HorzScrollBar.Position = px then
            FLastMousePointX := X;
          if VertScrollBar.Position = py then
            FLastMousePointY := Y;
        end;
    end;
  end
  else if FTool = dtZoom then
    Cursor := crZoom
  else if FTool = dtText then
    Cursor := crIBeam
  else if FTool = dtFormat then
    Cursor := crFormat;

  if not FMouseDown and (FMode = dmSelect) and
    ((FMode1 = dmNone) or (FMode1 = dmMoveGuide)) and not FPopupFormVisible then
  begin
    if FPage is TfrxReportPage then
    begin
      for i := 0 to HGuides.Count - 1 do
      begin
        e := frxStrToFloat(HGuides[i]);
        if (Y / Scale > e - 5) and (Y / Scale < e + 5) then
        begin
          FMode1 := dmMoveGuide;
          Cursor := crVSplit;
          FGuide := i;
        end;
      end;

      for i := 0 to VGuides.Count - 1 do
      begin
        e := frxStrToFloat(VGuides[i]);
        if (X / Scale > e - 5) and (X / Scale < e + 5) then
        begin
          FMode1 := dmMoveGuide;
          Cursor := crHSplit;
          FGuide := i;
        end;
      end;
    end;

    if FMode1 = dmNone then
    begin
      cOver := nil;
      for i := FObjects.Count - 1 downto 0 do
      begin
        c := FObjects[i];
        if (c is TfrxMemoView) and Contain(c) and
           (c.Parent is TfrxDataBand) and
           (TfrxDataBand(c.Parent).Dataset <> nil) and
           (TfrxDataBand(c.Parent).Dataset.FieldsCount > 0) then
        begin
          ds := TfrxDataBand(c.Parent).Dataset;
          if ds <> nil then
            cOver := c;
          break;
        end;
      end;

      if FMemo <> cOver then
      begin
        FMemo := TfrxMemoView(cOver);
        Repaint;
      end;
    end;
  end;

// moving the guideline
  if FMouseDown and (FMode1 = dmMoveGuide) then
  begin
    if Cursor = crHSplit then
    begin
      e := frxStrToFloat(VGuides[FGuide]);
      kx := X / Scale - FLastMousePointX;
      ky := 0;

      if not (GridAlign and not GridCheck) then
      begin
        FModifyFlag := True;
        e := Round((e + kx) * 100000000) / 100000000;
        FLastMousePointX := FLastMousePointX + kx;
      end;

      VGuides[FGuide] := FloatToStr(e);
    end
    else
    begin
      e := frxStrToFloat(HGuides[FGuide]);
      kx := 0;
      ky := Y / Scale - FLastMousePointY;

      if not (GridAlign and not GridCheck) then
      begin
        FModifyFlag := True;
        e := Round((e + ky) * 100000000) / 100000000;
        FLastMousePointY := FLastMousePointY + ky;
      end;

      HGuides[FGuide] := FloatToStr(e);
    end;

    Repaint;
  end;
end;

procedure TDesignerWorkspace.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  e: Extended;
  c: TfrxComponent;

  function Contain(c: TfrxComponent): Boolean;
  begin
    with FSelectionRect do
      Result := not ((c.Left > Right / FScale) or
                     (c.Left + c.Width < Left / FScale) or
                     (c.AbsTop > Bottom / FScale) or
                     (c.AbsTop + c.Height < Top / FScale));
  end;

  procedure CopyFormat(MemoFrom, MemoTo: TfrxMemoView);
  begin
    MemoTo.Color := MemoFrom.Color;
    MemoTo.Font := MemoFrom.Font;
    MemoTo.Frame.Assign(MemoFrom.Frame);
    MemoTo.BrushStyle := MemoFrom.BrushStyle;
    MemoTo.HAlign := MemoFrom.HAlign;
    MemoTo.VAlign := MemoFrom.VAlign;
  end;

begin
  if FDisableUpdate then Exit;
  FSimulateMove := False;
  FVirtualGuideObjects.Clear;

  if FTool = dtZoom then
  begin
    FMode1 := dmNone;
    NormalizeRect(FSelectionRect);

    with FSelectionRect do
      if (Right - Left > 5) and (Bottom - Top > 5) then
      begin
        e := Scale;

        if (Right - Left) / (Parent.ClientWidth - 16) <
           (Bottom - Top) / (Parent.ClientHeight - 16) then
          FDesigner.Scale := (Parent.ClientHeight - 16) / (Bottom - Top) * Scale else
          FDesigner.Scale := (Parent.ClientWidth - 16) / (Right - Left) * Scale;

        if Parent is TScrollingWinControl then
          with TScrollingWinControl(Parent) do
          begin
            HorzScrollBar.Position := Round((FSelectionRect.Left / e +
              TfrxReportPage(FDesigner.Page).LeftMargin * fr01cm) * Scale);
            VertScrollBar.Position := Round((FSelectionRect.Top / e +
              TfrxReportPage(FDesigner.Page).TopMargin * fr01cm) * Scale);
          end;
      end
      else
      begin
        e := Scale;
        if Button = mbLeft then
        begin
          if FDesigner.Scale >= 1 then
            FDesigner.Scale := FDesigner.Scale + 1
          else
            FDesigner.Scale := FDesigner.Scale + 0.25
        end
        else
        begin
          if FDesigner.Scale >= 2 then
            FDesigner.Scale := FDesigner.Scale - 1
          else if FDesigner.Scale > 0.4 then
            FDesigner.Scale := FDesigner.Scale - 0.25
        end;
        if Parent is TScrollingWinControl then
          with TScrollingWinControl(Parent) do
          begin
            HorzScrollBar.Position := Round((FSelectionRect.Left / e +
              TfrxReportPage(FDesigner.Page).LeftMargin * fr01cm) * Scale -
              ClientWidth / 2);
            VertScrollBar.Position := Round((FSelectionRect.Top / e +
              TfrxReportPage(FDesigner.Page).TopMargin * fr01cm) * Scale -
              ClientHeight / 2);
          end;
      end;
  end

  else if (FTool = dtText) and FMouseDown then
  begin
    FMode1 := dmNone;
    FMouseDown := False;
    NormalizeRect(FSelectionRect);

    if FInplaceObject <> nil then
      TInplaceMemo(FInplaceMemo).EditDone;

    FInplaceObject := nil;

    with FSelectionRect do
      if (Right - Left < 5) or (Bottom - Top < 5) then
      begin
        for i := 0 to FObjects.Count - 1 do
        begin
          c := FObjects[i];
          if (c is TfrxCustomMemoView) and Contain(c) then
            FInplaceObject := TfrxMemoView(c);
        end;
      end
      else
      begin
        if GridAlign then
        begin
          Left := Trunc(Left / GridX) * GridX;
          Right := Trunc(Right / GridX) * GridX;
          Top := Trunc(Top / GridY) * GridY;
          Bottom := Trunc(Bottom / GridY) * GridY;
        end;

        FInsertion.Left := Left / FScale;
        FInsertion.Top := Top / FScale;
        FInsertion.Width := (Right - Left) / FScale;
        FInsertion.Height := (Bottom - Top) / FScale;
        if Page is TfrxDMPPage then
          FInsertion.ComponentClass := TfrxDMPMemoView else
          FInsertion.ComponentClass := TfrxMemoView;

        if Assigned(FOnInsert) then
          FOnInsert(Self);
        AdjustBands;

        if TObject(FSelectedObjects[0]) is TfrxCustomMemoView then
          FInplaceObject := FSelectedObjects[0];
      end;

    if FInplaceObject <> nil then
    begin
      FSelectedObjects.Clear;
      FSelectedObjects.Add(FInplaceObject);
      SelectionChanged;
      TInplaceMemo(FInplaceMemo).Edit(FInplaceObject);
    end;

    Exit;
  end
  else if FTool = dtFormat then
  begin
    FSelectionRect := frxRect(X, Y, X + 1, Y + 1);
    for i := FObjects.Count - 1 downto 0 do
    begin
      c := FObjects[i];
      if (c is TfrxMemoView) and Contain(c) and not
         (rfDontModify in c.Restrictions) and (c <> FSelectedObjects[0]) then
      begin
        CopyFormat(TfrxMemoView(FSelectedObjects[0]), TfrxMemoView(c));
        FModifyFlag := True;
        break;
      end;
    end;
  end;


  if FMode1 = dmMoveGuide then
  begin
    if Cursor = crHSplit then
    begin
      e := frxStrToFloat(VGuides[FGuide]);
      if (e < 3) or (e > (Width / Scale) - 3) then
        VGuides.Delete(FGuide);
    end
    else
    begin
      e := frxStrToFloat(HGuides[FGuide]);
      if (e < 3) or (e > (Height / Scale) - 3) then
        HGuides.Delete(FGuide);
    end;

    Repaint;
  end;

  inherited;
end;

procedure TDesignerWorkspace.DblClick;
begin
  if FTool = dtSelect then
    inherited;
end;

procedure TDesignerWorkspace.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) and FSimulateMove then
  begin
    Key := VK_DELETE;
    MouseUp(mbLeft, [], 0, 0);
  end;
  inherited;
end;

procedure TDesignerWorkspace.SimulateMove;
var
  r: TfrxRect;
begin
  FMode1 := dmMove;
  r := GetSelectionBounds;
  MouseDown(mbLeft, [], Round(r.Left / Scale) + 20, Round(r.Top / Scale) + 20);
  FSimulateMove := True;
end;

procedure TDesignerWorkspace.CreateVirtualGuides;
var
  i: Integer;
begin
  FVirtualGuideObjects.Clear;
  for i := 0 to Objects.Count - 1 do
    FVirtualGuideObjects.Add(Objects[i]);
end;

procedure TDesignerWorkspace.DoLBClick(Sender: TObject);
begin
  if FMemo <> nil then
  begin
    FMemo.DataSet := TfrxDataBand(FMemo.Parent).Dataset;
    FMemo.DataField := FListBox.Items[FListBox.ItemIndex];
  end;
  FPopupForm.Hide;

  FModifyFlag := True;
  DoModify;
end;

procedure TDesignerWorkspace.DoPopupHide(Sender: TObject);
begin
  FPopupFormVisible := False;
end;

procedure TDesignerWorkspace.LBDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
begin
  with FListBox do
  begin
    Canvas.FillRect(ARect);
    frxResources.MainButtonImages.Draw(Canvas, ARect.Left, ARect.Top, 54);
    Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
  end;
end;

procedure TDesignerWorkspace.CheckGuides(var kx, ky: Extended;
  var Result: Boolean);
var
  i: Integer;
  c: TfrxComponent;

  procedure CheckH(coord: Extended);
  var
    i: Integer;
    e: Extended;
  begin
    if FPage is TfrxReportPage then
      for i := 0 to HGuides.Count - 1 do
      begin
        e := frxStrToFloat(HGuides[i]);
        if Abs(coord + ky - e) < 6 then
        begin
          ky := e - coord;
          break;
        end;
      end;
  end;

  procedure CheckV(coord: Extended);
  var
    i: Integer;
    e: Extended;
  begin
    if FPage is TfrxReportPage then
      for i := 0 to VGuides.Count - 1 do
      begin
        e := frxStrToFloat(VGuides[i]);
        if Abs(coord + kx - e) < 6 then
        begin
          kx := e - coord;
          break;
        end;
      end;
  end;

  procedure CheckHH(Left, Top: Extended; Obj: TfrxComponent);
  var
    i: Integer;
    c: TfrxComponent;
    e: Extended;
  begin
    for i := 0 to FVirtualGuideObjects.Count - 1 do
    begin
      c := FVirtualGuideObjects[i];
      if c = Obj then continue;
      e := c.AbsTop;
      if Abs(Top + ky - e) < 0.001 then
        FVirtualGuides.Add(Left, e, c.AbsLeft, e);
      e := c.AbsTop + c.Height;
      if Abs(Top + ky - e) < 0.001 then
        FVirtualGuides.Add(Left, e, c.AbsLeft, e);
    end;
  end;

  procedure CheckVV(Left, Top: Extended; Obj: TfrxComponent);
  var
    i: Integer;
    c: TfrxComponent;
    e: Extended;
  begin
    for i := 0 to FVirtualGuideObjects.Count - 1 do
    begin
      c := FVirtualGuideObjects[i];
      if c = Obj then continue;
      e := c.AbsLeft;
      if Abs(Left + kx - e) < 0.001 then
        FVirtualGuides.Add(e, c.AbsTop, e, Top);
      e := c.AbsLeft + c.Width;
      if Abs(Left + kx - e) < 0.001 then
        FVirtualGuides.Add(e, c.AbsTop, e, Top);
    end;
  end;

begin
  if not FShowGuides then Exit;

  FVirtualGuides.Clear;

  if FMouseDown and (FMode1 = dmSizeBand) then
    CheckH(FSizedBand.Top + FSizedBand.Height);

  if not FMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
  begin
    CheckV(FInsertion.Left);
    CheckH(FInsertion.Top);
    CheckVV(FInsertion.Left, FInsertion.Top, nil);
    CheckHH(FInsertion.Left, FInsertion.Top, nil);
    CheckV(FInsertion.Left + FInsertion.Width);
    CheckH(FInsertion.Top + FInsertion.Height);
    CheckVV(FInsertion.Left + FInsertion.Width, FInsertion.Top, nil);
    CheckHH(FInsertion.Left, FInsertion.Top + FInsertion.Height, nil);
  end;

  if FMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
  begin
    CheckV(FInsertion.Left);
    CheckH(FInsertion.Top);
    CheckVV(FInsertion.Left, FInsertion.Top, nil);
    CheckHH(FInsertion.Left, FInsertion.Top, nil);
  end;

  if FMouseDown and (FMode1 = dmMove) then
    for i := 0 to SelectedCount - 1 do
    begin
      c := FSelectedObjects[i];
      CheckV(c.Left);
      CheckVV(c.AbsLeft, c.AbsTop, c);
      CheckHH(c.AbsLeft, c.AbsTop, c);
      CheckH(c.AbsTop);
      CheckH(c.Top);
      CheckV(c.Left + c.Width);
      CheckVV(c.AbsLeft + c.Width, c.AbsTop, c);
      CheckHH(c.AbsLeft, c.AbsTop + c.Height, c);
      CheckH(c.AbsTop + c.Height);
    end;

  if FMouseDown and (FMode1 = dmSize) then
  begin
    c := FSelectedObjects[0];
    if FCT in [ct1, ct6, ct4] then
    begin
      CheckV(c.Left);
      CheckVV(c.AbsLeft, c.AbsTop, c);
    end;
    if FCT in [ct1, ct7, ct3] then
    begin
      CheckH(c.AbsTop);
      CheckHH(c.AbsLeft, c.AbsTop, c);
    end;
    if FCT in [ct3, ct5, ct2] then
    begin
      CheckV(c.Left + c.Width);
      CheckVV(c.AbsLeft + c.Width, c.AbsTop, c);
    end;
    if FCT in [ct4, ct8, ct2] then
    begin
      CheckH(c.AbsTop + c.Height);
      CheckHH(c.AbsLeft, c.AbsTop + c.Height, c);
    end;
  end;
end;

procedure TDesignerWorkspace.SetShowGuides(const Value: Boolean);
begin
  FShowGuides := Value;
  Invalidate;
end;

function TDesignerWorkspace.GetHGuides: TStrings;
begin
  Result := TfrxReportPage(FPage).HGuides;
end;

function TDesignerWorkspace.GetVGuides: TStrings;
begin
  Result := TfrxReportPage(FPage).VGuides;
end;

procedure TDesignerWorkspace.SetHGuides(const Value: TStrings);
begin
  TfrxReportPage(FPage).HGuides := Value;
end;

procedure TDesignerWorkspace.SetVGuides(const Value: TStrings);
begin
  TfrxReportPage(FPage).VGuides := Value;
end;

procedure TDesignerWorkspace.SetTool(const Value: TfrxDesignTool);
begin
  FTool := Value;
end;

end.


//