frxdesgnworkspace1.pas

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

{******************************************}
{ }
{ FastReport v3.0 }
{ Designer workspace }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxDesgnWorkspace1;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, frxClass, frxDesgn, frxDesgnWorkspace
{$IFDEF Delphi6}
, Variants
{$ENDIF};
  

type
  TfrxDesignTool = (dtSelect, dtHand, dtZoom, dtText, dtFormat);

  TDesignerWorkspace = class(TfrxDesignerWorkspace)
  private
    FDesigner:TfrxDesignerForm;
    FGuide:Integer;
    FListBox:TListBox;
    FMemo:TfrxMemoView;
    FShowGuides:Boolean;
    FTool:TfrxDesignTool;
    FSimulateMove:Boolean;
    procedure DoLBClick(Sender:TObject);
    procedure LBDrawItem(Control:TWinControl; Index:Integer;
      ARect:TRect; State:TOwnerDrawState);
    procedure SetShowGuides(const Value:Boolean);
    procedure SetHGuides(const Value:TStrings);
    procedure SetVGuides(const Value:TStrings);
    function GetHGuides:TStrings;
    function GetVGuides:TStrings;
    property HGuides:TStrings read GetHGuides write SetHGuides;
    property VGuides:TStrings read GetVGuides write SetVGuides;
    procedure SetTool(const Value:TfrxDesignTool);
  protected
    procedure CheckGuides(var kx, ky:Extended; var Result:Boolean); override;
    procedure DragOver(Source:TObject; X, Y:Integer; State:TDragState;
      var Accept:Boolean); override;
    procedure DrawObjects; override;
    procedure KeyDown(var Key:Word; Shift:TShiftState); override;
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
    procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
    procedure DblClick; override;
  public
    constructor Create(AOwner:TComponent); override;
    procedure DeleteObjects; override;
    procedure DragDrop(Source:TObject; X, Y:Integer); override;
    procedure SimulateMove;
    property ShowGuides:Boolean read FShowGuides write SetShowGuides;
    property Tool:TfrxDesignTool read FTool write SetTool;
  end;

implementation

uses
  ComCtrls, frxDesgnCtrls, frxUtils, frxDataTree, frxDMPClass, frxRes;

{ TDesignerWorkspace }

constructor TDesignerWorkspace.Create(AOwner:TComponent);
begin
  inherited;
  FDesigner:= TfrxDesignerForm(AOwner);

  FListBox:= TListBox.Create(Self);
  with FListBox do
  begin
    Parent:= Self;
    Visible:= False;
    Style:= lbOwnerDrawFixed;
    ItemHeight:= 16;
    OnClick:= DoLBClick;
    OnDrawItem:= LBDrawItem;
  end;
end;

procedure TDesignerWorkspace.DeleteObjects;
var
  i:Integer;
  NeedReload:Boolean;
begin
  NeedReload:= False;
  for i:= 0 to FSelectedObjects.Count-1 do
    if TObject(FSelectedObjects[i]) is TfrxSubreport then
      NeedReload:= True;

  FMemo:= nil;
  inherited;

  if NeedReload then
    FDesigner.ReloadPages(FDesigner.Report.Objects.IndexOf(Page));
end;

procedure TDesignerWorkspace.DrawObjects;
var
  r:TRect;
  i, d:Integer;
begin
  if FDesigner.Page is TfrxReportPage then
    with TfrxReportPage(FDesigner.Page) do
      if Columns > 1 then
        for i:= 0 to Columns-1 do
        begin
          d:= Round(frxStrToFloat(ColumnPositions[i]) * fr01cm * FScale);
          if d = 0 then continue;
          FCanvas.Pen.Color:= clSilver;
          FCanvas.MoveTo(d, 0);
          FCanvas.LineTo(d, Self.Height);
        end;

  if FShowGuides and (FPage is TfrxReportPage) then
  begin
    with FCanvas do
    begin
      Pen.Width:= 1;
      Pen.Style:= psSolid;
      Pen.Color:= $FFCC00;
      Pen.Mode:= pmCopy;
    end;

    for i:= 0 to HGuides.Count-1 do
    begin
      d:= Round(frxStrToFloat(HGuides[i]) * Scale);
      FCanvas.MoveTo(0, d);
      FCanvas.LineTo(Width, d);
    end;

    for i:= 0 to VGuides.Count-1 do
    begin
      d:= Round(frxStrToFloat(VGuides[i]) * Scale);
      FCanvas.MoveTo(d, 0);
      FCanvas.LineTo(d, Height);
    end;
  end;

  inherited;

  if (FMemo<>nil) and FDesigner.DropFields then
    with FCanvas do
    begin
      r.TopLeft:= Point(Round((FMemo.Left+FMemo.Width) * FScale)-16,
                         Round((FMemo.AbsTop) * FScale)+2);
      r.BottomRight:= Point(r.Left+16, r.Top+16);
      DrawButtonFace(FCanvas, r, 1, bsNew, False, False, False);

      Brush.Color:= clBlack;
      Brush.Style:= bsSolid;
      Pen.Color:= clBlack;
      Pen.Style:= psSolid;
      FCanvas.Polygon([Point(r.Left+4, r.Top+6), Point(r.Left+7, r.Top+9),
        Point(r.Left+10, r.Top+6), Point(r.Left+4, r.Top+6)]);
    end;

end;

procedure TDesignerWorkspace.DragOver(Source:TObject; X, Y:Integer;
  State:TDragState; var Accept:Boolean);
var
  ds:TfrxDataset;
  s, fld:String;
  w:Integer;
begin
  Accept:= (((Source is TTreeView) and
    (TTreeView(Source).Owner = FDesigner.DataTree) and
    (FDesigner.DataTree.GetFieldName<>'')) or
    (Source is TfrxRuler)) and (FDesigner.Page is TfrxReportPage);
  if not Accept then Exit;

  if Source is TfrxRuler then
    with Canvas do
    begin
      Pen.Width:= 1;
      Pen.Style:= psSolid;
      Pen.Color:= clBlack;
      Repaint;

      if GridAlign then
      begin
        X:= Round(Trunc(X / (GridX * Scale)) * GridX * Scale);
        Y:= Round(Trunc(Y / (GridY * Scale)) * GridY * Scale);
      end;

      if TfrxRuler(Source).Align = alLeft then
      begin
        MoveTo(X, 0);
        LineTo(X, Height);
      end
      else
      begin
        MoveTo(0, Y);
        LineTo(Width, Y);
      end;

      MouseMove([], X, Y);
    end
  else
  begin
    if (FInsertion.ComponentClass = nil) and
      (FDesigner.DataTree.InsFieldCB.Checked or
      FDesigner.DataTree.InsCaptionCB.Checked or
      not FDesigner.DataTree.IsDataField) then
    begin
      s:= FDesigner.DataTree.GetFieldName;
      s:= Copy(s, 2, Length(s)-2);
      FDesigner.Report.GetDatasetAndField(s, ds, fld);
      try
        if (ds<>nil) and (fld<>'') then
          w:= ds.DisplayWidth[fld] else
          w:= 10;
      except
        w:= 10;
      end;

      SetInsertion(TfrxMemoView, Round(w * 8 / GridX) * GridX,
        FDesigner.GetDefaultObjectSize.Y, 0);
    end;

    MouseMove([], X-8, Y-8);
  end;
end;

procedure TDesignerWorkspace.DragDrop(Source:TObject; X, Y:Integer);
var
  eX, eY:Extended;
  m:TfrxCustomMemoView;
  ds:TfrxDataset;
  s, fld:String;

  function Round8(e:Extended):Extended;
  begin
    Result:= Round(e * 100000000) / 100000000;
  end;

begin
  if (Source is TfrxRuler) and (FPage is TfrxReportPage) then
  begin
    if GridAlign then
    begin
      eX:= Trunc(X / Scale / GridX) * GridX;
      eY:= Trunc(Y / Scale / GridY) * GridY;
    end
    else
    begin
      eX:= X / Scale;
      eY:= Y / Scale;
    end;

    eX:= Round8(eX);
    eY:= Round8(eY);

    if TfrxRuler(Source).Align = alLeft then
      VGuides.Add(FloatToStr(eX)) else
      HGuides.Add(FloatToStr(eY));
  end
  else if FDesigner.DataTree.InsFieldCB.Checked or
    FDesigner.DataTree.InsCaptionCB.Checked or
    not FDesigner.DataTree.IsDataField then
  begin
    FSelectedObjects.Clear;

    if Page is TfrxDMPPage then
      m:= TfrxDMPMemoView.Create(Page) else
      m:= TfrxMemoView.Create(Page);
    m.CreateUniqueName;
    m.IsDesigning:= True;
    s:= FDesigner.DataTree.GetFieldName;
    s:= Copy(s, 2, Length(s)-2);
    FDesigner.Report.GetDataSetAndField(s, ds, fld);

    if not FDesigner.DataTree.IsDataField or FDesigner.DataTree.InsFieldCB.Checked then
    begin
      m.DataSet:= ds;
      m.DataField:= fld;
      if (ds = nil) and (fld = '') then
      begin
        if Pos('<', FDesigner.DataTree.GetFieldName) = 1 then
          m.Text:= '['+s+']' else
          m.Text:= '['+FDesigner.DataTree.GetFieldName+']';
      end;
      m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
        Round8(FInsertion.Width), Round8(FInsertion.Height));
      FDesigner.SampleFormat.ApplySample(m);
      FObjects.Add(m);
      FSelectedObjects.Add(m);
      FInsertion.Top:= FInsertion.Top-FInsertion.Height;
    end
    else
      m.Free;
    if FDesigner.DataTree.IsDataField and FDesigner.DataTree.InsCaptionCB.Checked then
    begin
      if Page is TfrxDMPPage then
        m:= TfrxDMPMemoView.Create(Page) else
        m:= TfrxMemoView.Create(Page);
      m.CreateUniqueName;
      m.IsDesigning:= True;
      m.Text:= fld;
      m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
        Round8(FInsertion.Width), Round8(FInsertion.Height));
      FDesigner.SampleFormat.ApplySample(m);
      FObjects.Add(m);
      FSelectedObjects.Add(m);
    end;

    SetInsertion(nil, 0, 0, 0);
  end;

  FModifyFlag:= True;
  MouseUp(mbLeft, [], X, Y);
  SelectionChanged;
end;

procedure TDesignerWorkspace.MouseDown(Button:TMouseButton; Shift:TShiftState;
  X, Y:Integer);
var
  ds:TfrxDataset;
  r:TRect;

  function Contain(c:TfrxComponent):Boolean;
  begin
    Result:= (X / FScale >= c.Left+c.Width-16) and (X / FScale <= c.Left+c.Width) and
      (Y / FScale >= c.AbsTop) and (Y / FScale <= c.AbsTop+16);
  end;

begin
  if FDisableUpdate then Exit;
  if FListBox.Visible then
    FListBox.Hide;

  if FTool = dtHand then
  begin
    FMode1:= dmNone;
    FMouseDown:= True;
    FLastMousePointX:= X;
    FLastMousePointY:= Y;
    Exit;
  end
  else if FTool in [dtZoom, dtText] then
  begin
    FMode1:= dmSelectionRect;
    FSelectionRect:= frxRect(X, Y, X, Y);
  end
  else if FTool = dtFormat then
  begin
    FMode1:= dmNone;
    Exit;
  end;

  if (FMode = dmSelect) and (FMemo<>nil) and Contain(FMemo) and FDesigner.DropFields then
  begin
    with FListBox do
    begin
      Ctl3D:= False;
      r.Top:= Round(FMemo.AbsTop * FScale)+18;
      r.Right:= Round((FMemo.Left+FMemo.Width) * FScale);
      r.Left:= r.Right-140;
      r.Bottom:= r.Top+162;

      if r.Left < 0 then
      begin
        Inc(r.Right,-r.Left);
        r.Left:= 0;
      end;

      BoundsRect:= r;

      ds:= TfrxDataBand(FMemo.Parent).Dataset;
      if ds<>nil then
      begin
        ds.GetFieldList(Items);
        ItemIndex:= Items.IndexOf(FMemo.DataField);
        Show;
      end;
    end;

    FMode1:= dmNone;
    FMouseDown:= False;
    Exit;
  end;

  if not ((FTool = dtZoom) and (Button = mbRight)) then
    inherited;
end;

procedure TDesignerWorkspace.MouseMove(Shift:TShiftState; X, Y:Integer);
var
  i, px, py:Integer;
  c, cOver:TfrxComponent;
  ds:TfrxDataset;
  e, kx, ky:Extended;

  function Contain(c:TfrxComponent):Boolean;
  begin
    Result:= (X / FScale >= c.Left) and (X / FScale <= c.Left+c.Width-4) and
      (Y / FScale >= c.AbsTop) and (Y / FScale <= c.AbsTop+c.Height);
  end;

  function GridCheck:Boolean;
  begin
    Result:= (kx >= GridX) or (kx <=-GridX) or
              (ky >= GridY) or (ky <=-GridY);
    if Result then
    begin
      kx:= Trunc(kx / GridX) * GridX;
      ky:= Trunc(ky / GridY) * GridY;
    end;
  end;

begin
  if FDisableUpdate then Exit;
  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