fr_desgn.pas

不错的报表工具

      begin
        MoveTo(Left, Top);
        LineTo(Right, Top);
      end
      else
      begin
        MoveTo(Left, Top);
        LineTo(Left, Bottom);
      end;
    Pen.Mode := pmCopy;
  end;
end;

procedure TfrDesignerPage.DrawFocusRect(Rect: TRect);
begin
  with Canvas do
  begin
    Pen.Mode := pmXor;
    Pen.Color := clSilver;
    Pen.Width := 1;
    Pen.Style := psSolid;
    Brush.Style := bsClear;
    if (Rect.Right = Rect.Left + 1) or (Rect.Bottom = Rect.Top + 1) then
    begin
      if Rect.Right = Rect.Left + 1 then
        Dec(Rect.Right, 1) else
        Dec(Rect.Bottom, 1);
      MoveTo(Rect.Left, Rect.Top);
      LineTo(Rect.Right, Rect.Bottom);
    end
    else
      Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    Pen.Mode := pmCopy;
    Brush.Style := bsSolid;
  end;
end;

procedure TfrDesignerPage.DrawSelection(t: TfrView);
var
  px, py: Word;

  procedure DrawPoint(x, y: Word);
  begin
    Canvas.MoveTo(x, y);
    Canvas.LineTo(x, y);
  end;

begin
  if t.Selected then
  with t, Canvas do
  begin
    Pen.Width := 5;
    Pen.Mode := pmXor;
    Pen.Color := clWhite;
    px := x + dx div 2;
    py := y + dy div 2;
    DrawPoint(x, y);
    if (dx <> 0) and (dy <> 0) then
    begin
      DrawPoint(x + dx, y);
      DrawPoint(x, y + dy);
    end;
    if Objects.IndexOf(t) = RightBottom then
      Pen.Color := clTeal;
    DrawPoint(x + dx, y + dy);
    Pen.Color := clWhite;
    if (SelNum = 1) and (dx <> 0) and (dy <> 0) then
    begin
      DrawPoint(px, y); DrawPoint(px, y + dy);
      DrawPoint(x, py); DrawPoint(x + dx, py);
    end;
    Pen.Mode := pmCopy;
  end;
end;

procedure TfrDesignerPage.DrawShape(t: TfrView);
begin
  with t do
    if Selected then
      DrawFocusRect(Rect(x, y, x + dx + 1, y + dy + 1))
end;

procedure TfrDesignerPage.Draw(N: Integer; ClipRgn: HRGN);
var
  i: Integer;
  t: TfrView;
  R, R1: HRGN;
  Objects: TList;
  c: TColor;
  Bmp, Bmp1: TBitmap;

  procedure DrawBackground;
  var
    i, j: Integer;
  begin
    with Canvas do
    begin
      c := clBlack;
      if FDesigner.ShowGrid and (FDesigner.GridSizeX <> 18) then
      begin
        with GridBitmap.Canvas do
        begin
          if FDesigner.PageType = ptDialog then
            Brush.Color := FDesigner.Page.Color else
            Brush.Color := clWhite;
          FillRect(Rect(0, 0, 8, 8));
          Pixels[0, 0] := c;
          if FDesigner.GridSizeX = 4 then
          begin
            Pixels[4, 0] := c;
            Pixels[0, 4] := c;
            Pixels[4, 4] := c;
          end;
        end;
        Brush.Bitmap := GridBitmap;
      end
      else
      begin
        if FDesigner.PageType = ptDialog then
          Brush.Color := FDesigner.Page.Color else
          Brush.Color := clWhite;
        Brush.Style := bsSolid;
      end;
      FillRgn(Handle, R, Brush.Handle);
      if FDesigner.ShowGrid and (FDesigner.GridSizeX = 18) then
      begin
        i := 0;
        while i < Width do
        begin
          j := 0;
          while j < Height do
          begin
            if RectVisible(Handle, Rect(i, j, i + 1, j + 1)) then
              SetPixel(Handle, i, j, c);
            Inc(j, FDesigner.GridSizeY);
          end;
          Inc(i, FDesigner.GridSizeX);
        end;
      end;
    end;
  end;

  procedure DrawMargins;
  var
    i, j: Integer;
  begin
    with Canvas do
    begin
      Brush.Style := bsClear;
      Pen.Width := 1;
      Pen.Color := clGray;
      Pen.Style := psSolid;
      Pen.Mode := pmCopy;
      if FDesigner.PageType = ptReport then
        with FDesigner.Page do
        begin
          if UseMargins then
            Rectangle(LeftMargin, TopMargin, RightMargin, BottomMargin);
          if ColCount > 1 then
          begin
            ColWidth := (RightMargin - LeftMargin -
              ((ColCount - 1) * ColGap)) div ColCount;
            Pen.Style := psDot;
            j := LeftMargin;
            for i := 1 to ColCount do
            begin
              Rectangle(j, -1, j + ColWidth + 1,  PrnInfo.Pgh + 1);
              Inc(j, ColWidth + ColGap);
            end;
            Pen.Style := psSolid;
          end;
        end;
    end;
  end;

  function IsVisible(t: TfrView): Boolean;
  var
    R: HRGN;
  begin
    R := t.GetClipRgn(rtNormal);
    Result := CombineRgn(R, R, ClipRgn, RGN_AND) <> NULLREGION;
    DeleteObject(R);
  end;

  procedure DrawObject(t: TfrView; Canvas: TCanvas);
  begin
    t.Draw(Canvas);
    if t.Script.Count > 0 then
      Canvas.Draw(t.x + 1, t.y + 1, Bmp);
    if (t is TfrMemoView) and (TfrMemoView(t).HighlightStr <> '') then
      Canvas.Draw(t.x + 1, t.y + 10, Bmp1);
  end;

begin
  if (FDesigner.Page = nil) or DisableDraw then Exit;
  Bmp := TBitmap.Create;
  Bmp.LoadFromResourceName(hInstance, 'FR_SCRIPT');
  Bmp1 := TBitmap.Create;
  Bmp1.LoadFromResourceName(hInstance, 'FR_HIGHLIGHT');
  DocMode := dmDesigning;
  Objects := FDesigner.Page.Objects;
  if ClipRgn = 0 then
    with Canvas.ClipRect do
      ClipRgn := CreateRectRgn(Left, Top, Right, Bottom);
  SetTextCharacterExtra(Canvas.Handle, 0);
  R := CreateRectRgn(0, 0, Width, Height);
  for i := Objects.Count - 1 downto 0 do
  begin
    t := Objects[i];
    if i <= N then
      if t.Selected then
        DrawObject(t, Canvas)
      else if IsVisible(t) then
      begin
        R1 := CreateRectRgn(0, 0, 1, 1);
        CombineRgn(R1, ClipRgn, R, RGN_AND);
        SelectClipRgn(Canvas.Handle, R1);
        DeleteObject(R1);
        DrawObject(t, Canvas);
      end;
    SetTextCharacterExtra(Canvas.Handle, 0);
    R1 := t.GetClipRgn(rtNormal);
    CombineRgn(R, R, R1, RGN_DIFF);
    DeleteObject(R1);
    SelectClipRgn(Canvas.Handle, R);
  end;
  CombineRgn(R, R, ClipRgn, RGN_AND);
  DrawBackground;

  DeleteObject(R);
  DeleteObject(ClipRgn);
  SelectClipRgn(Canvas.Handle, 0);
  DrawMargins;
  if not Down then
    DrawPage(dmSelection);
  Bmp.Free;
  Bmp1.Free;
end;

procedure TfrDesignerPage.DrawPage(DrawMode: TfrDesignerDrawMode);
var
  i: Integer;
  t: TfrView;
begin
  if DocMode <> dmDesigning then Exit;
  for i := 0 to Objects.Count - 1 do
  begin
    t := Objects[i];
    case DrawMode of
      dmAll: t.Draw(Canvas);
      dmSelection: DrawSelection(t);
      dmShape: DrawShape(t);
    end;
  end;
end;

function TfrDesignerPage.FindNearestEdge(var x, y: Integer): Boolean;
var
  i: Integer;
  t: TfrView;
  min: Double;
  p: TPoint;
  function DoMin(a: Array of TPoint): Boolean;
  var
    i: Integer;
    d: Double;
  begin
    Result := False;
    for i := Low(a) to High(a) do
    begin
      d := sqrt((x - a[i].x) * (x - a[i].x) + (y - a[i].y) * (y - a[i].y));
      if d < min then
      begin
        min := d;
        p := a[i];
        Result := True;
      end;
    end;
  end;
begin
  Result := False;
  min := FDesigner.GridSizeX;
  p := Point(x, y);
  for i := 0 to Objects.Count - 1 do
  begin
    t := Objects[i];
    if DoMin([Point(t.x, t.y), Point(t.x + t.dx, t.y),
         Point(t.x + t.dx, t.y + t.dy),  Point(t.x, t.y + t.dy)]) then
      Result := True;
  end;
  x := p.x; y := p.y;
end;

procedure TfrDesignerPage.RoundCoord(var x, y: Integer);
begin
  with FDesigner do
    if GridAlign then
    begin
      x := x div GridSizeX * GridSizeX;
      y := y div GridSizeY * GridSizeY;
    end;
end;

procedure TfrDesignerPage.GetMultipleSelected;
var
  i, j, k: Integer;
  t: TfrView;
begin
  j := 0; k := 0;
  LeftTop := Point(10000, 10000);
  RightBottom := -1;
  MRFlag := False;
  if SelNum > 1 then                  {find right-bottom element}
  begin
    for i := 0 to Objects.Count-1 do
    begin
      t := Objects[i];
      if t.Selected then
      begin
        t.OriginalRect := Rect(t.x, t.y, t.dx, t.dy);
        if (t.x + t.dx > j) or ((t.x + t.dx = j) and (t.y + t.dy > k)) then
        begin
          j := t.x + t.dx;
          k := t.y + t.dy;
          RightBottom := i;
        end;
        if t.x < LeftTop.x then LeftTop.x := t.x;
        if t.y < LeftTop.y then LeftTop.y := t.y;
      end;
    end;
    t := Objects[RightBottom];
    OldRect := Rect(LeftTop.x, LeftTop.y, t.x + t.dx, t.y + t.dy);
    OldRect1 := OldRect;
    MRFlag := True;
  end;
end;

procedure TfrDesignerPage.MDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  f, v: Boolean;
  t: TfrView;
  Rgn: HRGN;
  p: TPoint;
begin
  WasCtrl := ssCtrl in Shift;
  if DFlag then
  begin
    DFlag := False;
    Exit;
  end;
  if (Button = mbRight) and Down and RFlag then
    DrawFocusRect(OldRect);
  RFlag := False;
  DrawPage(dmSelection);
  Down := True;
  if Button = mbLeft then
    if (ssCtrl in Shift) or (Cursor = crCross) then
    begin
      RFlag := True;
      if Cursor = crCross then
      begin
        if FDesigner.PageType = ptReport then
          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 / GridSizeX) * GridSizeX;
          y := Round(y / GridSizeY) * GridSizeY;
        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];
      if (t.dx < 3) or (t.dy < 3) then
      begin
        v := PtInRect(Rect(t.x - 3, t.y - 3, t.x + t.dx + 3, t.y + t.dy + 3),
          Point(X, Y));
      end
      else
      begin
        Rgn := t.GetClipRgn(rtNormal);
        v := PtInRegion(Rgn, X, Y);
        DeleteObject(Rgn);
      end;
      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 if not t.Selected then
        begin
          FDesigner.Unselect;
          SelNum := 1;
          t.Selected := 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;
  end;
  if SelNum = 0 then
  begin // reset multiple selection
    RightBottom := -1;
    MRFlag := False;
  end;
  LastX := x;
  LastY := y;
  Moved := False;
  FirstChange := True;