frxdock.pas

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

      if (Align = alBottom) and (c.Top < 0) then
      begin
        ShiftNeeded:= True;
        L:=-c.Top+1;
        Inc(NewSize, L);
        break;
      end;
      if (Align = alTop) and (c.Top+c.Height > NewSize) then
      begin
        NewSize:= c.Top+c.Height+1;
        break;
      end;
      if (Align = alLeft) and (c.Left+c.Width > NewSize) then
      begin
        NewSize:= c.Left+c.Width+1;
        break;
      end;
    end;
  end;
  if ShiftNeeded then
    for i:= 0 to ControlCount-1 do
    begin
      c:= Controls[i];
      if c.Visible then
        if Align = alRight then
          c.Left:= c.Left+L
        else if Align = alBottom then
          c.Top:= c.Top+L;
    end;

  for i:= 0 to ControlCount-1 do
  begin
    c:= Controls[i];
    if c.Visible then
    begin
      if (Align = alRight) and (c.Left+c.Width > NewSize) then
        NewSize:= c.Left+c.Width;
      if (Align = alBottom) and (c.Top+c.Height > NewSize) then
        NewSize:= c.Top+c.Height;
    end;
  end;

  case Align of
    alTop:Height:= NewSize;
    alLeft:Width:= NewSize;
    alBottom:
      if Height < NewSize then
        SetBounds(0, Top-(NewSize-Height), Width, NewSize)
      else
        Height:= NewSize;
    alRight:
      if Width < NewSize then
        SetBounds(Left-(NewSize-Width), Top, NewSize, Height)
      else
        Width:= NewSize;
  end;
end;

procedure TfrxDock.Paint;
var
  R:TRect;
begin
  with Canvas do
  begin
    Brush.Color:= clBtnFace;
    R:= Rect(0, 0, Width, Height);
    FillRect(R);
    if csDesigning in ComponentState then
    begin
      Pen.Color:= clBtnShadow;
      Rectangle(0, 0, Width, Height);
    end;
  end;
end;

{--------------------------------------------------------------------------}
constructor TfrxDragBox.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Width:= 8;
  Height:= 8;
end;

procedure TfrxDragBox.Paint;
var
  R:TRect;
  i:Integer;
begin
  with Canvas do
  begin
    Brush.Color:= clBtnFace;
    R:= Rect(0, 0, Width, Height);
    FillRect(R);
    Pen.Color:= clBtnShadow;
  end;
  if (Parent as TfrxToolBar).ParentAlign = alTop then
  begin
    for i:= 0 to Height-1 do
      if i mod 2 = 1 then
      begin
        Canvas.MoveTo(2, i);
        Canvas.LineTo(5, i);
      end;
  end
  else if (Parent as TfrxToolBar).ParentAlign = alLeft then
  begin
    for i:= 0 to Width-1 do
      if i mod 2 = 1 then
      begin
        Canvas.MoveTo(i, 2);
        Canvas.LineTo(i, 5);
      end;
  end;
end;

procedure TfrxDragBox.MouseDown(Button:TMouseButton; Shift:TShiftState;
  X, Y:Integer);
var
  p:TPoint;
begin
  p:= ClientToScreen(Point(X, Y));
  p:= Parent.ScreenToClient(p);
  (Parent as TfrxToolBar).DoMouseDown(Self, Button, Shift, P.X, P.Y);
end;

procedure TfrxDragBox.MouseMove(Shift:TShiftState; X, Y:Integer);
var
  p:TPoint;
begin
  p:= ClientToScreen(Point(X, Y));
  p:= Parent.ScreenToClient(p);
  (Parent as TfrxToolBar).DoMouseMove(Self, Shift, P.X, P.Y);
end;

procedure TfrxDragBox.MouseUp(Button:TMouseButton; Shift:TShiftState;
  X, Y:Integer);
var
  p:TPoint;
begin
  p:= ClientToScreen(Point(X, Y));
  p:= Parent.ScreenToClient(p);
  (Parent as TfrxToolBar).DoMouseUp(Self, Button, Shift, P.X, P.Y);
end;

{--------------------------------------------------------------------------}
constructor TfrxToolBar.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Height:= 26;
  FDragBox:= TfrxDragBox.Create(Self);
  FDragBox.Parent:= Self;
  FDragBox.Align:= alLeft;
  FullRepaint:= False;
  OnMouseDown:= DoMouseDown;
  OnMouseMove:= DoMouseMove;
  OnMouseUp:= DoMouseUp;
  OnResize:= DoResize;
  FCanFloat:= True;
  FOrientation:= toAny;
end;

destructor TfrxToolBar.Destroy;
begin
  FDragBox.Free;
  if FWindow<>nil then
  begin
    Parent:= nil;
    FWindow.Hide;
    FWindow.Free;
  end;
  inherited Destroy;
end;

procedure TfrxToolBar.Loaded;
begin
  inherited Loaded;
  AdjustBounds;
end;

procedure TfrxToolBar.Paint;
var
  R:TRect;
begin
  with Canvas do
  begin
    Brush.Color:= clBtnFace;
    R:= Rect(0, 0, Width, Height);
    FillRect(R);
    if not IsFloat then
      Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  end;
end;

function TfrxToolBar.ParentAlign:TAlign;
begin
  Result:= Parent.Align;
  if Result = alBottom then Result:= alTop;
  if Result = alRight then Result:= alLeft;
end;

function TfrxToolBar.GetClientRect:TRect;
begin
  Result:= inherited GetClientRect;
  InflateRect(Result,-1,-1);
end;

function TfrxToolBar.GetVisible:Boolean;
begin
  if IsFloat then
    Result:= FWindow.Visible else
    Result:= Visible;
end;

procedure TfrxToolBar.SetVisible(Value:Boolean);
begin
  if IsFloat then
    FWindow.Visible:= Value else
    Visible:= Value;
end;

procedure TfrxToolBar.DockTo(Dock:TfrxDock; X, Y:Integer);
var
  oldParent:TfrxDock;
begin
  Hide;
  if FWindow<>nil then
  begin
    FWindow.Hide;
    FWindow.Release;
    Parent:= nil;
  end;
  FWindow:= nil;
  oldParent:= nil;
  if (Parent<>nil) and (Parent is TfrxDock) then
    oldParent:= Parent as TfrxDock;
  Parent:= Dock;
  if oldParent<>nil then
    oldParent.AdjustBounds;
  FIsFloat:= False;
  FDragBox.Show;
  RealignControls;
  Left:= X; Top:= Y;
  Show;
  AdjustBounds;
  Dock.AdjustBounds;
  RemoveFromToolbarList(Self);
end;

procedure TfrxToolBar.AddToDock(Dock:TfrxDock);
var
  X,Y:Integer;
begin
  X:= 0; Y:= 0;
  case Dock.Align of
    alTop:
      begin
        X:= 0; Y:= Dock.Height-1;
      end;
    alBottom:
      begin
        X:= 0; Y:=-Height+1;
      end;
    alLeft:
      begin
        X:= Dock.Width-1; Y:= 0;
      end;
    alRight:
      begin
        X:=-Width+1; Y:= 0;
      end;
  end;
  DockTo(Dock, X, Y);
end;

function TfrxToolBar.FindDock(AOwner:TWinControl; p:TPoint):Boolean;
var
  i:Integer;
  c:TControl;
  d:TfrxDock;
begin
  Result:= False;
  for i:= 0 to AOwner.ControlCount-1 do
  begin
    c:= AOwner.Controls[i];
    if c is TfrxDock then
      if (p.X >= c.Left) and (p.X <= c.Left+c.Width) and
         (p.Y >= c.Top) and (p.Y <= c.Top+c.Height) then
      begin
        with c as TfrxDock do
          if ((FOrientation = toHorzOnly) and (Align in [alLeft, alRight])) or
             ((FOrientation = toVertOnly) and (Align in [alTop, alBottom])) then
            break;
        d:= c as TfrxDock;
        if d.Align in [alTop,alBottom] then
        begin
          p:= Point(p.X-d.Left, d.Height-1);
          if p.X+Width > d.Width then
            p.X:= d.Width-Width;
          if p.X < 0 then p.X:= 0;
          if d.Align = alBottom then
            p.Y:=-Height+1;
        end
        else
        begin
          p:= Point(d.Width-1, p.Y-d.Top);
          if p.Y+Height > d.Height then
            p.Y:= d.Height-Height;
          if p.Y < 0 then p.Y:= 0;
          if d.Align = alRight then
            p.X:=-Height+1;
        end;
        DockTo(d, p.X, p.Y);
        SetCaptureControl(Self);
        DoMouseDown(Self, mbLeft, [], 0, 0);
        Result:= True;
        break;
      end;
  end;
end;

procedure TfrxToolBar.RealignControls;
var
  i, j, t:Integer;
  TempCtrl:TControl;
  Ctrls:Array[0..100] of TControl;
begin
  with FDragBox do
    SetBounds(0, 0, Width, Height);
  for i:= 0 to ControlCount-1 do
    Ctrls[i]:= Controls[i];
  for i:= 0 to ControlCount-1 do
    for j:= 0 to ControlCount-2 do
      if Ctrls[j].Visible then
        if Parent.Align in [alTop, alBottom, alNone] then
        begin
          if Ctrls[j].Left > Ctrls[j+1].Left then
          begin
            TempCtrl:= Ctrls[j+1];
            Ctrls[j+1]:= Ctrls[j];
            Ctrls[j]:= TempCtrl;
          end;
        end
        else
        begin
          if (Ctrls[j].Align in [alTop, alBottom]) and
             (Ctrls[j+1].Align in [alTop, alBottom]) and
             (Ctrls[j].Top > Ctrls[j+1].Top) then
          begin
            TempCtrl:= Ctrls[j];
            Ctrls[j]:= Ctrls[j+1];
            Ctrls[j+1]:= TempCtrl;
          end;
        end;
  case Parent.Align of
    alTop, alBottom, alNone:
    begin
      if Height > Width then
      begin
        t:= Width;
        Width:= Height;
        Height:= t;
      end;
      for t:= 0 to ControlCount-1 do
        if (Ctrls[t]<>nil) and Ctrls[t].Visible then
          if not (Ctrls[t].Align in [alLeft, alRight]) then
            if (Ctrls[t].Align = alBottom) then
              Ctrls[t].Align:= alRight
            else
            begin
              Ctrls[t].Left:= Ctrls[t].Top;
              Ctrls[t].Align:= alLeft;
            end;
    end;
    alLeft, alRight:
    begin
      if Width > Height then
      begin
        t:= Width;
        Width:= Height;
        Height:= t;
      end;
      for t:= 0 to ControlCount-1 do
        if (Ctrls[t]<>nil) and Ctrls[t].Visible then
          if not (Ctrls[t].Align in [alTop, alBottom]) then
            if (Ctrls[t].Align = alRight) then
              Ctrls[t].Align:= alBottom
            else
            begin
              Ctrls[t].Top:= Ctrls[t].Left;
              Ctrls[t].Align:= alTop;
            end;
    end;
  end;
end;

procedure TfrxToolBar.AdjustBounds;
var
  i, max:Integer;
  c:TControl;
begin
  RealignControls;
  max:= 0;
  for i:= 0 to ControlCount-1 do
  begin
    c:= Controls[i];
    if c.Visible then
      if Parent.Align in [alTop, alBottom, alNone] then
        Inc(max, c.Width)
      else
        Inc(max, c.Height);
  end;
  if Parent.Align in [alTop, alBottom, alNone] then
    Width:= max+4 else
    Height:= max+4;
end;

procedure TfrxToolBar.MakeFloat;
var
  p:TPoint;
begin
  FIsFloat:= True;
  GetCursorPos(p);
  FloatTo(p.X, p.Y);
  FWindow.Capture;
end;

procedure TfrxToolBar.FloatTo(X, Y:Integer);
var
  oldParent:TfrxDock;
begin