frxdesgnworkspace.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

end;

procedure TfrxDesignerWorkspace.SetScale(Value:Extended);
begin
  FScale:= Value;

  FMarginsPanel.Width:= Round(FPageWidth * FScale);
  FMarginsPanel.Height:= Round(FPageHeight * FScale);

  SetBounds(FMarginsPanel.Left+Round(FMargins.Left * FScale),
            FMarginsPanel.Top+Round(FMargins.Top * FScale),
            FMarginsPanel.Width-Round((FMargins.Left+FMargins.Right-1) * FScale),
            FMarginsPanel.Height-Round((FMargins.Top+FMargins.Bottom-1) * FScale));

  FMarginsPanel.Invalidate;
  Invalidate;
end;

procedure TfrxDesignerWorkspace.SetPageDimensions(AWidth, AHeight:Integer;
  AMargins:TRect);
begin
  FPageWidth:= AWidth;
  FPageHeight:= AHeight;
  FMargins:= AMargins;
  SetScale(FScale);
  AdjustBands;
end;

procedure TfrxDesignerWorkspace.SetShowGrid(const Value:Boolean);
begin
  FShowGrid:= Value;
  Invalidate;
end;

procedure TfrxDesignerWorkspace.UpdateBandHeader;
begin
  case FGridType of
    gt1pt, gtDialog:
      FBandHeader:= 16;
    gt1cm:
      FBandHeader:= fr01cm * 5;
    gt1in:
      FBandHeader:= fr01in * 2;
    gtChar:
      FBandHeader:= fr1CharY;
  end;

  if not FShowBandCaptions then
    FBandHeader:= 0;
end;

procedure TfrxDesignerWorkspace.SetGridType(const Value:TfrxGridType);
begin
  FGridType:= Value;
  UpdateBandHeader;
  if FSelectedObjects.Count<>0 then
    MouseMove([], 0, 0);
  AdjustBands;
  Invalidate;
end;

procedure TfrxDesignerWorkspace.SetShowBandCaptions(const Value:Boolean);
begin
  FShowBandCaptions:= Value;
  UpdateBandHeader;
  AdjustBands;
  Invalidate;
end;

function TfrxDesignerWorkspace.GetOrigin:TPoint;
begin
  Result.X:= FMarginsPanel.Left;
  Result.Y:= FMarginsPanel.Top;
end;

procedure TfrxDesignerWorkspace.SetOrigin(const Value:TPoint);
begin
  FMarginsPanel.Left:= Value.X;
  FMarginsPanel.Top:= Value.Y;
end;

procedure TfrxDesignerWorkspace.SetColor(const Value:TColor);
begin
  FColor:= Value;
  FMarginsPanel.Color:= Value;
end;

procedure TfrxDesignerWorkspace.DoModify;
begin
  if FModifyFlag then
    if Assigned(FOnModify) then
      FOnModify(Self);
  FModifyFlag:= False;
end;

procedure TfrxDesignerWorkspace.SelectionChanged;
var
  i, j:Integer;
  c, c1:TfrxComponent;
begin
  for i:= 0 to SelectedCount-1 do
  begin
    c:= FSelectedObjects[i];
    if (c is TfrxReportComponent) and (c.GroupIndex<>0) then
      for j:= 0 to FObjects.Count-1 do
      begin
        c1:= FObjects[j];
        if (c1 is TfrxReportComponent) and (c1.GroupIndex = c.GroupIndex) then
        begin
          if FSelectedObjects.IndexOf(c1) =-1 then
            FSelectedObjects.Add(c1);
        end;
      end;
  end;

  if Assigned(FOnSelectionChanged) then
    FOnSelectionChanged(Self);
  Repaint;
end;

function TfrxDesignerWorkspace.GetSelectionBounds:TfrxRect;
var
  i:Integer;
  c:TfrxComponent;
begin
  if SelectedCount = 1 then
  begin
    with TfrxComponent(FSelectedObjects[0]) do
      Result:= frxRect(Left, Top, Width, Height);
    Exit;
  end;

  Result:= frxRect(1e10, 1e10,-1e10,-1e10);

  for i:= 0 to SelectedCount-1 do
  begin
    c:= FSelectedObjects[i];

    if c.AbsLeft < Result.Left then
      Result.Left:= c.AbsLeft;
    if c.AbsTop < Result.Top then
      Result.Top:= c.AbsTop;
    if c.AbsLeft+c.Width > Result.Right then
      Result.Right:= c.AbsLeft+c.Width;
    if c.AbsTop+c.Height > Result.Bottom then
      Result.Bottom:= c.AbsTop+c.Height;
  end;

  with Result do
    Result:= frxRect(Left, Top, Right-Left, Bottom-Top);
end;

function TfrxDesignerWorkspace.GetRightBottomObject:TfrxComponent;
var
  i:Integer;
  c:TfrxComponent;
  maxx, maxy:Extended;
begin
  maxx:= 0;
  maxy:= 0;
  Result:= nil;

  for i:= 0 to SelectedCount-1 do
  begin
    c:= FSelectedObjects[i];
    if (c.AbsLeft+c.Width > maxx) or
       ((c.AbsLeft+c.Width = maxx) and (c.AbsTop+c.Height > maxy)) then
    begin
      maxx:= c.AbsLeft+c.Width;
      maxy:= c.AbsTop+c.Height;
      Result:= c;
    end;
  end;
end;

function TfrxDesignerWorkspace.SelectedCount:Integer;
begin
  Result:= FSelectedObjects.Count;
  if (Result = 1) and
    ((FSelectedObjects[0] = FPage) or (TObject(FSelectedObjects[0]) is TfrxReport)) then
    Result:= 0;
end;

procedure TfrxDesignerWorkspace.WMEraseBackground(var Message:TMessage);
begin
// do nothing, prevent flickering
end;

procedure TfrxDesignerWorkspace.Paint;
var
  bmp:TBitmap;
begin
  bmp:= TBitmap.Create;
  try
    with Canvas.ClipRect do
    begin
      bmp.Width:= Right-Left;
      bmp.Height:= Bottom-Top;
      FCanvas:= bmp.Canvas;
      SetViewPortOrgEx(FCanvas.Handle,-Left,-Top, nil);
    end;

    DrawBackground;
    if not FDisableUpdate then
    begin
      if (FPage<>nil) and (FPage is TfrxReportPage) then
        TfrxReportPage(FPage).Draw(FCanvas, FScale, FScale,
         -FMargins.Left * FScale,
         -FMargins.Top * FScale);
      DrawObjects;
    end;

    BitBlt(Canvas.Handle, 0, 0, Width, Height, FCanvas.Handle, 0, 0, SRCCOPY);
  finally
    bmp.Free;
  end;
  FCanvas:= nil;
end;

procedure TfrxDesignerWorkspace.DrawObjects;
var
  i:Integer;

  function CreateRotatedFont(Font:TFont; Rotation:Integer):HFont;
  var
    F:TLogFont;
  begin
    GetObject(Font.Handle, SizeOf(TLogFont), @F);
    F.lfEscapement:= Rotation * 10;
    F.lfOrientation:= Rotation * 10;
    Result:= CreateFontIndirect(F);
  end;

  procedure DrawPoint(x, y:Extended);
  var
    i, w:Integer;
  begin
    if FScale > 1.7 then
      w:= 7
    else if FScale < 0.7 then
      w:= 3 else
      w:= 5;
    for i:= 0 to w-1 do
    begin
      FCanvas.MoveTo(Round(x * FScale)-w div 2, Round(y * FScale)-w div 2+i);
      FCanvas.LineTo(Round(x * FScale)+w div 2+1, Round(y * FScale)-w div 2+i);
    end;
  end;

  procedure DrawLine(x, y, dx, dy:Extended);
  begin
    FCanvas.MoveTo(Round(x * FScale), Round(y * FScale));
    FCanvas.LineTo(Round((x+dx) * FScale), Round((y+dy) * FScale));
  end;

  procedure DrawSqares(c:TfrxComponent);
  var
    px, py:Extended;
  begin
    with c, FCanvas do
    begin
      Pen.Style:= psSolid;
      Pen.Width:= 1;
      Pen.Mode:= pmXor;
      Pen.Color:= clWhite;
      px:= AbsLeft+Width / 2;
      py:= AbsTop+Height / 2;

      DrawPoint(AbsLeft, AbsTop);
      if not (c is TfrxCustomLineView) then
      begin
        DrawPoint(AbsLeft+Width, AbsTop);
        DrawPoint(AbsLeft, AbsTop+Height);
      end;
      if (SelectedCount > 1) and (c = GetRightBottomObject) then
        Pen.Color:= clTeal;
      DrawPoint(AbsLeft+Width, AbsTop+Height);

      Pen.Color:= clWhite;
      if (SelectedCount = 1) and not (c is TfrxCustomLineView) then
      begin
        DrawPoint(px, AbsTop); DrawPoint(px, AbsTop+Height);
        DrawPoint(AbsLeft, py); DrawPoint(AbsLeft+Width, py);
      end;

      Pen.Mode:= pmCopy;
    end;
  end;

  procedure DrawScriptSign(c:TfrxReportComponent);
  var
    NeedDraw:Boolean;
    Offs:Extended;
  begin
    NeedDraw:= False;
    Offs:= 0;
    if c is TfrxReportComponent then
      with c do
        if (OnBeforePrint<>'') or (OnAfterPrint<>'') or
          (OnAfterData<>'') or (OnPreviewClick<>'') then
          NeedDraw:= True;
    if c is TfrxDialogControl then
      with TfrxDialogControl(c) do
        if (OnClick<>'') or (OnDblClick<>'') or
          (OnEnter<>'') or (OnExit<>'') or
          (OnKeyDown<>'') or (OnKeyPress<>'') or
          (OnKeyUp<>'') or (OnMouseDown<>'') or
          (OnMouseMove<>'') or (OnMouseUp<>'') then
          NeedDraw:= True;
    if c is TfrxBand then
      with TfrxBand(c) do
      begin
        if (OnAfterCalcHeight<>'') then
          NeedDraw:= True;
        if not Vertical then
          Offs:=-FBandHeader+2;
      end;

    if NeedDraw then
      with c, FCanvas do
      begin
        Pen.Style:= psSolid;
        Pen.Color:= clRed;
        Pen.Width:= 1;
        DrawLine(AbsLeft+2, AbsTop+Offs+1, 0, 7);
        DrawLine(AbsLeft+3, AbsTop+Offs+2, 0, 5);
        DrawLine(AbsLeft+4, AbsTop+Offs+3, 0, 3);
        DrawLine(AbsLeft+5, AbsTop+Offs+4, 0, 1);
      end;
  end;

  procedure DrawObject(c:TfrxReportComponent);
  var
    s:String;
    i, w, x, y:Integer;
    d:TfrxDataBand;
    fh, oldfh:HFont;
  begin
    c.IsDesigning:= True;
    c.Draw(FCanvas, FScale, FScale, FOffsetX, FOffsetY);

    if c is TfrxBand then
      with c as TfrxBand, FCanvas do
      begin
        if Vertical then
        begin
          Top:= 0;
          Pen.Style:= psSolid;
          Pen.Color:= clGray;
          Pen.Width:= 1;
          Brush.Style:= bsClear;
          x:= Round((Left-FBandHeader) * FScale);
          Rectangle(x, 0, Round((Left+Width) * FScale)+1, Round((Height) * FScale));

          if FShowBandCaptions then
          begin
            Brush.Style:= bsSolid;
            if c is TfrxDataBand then
              Brush.Color:= $EEBB00 else
              Brush.Color:= clBtnFace;
            FillRect(Rect(x+1, 1, Round(Left * FScale), Round(Height * FScale)));
          end;

          Font.Name:= DefFontName;
          Font.Size:= Round(8 * FScale);
          Font.Color:= clBlack;
          Font.Style:= [];
          fh:= CreateRotatedFont(Font, 90);
          oldfh:= SelectObject(Handle, fh);
          y:= TextWidth(Name)+4;
          TextOut(x+2, y, Name);
          SelectObject(Handle, oldfh);
          DeleteObject(fh);
          Font.Style:= [fsBold];
          fh:= CreateRotatedFont(Font, 90);
          oldfh:= SelectObject(Handle, fh);
          TextOut(x+2, y+TextWidth(BandName+':')+2, BandName+':');
          SelectObject(Handle, oldfh);
          DeleteObject(fh);
        end
        else
        begin
          Left:= 0;
          Pen.Style:= psSolid;
          Pen.Color:= clGray;
          Pen.Width:= 1;
          Brush.Style:= bsClear;
          y:= Round((Top-FBandHeader) * FScale);
          Rectangle(0, y, Round(Width * FScale)+1, Round((Top+Height) * FScale)+1);

          if FShowBandCaptions then
          begin
            Brush.Style:= bsSolid;
            if c is TfrxDataBand then
              Brush.Color:= $EEBB00 else
              Brush.Color:= clBtnFace;
            FillRect(Rect(1, y+1, Round(Width * FScale), Round(Top * FScale)));
          end;

          Font.Name:= DefFontName;
          Font.Size:= Round(8 * FScale);
          Font.Color:= clBlack;
          Font.Style:= [fsBold];
          TextOut(6, y+2, BandName);
          Font.Style:= [];
          TextOut(PenPos.X, y+2, ':'+Name);

          if c is TfrxDataBand then
          begin
            d:= TfrxDataBand(c);

            if FShowBandCaptions then
            begin
              if (d.DataSet<>nil) and (c.Report<>nil) then
                s:= c.Report.GetAlias(d.DataSet)
              else if d.RowCount<>0 then
                s:= IntToStr(d.RowCount)
              else
                s:= '';
              w:= TextWidth(s);
              if FScale > 0.7 then
                frxDrawTransparent(FCanvas, Round(Width * FScale-w-20),
                  Round(y+4 * FScale), FBMPBand);
              if s<>'' then
                TextOut(Round(Width * FScale-w-3), y+3, s);
            end;

            if d.Columns > 1 then
            begin
              Pen.Style:= psDot;
              Pen.Color:= clBlack;
              Brush.Style:= bsClear;
              for i:= 1 to d.Columns do
                Rectangle(Round((i-1) * (d.ColumnWidth+d.ColumnGap) * FScale),
                          Round(d.Top * FScale),
                          Round(((i-1) * (d.ColumnWidth+d.ColumnGap)+d.ColumnWidth) * FScale),
                          Round((d.Top+d.Height) * FScale));
            end;
          end;
          if c is TfrxGroupHeader then
          begin
            s:= TfrxGroupHeader(c).Condition;
            if s<>'' then
              if FShowBandCaptions then
                TextOut(Round(Width * FScale-TextWidth(s)-3), y+3, s);
          end;
        end
      end
    else if not (c is TfrxCustomLineView) and not (c is TfrxDialogComponent) and
      not (c is TfrxDialogControl) then
      with c, FCanvas do
        if FShowEdges and (c is TfrxView) and
          (TfrxView(c).Frame.Typ<>[ftLeft, ftRight, ftTop, ftBottom]) then
        begin
          Pen.Style:= psSolid;
          Pen.Color:= clBlack;
          Pen.Width:= 1;
          DrawLine(AbsLeft, AbsTop+3, 0,-3);
          DrawLine(AbsLeft, AbsTop, 4, 0);
          DrawLine(AbsLeft, AbsTop+Height-3, 0, 3);
          DrawLine(AbsLeft, AbsTop+Height, 4, 0);
          DrawLine(AbsLeft+Width-3, AbsTop, 3, 0);
          DrawLine(AbsLeft+Width, AbsTop, 0, 4);
          DrawLine(AbsLeft+Width-3, AbsTop+Height, 3, 0);
          DrawLine(AbsLeft+Width, AbsTop+Height, 0,-4);
        end;

    DrawScriptSign(c);
  end;

begin
  { update aligned objects }
  if Page is TfrxReportPage then
    Page.AlignChildren;

  { draw objects }
  for i:= 0 to FObjects.Count-1 do
    if TObject(FObjects[i]) is TfrxReportComponent then
      DrawObject(FObjects[i]);

  { draw selection }
  for i:= 0 to SelectedCount-1 do
    if not FMouseDown then
      DrawSqares(FSelectedObjects[i]);
end;

procedure TfrxDesignerWorkspace.DrawBackground;

  procedure Line(x, y, x1, y1:Integer);
  begin
    FCanvas.MoveTo(x, y);
    FCanvas.LineTo(x1, y1);
  end;

  procedure DrawPoints;
  var
    GridBmp:TBitmap;
    i:Extended;
    c:TColor;
    dx, dy:Extended;
  begin
    if FGridType = gtDialog then