⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fr_desgn.pas

📁 FreeReport 2.34 consists of the report engine, designer and previewer, with capabilities comparable
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    DFlag := False;
    Exit;
  end;
  if (Button = mbRight) and Down and RFlag then
    DrawFocusRect(OldRect);
  RFlag := False;
  DrawPage(dmSelection);
  Down := True;
  DontChange := False;
  if Button = mbLeft then
    if (ssCtrl in Shift) or (Cursor = crCross) then
    begin
      RFlag := True;
      if Cursor = crCross then
      begin
        DrawFocusRect(OldRect);
        RoundCoord(x, y);
        OldRect1 := OldRect;
      end;
      OldRect := Rect(x, y, x, y);
      FDesigner.Unselect;
      SelNum := 0;
      RightBottom := -1;
      MRFlag := False;
      FirstSelected := nil;
      Exit;
    end
    else if Cursor = crPencil then
    begin
      with FDesigner do
      if GridAlign then
        if not FindNearestEdge(x, y) then
        begin
          x := Round(x / GridSize) * GridSize;
          y := Round(y / GridSize) * GridSize;
        end;
      OldRect := Rect(x, y, x, y);
      FDesigner.Unselect;
      SelNum := 0;
      RightBottom := -1;
      MRFlag := False;
      FirstSelected := nil;
      LastX := x;
      LastY := y;
      Exit;
    end;
  if Cursor = crDefault then
  begin
    f := False;
    for i := Objects.Count - 1 downto 0 do
    begin
      t := Objects[i];
      Rgn := t.GetClipRgn(rtNormal);
      v := PtInRegion(Rgn, X, Y);
      DeleteObject(Rgn);
      if v then
      begin
        if ssShift in Shift then
        begin
          t.Selected := not t.Selected;
          if t.Selected then Inc(SelNum) else Dec(SelNum);
        end
        else
        begin
          if not t.Selected then
          begin
            FDesigner.Unselect;
            SelNum := 1;
            t.Selected := True;
          end
          else DontChange := True;
        end;
        if SelNum = 0 then FirstSelected := nil
        else if SelNum = 1 then FirstSelected := t
        else if FirstSelected <> nil then
          if not FirstSelected.Selected then FirstSelected := nil;
        f := True;
        break;
      end;
    end;
    if not f then
    begin
      FDesigner.Unselect;
      SelNum := 0;
      FirstSelected := nil;
      if Button = mbLeft then
      begin
        RFlag := True;
        OldRect := Rect(x, y, x, y);
        Exit;
      end;
    end;
    GetMultipleSelected;
    if not DontChange then FDesigner.SelectionChanged;
  end;
  if SelNum = 0 then
  begin // reset multiple selection
    RightBottom := -1;
    MRFlag := False;
  end;
  LastX := x;
  LastY := y;
  Moved := False;
  FirstChange := True;
  FirstBandMove := True;
  if Button = mbRight then
  begin
    DrawPage(dmSelection);
    Down := False;
    GetCursorPos(p);
    FDesigner.Popup1Popup(nil);
    TrackPopupMenu(FDesigner.Popup1.Handle,
      TPM_LEFTALIGN or TPM_RIGHTBUTTON, p.X, p.Y, 0, FDesigner.Handle, nil);
  end
  else if FDesigner.ShapeMode = smFrame then
    DrawPage(dmShape);
end;

procedure TfrDesignerPage.MUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  i, k, dx, dy: Integer;
  t: TfrView;
  ObjectInserted: Boolean;
  procedure AddObject(ot: Byte);
  begin
    Objects.Add(frCreateObject(ot, ''));
    t := Objects.Last;
  end;
  procedure CreateSection;
  var
    s: String;
  begin
    frBandTypesForm := TfrBandTypesForm.Create(nil);
    ObjectInserted := frBandTypesForm.ShowModal = mrOk;
    if ObjectInserted then
    begin
      Objects.Add(TfrBandView.Create);
      t := Objects.Last;
      (t as TfrBandView).BandType := frBandTypesForm.SelectedTyp;
      s := frBandNames[Integer(frBandTypesForm.SelectedTyp)];
      if Pos(' ', s) <> 0 then
      begin
        s[Pos(' ', s) + 1] := UpCase(s[Pos(' ', s) + 1]);
        Delete(s, Pos(' ', s), 1);
      end;
      THackView(t).BaseName := s;
      SendBandsToDown;
    end;
    frBandTypesForm.Free;
  end;
  procedure CreateSubReport;
  begin
    Objects.Add(TfrSubReportView.Create);
    t := Objects.Last;
    (t as TfrSubReportView).SubPage := CurReport.Pages.Count;
    CurReport.Pages.Add;
  end;

begin
  if Button <> mbLeft then Exit;
  Down := False;
  if FDesigner.ShapeMode = smFrame then
    DrawPage(dmShape);
// inserting a new object
  if Cursor = crCross then
  begin
    Mode := mdSelect;
    DrawFocusRect(OldRect);
    if (OldRect.Left = OldRect.Right) and (OldRect.Top = OldRect.Bottom) then
      OldRect := OldRect1;
    NormalizeRect(OldRect);
    RFlag := False;
    ObjectInserted := True;
    with FDesigner.Panel4 do
    for i := 0 to ControlCount - 1 do
      if Controls[i] is TfrSpeedButton then
      with Controls[i] as TfrSpeedButton do
        if Down then
        begin
          if Tag = gtBand then
            if GetUnusedBand <> btNone then
              CreateSection else
              Exit
          else if Tag = gtSubReport then
            CreateSubReport
          else if Tag >= gtAddIn then
          begin
            k := Tag - gtAddIn;
            Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName));
            t := Objects.Last;
          end
          else
            AddObject(Tag);
          break;
        end;
    if ObjectInserted then
    begin
      t.CreateUniqueName;
      with OldRect do
        if (Left = Right) or (Top = Bottom) then
        begin
          dx := 40; dy := 40;
          if t is TfrMemoView then
            FDesigner.GetDefaultSize(dx, dy);
          OldRect := Rect(Left, Top, Left + dx, Top + dy);
        end;
      FDesigner.Unselect;
      t.x := OldRect.Left; t.y := OldRect.Top;
      t.dx := OldRect.Right - OldRect.Left; t.dy := OldRect.Bottom - OldRect.Top;
      if (t is TfrBandView) and
         (TfrBandType(t.FrameTyp) in [btCrossHeader..btCrossFooter]) and
         (t.dx > Width - 10) then
         t.dx := 40;
      t.FrameWidth := LastFrameWidth;
      t.FrameColor := LastFrameColor;
      t.FillColor := LastFillColor;
      t.Selected := True;
      if t.Typ <> gtBand then
        t.FrameTyp := LastFrameTyp;
      if t is TfrMemoView then
        with t as TfrMemoView do
        begin
          Font.Name := LastFontName;
          Font.Size := LastFontSize;
          Font.Color := LastFontColor;
          Font.Style := frSetFontStyle(LastFontStyle);
          Adjust := LastAdjust;
        end;
      SelNum := 1;
      if t.Typ = gtBand then
        Draw(10000, t.GetClipRgn(rtExtended))
      else
      begin
        t.Draw(Canvas);
        DrawSelection(t);
      end;
      with FDesigner do
      begin
        SelectionChanged;
        AddUndoAction(acInsert);
        if EditAfterInsert then
          ShowEditor;
      end;
    end;
    if not ObjRepeat then
      FDesigner.OB1.Down := True else
      DrawFocusRect(OldRect);
    Exit;
  end;
// line drawing
  if Cursor = crPencil then
  begin
    DrawRectLine(OldRect);
    AddObject(gtLine);
    t.CreateUniqueName;
    t.x := OldRect.Left; t.y := OldRect.Top;
    t.dx := OldRect.Right - OldRect.Left; t.dy := OldRect.Bottom - OldRect.Top;
    if t.dx < 0 then
    begin
      t.dx := -t.dx; if Abs(t.dx) > Abs(t.dy) then t.x := OldRect.Right;
    end;
    if t.dy < 0 then
    begin
      t.dy := -t.dy; if Abs(t.dy) > Abs(t.dx) then t.y := OldRect.Bottom;
    end;
    t.Selected := True;
    t.FrameWidth := LastLineWidth;
    t.FrameColor := LastFrameColor;
    SelNum := 1;
    t.Draw(Canvas);
    DrawSelection(t);
    FDesigner.SelectionChanged;
    FDesigner.AddUndoAction(acInsert);
    Exit;
  end;

// calculating which objects contains in frame (if user select it with mouse+Ctrl key)
  if RFlag then
  begin
    DrawFocusRect(OldRect);
    RFlag := False;
    NormalizeRect(OldRect);
    for i := 0 to Objects.Count - 1 do
    begin
      t := Objects[i];
      with OldRect do
      if t.Typ <> gtBand then
        if not ((t.x > Right) or (t.x + t.dx < Left) or
                (t.y > Bottom) or (t.y + t.dy < Top)) then
        begin
          t.Selected := True;
          Inc(SelNum);
        end;
    end;
    GetMultipleSelected;
    FDesigner.SelectionChanged;
    DrawPage(dmSelection);
    Exit;
  end;
// splitting
  if Moved and MRFlag and (Cursor = crHSplit) then
  begin
    with SplitInfo do
    begin
      dx := SplRect.Left - SplX;
      if (View1.dx + dx > 0) and (View2.dx - dx > 0) then
      begin
        Inc(View1.dx, dx);
        Inc(View2.x, dx);
        Dec(View2.dx, dx);
      end;
    end;
    GetMultipleSelected;
    Draw(TopSelected, ClipRgn);
    Exit;
  end;
// resizing several objects
  if Moved and MRFlag and (Cursor <> crDefault) then
  begin
    Draw(TopSelected, ClipRgn);
    Exit;
  end;
// redrawing all moved or resized objects
  if not Moved then DrawPage(dmSelection);
  if (SelNum >= 1) and Moved then
    if SelNum > 1 then
    begin
      Draw(TopSelected, ClipRgn);
      GetMultipleSelected;
      FDesigner.ShowPosition;
    end
    else
    begin
      t := Objects[TopSelected];
      NormalizeCoord(t);
      if Cursor <> crDefault then t.Resized;
      Draw(TopSelected, ClipRgn);
      FDesigner.ShowPosition;
    end;
  Moved := False;
  CT := ctNone;
end;

procedure TfrDesignerPage.MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  i, j, kx, ky, w, dx, dy: Integer;
  t, t1, Bnd: TfrView;
  nx, ny, x1, x2, y1, y2: Double;
  hr, hr1: HRGN;

  function Cont(px, py, x, y: Integer): Boolean;
  begin
    Result := (x >= px - w) and (x <= px + w + 1) and
      (y >= py - w) and (y <= py + w + 1);
  end;
  function GridCheck:Boolean;
  begin
    with FDesigner do
    begin
      Result := (kx >= GridSize) or (kx <= -GridSize) or
                (ky >= GridSize) or (ky <= -GridSize);
      if Result then
      begin
        kx := kx - kx mod GridSize;
        ky := ky - ky mod GridSize;
      end;
    end;
  end;

  procedure AddRgn(var HR: HRGN; T: TfrView);
  var
    tr: HRGN;
  begin
    tr := t.GetClipRgn(rtExtended);
    CombineRgn(HR, HR, TR, RGN_OR);
    DeleteObject(TR);
  end;


begin
  Moved := True;
  w := 2;
  if FirstChange and Down and not RFlag then
  begin
    kx := x - LastX;
    ky := y - LastY;
    if not FDesigner.GridAlign or GridCheck then
    begin
      GetRegion;
      FDesigner.AddUndoAction(acEdit);
    end;
  end;

  if not Down then
    if FDesigner.OB6.Down then
    begin
      Mode := mdSelect;
      Cursor := crPencil;
    end
    else if FDesigner.OB1.Down then
    begin
      Mode := mdSelect;
      Cursor := crDefault;
    end
    else
    begin
      Mode := mdInsert;
      if Cursor <> crCross then
      begin
        RoundCoord(x, y);
        kx := Width; ky := 40;
        if not FDesigner.OB3.Down then
          FDesigner.GetDefaultSize(kx, ky);
        OldRect := Rect(x, y, x + kx, y + ky);
        DrawFocusRect(OldRect);
      end;
      Cursor := crCross;
    end;
  if (Mode = mdInsert) and not Down then
  begin
    DrawFocusRect(OldRect);
    RoundCoord(x, y);
    OffsetRect(OldRect, x - OldRect.Left, y - OldRect.Top);
    DrawFocusRect(OldRect);
    ShowSizes := True;
    FDesigner.PBox1Paint(nil);
    ShowSizes := False;
    Exit;
  end;

 // cursor shapes
  if not Down and (SelNum = 1) and (Mode = mdSelect) and
    not FDesigner.OB6.Down then
  begin
    t := Objects[TopSelected];
    if Cont(t.x, t.y, x, y) or Cont(t.x + t.dx, t.y + t.dy, x, y) then
      Cursor := crSizeNWSE
    else if Cont(t.x + t.dx, t.y, x, y) or Cont(t.x, t.y + t.dy, x, y)then
      Cursor := crSizeNESW
    else if Cont(t.x + t.dx div 2, t.y, x, y) or Cont(t.x + t.dx div 2, t.y + t.dy, x, y) then
      Cursor := crSizeNS
    else if Cont(t.x, t.y + t.dy div 2, x, y) or Cont(t.x + t.dx, t.y + t.dy div 2, x, y) then
      Cursor := crSizeWE
    else
      Cursor := crDefault;
  end;
  // selecting a lot of objects
  if Down and RFlag then
  begin
    DrawFocusRect(OldRect);
    if Cursor = crCross then
      RoundCoord(x, y);
    OldRect := Rect(OldRect.Left, OldRect.Top, x, y);
    DrawFocusRect(OldRect);
    ShowSizes := True;
    if Cursor = crCross then
      FDesigner.PBox1Paint(nil);
    ShowSizes := False;
    Exit;
  end;
  // line drawing

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -