frxdock.pas

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

  FIsFloat:= True;
  if FWindow = nil then
  begin
    oldParent:= nil;
    if (Parent<>nil) and (Parent is TfrxDock) then
      oldParent:= Parent as TfrxDock;
    Hide;
    FDragBox.Hide;
    FWindow:= TfrxFloatWindow.Create(GetParentForm(Self));
    FWindow.BorderStyle:= bsNone;
    FWindow.Left:= X;
    FWindow.Top:= Y;
    FWindow.Caption:= Caption;
    Parent:= FWindow;
    RealignControls;
    AdjustBounds;
    if oldParent<>nil then
      oldParent.AdjustBounds;
    FWindow.ClientWidth:= Width+6;
    FWindow.ClientHeight:= Height+21;
    FWindow.ToolBar:= Self;
    Left:= 3; Top:= 18;
    Show;
    FWindow.Show;
    AddToToolbarList(Self);
  end
  else
    FWindow.SetBounds(X, Y, FWindow.Width, FWindow.Height);
end;

function TfrxToolBar.MoveTo(X, Y:Integer):Boolean;
var
  i, n, oldSize, ShiftCount:Integer;
  c:TControl;
  procedure Shift(ax,ay:Integer);
  begin
    x:= ax;
    y:= ay;
    Inc(ShiftCount);
  end;
begin
  Result:= True;
  if IsFloat then Exit;
  n:= 0;
  repeat
    ShiftCount:= 0;
    if ParentAlign = alTop then
    begin
      if x <-20 then FIsFloat:= True;
      if x < 0 then Shift(0, y);
      if x+Width > Parent.Width then Shift(Parent.Width-Width, y);
    end
    else // if ParentAlign = alLeft then
    begin
      if y <-20 then FIsFloat:= True;
      if y < 0 then Shift(x, 0);
      if y+Height > Parent.Height then Shift(x, Parent.Height-Height);
    end;
    if not IsFloat then
      for i:= 0 to Parent.ControlCount-1 do
      begin
        c:= Parent.Controls[i];
        if (c<>Self) and c.Visible then
          if ParentAlign = alTop then
          begin
            if ((y >= c.Top) and (y < c.Top+c.Height)) or
               ((y <= c.Top) and (y+Height > c.Top)) then
            begin
              if (x >= c.Left) and (x < c.Left+c.Width) then
                Shift(c.Left+c.Width, y);
              if (x < c.Left) and (x+Width > c.Left) then
                Shift(c.Left-Width, y);
            end;
          end
          else // if ParentAlign = alLeft then
          begin
            if ((x >= c.Left) and (x < c.Left+c.Width)) or
               ((x <= c.Left) and (x+Width > c.Left)) then
            begin
              if (y >= c.Top) and (y < c.Top+c.Height) then
                Shift(x, c.Top+c.Height);
              if (y < c.Top) and (y+Height > c.Top) then
                Shift(x, c.Top-Height);
            end;
          end;
      end;
    Inc(n);
  until (n > 3) or (ShiftCount = 0) or IsFloat;

  if not FCanFloat then FIsFloat:= False;
  if IsFloat then
    MakeFloat
  else
    if n < 3 then
    begin
      if ParentAlign = alTop then
        if (y+Height > Parent.Height) or (y < 0) then
          oldSize:= Parent.Height else
          oldSize:= 0
      else
        if (x+Width > Parent.Width) or (x < 0) then
          oldSize:= Parent.Width else
          oldSize:= 0;
      Left:= x;
      Top:= y;
      (Parent as TfrxDock).AdjustBounds;
      if FCanFloat then
        if ((ParentAlign = alTop) and (Parent.Height = oldSize)) or
           ((ParentAlign = alLeft) and (Parent.Width = oldSize)) then
          MakeFloat;
    end
    else Result:= False;
end;

procedure TfrxToolBar.DoMouseDown(Sender:TObject; Button:TMouseButton;
  Shift:TShiftState; X, Y:Integer);
var
  p:TPoint;
begin
  GetCursorPos(p);
  FLastX:= p.X; FLastY:= p.Y;
  FDown:= True;
end;

procedure TfrxToolBar.DoMouseMove(Sender:TObject; Shift:TShiftState; X,
  Y:Integer);
var
  p:TPoint;
  dx, dy:Integer;
  StepX, StepY:Integer;
  b:Boolean;
begin
  if IsFloat then
  begin
    Cursor:= crDefault;
    FDown:= False;
    Exit;
  end;
  if not FDown then Exit;
  GetCursorPos(p);
  if ParentAlign = alTop then
    StepY:= (Parent as TfrxDock).RowSize else
    StepY:= 1;
  if ParentAlign = alLeft then
    StepX:= (Parent as TfrxDock).RowSize else
    StepX:= 1;
  dx:= (p.X-FLastX) div StepX * StepX;
  dy:= (p.Y-FLastY) div StepY * StepY;
  b:= False;
  if (dx<>0) or (dy<>0) then b:= MoveTo(Left+dx, Top+dy);
  if b then
  begin
    if dx<>0 then FLastX:= p.X;
    if dy<>0 then FLastY:= p.Y;
  end;
end;

procedure TfrxToolBar.DoMouseUp(Sender:TObject; Button:TMouseButton;
  Shift:TShiftState; X, Y:Integer);
begin
  FDown:= False;
end;

procedure TfrxToolBar.DoResize(Sender:TObject);
begin
  if csDestroying in ComponentState then Exit;
  FDragBox.SetBounds(0, 0, 8, 8);
  if ParentAlign = alTop then
    FDragBox.Align:= alLeft else
    FDragBox.Align:= alTop;
end;

procedure TfrxToolBar.WMWindowPosChanged(var Message:TWMWindowPosChanged);
begin
  if csDesigning in ComponentState then
    inherited else
    DefaultHandler(Message);
end;

function TfrxToolBar.GetFloatWindow:TForm;
begin
  Result:= FWindow;
end;

{ TfrxTBPanel }

function GetAlign(al:TAlign):TAlign;
begin
  if al in [alLeft, alRight] then
    Result:= alTop else
    Result:= alLeft;
end;

constructor TfrxTBPanel.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Align:= alLeft;
  Width:= 8;
  Height:= 8;
end;

procedure TfrxTBPanel.SetParent(AParent:TWinControl);
begin
  inherited;
  if not (csDestroying in ComponentState) and (AParent<>nil) and (Parent is TPanel) then
    Align:= GetAlign(AParent.Parent.Align);
end;

procedure TfrxTBPanel.Paint;
begin
  with Canvas do
  begin
    Brush.Color:= clBtnFace;
    FillRect(Rect(0, 0, Width, Height));
    if csDesigning in ComponentState then
    begin
      Brush.Style:= bsClear;
      Pen.Style:= psDot;
      Pen.Color:= clBtnShadow;
      Rectangle(0, 0, Width-1, Height-1);
    end;
  end;
end;

{ TfrxFloatWindow }

constructor TfrxFloatWindow.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
end;

procedure TfrxFloatWindow.CreateParams(var Params:TCreateParams);
begin
  inherited;
  Params.WndParent:= TForm(Owner).Handle;
end;

procedure TfrxFloatWindow.Capture;
begin
  SetCaptureControl(Self);
  MouseDown(mbLeft, [], 0, 0);
end;

procedure TfrxFloatWindow.MouseDown(Button:TMouseButton; Shift:TShiftState;
  X, Y:Integer);
var
  p:TPoint;
begin
  GetCursorPos(p);
  FPoint:= p;
  Application.ProcessMessages;
  FDown:= True;
end;

procedure TfrxFloatWindow.MouseMove(Shift:TShiftState; X, Y:Integer);
var
  p:TPoint;
begin
  if not FDown or not (ssLeft in Shift) then Exit;
  GetCursorPos(p);
  SetBounds(Left+p.X-FPoint.X, Top+p.Y-FPoint.Y, Width, Height);

  FPoint:= p;
  if ToolBar.FindDock(Owner as TWinControl,
    (Owner as TWinControl).ScreenToClient(p)) then
    Exit;
end;

procedure TfrxFloatWindow.MouseUp(Button:TMouseButton; Shift:TShiftState;
  X, Y:Integer);
begin
  FDown:= False;
end;

procedure TfrxFloatWindow.FormDestroy(Sender:TObject);
begin
  if ToolBar<>nil then
    ToolBar.FWindow:= nil;
end;

procedure TfrxFloatWindow.FormPaint(Sender:TObject);
begin
  with Canvas do
  begin
    Pen.Color:= clGray;
    Pen.Width:= 3;
    Rectangle(1, 1, Width-1, Height-1);

    Brush.Color:= clGray;
    FillRect(Rect(3, 3, Width-3, 18));

    Pen.Width:= 1;
    Pen.Color:= clBtnFace;
    MoveTo(2, 3); LineTo(2, Height-3);
    MoveTo(3, 2); LineTo(Width-3, 2);
    MoveTo(Width-3, 3); LineTo(Width-3, Height-3);
    MoveTo(3, Height-3); LineTo(Width-3, Height-3);

    Font.Color:= clCaptionText;
    Font.Style:= [fsBold];
    TextOut(6, 3, Caption);
  end;
end;

procedure TfrxFloatWindow.CloseBtnClick(Sender:TObject);
begin
  Close;
end;

procedure TfrxFloatWindow.FormShow(Sender:TObject);
begin
  CloseBtn.SetBounds(Width-14, 4, 11, 11);
end;

{ TfrxDockSite }

type
  THackControl = class(TControl)
  end;

constructor TfrxDockSite.Create(AOwner:TComponent);
begin
  inherited;
  DockSite:= True;
  Align:= alLeft;
  Caption:= ' ';
  AutoSize:= True;
  BevelInner:= bvNone;
  BevelOuter:= bvNone;
  Width:= 10;

  FSplitter:= TGraphicControl.Create(Self);
  with FSplitter do
  begin
    Cursor:= crHSplit;
    Visible:= False;
    Width:= 3;
  end;
  THackControl(FSplitter).OnMouseDown:= SMouseDown;
  THackControl(FSplitter).OnMouseMove:= SMouseMove;
  THackControl(FSplitter).OnMouseUp:= SMouseUp;
end;

procedure TfrxDockSite.SetParent(AParent:TWinControl);
begin
  inherited;
  if Parent<>nil then
    FSplitter.Parent:= Parent;
end;

procedure TfrxDockSite.SetBounds(ALeft, ATop, AWidth, AHeight:Integer);
begin
  inherited;
  if FSplitter<>nil then
    if Align<>FSplitter.Align then
    begin
      if Align = alLeft then
        FSplitter.Left:= Left+Width+3 else
        FSplitter.Left:= Left-3;
      FSplitter.Align:= Align;
    end;
end;

procedure TfrxDockSite.DockDrop(Source:TDragDockObject; X, Y:Integer);
begin
  inherited;
  if Width < FPanelWidth then
    Source.Control.Width:= FPanelWidth;
  FSplitter.Show;
end;

procedure TfrxDockSite.DockOver(Source:TDragDockObject; X, Y:Integer;
  State:TDragState; var Accept:Boolean);
begin
  inherited;
  FPanelWidth:= Source.Control.Width;
end;

function TfrxDockSite.DoUnDock(NewTarget:TWinControl; Client:TControl):Boolean;
begin
  Result:= inherited DoUnDock(NewTarget, Client);
  if DockClientCount <= 1 then
    FSplitter.Hide;
end;

procedure TfrxDockSite.SMouseDown(Sender:TObject; Button:TMouseButton;
  Shift:TShiftState; X, Y:Integer);
begin
  FDown:= True;
end;

procedure TfrxDockSite.SMouseMove(Sender:TObject; Shift:TShiftState; X,
  Y:Integer);
begin
  if FDown then
  begin
    AutoSize:= False;
    if Align = alLeft then
      Width:= Width+X else
      Width:= Width-X;
    AutoSize:= True;
  end;
end;

procedure TfrxDockSite.SMouseUp(Sender:TObject; Button:TMouseButton;
  Shift:TShiftState; X, Y:Integer);
begin
  FDown:= False;
end;

procedure TfrxDockSite.ReloadDockedControl(const AControlName:string;
  var AControl:TControl);
begin
  AControl:= FindGlobalComponent(AControlName) as TControl;
end;

{----------------------------------------------------------------------------}

initialization
  FloatingToolBars:= TList.Create;
  frxRegRootKey:= 'Software\FastReport';

finalization
  DestroyToolbarList;
  FloatingToolBars.Free;

end.