fr_dock.pas

FASTREPORT报表工具,可以迅速制作报表.

      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 TfrDock.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 TfrDragBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 11;
  Height := 11;
end;

procedure TfrDragBox.Paint;
var
  R: TRect;
begin
  with Canvas do
  begin
    Brush.Color := clBtnFace;
    R := Rect(0, 0, Width, Height);
    FillRect(R);
  end;
  if (Parent as TfrToolBar).ParentAlign = alTop then
  begin
    R := Rect(2, 0, 5, Height);
    Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
    R := Rect(5, 0, 8, Height);
    Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  end
  else if (Parent as TfrToolBar).ParentAlign = alLeft then
  begin
    R := Rect(0, 2, Width, 5);
    Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
    R := Rect(0, 5, Width, 8);
    Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  end;
end;

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

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

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


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

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

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

procedure TfrToolBar.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 TfrToolBar.ParentAlign: TAlign;
begin
  Result := Parent.Align;
  if Result = alBottom then Result := alTop;
  if Result = alRight then Result := alLeft;
end;

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

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

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

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

procedure TfrToolBar.AddToDock(Dock: TfrDock);
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 TfrToolBar.FindDock(AOwner: TWinControl; p: TPoint): Boolean;
var
  i: Integer;
  c: TControl;
  d: TfrDock;
begin
  Result := False;
  for i := 0 to AOwner.ControlCount-1 do
  begin
    c := AOwner.Controls[i];
    if c is TfrDock 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 TfrDock do
          if ((FOrientation = toHorzOnly) and (Align in [alLeft, alRight])) or
             ((FOrientation = toVertOnly) and (Align in [alTop, alBottom])) then
            break;
        d := c as TfrDock;
        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 TfrToolBar.RealignControls;
var
  i, j, t: Integer;
  TempCtrl: TControl;
  Ctrls: Array[0..100] of TControl;
begin
  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 TfrToolBar.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 TfrToolBar.MakeFloat;
var