fr_desgn.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

    DrawPage(dmSelection);
    Down := False;
    GetCursorPos(p);
    FDesigner.SelectionChanged;
    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;
    frBandTypesForm: TfrBandTypesForm;

    function IsSubreport(PageN: Integer): Boolean;
    var
      i, j: Integer;
      t: TfrView;
    begin
      Result := False;
      with CurReport do
        for i := 0 to Pages.Count - 1 do
          for j := 0 to Pages[i].Objects.Count - 1 do
          begin
            t := Pages[i].Objects[j];
            if t.Typ = gtSubReport then
              if TfrSubReportView(t).SubPage = PageN then
              begin
                Result := True;
                Exit;
              end;
          end;
    end;

  begin
    frBandTypesForm := TfrBandTypesForm.Create(nil);
    frBandTypesForm.IsSubreport := IsSubreport(FDesigner.CurPage);
    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;

  function CheckUnique(Name: String): Boolean;
  var
    i: Integer;
  begin
    Result := True;
    for i := 0 to Objects.Count - 1 do
      if TfrView(Objects[i]).ClassName = Name then
        if (TfrView(Objects[i]).Flags and flOnePerPage) <> 0 then
          Result := False;
  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;
    if FDesigner.PageType = ptReport then
    begin
      DrawFocusRect(OldRect);
      if (OldRect.Left = OldRect.Right) and (OldRect.Top = OldRect.Bottom) then
        OldRect := OldRect1;
    end;
    NormalizeRect(OldRect);
    RFlag := False;
    if DesignerRestrictions * [frdrDontCreateObj] = [] then
    begin
      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;
              if CheckUnique(frAddIns[k].ClassRef.ClassName) then
              begin
                t := frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName);
                Objects.Add(t);
              end
              else
              begin
                ObjectInserted := False;
                Application.MessageBox(
                  PChar(Format(frLoadStr(SOnePerPage), [frAddIns[k].ClassRef.ClassName])),
                  PChar(frLoadStr(SError)), mb_IconError + mb_Ok);
              end;
            end
            else
              AddObject(Tag);
            break;
          end;
    end
    else
      ObjectInserted := False;
    if ObjectInserted then
    begin
      t.CreateUniqueName;
      if t is TfrSubReportView then
        FDesigner.SetPageTitles;
      with OldRect do
        if (Left = Right) or (Top = Bottom) then
        begin
          dx := 36; dy := 36;
          if t is TfrMemoView then
            FDesigner.GetDefaultSize(dx, dy)
          else if FDesigner.PageType = ptDialog then
          begin
            dx := t.dx;
            dy := t.dy;
          end;
          OldRect := Rect(Left, Top, Left + dx, Top + dy);
        end;
      FDesigner.Unselect;
      t.x := OldRect.Left; t.y := OldRect.Top;
      if (t.dx = 0) and (t.dy = 0) then
      begin
        t.dx := OldRect.Right - OldRect.Left; t.dy := OldRect.Bottom - OldRect.Top;
      end;
      if (t is TfrBandView) and
         (TfrBandType(t.FrameTyp) in [btCrossHeader..btCrossFooter]) and
         (t.dx > Width - 10) then
         t.dx := 40;
      if t.Typ <> gtAddIn then
        t.FrameWidth := LastFrameWidth;
      t.FrameColor := LastFrameColor;
      t.FillColor := LastFillColor;
      t.Selected := True;
      if t is TfrMemoView then
        with t as TfrMemoView do
        begin
          FrameTyp := LastFrameTyp;
          Font.Name := LastFontName;
          Font.Size := LastFontSize;
          Font.Color := LastFontColor;
          Font.Style := frSetFontStyle(LastFontStyle);
{$IFNDEF Delphi2}
          Font.Charset := LastCharset;
{$ENDIF}
          Alignment := LastAlignment;
        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 and not FDrag and not (t is TfrControl) then
          ShowEditor;
      end;
    end;
    if not ObjRepeat then
      FDesigner.OB1.Down := True else
      DrawFocusRect(OldRect);
    Exit;
  end;
// line drawing
  if Cursor = crPencil then
  begin
    with OldRect do
      if (Left = Right) and (Top = Bottom) then
        Exit;
    if DesignerRestrictions * [frdrDontCreateObj] <> [] then Exit;
    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);
    SelNum := 0;
    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;

    if SelNum = 0 then
      for i := 0 to Objects.Count - 1 do
      begin
        t := Objects[i];
        with OldRect do
          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 DesignerRestrictions * [frdrDontMoveObj, frdrDontSizeObj] = [] then
        if ((View1.Restrictions and frrfDontSize) = 0) and
          ((View2.Restrictions and (frrfDontMove + frrfDontSize)) = 0) then
          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
  begin
    FDesigner.SelectionChanged;
    DrawPage(dmSelection);
  end;
  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.SelectionChanged;
      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;
  FAlign, cv: Boolean;
  ii: Integer;

  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 >= GridSizeX) or (kx <= -GridSizeX) or
                (ky >= GridSizeY) or (ky <= -GridSizeY);
      if Result then
      begin
        kx := kx - kx mod GridSizeX;
        ky := ky - ky mod GridSizeY;
      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;

  function CheckNegative(t: TfrView): Boolean;
  begin
    if (t.dx < 0) or (t.dy < 0) then
    begin
      NormalizeCoord(t);
      Result := True;
    end
    else
      Result := False;
  end;

begin
  Moved := True;
  FDrag := False;
  FAlign := FDesigner.GridAlign;
  if ssAlt in Shift then
    FAlign := not FAlign;

  w := 2;
  if FirstChange and Down and not RFlag then
  begin
    kx := x - LastX;
    ky := y - LastY;
    if not FAlign 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;
      if SelNum = 0 then
      begin
        ShowSizes := False;
        OldRect := Rect(x, y, x, y);
        FDesigner.PBox1Paint(nil);
      end;
    end
    else
    begin
      Mode := mdInsert;
      if Cursor <> crCross then
      begin
        RoundCoord(x, y);
        FDesigner.GetDefaultSize(kx, ky);
        if FDesigner.OB3.Down then
          kx := Width;
        OldRect := Rect(x, y, x + kx, y + ky);
        if FDesigner.PageType = ptReport then
          DrawFocusRect(OldRect);
      end;
      Cursor := crCross;
    end;

  if (Mode = mdInsert) and not Down then
  begin
    if FDesigner.PageType = ptReport then
      DrawFocusRect(OldRect);
    RoundCoord(x, y);
    OffsetRect(OldRect, x - OldRect.Left, y - OldRect.Top);
    if FDesigner.PageType = ptReport then
      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